Commit | Line | Data |
---|---|---|
eb57651e TL |
1 | #!/usr/bin/perl |
2 | # | |
3 | # Copyright (C) 2014 Todd Lyons | |
4 | # License GPLv2: GNU GPL version 2 | |
5 | # <http://www.gnu.org/licenses/old-licenses/gpl-2.0.html> | |
6 | # | |
7 | # This script emulates a proxy which uses Proxy Protocol to communicate | |
8 | # to a backend server. It should be run from an IP which is configured | |
9 | # to be a Proxy Protocol connection (or not, if you are testing error | |
10 | # scenarios) because Proxy Protocol specs require not to fall back to a | |
11 | # non-proxied mode. | |
12 | # | |
13 | # The script is interactive, so when you run it, you are expected to | |
14 | # perform whatever conversation is required for the protocol being | |
15 | # tested. It uses STDIN/STDOUT, so you can also pipe output to/from the | |
16 | # script. It was originally written to test Exim's Proxy Protocol | |
17 | # code, and it could be tested like this: | |
18 | # | |
19 | # swaks --pipe 'perl proxy_protocol_client.pl --server-ip | |
20 | # host.internal.lan' --from user@example.com --to user@example.net | |
21 | # | |
22 | use strict; | |
23 | use warnings; | |
4d3d955f | 24 | BEGIN { pop @INC if $INC[-1] eq '.' }; |
eb57651e TL |
25 | use IO::Select; |
26 | use IO::Socket; | |
27 | use Getopt::Long; | |
28 | use Data::Dumper; | |
29 | ||
30 | my %opts; | |
31 | GetOptions( \%opts, | |
32 | 'help', | |
33 | '6|ipv6', | |
34 | 'dest-ip:s', | |
35 | 'dest-port:i', | |
36 | 'source-ip:s', | |
37 | 'source-port:i', | |
38 | 'server-ip:s', | |
39 | 'server-port:i', | |
40 | 'version:i' | |
41 | ); | |
42 | &usage() if ($opts{help} || !$opts{'server-ip'}); | |
43 | ||
44 | my ($dest_ip,$source_ip,$dest_port,$source_port); | |
45 | my %socket_map; | |
46 | my $status_line = "Testing Proxy Protocol Version " . | |
47 | ($opts{version} ? $opts{version} : '2') . | |
48 | ":\n"; | |
49 | ||
50 | # All ip's and ports are in network byte order in version 2 mode, but are | |
51 | # simple strings when in version 1 mode. The binary_pack_*() functions | |
52 | # return the required data for the Proxy Protocol version being used. | |
53 | ||
54 | # Use provided source or fall back to www.mrball.net | |
55 | $source_ip = $opts{'source-ip'} ? binary_pack_ip($opts{'source-ip'}) : | |
56 | $opts{6} ? | |
57 | binary_pack_ip("2001:470:d:367::50") : | |
58 | binary_pack_ip("208.89.139.252"); | |
59 | $source_port = $opts{'source-port'} ? | |
60 | binary_pack_port($opts{'source-port'}) : | |
61 | binary_pack_port(43118); | |
62 | ||
63 | $status_line .= "-> " if (!$opts{version} || $opts{version} == 2); | |
64 | ||
65 | # Use provided dest or fall back to mail.exim.org | |
66 | $dest_ip = $opts{'dest-ip'} ? binary_pack_ip($opts{'dest-ip'}) : | |
67 | $opts{6} ? | |
68 | binary_pack_ip("2001:630:212:8:204:23ff:fed6:b664") : | |
69 | binary_pack_ip("131.111.8.192"); | |
70 | $dest_port = $opts{'dest-port'} ? | |
71 | binary_pack_port($opts{'dest-port'}) : | |
72 | binary_pack_port(25); | |
73 | ||
74 | # The IP and port of the Proxy Protocol backend real server being tested, | |
75 | # don't binary pack it. | |
76 | my $server_ip = $opts{'server-ip'}; | |
77 | my $server_port = $opts{'server-port'} ? $opts{'server-port'} : 25; | |
78 | ||
79 | my $s = IO::Select->new(); # for socket polling | |
80 | ||
81 | sub generate_preamble { | |
82 | my @preamble; | |
83 | if (!$opts{version} || $opts{version} == 2) { | |
84 | @preamble = ( | |
85 | "\x0D\x0A\x0D\x0A\x00\x0D\x0A\x51\x55\x49\x54\x0A", # 12 byte v2 header | |
36719342 TL |
86 | "\x21", # top 4 bits declares v2 |
87 | # bottom 4 bits is command | |
eb57651e | 88 | $opts{6} ? "\x21" : "\x11", # inet6/4 and TCP (stream) |
36719342 | 89 | $opts{6} ? "\x00\x24" : "\x00\x0b", # 36 bytes / 12 bytes |
eb57651e TL |
90 | $source_ip, |
91 | $dest_ip, | |
92 | $source_port, | |
93 | $dest_port | |
94 | ); | |
95 | } | |
96 | else { | |
97 | @preamble = ( | |
98 | "PROXY", " ", # Request proxy mode | |
99 | $opts{6} ? "TCP6" : "TCP4", " ", # inet6/4 and TCP (stream) | |
100 | $source_ip, " ", | |
101 | $dest_ip, " ", | |
102 | $source_port, " ", | |
103 | $dest_port, | |
104 | "\x0d\x0a" | |
105 | ); | |
106 | $status_line .= join "", @preamble; | |
107 | } | |
108 | print "\n", $status_line, "\n"; | |
109 | print "\n" if (!$opts{version} || $opts{version} == 2); | |
110 | return @preamble; | |
111 | } | |
112 | ||
113 | sub binary_pack_port { | |
114 | my $port = shift(); | |
115 | if ($opts{version} && $opts{version} == 1) { | |
116 | return $port | |
117 | if ($port && $port =~ /^\d+$/ && $port > 0 && $port < 65536); | |
118 | die "Not a valid port: $port"; | |
119 | } | |
120 | $status_line .= $port." "; | |
121 | $port = pack "S", $port; | |
122 | return $port; | |
123 | } | |
124 | ||
125 | sub binary_pack_ip { | |
126 | my $ip = shift(); | |
127 | if ( $ip =~ m/\./ && !$opts{6}) { | |
128 | if (IP4_valid($ip)) { | |
129 | return $ip if ($opts{version} && $opts{version} == 1); | |
130 | $status_line .= $ip.":"; | |
131 | $ip = pack "C*", split /\./, $ip; | |
132 | } | |
133 | else { die "Invalid IPv4: $ip"; } | |
134 | } | |
135 | elsif ($ip =~ m/:/ && $opts{6}) { | |
136 | $ip = pad_ipv6($ip); | |
137 | if (IP6_valid($ip)) { | |
138 | return $ip if ($opts{version} && $opts{version} == 1); | |
139 | $status_line .= $ip.":"; | |
140 | $ip = pack "S>*", map hex, split /:/, $ip; | |
141 | } | |
142 | else { die "Invalid IPv6: $ip"; } | |
143 | } | |
144 | else { die "Mismatching IP families passed: $ip"; } | |
145 | return $ip; | |
146 | } | |
147 | ||
148 | sub pad_ipv6 { | |
149 | my $ip = shift(); | |
150 | my @ip = split /:/, $ip; | |
151 | my $segments = scalar @ip; | |
152 | return $ip if ($segments == 8); | |
153 | $ip = ""; | |
154 | for (my $count=1; $count <= $segments; $count++) { | |
155 | my $block = $ip[$count-1]; | |
156 | if ($block) { | |
157 | $ip .= $block; | |
158 | $ip .= ":" unless $count == $segments; | |
159 | } | |
160 | elsif ($count == 1) { | |
161 | # Somebody passed us ::1, fix it, but it's not really valid | |
162 | $ip = "0:"; | |
163 | } | |
164 | else { | |
165 | $ip .= join ":", map "0", 0..(8-$segments); | |
166 | $ip .= ":"; | |
167 | } | |
168 | } | |
169 | return $ip; | |
170 | } | |
171 | ||
172 | sub IP6_valid { | |
173 | my $ip = shift; | |
174 | $ip = lc($ip); | |
175 | return 0 unless ($ip =~ /^[0-9a-f:]+$/); | |
176 | my @ip = split /:/, $ip; | |
177 | return 0 if (scalar @ip != 8); | |
178 | return 1; | |
179 | } | |
180 | ||
181 | sub IP4_valid { | |
182 | my $ip = shift; | |
183 | $ip =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/; | |
184 | foreach ($1,$2,$3,$4){ | |
185 | if ($_ <256 && $_ >0) {next;} | |
186 | return 0; | |
187 | } | |
188 | return 1; | |
189 | } | |
190 | ||
191 | sub go_interactive { | |
192 | my $continue = 1; | |
193 | while($continue) { | |
194 | # Check for input on both ends, recheck every 5 sec | |
195 | for my $socket ($s->can_read(5)) { | |
196 | my $remote = $socket_map{$socket}; | |
197 | my $buffer; | |
198 | my $read = $socket->sysread($buffer, 4096); | |
199 | if ($read) { | |
200 | $remote->syswrite($buffer); | |
201 | } | |
202 | else { | |
203 | $continue = 0; | |
204 | } | |
205 | } | |
206 | } | |
207 | } | |
208 | ||
209 | sub connect_stdin_to_proxy { | |
210 | my $sock = new IO::Socket::INET( | |
211 | PeerAddr => $server_ip, | |
212 | PeerPort => $server_port, | |
213 | Proto => 'tcp' | |
214 | ); | |
215 | ||
216 | die "Could not create socket: $!\n" unless $sock; | |
217 | # Add sockets to the Select group | |
218 | $s->add(\*STDIN); | |
219 | $s->add($sock); | |
220 | # Tie the sockets together using this hash | |
221 | $socket_map{\*STDIN} = $sock; | |
222 | $socket_map{$sock} = \*STDOUT; | |
223 | return $sock; | |
224 | } | |
225 | ||
226 | sub usage { | |
227 | chomp(my $prog = `basename $0`); | |
228 | print <<EOF; | |
229 | Usage: $prog [required] [optional] | |
230 | Required: | |
231 | --server-ip IP of server to test proxy configuration, | |
232 | a hostname is ok, but for only this setting | |
233 | Optional: | |
234 | --server-port Port server is listening on (default 25) | |
235 | --6 IPv6 source/dest (default IPv4), if none specified, | |
236 | some default, reverse resolvable IP's are used for | |
237 | the source and dest ip/port | |
238 | --dest-ip Public IP of the proxy server | |
239 | --dest-port Port of public IP of proxy server | |
240 | --source-ip IP connecting to the proxy server | |
241 | --source-port Port of IP connecting to the proxy server | |
242 | --help This output | |
243 | EOF | |
244 | exit; | |
245 | } | |
246 | ||
247 | ||
248 | my $sock = connect_stdin_to_proxy(); | |
249 | my @preamble = generate_preamble(); | |
250 | print $sock @preamble; | |
251 | go_interactive(); |