1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
|
#!perl
use strict;
use warnings;
use Net::SSLeay;
use Socket;
use IO::Socket::SSL;
use IO::Socket::SSL::Intercept;
do './testlib.pl' || do './t/testlib.pl' || die "no testlib";
print "1..8\n";
my @pid;
END { kill 9,@pid }
my $server = IO::Socket::SSL->new(
LocalAddr => '127.0.0.1',
LocalPort => 0,
SSL_cert_file => 'certs/server-cert.pem',
SSL_key_file => 'certs/server-key.pem',
Listen => 10,
);
ok($server,"server ssl socket");
my $saddr = $server->sockhost.':'.$server->sockport;
defined( my $pid = fork ) or die $!;
exit( server()) if ! $pid; # child -> server()
push @pid,$pid;
close($server);
my $proxy = IO::Socket::INET->new(
LocalAddr => '127.0.0.1',
LocalPort => 0,
Listen => 10,
Reuse => 1,
);
sys_ok($proxy,"proxy tcp socket");
my $paddr = $proxy->sockhost.':'.$proxy->sockport;
defined( $pid = fork ) or die $!;
exit( proxy()) if ! $pid; # child -> proxy()
push @pid,$pid;
close($proxy);
# connect to server, check certificate
my $cl = IO::Socket::SSL->new(
PeerAddr => $saddr,
SSL_verify_mode => 1,
SSL_ca_file => 'certs/my-ca.pem',
);
ssl_ok($cl,"ssl connected to server");
ok( $cl->peer_certificate('subject') =~ m{server\.local}, "subject w/o mitm");
ok( $cl->peer_certificate('issuer') =~ m{IO::Socket::SSL Demo CA},
"issuer w/o mitm");
# connect to proxy, check certificate
$cl = IO::Socket::SSL->new(
PeerAddr => $paddr,
SSL_verify_mode => 1,
SSL_ca_file => 'certs/proxyca.pem',
);
ssl_ok($cl,"ssl connected to proxy");
ok( $cl->peer_certificate('subject') =~ m{server\.local}, "subject w/ mitm");
ok( $cl->peer_certificate('issuer') =~ m{IO::Socket::SSL::Intercept},
"issuer w/ mitm");
sub server {
while (1) {
my $cl = $server->accept or next;
sleep(1);
}
}
sub proxy {
my $mitm = IO::Socket::SSL::Intercept->new(
proxy_cert_file => 'certs/proxyca.pem',
proxy_key_file => 'certs/proxyca.pem',
);
while (1) {
my $toc = $proxy->accept or next;
my $tos = IO::Socket::SSL->new(
PeerAddr => $saddr,
SSL_verify_mode => 1,
SSL_ca_file => 'certs/my-ca.pem',
) or die "failed connect to server: $!, $SSL_ERROR";
my ($cert,$key) = $mitm->clone_cert($tos->peer_certificate);
$toc = IO::Socket::SSL->start_SSL( $toc,
SSL_server => 1,
SSL_cert => $cert,
SSL_key => $key,
) or die "ssl upgrade client failed: $SSL_ERROR";
sleep(1);
}
}
sub ok {
my ($what,$msg) = @_;
print "not " if ! $what;
print "ok # $msg\n";
}
sub sys_ok {
my ($what,$msg) = @_;
if ( $what ) {
print "ok # $msg\n";
} else {
print "not ok # $msg - $!\n";
exit
}
}
sub ssl_ok {
my ($what,$msg) = @_;
if ( $what ) {
print "ok # $msg\n";
} else {
print "not ok # $msg - $SSL_ERROR\n";
exit
}
}
|
