lib/Sack/Server.pm

#!/usr/bin/perl

use warnings;
use strict;

use IO::Socket::INET;
use IO::Select;

use Data::Dump qw(dump);
use Storable qw();

my $listen_port = 4444;

my $node_path = '/tmp/client.pl';

my $lsn = IO::Socket::INET->new(Listen => 1, LocalPort => $listen_port, Reuse => 1) or exit;
my $sel = IO::Select->new($lsn);

sub fork_node {
        my ( $port, $host ) = @_;

        if ( my $pid = fork ) {
                # parent

                return $port;

        } elsif ( ! defined $pid ) {
                warn "can't fork $host $port";
                return;
        } else {
                # child
                my $cmd = qq|ssh -R $port:127.0.0.1:$listen_port $host $node_path $port|;
                warn "# exec: $cmd\n";
                exec $cmd;
        }
}

my $node_port = 4000;

foreach my $host ( qw/localhost tab.lan llin.lan/ ) {
        system "scp client.pl $host:$node_path";
        fork_node( $node_port++, $host );
}

my $session;

while (1) {
        for my $sock ($sel->can_read(1)) {
                if ($sock == $lsn) {
                        my $new = $lsn->accept;
                        $sel->add($new);
                        $session->{$new} = $new->peerhost;
                        warn "[socket] connect\n";
                        Storable::store_fd( { ping => 1 }, $new );
                } else {
                        my $data = eval { Storable::fd_retrieve( $sock ) };
                        if ( $@ ) {
                                delete $session->{$sock};
                                warn "[socket] disconnect: $@\n";
                                $sel->remove($sock);
                                $sock->close;
                        } else {
                                warn "<<<< ", dump($data), $/;
                                if ( $data->{repl} ) {
                                        Storable::store_fd( { repl => $data }, $sock );
                                }
                        }
                }
        }
}
1	dpavlin	163	#!/usr/bin/perl
2
3			use warnings;
4			use strict;
5
6			use IO::Socket::INET;
7			use IO::Select;
8
9			use Data::Dump qw(dump);
10			use Storable qw();
11
12			my $listen_port = 4444;
13
14			my $node_path = '/tmp/client.pl';
15
16			my $lsn = IO::Socket::INET->new(Listen => 1, LocalPort => $listen_port, Reuse => 1) or exit;
17			my $sel = IO::Select->new($lsn);
18
19			sub fork_node {
20			my ( $port, $host ) = @_;
21
22			if ( my $pid = fork ) {
23			# parent
24
25			return $port;
26
27			} elsif ( ! defined $pid ) {
28			warn "can't fork $host $port";
29			return;
30			} else {
31			# child
32			my $cmd = qq\|ssh -R $port:127.0.0.1:$listen_port $host $node_path $port\|;
33			warn "# exec: $cmd\n";
34			exec $cmd;
35			}
36			}
37
38			my $node_port = 4000;
39
40			foreach my $host ( qw/localhost tab.lan llin.lan/ ) {
41			system "scp client.pl $host:$node_path";
42			fork_node( $node_port++, $host );
43			}
44
45			my $session;
46
47			while (1) {
48			for my $sock ($sel->can_read(1)) {
49			if ($sock == $lsn) {
50			my $new = $lsn->accept;
51			$sel->add($new);
52			$session->{$new} = $new->peerhost;
53	dpavlin	164	warn "[socket] connect\n";
54	dpavlin	163	Storable::store_fd( { ping => 1 }, $new );
55			} else {
56	dpavlin	165	my $data = eval { Storable::fd_retrieve( $sock ) };
57			if ( $@ ) {
58			delete $session->{$sock};
59			warn "[socket] disconnect: $@\n";
60			$sel->remove($sock);
61			$sock->close;
62			} else {
63	dpavlin	163	warn "<<<< ", dump($data), $/;
64	dpavlin	164	if ( $data->{repl} ) {
65			Storable::store_fd( { repl => $data }, $sock );
66			}
67	dpavlin	163	}
68			}
69			}
70			}