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 / sslcat.al < prev    next >
Text File  |  2004-02-17  |  3KB  |  100 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 1718 "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;
  100.