experiments/protocol-v3/server.pl

#!/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	#!/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	warn "[socket] connect\n";
54	Storable::store_fd( { ping => 1 }, $new );
55	} else {
56	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	warn "<<<< ", dump($data), $/;
64	if ( $data->{repl} ) {
65	Storable::store_fd( { repl => $data }, $sock );
66	}
67	}
68	}
69	}
70	}