diff options
author | Florian Pritz <bluewind@xinu.at> | 2013-10-29 23:15:25 +0100 |
---|---|---|
committer | Florian Pritz <bluewind@xinu.at> | 2013-10-29 23:15:25 +0100 |
commit | d68cf8c1dd6ab79b4e17851e7766a5c30161072e (patch) | |
tree | 954491e162d9664c3ad3f8ce947fe268613c3454 /socket-multiplexer.pl | |
parent | a171f2b36d8e8ce56b375a18d911303cc5e9d09e (diff) | |
download | bin-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-x | socket-multiplexer.pl | 74 |
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; |