name : simulate_proxy.pl use strict; use warnings; use IO::Socket::SSL; use IO::Socket::SSL::Utils; use IO::Select; use Socket 'MSG_PEEK'; use Getopt::Long qw(:config posix_default bundling); my $DEBUG; { my $addr = '0.0.0.0:8080'; my $ciphers; my $version; my $deny_tls12 = my $deny_tls11 = 0; my $issuer; my $wildcards = 0; GetOptions( 'h|help' => sub { usage() }, 'd|debug' => \$DEBUG, 'C|ciphers=s' => \$ciphers, 'V|version=s' => \$version, 'deny-tls12' => \$deny_tls12, 'deny-tls11' => \$deny_tls11, 'wildcards=i' => \$wildcards, 'issuer=s' => \$issuer, ); sub usage { print STDERR <<USAGE; Usage: $0 [options] [listen-ip:port] Simulates Proxy, listens on listen-ip:port (default $addr). Will automatically distinguish between normal HTTP requests, proxy requests and direct SSL connects Options: -h|--help - this usage -d|--debug - some debugging messages -C|--ciphers C - specify the ciphers to use instead of builtin -V|--version V - specify SSL version to use instead of builtin --issuer F - use CA in file F (containing certificate and key in PEM) as issuer instead of builtin --deny-tls12 - close connection on TLSv12 handshakes from client --deny-tls11 - close connection on TLSv11 handshakes from client --wildcards N - generate certificate with N left wildcards (default 0) USAGE exit(1); } $addr = shift if @ARGV; usage() if @ARGV; my $data = $issuer ? do { open( my $fh,'<',$issuer ) or die "open $issuer: $!"; local $/; <$fh> } : do { local $/; <DATA> }; my $issuer_cert = PEM_string2cert($data) or die "no issuer cert found"; my $issuer_key = PEM_string2key($data) or die "no issuer key found"; proxy_server( $addr, deny_tls12 => $deny_tls12, deny_tls11 => $deny_tls11, $ciphers ? ( SSL_cipher_list => $ciphers ):(), $version ? ( SSL_version => $version ):(), issuer_cert => $issuer_cert, issuer_key => $issuer_key, wildcards => $wildcards, ); } # ---------------------------------------------------------------------------- # simulate Proxy # ---------------------------------------------------------------------------- sub proxy_server { my ($addr,%args) = @_; my %sslargs; $sslargs{$_} = delete $args{$_} for grep { m{^SSL_} } keys %args; # dynamically create server certs my $wildcards = delete $args{wildcards} || 0; my $issuer_cert = delete $args{issuer_cert}; my $issuer_key = delete $args{issuer_key}; my $get_cert = do { my %cache; sub { my $host = my $cn = shift; $cn =~s{(^|\.)([\w\-]+)}{$1*} for(1..$wildcards); if ( $cache{$cn} ) { debug("reusing cert for $cn ($host) wildcards=$wildcards"); } else { debug("creating cert for $cn ($host) wildcards=$wildcards"); $cache{$cn} = [ CERT_create( subject => { commonName => $cn }, issuer_cert => $issuer_cert, issuer_key => $issuer_key, )]; } return @{ $cache{$cn} }; } }; debug("listen on $addr"); my $srv = IO::Socket::INET->new( LocalAddr => $addr, Listen => 1, Reuse => 1 ) or die $!; my $cl; while (1) { ACCEPT: $cl = undef; debug("waiting for request..."); $cl = $srv->accept or next; # peek into socket to determine if this is SSL or not # minimal request is "GET / HTTP/1.1\n\n" my $buf = ''; _peek($cl,\$buf,15) or do { debug("failed to get data from client"); goto ACCEPT; }; my $ssl_host = undef; if ( $buf =~m{\A[A-Z]{3,} } ) { # looks like HTTP $buf = ''; } else { # does not look like HTTP, assume direct SSL $ssl_host = "direct.ssl.access"; } SSL_UPGRADE: my $got_ciphers = ''; if ( $ssl_host ) { if ( $args{deny_tls12} || $args{deny_tls11} ) { _peek($cl,\$buf,11) or do { debug("failed to get client hello"); goto ACCEPT; }; if ( $args{deny_tls12} && $buf =~m{^.{9}\x03\x03}s ) { debug("got TLSv1.2 handshake - cut!"); goto ACCEPT; } elsif ( $args{deny_tls11} && $buf =~m{^.{9}\x03\x02}s ) { debug("got TLSv1.1 handshake - cut!"); goto ACCEPT; } } my ($cert,$key) = $get_cert->($ssl_host); debug("upgrade to SSL with certificate for $ssl_host"); IO::Socket::SSL->start_SSL( $cl, SSL_server => 1, SSL_cert => $cert, SSL_key => $key, %sslargs, ) or do { debug("SSL handshake failed: $SSL_ERROR"); goto ACCEPT; }; $got_ciphers = $cl->get_cipher; } REQUEST: # read header my $req = ''; while (<$cl>) { $_ eq "\r\n" and last; $req .= $_; } if ( $req =~m{\ACONNECT ([^\s:]+)} ) { if ( $ssl_host ) { debug("CONNECT inside SSL tunnel - cut"); next ACCEPT; } $ssl_host = $1; # simulate proxy print $cl "HTTP/1.0 200 ok\r\n\r\n"; debug("got proxy request to establish tunnel: CONNECT $ssl_host"); goto SSL_UPGRADE; } my ($met,$ver,$hdr) = $req =~m{\A([A-Z]+) \S+ HTTP/(1\.[01])\r?\n(.*)\Z}s or do { debug("bad request $req"); goto ACCEPT; }; $hdr =~s{\r?\n([ \t])}{$1}g; # continuation lines my $rqbody = ''; my $rqchunked; if ( $ver eq '1.1' and $hdr =~m{^Transfer-Encoding: *chunked}mi ) { $rqchunked = 1; debug("chunked request body"); while (1) { my $h = <$cl>; my $len = $h =~m{\A([\da-fA-F]+)\s*(?:;.*)?\r?\n\Z} && hex($1) // do { debug("bad chunking header in request body"); goto ACCEPT }; if ($len) { my $n = read($cl,$rqbody,$len,length($rqbody)); if ( $n != $len ) { debug("eof inside chunk in request body"); goto ACCEPT; } } $h = <$cl>; $h =~m{\A\r?\n\Z} or do { debug("expected newline after chunk, got '$h'"); goto ACCEPT; }; last if ! $len; } } elsif ( my $len = $hdr=~m{^Content-length: *(\d+)}mi && $1 ) { debug("request body with content-length=$len"); my $n = read($cl,$rqbody,$len); if ( $n != $len ) { debug("eof while reading request body, got $n of $len bytes"); goto ACCEPT; } } my $body = ( $ssl_host ? "SSL_HOST: $ssl_host\nCIPHERS: $got_ciphers\n": "NO SSL\n" ) . "---------\n" . $req; if ( $rqchunked ) { $body .= "--------- (chunked) body size=".(length($rqbody))."------\n$rqbody\n"; } elsif ( $rqbody ne '' ) { $body .= "--------- body size=".(length($rqbody))." ------\n$rqbody\n"; } print $cl "HTTP/1.0 200 ok\r\nContent-type: text/plain\r\n". "Content-length: ".length($body)."\r\n". "\r\n". $body; } } sub debug { $DEBUG or return; my $msg = shift; $msg = sprintf($msg,@_) if @_; print STDERR "DEBUG: $msg\n"; } sub _peek { my ($cl,$rbuf,$len) = @_; while (length($$rbuf)<$len) { my $lbuf; if ( ! IO::Select->new($cl)->can_read(30) or ! defined recv($cl,$lbuf,20,MSG_PEEK)) { return; } $$rbuf .= $lbuf; } return 1; } # ---------------------------------------------------------------------------- # this was used to create CA cert # ---------------------------------------------------------------------------- #| use IO::Socket::SSL::Utils; #| my ($cacert,$key) = CERT_create( CA => 1, #| subject => { organizationName => 'genua mbh', commonName => 'Test CA' } #| ); #| print PEM_cert2string($cacert).PEM_key2string($key); __DATA__ -----BEGIN CERTIFICATE----- MIICVjCCAb+gAwIBAgIFAIbQ7t4wDQYJKoZIhvcNAQEFBQAwJjEQMA4GA1UEAxMH VGVzdCBDQTESMBAGA1UEChMJZ2VudWEgbWJoMB4XDTEzMTAyMzA4MjI0MFoXDTE0 MTAyMzA4MjI0MFowJjEQMA4GA1UEAxMHVGVzdCBDQTESMBAGA1UEChMJZ2VudWEg bWJoMIGfMA0GCSqGSIb3DQEBAQUAA4GNADCBiQKBgQDBD9oBSf8pueg3BxNdf6Mm PKGmh46R0O3xNOE/HfXc9Z2WxgLEX4PaYMwdzgFuPcVTZycI5NdhM53yydnTilsX eFct5D2Bz3faiIOB2WnoiNft15YGCdyeue9kf2NkYRLs3eBQDPeU/cXKyfcHb1dS QpQNKiyL/ono1c0kZRoP3wIDAQABo4GPMIGMMB0GA1UdDgQWBBReUpKjaiNSYfZT X2+XsfQsYZef0zAfBgNVHSMEGDAWgBReUpKjaiNSYfZTX2+XsfQsYZef0zA8BgNV HSMENTAzoSqkKDAmMRAwDgYDVQQDEwdUZXN0IENBMRIwEAYDVQQKEwlnZW51YSBt YmiCBQCG0O7eMAwGA1UdEwQFMAMBAf8wDQYJKoZIhvcNAQEFBQADgYEAg9H/7umS 4bKSEyyCzzqyR1vf735wPnUmTL7NrduPCaT/bLVRPmDwhyRrpNVedICxyU3NK9fc r0Fj12oBBbvLACm8Xfnt23x8IbnGXIz7n5aTFvrv2l3rVMkZOFqo/DFtFnfYGuY8 /N4DtEHG21dwpMrDxXE1pAE5IY+vRMlNEtA= -----END CERTIFICATE----- -----BEGIN PRIVATE KEY----- MIICdgIBADANBgkqhkiG9w0BAQEFAASCAmAwggJcAgEAAoGBAMEP2gFJ/ym56DcH E11/oyY8oaaHjpHQ7fE04T8d9dz1nZbGAsRfg9pgzB3OAW49xVNnJwjk12EznfLJ 2dOKWxd4Vy3kPYHPd9qIg4HZaeiI1+3XlgYJ3J6572R/Y2RhEuzd4FAM95T9xcrJ 9wdvV1JClA0qLIv+iejVzSRlGg/fAgMBAAECgYBK8Hs/6tg3+yjPS1jR/zx2GCzr Nk05/q6N5WfVlyybg1+TafMjBKxqtQ4mN5PIlgOldzHouuN7oIyb9IwwF9F5YeUb 8WTK1iLzTmrcfFJmtRyj0ITF5gb+r6PhPxGr4yt8f9bzaIj7G57a+QT9gXKnLKao AN4Vxx51MAPvMeREYQJBAPstPjOyWxLsT8yBphlok2w4MnWQASsrflrL6MzuJYOq zpVxQF3lwSHukhoUhDoyee9miY2kcB9H9PoXWbq4io8CQQDExOwxTlYnyqyvKjFq vXchcNZ4wCU5sf6pzXF2l6Hb6eCuqYlarMu2JN0h7CC0Jq4qr1BalgesS3WUT1M8 dw2xAkB6Kfgd5rp7CqqJOemSZBWHxhFssnyPBZlwCcsRmSZv0qylbK60vKFhooo2 2xGwyIob0RBH7tmFrVbOKHtA4K6rAkA3sRi8t9RQvN91UHbeJDP0phA96vxeQQ+4 Faq4iyBHswFhziBPJrsdmX9xG3kCJDSFZktS6EXRsSXdTTpc0cFxAkEAo5GS9dAY 7WLAcqNDUorHhFOcZouCYX3LRssikmwc0/dvc9DjwqpNqF1BHT6ucX0pqdQI+fp1 VHJ5f4e/SUTV3g== -----END PRIVATE KEY----- ;