blob: 2290fd260d216cecc4b0b1299df4acc8fcaea24b (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
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;
|
