git.maemo.org Git - dh-make-perl/blob - dev/arm/libnet-ssleay-perl/libnet-ssleay-perl-1.35/debian/libnet-ssleay-perl/usr/lib/perl5/auto/Net/SSLeay/sslcat.al

   1 # NOTE: Derived from blib/lib/Net/SSLeay.pm.
   2 # Changes made here will be lost when autosplit is run again.
   3 # See AutoSplit.pm.
   4 package Net::SSLeay;
   5
   6 #line 2167 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/sslcat.al)"
   7 ###
   8 ### Basic request - response primitive (don't use for https)
   9 ###
  10
  11 sub sslcat { # address, port, message, $crt, $key --> reply / (reply,errs,cert)
  12     my ($dest_serv, $port, $out_message, $crt_path, $key_path) = @_;
  13     my ($ctx, $ssl, $got, $errs, $written);
  14
  15     ($got, $errs) = open_proxy_tcp_connection($dest_serv, $port);
  16     return (wantarray ? (undef, $errs) : undef) unless $got;
  17
  18     ### Do SSL negotiation stuff
  19
  20     warn "Creating SSL $ssl_version context...\n" if $trace>2;
  21     load_error_strings();         # Some bloat, but I'm after ease of use
  22     SSLeay_add_ssl_algorithms();  # and debuggability.
  23     randomize();
  24
  25     $ctx = new_x_ctx();
  26     goto cleanup2 if $errs = print_errs('CTX_new') or !$ctx;
  27
  28     CTX_set_options($ctx, &OP_ALL);
  29     goto cleanup2 if $errs = print_errs('CTX_set_options');
  30
  31     warn "Cert `$crt_path' given without key" if $crt_path && !$key_path;
  32     set_cert_and_key($ctx, $crt_path, $key_path) if $crt_path;
  33
  34     warn "Creating SSL connection (context was '$ctx')...\n" if $trace>2;
  35     $ssl = new($ctx);
  36     goto cleanup if $errs = print_errs('SSL_new') or !$ssl;
  37
  38     warn "Setting fd (ctx $ctx, con $ssl)...\n" if $trace>2;
  39     set_fd($ssl, fileno(SSLCAT_S));
  40     goto cleanup if $errs = print_errs('set_fd');
  41
  42     warn "Entering SSL negotiation phase...\n" if $trace>2;
  43
  44     if ($trace>2) {
  45         my $i = 0;
  46         my $p = '';
  47         my $cipher_list = 'Cipher list: ';
  48         $p=Net::SSLeay::get_cipher_list($ssl,$i);
  49         $cipher_list .= $p if $p;
  50         do {
  51             $i++;
  52             $cipher_list .= ', ' . $p if $p;
  53             $p=Net::SSLeay::get_cipher_list($ssl,$i);
  54         } while $p;
  55         $cipher_list .= '\n';
  56         warn $cipher_list;
  57     }
  58
  59     $got = Net::SSLeay::connect($ssl);
  60     warn "SSLeay connect returned $got\n" if $trace>2;
  61     goto cleanup if $errs = print_errs('SSL_connect');
  62
  63     my $server_cert = get_peer_certificate($ssl);
  64     print_errs('get_peer_certificate');
  65     if ($trace>1) {
  66         warn "Cipher `" . get_cipher($ssl) . "'\n";
  67         print_errs('get_ciper');
  68         warn dump_peer_certificate($ssl);
  69     }
  70
  71     ### Connected. Exchange some data (doing repeated tries if necessary).
  72
  73     warn "sslcat $$: sending " . blength($out_message) . " bytes...\n"
  74         if $trace==3;
  75     warn "sslcat $$: sending `$out_message' (" . blength($out_message)
  76         . " bytes)...\n" if $trace>3;
  77     ($written, $errs) = ssl_write_all($ssl, $out_message);
  78     goto cleanup unless $written;
  79
  80     sleep $slowly if $slowly;  # Closing too soon can abort broken servers
  81     CORE::shutdown SSLCAT_S, 1;  # Half close --> No more output, send EOF to server
  82
  83     warn "waiting for reply...\n" if $trace>2;
  84     ($got, $errs) = ssl_read_all($ssl);
  85     warn "Got " . blength($got) . " bytes.\n" if $trace==3;
  86     warn "Got `$got' (" . blength($got) . " bytes)\n" if $trace>3;
  87
  88 cleanup:
  89     free ($ssl);
  90     $errs .= print_errs('SSL_free');
  91 cleanup2:
  92     CTX_free ($ctx);
  93     $errs .= print_errs('CTX_free');
  94     close SSLCAT_S;
  95     return wantarray ? ($got, $errs, $server_cert) : $got;
  96 }
  97
  98 # end of Net::SSLeay::sslcat
  99 1;