home *** CD-ROM | disk | FTP | other *** search
/ PC World 2005 June / PCWorld_2005-06_cd.bin / software / vyzkuste / firewally / firewally.exe / framework-2.3.exe / https_cat.al < prev    next >
Text File  |  2004-02-17  |  3KB  |  98 lines
  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 1809 "blib/lib/Net/SSLeay.pm (autosplit into blib/lib/auto/Net/SSLeay/https_cat.al)"
  7. ###
  8. ### Basic request - response primitive, this is different from sslcat
  9. ###                 because this does not shutdown the connection.
  10. ###
  11.  
  12. sub https_cat { # address, port, message --> returns reply / (reply,errs,cert)
  13.     my ($dest_serv, $port, $out_message, $crt_path, $key_path) = @_;
  14.     my ($ctx, $ssl, $got, $errs, $written);
  15.     
  16.     ($got, $errs) = open_proxy_tcp_connection($dest_serv, $port);
  17.     return (wantarray ? (undef, $errs) : undef) unless $got;
  18.         
  19.     ### Do SSL negotiation stuff
  20.         
  21.     warn "Creating SSL $ssl_version context...\n" if $trace>2;
  22.     load_error_strings();         # Some bloat, but I'm after ease of use
  23.     SSLeay_add_ssl_algorithms();  # and debuggability.
  24.     randomize();
  25.  
  26.     $ctx = new_x_ctx();
  27.     goto cleanup2 if $errs = print_errs('CTX_new') or !$ctx;
  28.  
  29.     CTX_set_options($ctx, &OP_ALL);
  30.     goto cleanup2 if $errs = print_errs('CTX_set_options');
  31.     
  32.     warn "Cert `$crt_path' given without key" if $crt_path && !$key_path;
  33.     set_cert_and_key($ctx, $crt_path, $key_path) if $crt_path;
  34.     
  35.     warn "Creating SSL connection (context was '$ctx')...\n" if $trace>2;
  36.     $ssl = new($ctx);
  37.     goto cleanup if $errs = print_errs('SSL_new') or !$ssl;
  38.     
  39.     warn "Setting fd (ctx $ctx, con $ssl)...\n" if $trace>2;
  40.     set_fd($ssl, fileno(SSLCAT_S));
  41.     goto cleanup if $errs = print_errs('set_fd');
  42.     
  43.     warn "Entering SSL negotiation phase...\n" if $trace>2;
  44.     
  45.     if ($trace>2) {
  46.     my $i = 0;
  47.     my $p = '';
  48.     my $cipher_list = 'Cipher list: ';
  49.     $p=Net::SSLeay::get_cipher_list($ssl,$i);
  50.     $cipher_list .= $p if $p;
  51.     do {
  52.         $i++;
  53.         $cipher_list .= ', ' . $p if $p;
  54.         $p=Net::SSLeay::get_cipher_list($ssl,$i);
  55.     } while $p;
  56.     $cipher_list .= '\n';
  57.     warn $cipher_list;
  58.     }
  59.  
  60.     $got = Net::SSLeay::connect($ssl);
  61.     warn "SSLeay connect failed" if $trace>2 && $got==0;
  62.     goto cleanup if $errs = print_errs('SSL_connect');
  63.     
  64.     my $server_cert = get_peer_certificate($ssl);
  65.     print_errs('get_peer_certificate');
  66.     if ($trace>1) {        
  67.     warn "Cipher `" . get_cipher($ssl) . "'\n";
  68.     print_errs('get_ciper');
  69.     warn dump_peer_certificate($ssl);
  70.     }
  71.     
  72.     ### Connected. Exchange some data (doing repeated tries if necessary).
  73.         
  74.     warn "sslcat $$: sending " . blength($out_message) . " bytes...\n"
  75.     if $trace==3;
  76.     warn "sslcat $$: sending `$out_message' (" . blength($out_message)
  77.     . " bytes)...\n" if $trace>3;
  78.     ($written, $errs) = ssl_write_all($ssl, $out_message);
  79.     goto cleanup unless $written;
  80.     
  81.     warn "waiting for reply...\n" if $trace>2;
  82.     ($got, $errs) = ssl_read_all($ssl);
  83.     warn "Got " . blength($got) . " bytes.\n" if $trace==3;
  84.     warn "Got `$got' (" . blength($got) . " bytes)\n" if $trace>3;
  85.  
  86. cleanup:
  87.     free ($ssl);
  88.     $errs .= print_errs('SSL_free');
  89. cleanup2:
  90.     CTX_free ($ctx);
  91.     $errs .= print_errs('CTX_free');
  92.     close SSLCAT_S;    
  93.     return wantarray ? ($got, $errs, $server_cert) : $got;
  94. }
  95.  
  96. # end of Net::SSLeay::https_cat
  97. 1;
  98.