git.maemo.org Git - dh-make-perl/blob - dev/arm/libnet-ssleay-perl/libnet-ssleay-perl-1.35/examples/https-proxy-snif.pl

   1 #!/usr/bin/perl
   2 # 5.6.1998, Sampo Kellomaki <sampo@iki.fi>
   3
   4 $usage = <<USAGE
   5 Usage: ./https-proxy-snif.pl *listen_port* *dest_machine* *dest_port*
   6 E.g:   ./https-proxy-snif.pl 4443 www.bacus.pt 443
   7
   8 This proxy allows you to observe the protocol talked by your browser
   9 to remote https server. Useful for debugging http headers etc sent
  10 in this dialogue as well as capturing the requests for later
  11 automating the task.
  12
  13 The proxying is not perfect: the client will see different
  14 certificate than actually sent by server. You will be able to launch
  15 only one simultaneous connection (set you browser to attempt only
  16 one at a time) because it is iterative server, keep-alives are not
  17 handled at all, etc.
  18
  19 Remeber: you must have cert.pem and key.pem in the current working directory.
  20
  21 Example:
  22     ./https-proxy-snif.pl 4443 www.bacus.pt 443
  23 Then enter https://localhost:4443/ in Netscape Location prompt.
  24 USAGE
  25     ;
  26
  27 die $usage unless $#ARGV == 2;
  28 ($listen_port, $dest_host, $dest_port) = @ARGV;
  29 $trace = 0;
  30
  31 use Socket;
  32 use Net::SSLeay qw(sslcat die_now die_if_ssl_error);
  33 #$Net::SSLeay::trace = 3; # Super verbose debugging
  34 Net::SSLeay::load_error_strings();
  35 Net::SSLeay::SSLeay_add_ssl_algorithms();
  36
  37 $our_ip = "\0\0\0\0";  # Bind to all interfaces
  38 $sockaddr_template = 'S n a4 x8';
  39 $our_serv_params = pack ($sockaddr_template, &AF_INET, $listen_port, $our_ip);
  40
  41 socket (S, &AF_INET, &SOCK_STREAM, 0)  or die "socket: $!";
  42 bind (S, $our_serv_params)             or die "bind:   $!";
  43 listen (S, 5)                          or die "listen: $!";
  44 $ctx = Net::SSLeay::CTX_new ()         or die_now("CTX_new ($ctx): $!");
  45 Net::SSLeay::set_server_cert_and_key($ctx, 'cert.pem', 'key.pem') or die "key";
  46
  47 while (1) {
  48     print "Accepting connections...\n";
  49     ($addr = accept (NS, S))           or die "accept: $!";
  50     select (NS); $| = 1; select (STDOUT);  # Piping hot!
  51
  52     ($af,$client_port,$client_ip) = unpack($sockaddr_template,$addr);
  53     @inetaddr = unpack('C4',$client_ip);
  54     print "$af connection from "
  55         . join ('.', @inetaddr) . ":$client_port\n";
  56
  57     ### We now have a network connection, lets fire up SSLeay...
  58
  59     $ssl = Net::SSLeay::new($ctx)      or die_now("SSL_new ($ssl): $!");
  60     #print &Net::SSLeay::get_cipler_list($ssl, 32000);
  61     &Net::SSLeay::set_fd($ssl, fileno(NS));
  62
  63     $err = Net::SSLeay::accept($ssl);
  64     die_if_ssl_error("ssl accept: ($!)");
  65     print "Cipher `" . Net::SSLeay::get_cipher($ssl) . "'\n";
  66
  67     ### Connected. Get the HTTP request and wrap it for transport
  68     ### to remote host.
  69
  70     $got = Net::SSLeay::read($ssl) or die "$$: ssl read failed";
  71     print "Got `$got' (" . length ($got) . " chars)\n" if $trace;
  72
  73     $got =~ s/Host:\s+\S+\r?\n/Host: $dest_host:$dest_port\r\n/i;
  74
  75     print "Will send `$got' (" . length ($got)
  76         . " chars) to $dest_host:$dest_port\n";
  77
  78     ### Set up a client socket
  79
  80     $dest_port = getservbyname  ($dest_port, 'tcp')
  81         unless $dest_port =~ /^\d+$/;
  82     $dest_serv_ip = gethostbyname ($dest_host);
  83     $dest_serv_params  = pack ($sockaddr_template, &AF_INET,
  84                                $dest_port, $dest_serv_ip);
  85
  86     socket  (SS, &AF_INET, &SOCK_STREAM, 0) or die "client: socket: $!";
  87     connect (SS, $dest_serv_params)         or die "client: connect: $!";
  88     select  (SS); $| = 1; select (STDOUT);
  89
  90     ### Do SSL handshake with remote server
  91
  92     $ssl2 = Net::SSLeay::new($ctx) or die_now("client: SSL_new ($ssl2)");
  93     &Net::SSLeay::set_fd($ssl2, fileno(SS));
  94     &Net::SSLeay::set_cipher_list($ssl2, "DES-CBC3-MD5:RC4-MD5");
  95     &Net::SSLeay::print_errs();
  96     $err = Net::SSLeay::connect($ssl2);
  97     &Net::SSLeay::print_errs();
  98     print "client: Cipher '" . Net::SSLeay::get_cipher($ssl2) . "'\n";
  99     &Net::SSLeay::print_errs();
 100
 101     ### Exchange data with remote server
 102
 103     $err = Net::SSLeay::write($ssl2, $got) or die "client: write: $!";
 104     &Net::SSLeay::print_errs();
 105
 106     shutdown SS, 1;
 107
 108     $reply = Net::SSLeay::read($ssl2);
 109     &Net::SSLeay::print_errs();
 110
 111     print "Remote replied `$reply' (" . length ($reply) . " chars)\n";
 112
 113     &Net::SSLeay::free ($ssl2);
 114     &Net::SSLeay::print_errs();
 115     close SS;
 116
 117     ### Reply to our client
 118
 119     &Net::SSLeay::write ($ssl, $reply) or die "write: $!";
 120     &Net::SSLeay::print_errs();
 121
 122     (&Net::SSLeay::write ($ssl, <<HTTP) or die "write: $!") if 0;
 123 HTTP/1.0 200 It works. Cool.
 124 Content-Type: text/html
 125
 126 <title>foo</title>
 127 <h1>Bar Cool</h1>
 128 HTTP
 129     ;
 130
 131     &Net::SSLeay::free ($ssl);           # Tear down connection
 132     close NS;
 133 }
 134
 135 __END__