src/util/proxy_protocol_client.pl

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