| 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 | BEGIN { pop @INC if $INC[-1] eq '.' }; |
| 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 |
| 86 | "\x21", # top 4 bits declares v2 |
| 87 | # bottom 4 bits is command |
| 88 | $opts{6} ? "\x21" : "\x11", # inet6/4 and TCP (stream) |
| 89 | $opts{6} ? "\x00\x24" : "\x00\x0b", # 36 bytes / 12 bytes |
| 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(); |