@@ -5,42 +5,154 @@ use Test::More;
55use Proc::Daemon;
66use constant PIDFILE => ' /tmp/socksserver.pid'
77
8- my $d = Proc::Daemon-> new( pid_file => PIDFILE, work_dir => ' .'
8+ my $d = Proc::Daemon-> new(
9+ pid_file => PIDFILE,
10+ work_dir => ' .'
11+ );
912die ' Already running' unless ( 0 == ( -r PIDFILE ? $d -> Status(PIDFILE) : 0 ) );
1013
1114my $k = $d -> Init();
1215unless ( 0 == $k ) {
1316 plan tests => 1;
1417 ok $k , " Started Daemon at $k "
18+ sleep 2;
19+ until (
20+ my $s = IO::Socket::Socks-> new(
21+ ProxyAddr => ' 127.0.0.1'
22+ ProxyPort => 9051,
23+ ConnectAddr => ' nulloooooooooooo.onion'
24+ ConnectPort => ' 25'
25+ )
26+ )
27+ {
28+ warn $IO::Socket::Socks::SOCKS_ERROR ;
29+ sleep 2;
30+ }
1531 exit 0;
1632}
1733
18- my ( $output , $failure_output , $todo_output , ) ;
34+ my $output ;
1935my $builder = Test::More-> builder;
2036$builder -> output( \$output );
21- $builder -> failure_output( \$failure_output );
22- $builder -> todo_output( \$todo_output );
37+ $builder -> failure_output( \$output );
38+ $builder -> todo_output( \$output );
2339
2440my $tests = 0;
2541
2642my %tree = (
43+ ' manualhttpdooooo.onion:80' => sub {
44+ my $client = shift ;
45+ use HTTP::Headers;
46+ my $h = HTTP::Headers-> new;
47+ my ( $hname , $hdata );
48+ while ( ( $_ = <$client > ) =~ / ^[\r ]?$ /
49+ if ( $hname != undef ) {
50+ if (/ ^[ \t ]/
51+ $hdata .= $_ ;
52+ } else {
53+ $h -> push_header( $hname => $hdata );
54+ / ^([^:]*):?(.*)$ /
55+ $hname = $1 ;
56+ $hdata = $2 ;
57+ }
58+ } else {
59+ / ^([^:]*):?(.*)$ /
60+ $hname = $1 ;
61+ $hdata = $2 ;
62+ }
63+ }
64+ $h -> push_header( $hname => $hdata );
65+ },
66+ ' perlhttpdooooooo.onion:80' => sub {
67+ my $client = shift ;
68+ use HTTP::Daemon();
69+
70+ # This should not work.
71+ HTTP::Daemon::ClientConn::get_request($client );
72+ },
73+ ' echooooooooooooo.onion:80' => sub {
74+ my $client = shift ;
75+ my $len = 1;
76+ do {
77+ my $request = ' '
78+ while ( 0 < $len && $request !~ / \n /m
79+ $len = $client -> read ( my $b , 1 );
80+ $request .= $b ;
81+ }
82+ if ( 0 < $len ) {
83+ $tests ++;
84+ ok $request =~ m %\r ?\n % im ' Have HTTP 1.1'
85+ if ( $request =~ m %[a-z2-7] {16}\\ .onion% i
86+ $tests ++;
87+ ok $request =~ m %[a-z2-7] {16}\\ .onion/% i
88+ ' Correct hostname in request line'
89+ }
90+ }
91+ while ( 0 < $len && $request !~ / \n\r ?\n /m
92+ $len = $client -> read ( my $b , 1 );
93+ $request .= $b ;
94+ }
95+ if ( 0 < $len ) {
96+ if ( $request =~ / ^Host:\s *([a-z2-7]{16}\\ .onion[^\r\n ]*)/mi
97+ $tests ++;
98+ my $h = $1 ;
99+ ok $request =~ m %\s *[a-z2-7] {16}\\ .onion\r ?\n /% i
100+ " Correct hostname in host header: $h "
101+ }
102+ if ( $request =~ / ^Cookie:([^\r\n ]*)/mi
103+ $tests ++;
104+ my $h = $1 ;
105+ fail " Correct cookie domain: $h "
106+ }
107+ if ( $request =~ / ^Content-Length:\s *([1-9][0-9]*)/mi
108+ my ( $b , $clen ) = ( undef , $1 );
109+ while ( 0 < $clen ) {
110+ $len = $client -> read ( $b , $clen );
111+ $request .= $b ;
112+ $clen -= $len ;
113+ }
114+ }
115+ }
116+ my $clen = length $request ;
117+ $client -> print (
118+ " HTTP/1.1 200 Success\r\n Content-Type: text/plain\r\n Content-Length: $clen \r\n\r\n $request "
119+ );
120+ } while ( 0 != $len );
121+ },
122+ ' proxy2httpdooooo.onion:80' => sub {
123+ my $client = shift ;
124+
125+ # Open connection to httpd and enter bi-directional pass-through.
126+ # Ends when socket closes.
127+ },
128+ ' nulloooooooooooo.onion:25' => sub {
129+ my $client = shift ;
130+ },
27131 ' exit:25' => sub {
28132 my $client = shift ;
29133 done_testing($tests );
30- $client -> send ( $output . $failure_output . $todo_output );
31- $client -> close ();
134+ $client -> print ($output );
32135 exit 0;
33136 },
34137);
35138
36139use IO::Socket::Socks ' :constants'
37140
38- my $s = IO::Socket::Socks-> new(
39- ProxyAddr => ' localhost'
40- ProxyPort => 9051,
41- Listen => 1,
42- SocksResolve => 0,
43- ) or die $IO::Socket::Socks::SOCKS_ERROR ;
141+ $IO::Socket::Socks::SOCKS4_RESOLVE = 1;
142+ $IO::Socket::Socks::SOCKS5_RESOLVE = 0;
143+ my $s ;
144+ until (
145+ $s = IO::Socket::Socks-> new(
146+ SocksVersion => [ 4, 5 ],
147+ ProxyAddr => ' 127.0.0.1'
148+ ProxyPort => 9051,
149+ Listen => 1,
150+ )
151+ )
152+ {
153+ diag $IO::Socket::Socks::SOCKS_ERROR ;
154+ sleep 3;
155+ }
44156
45157ok $s , ' Have socks server'
46158$tests ++;
@@ -49,20 +161,42 @@ while (1) {
49161 my $client = $s -> accept();
50162
51163 unless ($client ) {
52- print STDERR " ERROR: $IO::Socket::Socks::SOCKS_ERROR \n "
164+ fail $IO::Socket::Socks::SOCKS_ERROR ;
165+ $tests ++;
53166 next ;
54167 }
55168
56169 my $command = $client -> command();
57170 if ( $command -> [0] == CMD_CONNECT ) {
58-
59- # Handle the CONNECT
60- $client -> command_reply( REPLY_SUCCESS, $command -> [1], $command -> [2] );
171+ my $host = $client -> version == 4 ? " 0.0.0.1" $command -> [1];
172+ if ( exists $tree {" $command ->[1]:$command ->[2]"
173+
174+ # Handle the CONNECT
175+ $client -> command_reply(
176+ $client -> version == 4 ? REQUEST_GRANTED : REPLY_SUCCESS,
177+ $host , $command -> [2] );
178+ $client -> autoflush(1);
179+ $tree {" $command ->[1]:$command ->[2]" $client );
180+ } else {
181+ diag " Not found in tree: $command ->[1]:$command ->[2]"
182+ diag $client -> command_reply(
183+ $client -> version == 4
184+ ? REQUEST_FAILED
185+ : REPLY_ADDR_NOT_SUPPORTED,
186+ $host , $command -> [2]
187+ );
188+ }
189+ } else {
190+ diag ' Unknowen command from socks:'
191+ use Data::Dumper;
192+ diag Dumper $command ;
193+ $client -> command_reply( $client -> version == 4
194+ ? REQUEST_FAILED
195+ : REPLY_CMD_NOT_SUPPORTED,
196+ $command -> [1], $command -> [2] );
61197 }
62198
63- $tree {" $command ->[1]:$command ->[2]" $client )
64- if ( exists $tree {" $command ->[1]:$command ->[2]"
65-
199+ sleep 2;
66200 $client -> close ();
67201}
68202
0 commit comments