vcs.maemo.org Git - dh-make-perl/blob - dev/arm/libnet-ssleay-perl/libnet-ssleay-perl-1.35/examples/stdio_bulk.pl

   1 #!/usr/local/bin/perl
   2 # stdio_bulk.pl - 8.6.1998, Sampo Kellomaki <sampo@iki.fi>
   3 # Send tons of stuff over SSL connected by STDIO pipe.
   4 # This also demonstrates how you can communicate via arbitrary stream, not
   5 # just a TCP one.
   6 # $Id: stdio_bulk.pl,v 1.3 2003/06/13 21:14:41 sampo Exp $
   7
   8 use Socket;
   9 use Net::SSLeay qw(die_now die_if_ssl_error);
  10 $ENV{RND_SEED} = '1234567890123456789012345678901234567890';
  11 Net::SSLeay::randomize();
  12 Net::SSLeay::load_error_strings();
  13 Net::SSLeay::SSLeay_add_ssl_algorithms();
  14 #$Net::SSLeay::trace = 2;
  15
  16 ($cert_pem, $key_pem, $how_much) = @ARGV;      # Read command line
  17
  18 $ctx = Net::SSLeay::CTX_new() or die_now("Failed to create SSL_CTX $!");
  19 Net::SSLeay::set_server_cert_and_key($ctx, $cert_pem, $key_pem) or die "key";
  20
  21 pipe RS, WC or die "pipe 1 ($!)";
  22 pipe RC, WS or die "pipe 2 ($!)";
  23 select WC; $| = 1;
  24 select WS; $| = 1;
  25 select STDOUT;
  26 $| = 1;
  27
  28 if ($child_pid = fork) {
  29     print "$$: I'm the server for child $child_pid\n";
  30     $ssl = Net::SSLeay::new($ctx)     or die_now "$$: new ($ssl) ($!)";
  31
  32     Net::SSLeay::set_rfd($ssl, fileno(RS));
  33     Net::SSLeay::set_wfd($ssl, fileno(WS));
  34
  35     Net::SSLeay::accept($ssl) and die_if_ssl_error("$$: ssl accept: $!");
  36     print "$$: Cipher `" . Net::SSLeay::get_cipher($ssl) . "'\n";
  37     #print "$$: " . Net::SSLeay::dump_peer_certificate($ssl);
  38
  39     $got = Net::SSLeay::ssl_read_all($ssl,$how_much)
  40         or die "$$: ssl read failed";
  41     print "$$: got " . length($got) . " bytes\n";
  42     Net::SSLeay::ssl_write_all($ssl, \$got) or die "$$: ssl write failed";
  43     $got = '';
  44
  45     Net::SSLeay::free ($ssl);               # Tear down connection
  46     Net::SSLeay::CTX_free ($ctx);
  47
  48     wait;  # wait for child to read the stuff
  49
  50     close WS;
  51     close RS;
  52     print "$$: server done ($?).\n"
  53         . (($? >> 8) ? "ERROR\n" : "OK\n");
  54     exit;
  55 }
  56
  57 print "$$: I'm the child.\n";
  58 sleep 1;  # Give server time to get its act together
  59
  60 $ssl = Net::SSLeay::new($ctx) or die_now("Failed to create SSL $!");
  61 Net::SSLeay::set_rfd($ssl, fileno(RC));
  62 Net::SSLeay::set_wfd($ssl, fileno(WC));
  63 Net::SSLeay::connect($ssl);
  64 die_if_ssl_error("ssl connect");
  65
  66 print "$$: Cipher `" . Net::SSLeay::get_cipher($ssl) . "'\n";
  67 print "$$: " . Net::SSLeay::dump_peer_certificate($ssl);
  68
  69 # Exchange data
  70
  71 $data = 'B' x $how_much;
  72 Net::SSLeay::ssl_write_all($ssl, \$data) or die "$$: ssl write failed";
  73 $got = Net::SSLeay::ssl_read_all($ssl, $how_much)
  74     or die "$$: ssl read failed";
  75
  76 Net::SSLeay::free ($ssl);               # Tear down connection
  77 Net::SSLeay::CTX_free ($ctx);
  78 close WC;
  79 close RC;
  80 exit ($data ne $got);
  81
  82 __END__