vcs.maemo.org Git - pkg-perl/blob - deb-src/libnet-ssleay-perl/libnet-ssleay-perl-1.35/examples/cli-cert.pl

   1 #!/usr/local/bin/perl
   2 # cli-cert.pl
   3 # 8.6.1998, originally written as stdio_bulk.pl Sampo Kellomaki <sampo@iki.fi>
   4 # 8.12.2001, adapted to test client certificates
   5 #
   6 # Contact server using client side certificate. Demonstrates how to
   7 # set up the client and how to make the server request the certificate.
   8 # This also demonstrates how you can communicate via arbitrary stream, not
   9 # just a TCP one.
  10 # $Id: cli-cert.pl,v 1.2 2003/06/13 21:14:41 sampo Exp $
  11
  12 use Socket;
  13 use Net::SSLeay qw(die_now die_if_ssl_error);
  14 $ENV{RND_SEED} = '1234567890123456789012345678901234567890';
  15 Net::SSLeay::randomize();
  16 Net::SSLeay::load_error_strings();
  17 Net::SSLeay::SSLeay_add_ssl_algorithms();
  18 #$Net::SSLeay::trace = 2;
  19
  20 ($cert_pem, $key_pem, $cert_dir) = @ARGV;      # Read command line
  21 $how_much = 10000;
  22
  23 ### Note: the following initialization is common for both client
  24 ### and the server. In particular, it is important that VERIFY_PEER
  25 ### is sent on the server as well, because otherwise the client
  26 ### certificate will never be requested.
  27
  28 $ctx = Net::SSLeay::CTX_new() or die_now("Failed to create SSL_CTX $!");
  29 Net::SSLeay::set_cert_and_key($ctx, $cert_pem, $key_pem) or die "key";
  30 Net::SSLeay::CTX_load_verify_locations($ctx, '', $cert_dir)
  31     or die_now("CTX load verify loc=`$cert_dir' $!");
  32 Net::SSLeay::CTX_set_verify($ctx, &Net::SSLeay::VERIFY_PEER, \&verify);
  33 die_if_ssl_error('callback: ctx set verify');
  34
  35 pipe RS, WC or die "pipe 1 ($!)";
  36 pipe RC, WS or die "pipe 2 ($!)";
  37 select WC; $| = 1;
  38 select WS; $| = 1;
  39 select STDOUT;
  40 $| = 1;
  41
  42 if ($child_pid = fork) {
  43     print "$$: I'm the server for child $child_pid\n";
  44     $ssl = Net::SSLeay::new($ctx)     or die_now "$$: new ($ssl) ($!)";
  45
  46     Net::SSLeay::set_rfd($ssl, fileno(RS));
  47     Net::SSLeay::set_wfd($ssl, fileno(WS));
  48
  49     Net::SSLeay::accept($ssl) and die_if_ssl_error("$$: ssl accept: $!");
  50     print "$$: Cipher `" . Net::SSLeay::get_cipher($ssl) . "'\n";
  51     print "$$: client cert: " . Net::SSLeay::dump_peer_certificate($ssl);
  52
  53     $got = Net::SSLeay::ssl_read_all($ssl,$how_much)
  54         or die "$$: ssl read failed";
  55     print "$$: got " . length($got) . " bytes\n";
  56     Net::SSLeay::ssl_write_all($ssl, \$got) or die "$$: ssl write failed";
  57     $got = '';
  58
  59     Net::SSLeay::free ($ssl);               # Tear down connection
  60     Net::SSLeay::CTX_free ($ctx);
  61
  62     wait;  # wait for child to read the stuff
  63
  64     close WS;
  65     close RS;
  66     print "$$: server done ($?).\n"
  67         . (($? >> 8) ? "ERROR\n" : "OK\n");
  68     exit;
  69 }
  70
  71 print "$$: I'm the child.\n";
  72 sleep 1;  # Give server time to get its act together
  73
  74 $ssl = Net::SSLeay::new($ctx) or die_now("Failed to create SSL $!");
  75 Net::SSLeay::set_rfd($ssl, fileno(RC));
  76 Net::SSLeay::set_wfd($ssl, fileno(WC));
  77 Net::SSLeay::connect($ssl);
  78 die_if_ssl_error("ssl connect");
  79
  80 print "$$: Cipher `" . Net::SSLeay::get_cipher($ssl) . "'\n";
  81 print "$$: server cert: " . Net::SSLeay::dump_peer_certificate($ssl);
  82
  83 # Exchange data
  84
  85 $data = 'B' x $how_much;
  86 Net::SSLeay::ssl_write_all($ssl, \$data) or die "$$: ssl write failed";
  87 $got = Net::SSLeay::ssl_read_all($ssl, $how_much)
  88     or die "$$: ssl read failed";
  89
  90 Net::SSLeay::free ($ssl);               # Tear down connection
  91 Net::SSLeay::CTX_free ($ctx);
  92 close WC;
  93 close RC;
  94 exit ($data ne $got);
  95
  96 sub verify {
  97     return 1;
  98     my ($ok, $x509_store_ctx) = @_;
  99     print "$$: **** Verify 2 called ($ok)\n";
 100     my $x = Net::SSLeay::X509_STORE_CTX_get_current_cert($x509_store_ctx);
 101     if ($x) {
 102         print "$$: Certificate:\n";
 103             print "  Subject Name: "
 104                 . Net::SSLeay::X509_NAME_oneline(
 105                     Net::SSLeay::X509_get_subject_name($x))
 106                     . "\n";
 107             print "  Issuer Name:  "
 108                 . Net::SSLeay::X509_NAME_oneline(
 109                     Net::SSLeay::X509_get_issuer_name($x))
 110                     . "\n";
 111     }
 112     $callback_called++;
 113     return 1;
 114 }
 115
 116 __END__