add basic serial port locking

diff --git a/CurrentCost.pl b/CurrentCost.pl
index 52f235c..adfcf84 100755 (executable)
--- a/CurrentCost.pl
+++ b/CurrentCost.pl
@@ -6,6 +6,7 @@
 
 use strict;
 use Device::SerialPort qw( :PARAM :STAT 0.07 );
+use SerialLock;
 
 my $BAUD = "57600";
 my $RRD = "/var/lib/collectd/rrd/currentcost.rrd";
@@ -56,6 +57,16 @@ die "unknown argument" if (defined $a);
 
 die "No RRD ($RRD)" unless -f $RRD;
 
+die "Cannot lock port" unless 1==slock($PORT);
+
+sub cleanup {
+       #print "unlocking $PORT\n";
+       sunlock($PORT);
+       exit 0;
+}
+$SIG{'__DIE__'} = \&cleanup;
+$SIG{'INT'} = \&cleanup;
+
 my $ob = Device::SerialPort->new($PORT);
 unless (-c $PORT && defined($ob)) {
        die "no serial port!";

diff --git a/SerialLock.pm b/SerialLock.pm
new file mode 100644 (file)
index 0000000..4ea480e
--- /dev/null
+++ b/SerialLock.pm
@@ -0,0 +1,95 @@
+#
+
+package SerialLock;
+
+use strict;
+use warnings;
+our $VERSION = '0.1';
+use base 'Exporter';
+our @EXPORT = qw/slock sunlock/;
+use Carp;
+
+=head1 SerialLock
+
+SerialLock - serial port locking
+
+=head1 SYNOPSIS
+       use SerialLock;
+       lock("/dev/ttyUSB0");
+       lock("/dev/ttyUSB0", 1); # fails
+       lock("/dev/ttyUSB0", 0); # waits forever
+       unlock("/dev/ttyUSB0");
+
+=head2 Functions
+
+=head3 lock(port)
+
+Locks the given port and returns 1. If the port is already locked, returns 0.
+
+=head3 unlock(port)
+
+Unlocks the given port.
+You may want to set up a die handler to call this.
+
+=cut
+
+use Fcntl qw(:flock SEEK_END);
+
+sub slock($) {
+       my $dev = shift;
+       unless (-c $dev) {
+               carp "No such device";
+               return 0;
+       }
+       $dev =~ s,/dev/,,;
+       my $lck = "/var/lock/LCK..".$dev;
+
+       return 0 if -f $lck;
+       # TODO determine whether lock is stale
+
+       unless (open(LF, "+>$lck")) {
+               carp "cannot open $lck";
+               return 0;
+       }
+       my $rv=0;
+
+       if (flock(LF, LOCK_EX)) {
+               print LF "$$ $0 $<\n";
+               $rv=1;
+       } else {
+               carp "cannot flock $lck";
+       }
+
+       close LF;
+       return $rv;
+}
+
+sub sunlock($) {
+       my $dev = shift;
+       unless (-c $dev) {
+               carp "No such device";
+               return 0;
+       }
+       $dev =~ s,/dev/,,;
+       my $lck = "/var/lock/LCK..".$dev;
+
+       return 0 unless -f $lck;
+
+       unless (open(LF, "+<$lck")) {
+               carp "cannot open $lck";
+               return 0;
+       }
+       my $rv=0;
+
+       if (flock(LF, LOCK_EX)) {
+               $rv= (unlink $lck);
+               carp "cannot unlink $lck" unless 1==$rv;
+       } else {
+               carp "cannot flock $lck";
+       }
+
+       close LF;
+       return $rv;
+}
+
+1;