git.maemo.org Git - pkg-perl/blob - deb-src/libio-socket-ssl-perl/libio-socket-ssl-perl-1.16/example/ssl_client.pl

   1 #
   2 # a test client for testing IO::Socket::SSL-class's behavior
   3 # (marko.asplund at kronodoc.fi).
   4 #
   5 # $Id: ssl_client.pl,v 1.7 2002/01/04 08:45:12 aspa Exp $.
   6 #
   7
   8
   9 use strict;
  10 use IO::Socket::SSL;
  11
  12 my ($v_mode, $sock, $buf);
  13
  14 if($ARGV[0] eq "DEBUG") { $IO::Socket::SSL::DEBUG = 1; }
  15
  16 # Check to make sure that we were not accidentally run in the wrong
  17 # directory:
  18 unless (-d "certs") {
  19     if (-d "../certs") {
  20         chdir "..";
  21     } else {
  22         die "Please run this example from the IO::Socket::SSL distribution directory!\n";
  23     }
  24 }
  25
  26 if(!($sock = IO::Socket::SSL->new( PeerAddr => 'localhost',
  27                                    PeerPort => '9000',
  28                                    Proto    => 'tcp',
  29                                    SSL_use_cert => 1,
  30                                    SSL_verify_mode => 0x01,
  31                                    SSL_passwd_cb => sub { return "opossum" },
  32                                  ))) {
  33     warn "unable to create socket: ", &IO::Socket::SSL::errstr, "\n";
  34     exit(0);
  35 } else {
  36     warn "connect ($sock).\n" if ($IO::Socket::SSL::DEBUG);
  37 }
  38
  39 # check server cert.
  40 my ($subject_name, $issuer_name, $cipher);
  41 if( ref($sock) eq "IO::Socket::SSL") {
  42     $subject_name = $sock->peer_certificate("subject");
  43     $issuer_name = $sock->peer_certificate("issuer");
  44     $cipher = $sock->get_cipher();
  45 }
  46 warn "cipher: $cipher.\n", "server cert:\n",
  47     "\t '$subject_name' \n\t '$issuer_name'.\n\n";
  48
  49 my ($buf) = $sock->getlines;
  50
  51 $sock->close();
  52
  53 print "read: '$buf'.\n";