File: 35hook_dual.t

package info (click to toggle)
libnet-proxy-perl 0.12-5
  • links: PTS
  • area: main
  • in suites: squeeze, wheezy
  • size: 304 kB
  • ctags: 66
  • sloc: perl: 777; sh: 84; makefile: 44
file content (139 lines) | stat: -rw-r--r-- 4,934 bytes parent folder | download | duplicates (5)
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
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
use Test::More;
use strict;
use warnings;
use Net::Proxy;
use t::Util;

my @lines = (
    [   "thwapp qunckkk aiieee flrbbbbb clunk zlonk\n",
        "thwapp qunckkk aiieee flrbbbbb clunk zowie\n",
        "thwapp qunckkk aiieee flrbbbbb clunk zlonk\n",
    ],
    [   "cr_r_a_a_ck splatt crr_aaack awkkkkkk clunk zlopp ooooff pow\n",
        "cr_r_a_a_ck splatt crr_aaack awkkkkkk clunk zowie ooooff pow\n",
        "cr_r_a_a_ck splatt crr_aaack awkkkkkk clunk zlonk ooooff pow\n",
    ],
    [   "zgruppp clange clank_est whack zlopp pow awk swish\n",
        "zowie clange clank_est whack zowie pow awk swish\n",
        "zlonk clange clank_est whack zlonk pow awk swish\n",
    ],
    [   "bonk ouch_eth swa_a_p clank_est clash whack splatt zamm\n",
        "bonk ouch_eth swa_a_p clank_est clash whack splatt zowie\n",
        "bonk ouch_eth swa_a_p clank_est clash whack splatt zlonk\n",
    ],
);

my $tests = 2 * ( @lines + 1 );
plan tests => $tests;

init_rand(@ARGV);
my @free = find_free_ports(3);

SKIP: {
    skip 'Not enough available ports', $tests if @free < 3;

    my ( $proxy_port, $ssl_port, $ssh_port ) = @free;
    my $pid = fork;

SKIP: {

        skip "fork failed", $tests if !defined $pid;
        if ( $pid == 0 ) {

            # the child process runs the proxy
            my $proxy = Net::Proxy->new(
                {   in => {
                        type    => 'dual',
                        port    => $proxy_port,
                        timeout => 0.5,
                        hook    => sub {
                            my ( $dataref, $sock, $connector ) = @_;
                            $$dataref =~ s/\bz\w+/zowie/g;
                        },
                        server_first => {
                            type => 'tcp',
                            port => $ssh_port,
                        },
                        client_first => {
                            type => 'tcp',
                            port => $ssl_port,
                            hook => sub {
                                my ( $dataref, $sock, $connector ) = @_;
                                $$dataref =~ s/\bz\w+/zlonk/g;
                            },
                        }
                    },
                    out => { type => 'dummy' },
                }
            );

            $proxy->register();

            Net::Proxy->set_verbosity( $ENV{NET_PROXY_VERBOSITY} || 0 );
            Net::Proxy->mainloop(2);
            exit;
        }
        else {

            # wait for the proxy to set up
            sleep 1;

            # the parent process does the testing
            my $ssh_listener = listen_on_port($ssh_port)
                or skip "Couldn't start the ssh server: $!", $tests;
            my $ssl_listener = listen_on_port($ssl_port)
                or skip "Couldn't start the ssl server: $!", $tests;
            my ( $client, $server );

            # try 'ssh'
            $client = connect_to_port($proxy_port)
                or skip_fail "Couldn't start the client: $!", $tests;
            sleep 1;    # wait for the timeout
            $server = $ssh_listener->accept()
                or skip_fail "Proxy didn't connect: $!", $tests;

            # transmit data
            my $orig_client = $client;
            for my $line (@lines) {
                print $server $line->[0];    # real server speaks first
                my $trans = $client ne $orig_client;
                is( <$client>, $line->[$trans],
                    'SSH line received '
                        . ( 'intact', 'transformed' )[$trans] );
                ( $client, $server ) = random_swap( $client, $server );
            }

            # close connections
            $server->close();
            is_closed( $client, 'peer' );
            $client->close();

            # try ssl
            $client = connect_to_port($proxy_port)
                or skip_fail "Couldn't start the client: $!", $tests;
            print $client $lines[0][0];    # real client speaks first

            $server = $ssl_listener->accept()
                or skip_fail "Proxy didn't connect: $!", $tests;
            is( <$server>, $lines[0][1],
                "First SSL line received transformed (client)" );

            # transmit the rest of the data
            shift @lines;
            $orig_client = $client;
            for my $line (@lines) {
                ( $client, $server ) = random_swap( $client, $server );
                my $trans = $client eq $orig_client ? 1 : 2;
                print $client $line->[0];    # real client speaks first
                is( <$server>, $line->[$trans],
                    'SSL line received transformed '
                        . ( '', '(client)', '(server)' )[$trans] );
            }

            # close connections
            $client->close();
            is_closed( $server, 'peer' );
            $server->close();
        }
    }
}