summaryrefslogtreecommitdiffstats
path: root/socket-multiplexer.pl
diff options
context:
space:
mode:
authorFlorian Pritz <bluewind@xinu.at>2013-10-29 23:15:25 +0100
committerFlorian Pritz <bluewind@xinu.at>2013-10-29 23:15:25 +0100
commitd68cf8c1dd6ab79b4e17851e7766a5c30161072e (patch)
tree954491e162d9664c3ad3f8ce947fe268613c3454 /socket-multiplexer.pl
parenta171f2b36d8e8ce56b375a18d911303cc5e9d09e (diff)
downloadbin-d68cf8c1dd6ab79b4e17851e7766a5c30161072e.tar.gz
bin-d68cf8c1dd6ab79b4e17851e7766a5c30161072e.tar.xz
add socket-multiplexer.pl
Signed-off-by: Florian Pritz <bluewind@xinu.at>
Diffstat (limited to 'socket-multiplexer.pl')
-rwxr-xr-xsocket-multiplexer.pl74
1 files changed, 74 insertions, 0 deletions
diff --git a/socket-multiplexer.pl b/socket-multiplexer.pl
new file mode 100755
index 0000000..2290fd2
--- /dev/null
+++ b/socket-multiplexer.pl
@@ -0,0 +1,74 @@
+#!/usr/bin/perl -T
+use strict;
+use warnings;
+
+use AnyEvent;
+use AnyEvent::Socket;
+use AnyEvent::Handle;
+use Fcntl qw(:flock);
+use File::Basename;
+
+if ($#ARGV != 0) {
+ print STDERR "usage: ".basename($0)." <socket path>\n";
+ print STDERR "\n";
+ print STDERR "muliplex incoming messages on the socket to all clients\n";
+
+ exit 1;
+}
+
+our $sock_path = $ARGV[0];
+($sock_path) = ($sock_path =~ /^(.+)$/);
+
+sub signal_handler {
+ my ($signal) = @_;
+ print STDERR "Got signal: $signal\n";
+
+ for my $xid (keys %main::conns) {
+ $main::conns{$xid}->destroy;
+ }
+ $main::sock->destroy if $main::sock;
+
+ if ($main::lock) {
+ unlink $main::sock_path or warn "Failed to remove socket: $!\n";
+ flock($main::lock, LOCK_UN) or warn "Failed to release lock: $!\n";
+ close $main::lock or warn "Failed to close lock file: $!\n";
+ unlink "$main::sock_path.lock" or warn "Failed to remove lock file: $!\n";
+ }
+ exit(1);
+}
+
+use sigtrap 'handler', \&signal_handler, 'normal-signals';
+$SIG{PIPE} = 'IGNORE';
+
+open (our $lock, ">", "$sock_path.lock") or die "Can't open lock file: $!\n";
+flock($lock, LOCK_EX ^ LOCK_NB) or die "Failed to aquire lock: $!\n";
+
+my %conns;
+my $i = 0;
+
+our $sock_guard = tcp_server "unix/", $sock_path, sub {
+ my ($fh) = @_;
+ my $hdl = AnyEvent::Handle->new(
+ fh => $fh,
+ );
+
+ my $id = $i++;
+ $conns{$id} = $hdl;
+
+ $hdl->on_error(sub {
+ delete $conns{$id};
+ });
+
+ my @reader; @reader = (line => sub {
+ my $line = $_[1];
+
+ # send to everyone else
+ for my $xid (grep {$_ ne $id} keys %conns) {
+ $conns{$xid}->push_write("$line\n");
+ }
+ $hdl->push_read(@reader);
+ });
+ $hdl->push_read(@reader);
+};
+
+AnyEvent->condvar->recv;