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