debian experimental exim-daemon-heavy config
[exim.git] / 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 #
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();