Net::SSLeay - Perl extension for using OpenSSL

  use Net::SSLeay qw(get_https post_https sslcat make_headers make_form);

  ($page) = get_https('www.bacus.pt', 443, '/');                 # 1

  ($page, $response, %reply_headers)
	 = get_https('www.bacus.pt', 443, '/',                   # 2
	 	make_headers(User-Agent => 'Cryptozilla/5.0b1',
			     Referer    => 'https://www.bacus.pt'
		));

  ($page, $result, %headers) =                                   # 2b
         = get_https('www.bacus.pt', 443, '/protected.html',
	      make_headers(Authorization =>
			   'Basic ' . MIME::Base64::encode("$user:$pass",''))
	      );

  ($page, $response, %reply_headers)
	 = post_https('www.bacus.pt', 443, '/foo.cgi', '',       # 3
		make_form(OK   => '1',
			  name => 'Sampo'
		));

  $reply = sslcat($host, $port, $request);                       # 4

  ($reply, $err, $server_cert) = sslcat($host, $port, $request); # 5

  $Net::SSLeay::trace = 2;  # 0=no debugging, 1=ciphers, 2=trace, 3=dump data

  ($page, $response, @headers) = get_https('www.bacus.pt', 443, '/');
  for ($i = 0; $i < $#headers; $i+=2) {
      print "$headers[$i] = " . $headers[$i+1] . "\n";
  }

  ($page, $response, $headers, $server_cert)
    = get_https3('www.bacus.pt', 443, '/');
  print "$headers\n";

  ($page, $response, %headers_ref, $server_cert)
    = get_https4('www.bacus.pt', 443, '/');
  for $k (sort keys %{headers_ref}) {
      for $v (@{$headers_ref{$k}}) {
	  print "$k = $v\n";
      }
  }

  print $headers_ref{COOKIE}[0];

  ($p, $resp, $hdrs, $server_cert) = get_https3('www.bacus.pt', 443, '/');
  if (!defined($server_cert) || ($server_cert == 0)) {
      warn "Subject Name: undefined, Issuer  Name: undefined";
  } else {
      warn 'Subject Name: '
	  . Net::SSLeay::X509_NAME_oneline(
		 Net::SSLeay::X509_get_subject_name($server_cert))
	      . 'Issuer  Name: '
		  . Net::SSLeay::X509_NAME_oneline(
                         Net::SSLeay::X509_get_issuer_name($server_cert));
  }

  ($page, $result, %headers) =                                   # 2c
         = get_https('www.bacus.pt', 443, '/protected.html',
	      make_headers(Authorization =>
			   'Basic ' . MIME::Base64::encode("$user:$pass",'')),
	      '', $mime_type6, $path_to_crt7, $path_to_key8);

  ($page, $response, %reply_headers)
	 = post_https('www.bacus.pt', 443, '/foo.cgi',           # 3b
	      make_headers('Authorization' =>
			   'Basic ' . MIME::Base64::encode("$user:$pass",'')),
	      make_form(OK   => '1', name => 'Sampo'),
	      $mime_type6, $path_to_crt7, $path_to_key8);

  Net::SSLeay::set_verify(ssl, Net::SSLeay::VERIFY_PEER, 0);

  Net::SSLeay::set_proxy('gateway.myorg.com', 8080);
  ($page) = get_https('www.bacus.pt', 443, '/');

  Net::SSLeay::set_proxy('gateway.myorg.com', 8080, 'joe', 'salainen');
  ($page, $result, %headers) =
         = get_https('www.bacus.pt', 443, '/protected.html',
	      make_headers(Authorization =>
			   'Basic ' . MIME::Base64::encode("susie:pass",''))
	      );

	    &Net::SSLeay::X509_STORE_CTX_set_flags
		(&Net::SSLeay::CTX_get_cert_store($ssl), 
		 &Net::SSLeay::X509_V_FLAG_CRL_CHECK); 

	openssl crl -in crl.pem -hash -noout

    my $bio = Net::SSLeay::BIO_new_file($crlfilename, 'r');
    my $crl = Net::SSLeay::PEM_read_bio_X509_CRL($bio);
    if ($crl) {
        Net::SSLeay::X509_STORE_add_crl(Net::SSLeay::CTX_get_cert_store($ssl, $crl);
    } else {
        error reading CRL....
    }

    Net::SSLeay::randomize($rn_seed_file,$additional_seed);
    Net::SSLeay::set_cert_and_key($ctx, $cert_path, $key_path);
    $cert = Net::SSLeay::dump_peer_certificate($ssl);
    Net::SSLeay::ssl_write_all($ssl, $message) or die "ssl write failure";
    $got = Net::SSLeay::ssl_read_all($ssl) or die "ssl read failure";

    $got = Net::SSLeay::ssl_read_CRLF($ssl [, $max_length]);
    $got = Net::SSLeay::ssl_read_until($ssl [, $delimit [, $max_length]]);
    Net::SSLeay::ssl_write_CRLF($ssl, $message);

    $data = 'A' x 1000000000;
    Net::SSLeay::ssl_write_all($ssl, \$data) or die "ssl write failed";

	#include <ssl.h>

	err = SSL_set_verify (ssl, SSL_VERIFY_CLIENT_ONCE,
				   &your_call_back_here);

	use Net::SSLeay;

	$err = Net::SSLeay::set_verify ($ssl,
					Net::SSLeay::VERIFY_CLIENT_ONCE,
					\&your_call_back_here);

	$err = Net::SSLeay::ERR_get_error;

	$got = Net::SSLeay::read($ssl);
                                    # Performs SSL_read, but returns $got
                                    # resized according to data received.
                                    # Returns undef on failure.

	Net::SSLeay::write($ssl, $foo) || die;
                                    # Performs SSL_write, but automatically
                                    # figures out the size of $foo

	use Net::SSLeay qw(die_now die_if_ssl_error);
	Net::SSLeay::load_error_strings();
	Net::SSLeay::SSLeay_add_ssl_algorithms();    # Important!
        Net::SSLeay::ENGINE_load_builtin_engines();  # If you want built-in engines
        Net::SSLeay::ENGINE_register_all_complete(); # If you want built-in engines
        Net::SSLeay::randomize();

	Net::SSLeay::connect($ssl) or die_now("Failed SSL connect ($!)");
	Net::SSLeay::write($ssl, "foo") or die_if_ssl_error("SSL write ($!)");

    Net::SSLeay::set_fd($ssl, fileno(S));   # Must use fileno

	sub verify {
	    my ($ok, $x509_store_ctx) = @_;
	    print "Verifying certificate...\n";
		...
	    return $ok;
	}

	Net::SSLeay::set_verify ($ssl, Net::SSLeay::VERIFY_PEER, \&verify);

        Net::SSLeay::CTX_set_default_passwd_cb($ctx, sub { "top-secret" });
        Net::SSLeay::CTX_use_PrivateKey_file($ctx, "key.pem",
					     Net::SSLeay::FILETYPE_PEM)
            or die "Error reading private key";
        Net::SSLeay::CTX_set_default_passwd_cb($ctx, undef);

    sub session_secret_cb
    {
        my ($secret, \@cipherlist, \$preferredcipher, $somedata) = @_;
    }

    $x509_name = Net::SSLeay::X509_get_subject_name($x509_cert);
    $x509_name = Net::SSLeay::X509_get_issuer_name($x509_cert);
    print Net::SSLeay::X509_NAME_oneline($x509_name);
    $text = Net::SSLeay::X509_NAME_get_text_by_NID($name, $nid);

    ($type1, $subject1, $type2, $subject2, ...) =
       Net::SSLeay::X509_get_subjectAltNames($x509_cert)

    subjectAltName types as per x509v3.h GEN_*, for example
    GEN_DNS or GEN_IPADD which can be imported.

    Net::SSLeay::RAND_seed($buf);   # Perlishly figures out buf size
    Net::SSLeay::RAND_bytes($buf, $num);
    Net::SSLeay::RAND_pseudo_bytes($buf, $num);
    Net::SSLeay::RAND_add($buf, $num, $entropy);
    Net::SSLeay::RAND_poll();
    Net::SSLeay::RAND_status();
    Net::SSLeay::RAND_cleanup();
    Net::SSLeay::RAND_file_name($num);
    Net::SSLeay::RAND_load_file($file_name, $how_many_bytes);
    Net::SSLeay::RAND_write_file($file_name);
    Net::SSLeay::RAND_egd($path);
    Net::SSLeay::RAND_egd_bytes($path, $bytes);

    print Net::SSLeay::dump_peer_certificate($ssl);
    Net::SSLeay::randomize();

    $rsakey = Net::SSLeay::RSA_generate_key();
    Net::SSLeay::CTX_set_tmp_rsa($ctx, $rsakey);
    Net::SSLeay::RSA_free($rsakey);

    $hash = Net::SSLeay::MD5($foo);
    print unpack('H*', $hash);

    Net::SSLeay::BIO_s_mem();
    $bio = Net::SSLeay::BIO_new(BIO_s_mem())
    $bio = Net::SSLeay::BIO_new_file($filename, $mode);
    Net::SSLeay::BIO_free($bio)
    $count = Net::SSLeay::BIO_write($data);
    $data = Net::SSLeay::BIO_read($bio);
    $data = Net::SSLeay::BIO_read($bio, $maxbytes);
    $is_eof = Net::SSLeay::BIO_eof($bio);
    $count = Net::SSLeay::BIO_pending($bio);
    $count = Net::SSLeay::BIO_wpending ($bio);

    $client_random = Net::SSLeay::get_client_random($ssl);
    $server_random = Net::SSLeay::get_server_random($ssl);
    $session = Net::SSLeay::get_session($ssl);
    $master_key = Net::SSLeay::SESSION_get_master_key($session);
    Net::SSLeay::SESSION_set_master_key($session, $master_secret);
    $keyblocksize = Net::SSLeay::get_keyblock_size($session);

  use Net::SSLeay qw(get_http post_http tcpcat
                      get_httpx post_httpx tcpxcat
                      make_headers make_form);

  ($page, $result, %headers) =
         = get_http('www.bacus.pt', 443, '/protected.html',
	      make_headers(Authorization =>
			   'Basic ' . MIME::Base64::encode("$user:$pass",''))
	      );

  ($page, $response, %reply_headers)
	 = post_http('www.bacus.pt', 443, '/foo.cgi', '',
		make_form(OK   => '1',
			  name => 'Sampo'
		));

  ($reply, $err) = tcpcat($host, $port, $request);

  ($page, $result, %headers) =
         = get_httpx($usessl, 'www.bacus.pt', 443, '/protected.html',
	      make_headers(Authorization =>
			   'Basic ' . MIME::Base64::encode("$user:$pass",''))
	      );

  ($page, $response, %reply_headers)
	 = post_httpx($usessl, 'www.bacus.pt', 443, '/foo.cgi', '',
		make_form(OK   => '1',  name => 'Sampo'	));

  ($reply, $err, $server_cert) = tcpxcat($usessl, $host, $port, $request);

    #!/usr/local/bin/perl
    use Socket;
    use Net::SSLeay qw(die_now die_if_ssl_error) ;
    Net::SSLeay::load_error_strings();
    Net::SSLeay::SSLeay_add_ssl_algorithms();
    Net::SSLeay::randomize();

    ($dest_serv, $port, $msg) = @ARGV;      # Read command line
    $port = getservbyname ($port, 'tcp') unless $port =~ /^\d+$/;
    $dest_ip = gethostbyname ($dest_serv);
    $dest_serv_params  = sockaddr_in($port, $dest_ip);

    socket  (S, &AF_INET, &SOCK_STREAM, 0)  or die "socket: $!";
    connect (S, $dest_serv_params)          or die "connect: $!";
    select  (S); $| = 1; select (STDOUT);   # Eliminate STDIO buffering

    # The network connection is now open, lets fire up SSL    

    $ctx = Net::SSLeay::CTX_new() or die_now("Failed to create SSL_CTX $!");
    Net::SSLeay::CTX_set_options($ctx, &Net::SSLeay::OP_ALL)
         and die_if_ssl_error("ssl ctx set options");
    $ssl = Net::SSLeay::new($ctx) or die_now("Failed to create SSL $!");
    Net::SSLeay::set_fd($ssl, fileno(S));   # Must use fileno
    $res = Net::SSLeay::connect($ssl) and die_if_ssl_error("ssl connect");
    print "Cipher `" . Net::SSLeay::get_cipher($ssl) . "'\n";

    # Exchange data

    $res = Net::SSLeay::write($ssl, $msg);  # Perl knows how long $msg is
    die_if_ssl_error("ssl write");
    CORE::shutdown S, 1;  # Half close --> No more output, sends EOF to server
    $got = Net::SSLeay::read($ssl);         # Perl returns undef on failure
    die_if_ssl_error("ssl read");
    print $got;

    Net::SSLeay::free ($ssl);               # Tear down connection
    Net::SSLeay::CTX_free ($ctx);
    close S;

    #!/usr/local/bin/perl -w
    use Socket;
    use Net::SSLeay qw(die_now die_if_ssl_error);
    Net::SSLeay::load_error_strings();
    Net::SSLeay::SSLeay_add_ssl_algorithms();
    Net::SSLeay::randomize();

    $our_ip = "\0\0\0\0"; # Bind to all interfaces
    $port = 1235;							 
    $sockaddr_template = 'S n a4 x8';
    $our_serv_params = pack ($sockaddr_template, &AF_INET, $port, $our_ip);

    socket (S, &AF_INET, &SOCK_STREAM, 0)  or die "socket: $!";
    bind (S, $our_serv_params)             or die "bind:   $!";
    listen (S, 5)                          or die "listen: $!";
    $ctx = Net::SSLeay::CTX_new ()         or die_now("CTX_new ($ctx): $!");
    Net::SSLeay::CTX_set_options($ctx, &Net::SSLeay::OP_ALL)
         and die_if_ssl_error("ssl ctx set options");

    # Following will ask password unless private key is not encrypted
    Net::SSLeay::CTX_use_RSAPrivateKey_file ($ctx, 'plain-rsa.pem',
                                             &Net::SSLeay::FILETYPE_PEM);
    die_if_ssl_error("private key");
    Net::SSLeay::CTX_use_certificate_file ($ctx, 'plain-cert.pem',
 				           &Net::SSLeay::FILETYPE_PEM);
    die_if_ssl_error("certificate");

    while (1) {    
        print "Accepting connections...\n";
        ($addr = accept (NS, S))           or die "accept: $!";
        select (NS); $| = 1; select (STDOUT);  # Piping hot!

        ($af,$client_port,$client_ip) = unpack($sockaddr_template,$addr);
        @inetaddr = unpack('C4',$client_ip);
        print "$af connection from " .
        join ('.', @inetaddr) . ":$client_port\n";

        # We now have a network connection, lets fire up SSLeay...

        $ssl = Net::SSLeay::new($ctx)      or die_now("SSL_new ($ssl): $!");
        Net::SSLeay::set_fd($ssl, fileno(NS));

        $err = Net::SSLeay::accept($ssl) and die_if_ssl_error('ssl accept');
        print "Cipher `" . Net::SSLeay::get_cipher($ssl) . "'\n";

        # Connected. Exchange some data.

        $got = Net::SSLeay::read($ssl);     # Returns undef on fail
        die_if_ssl_error("ssl read");
        print "Got `$got' (" . length ($got) . " chars)\n";

        Net::SSLeay::write ($ssl, uc ($got)) or die "write: $!";
        die_if_ssl_error("ssl write");

        Net::SSLeay::free ($ssl);           # Tear down connection
        close NS;
    }

    #!/usr/local/bin/perl
    # /etc/inetd.conf
    #    ssltst stream tcp nowait root /path/to/server.pl server.pl
    # /etc/services
    #    ssltst		1234/tcp

    use Net::SSLeay qw(die_now die_if_ssl_error);
    Net::SSLeay::load_error_strings();
    Net::SSLeay::SSLeay_add_ssl_algorithms();
    Net::SSLeay::randomize();

    chdir '/key/dir' or die "chdir: $!";
    $| = 1;  # Piping hot!
    open LOG, ">>/dev/console" or die "Can't open log file $!";
    select LOG; print "server.pl started\n";

    $ctx = Net::SSLeay::CTX_new()     or die_now "CTX_new ($ctx) ($!)";
    $ssl = Net::SSLeay::new($ctx)     or die_now "new ($ssl) ($!)";
    Net::SSLeay::set_options($ssl, &Net::SSLeay::OP_ALL)
         and die_if_ssl_error("ssl set options");

    # We get already open network connection from inetd, now we just
    # need to attach SSLeay to STDIN and STDOUT
    Net::SSLeay::set_rfd($ssl, fileno(STDIN));
    Net::SSLeay::set_wfd($ssl, fileno(STDOUT));

    Net::SSLeay::use_RSAPrivateKey_file ($ssl, 'plain-rsa.pem',
                                         Net::SSLeay::FILETYPE_PEM);
    die_if_ssl_error("private key");
    Net::SSLeay::use_certificate_file ($ssl, 'plain-cert.pem',
                                       Net::SSLeay::FILETYPE_PEM);
    die_if_ssl_error("certificate");

    Net::SSLeay::accept($ssl) and die_if_ssl_err("ssl accept: $!");
    print "Cipher `" . Net::SSLeay::get_cipher($ssl) . "'\n";

    $got = Net::SSLeay::read($ssl);
    die_if_ssl_error("ssl read");
    print "Got `$got' (" . length ($got) . " chars)\n";

    Net::SSLeay::write ($ssl, uc($got)) or die "write: $!";
    die_if_ssl_error("ssl write");

    Net::SSLeay::free ($ssl);         # Tear down the connection
    Net::SSLeay::CTX_free ($ctx);
    close LOG;

    sslecho.pl   -  A simple server, not unlike the one above
    minicli.pl   -  Implements a client using low level SSLeay routines
    sslcat.pl    -  Demonstrates using high level sslcat utility function
    get_page.pl  -  Is a utility for getting html pages from secure servers
    callback.pl  -  Demonstrates certificate verification and callback usage
    stdio_bulk.pl       - Does SSL over Unix pipes
    ssl-inetd-serv.pl   - SSL server that can be invoked from inetd.conf
    httpd-proxy-snif.pl - Utility that allows you to see how a browser
                          sends https request to given server and what reply
                          it gets back (very educative :-)
    makecert.pl  -  Creates a self signed cert (does not use this module)

    $reply = '';
    while ($got = Net::SSLeay::read($ssl)) {
        last if print_errs('SSL_read');
        $reply .= $got;
    }

    $written = 0;

    while ($written < length($message)) {
        $written += Net::SSLeay::write($ssl, substr($message, $written));
        last if print_errs('SSL_write');
    }

    Net::SSLeay::ssl_write_all($ssl, $message) or die "ssl write failure";
    $got = Net::SSLeay::ssl_read_all($ssl) or die "ssl read failure";

    Argument "xxx" isn't numeric in entersub at blib/lib/Net/SSLeay.pm'

    Net::SSLeay::CTX_set_options($ctx, &Net::SSLeay::OP_ALL)
         and die_if_ssl_error("ssl ctx set options");

    $Net::SSLeay::slowly = 1;   # Add sleep so broken servers can keep up

   $Net::SSLeay::ssl_version = 2;  # Insist on SSLv2
   $Net::SSLeay::ssl_version = 3;  # Insist on SSLv3
   $Net::SSLeay::ssl_version = 10; # Insist on TLSv1

    perldoc Net::SSLeay

   Symlabs (netssleay@symlabs.com)
   Tel: +351-214.222.630
   Fax: +351-214.222.637

  Net::SSLeay::Handle                      - File handle interface
  ./examples                               - Example servers and a clients
  <http://www.openssl.org/>                - OpenSSL source, documentation, etc
  openssl-users-request@openssl.org        - General OpenSSL mailing list
  <http://www.ietf.org/rfc/rfc2246.txt>    - TLS 1.0 specification
  <http://www.w3c.org>                     - HTTP specifications
  <http://www.ietf.org/rfc/rfc2617.txt>    - How to send password
  <http://www.lothar.com/tech/crypto/>     - Entropy Gathering Daemon (EGD)
  <http://www.aet.tu-cottbus.de/personen/jaenicke/postfix_tls/prngd.html>
                           - pseudo-random number generating daemon (PRNGD)
  perl(1)
  perlref(1)
  perllol(1)
  perldoc ~openssl/doc/ssl/SSL_CTX_set_verify.pod

# Net::SSLeay.pm - Perl module for using Eric Young's implementation of SSL
#
# Copyright (c) 1996-2003 Sampo Kellomaki <sampo@iki.fi>, All Rights Reserved.
# Copyright (C) 2005 Florian Ragwitz <rafl@debian.org>, All Rights Reserved.
# Copyright (C) 2005 Mike McCauley <mikem@open.com.au>, All Rights Reserved.
#
# $Id$
#
# Version 1.04, 31.3.1999
# 30.7.1999, Tracking OpenSSL-0.9.3a changes, --Sampo
# 31.7.1999, version 1.05 --Sampo
# 7.4.2001,  fixed input error upon 0, OpenSSL-0.9.6a, version 1.06 --Sampo
# 18.4.2001, added TLSv1 support by Stephen C. Koehler
#            <koehler@securecomputing.com>, version 1.07, --Sampo
# 25.4.2001, 64 bit fixes by Marko Asplund <aspa@kronodoc.fi> --Sampo
# 17.4.2001, more error codes from aspa --Sampo
# 25.9.2001, added heaps and piles of newer OpenSSL auxiliary functions --Sampo
# 6.11.2001, got rid of $p_errs madness --Sampo
# 9.11.2001, added EGD (entropy gathering daemon) reference info --Sampo
# 7.12.2001, Added proxy support by Bruno De Wolf <bruno.dewolf@@pandora._be>
# 6.1.2002,  cosmetic fix to socket options from Kwindla Hultman Kramer <kwindla@@allafrica_.com>
# 25.3.2002, added post_https_cert and friends per patch from
#            mock@@obscurity.ogr, --Sampo
# 3.4.2002,  added `use bytes' from Marcus Taylor <marcus@@semantico_.com>
#            This avoids unicode/utf8 (as may appear in some XML docs)
#            from fooling the length comuptations. Dropped support for
#            perl5.005_03 because I do not have opportunity to test it. --Sampo
# 5.4.2002,  improved Unicode gotcha eliminator to support old perls --Sampo
# 8.4.2002,  added a small line end fix from Petr Dousa (pdousa@@kerio_.com)
# 17.5.2002, Added BIO_s_mem, BIO_new, BIO_free, BIO_write, BIO_read 
#            BIO_eof, BIO_pending, BIO_wpending, RSA_generate_key, RSA_free
#            --mikem@open._com.au
# 10.8.2002, Added SSL_peek patch to ssl_read_until from 
#            Peter Behroozi <peter@@fhpwireless_.com> --Sampo
# 21.8.2002, Added SESSION_get_master_key, SSL_get_client_random, SSL_get_server_random
#            --mikem@open.com_.au
# 2.9.2002,  Added SSL_CTX_get_cert_store, X509_STORE_add_cert, X509_STORE_add_crl
#            X509_STORE_set_flags, X509_load_cert_file, X509_load_crl_file
#            X509_load_cert_crl_file, PEM_read_bio_X509_CRL,
#            constants for X509_V_FLAG_* in order to support certificate revocation lists.
#            --mikem@open.com_.au
# 6.9.2002,  fixed X509_STORE_set_flags to X509_STORE_CTX_set_flags, --Sampo
# 19.9.2002, applied patch from Tim Engler <tim@burntcouch_.com>
# 18.2.2003, applied patch from Toni Andjelkovic <toni@soth._at>
# 13.6.2003, partially applied leak patch by Marian Jancar <mjancar@suse._cz>
# 25.6.2003, write_partial() return value patch from 
#            Kim Minh Kaplan <kmkaplan@selfoffice._com>
# 17.8.2003, added http support :-) --Sampo
# 17.8.2003, started 1.25 dev --Sampo
# 30.11.2005, Applied a patch by Peter Behroozi that adds get1_session() for session caching --Florian
# 30.11.2005, Applied a patch by ex8k-hbn@asahi-net.or.jp that limits the chunk size for tcp_read_all --Florian
# 30.11.2005, Applied a patch by ivan-cpan-rt@420.am that avoids adding a Host header if an own is specified in do_httpx3
# 13.12.2005, Added comments re thread safety and resetting of default_passwd_callback after use 
#             --mikem@open.com.au
#
# The distribution and use of this module are subject to the conditions
# listed in LICENSE file at the root of OpenSSL-0.9.7b
# distribution (i.e. free, but mandatory attribution and NO WARRANTY).

package Net::SSLeay;

use strict;
use Carp;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD $CRLF);
use Socket;
use Errno;

require Exporter;
use AutoLoader;

# 0=no warns, 1=only errors, 2=ciphers, 3=progress, 4=dump data
$Net::SSLeay::trace = 0;  # Do not change here, use
                          # $Net::SSLeay::trace = [1-4]  in caller

# 2 = insist on v2 SSL protocol
# 3 = insist on v3 SSL
# 10 = insist on TLSv1
# 0 or undef = guess (v23)
#
$Net::SSLeay::ssl_version = 0;  # don't change here, use 
                                # Net::SSLeay::version=[2,3,0] in caller

#define to enable the "cat /proc/$$/stat" stuff
$Net::SSLeay::linux_debug = 0;

# Number of seconds to sleep after sending message and before half
# closing connection. Useful with antiquated broken servers.
$Net::SSLeay::slowly = 0;

# RANDOM NUMBER INITIALIZATION
#
# Edit to your taste. Using /dev/random would be more secure, but may
# block if randomness is not available, thus the default is
# /dev/urandom. $how_random determines how many bits of randomness to take
# from the device. You should take enough (read SSLeay/doc/rand), but
# beware that randomness is limited resource so you should not waste
# it either or you may end up with randomness depletion (situation where
# /dev/random would block and /dev/urandom starts to return predictable
# numbers).
#
# N.B. /dev/urandom does not exit on all systems, such as Solaris 2.6. In that
#      case you should get a third party package that emulates /dev/urandom
#      (e.g. via named pipe) or supply a random number file. Some such
#      packages are documented in Caveat section of the POD documentation.

$Net::SSLeay::random_device = '/dev/urandom';
$Net::SSLeay::how_random = 512;

$VERSION = '1.36';
@ISA = qw(Exporter);
@EXPORT_OK = qw(
    AT_MD5_WITH_RSA_ENCRYPTION
    CB_ACCEPT_EXIT
    CB_ACCEPT_LOOP
    CB_CONNECT_EXIT
    CB_CONNECT_LOOP
    CK_DES_192_EDE3_CBC_WITH_MD5
    CK_DES_192_EDE3_CBC_WITH_SHA
    CK_DES_64_CBC_WITH_MD5
    CK_DES_64_CBC_WITH_SHA
    CK_DES_64_CFB64_WITH_MD5_1
    CK_IDEA_128_CBC_WITH_MD5
    CK_NULL
    CK_NULL_WITH_MD5
    CK_RC2_128_CBC_EXPORT40_WITH_MD5
    CK_RC2_128_CBC_WITH_MD5
    CK_RC4_128_EXPORT40_WITH_MD5
    CK_RC4_128_WITH_MD5
    CLIENT_VERSION
    ERROR_NONE
    ERROR_SSL
    ERROR_SYSCALL
    ERROR_WANT_CONNECT
    ERROR_WANT_READ
    ERROR_WANT_WRITE
    ERROR_WANT_X509_LOOKUP
    ERROR_ZERO_RETURN
    CT_X509_CERTIFICATE
    FILETYPE_ASN1
    FILETYPE_PEM
    F_CLIENT_CERTIFICATE
    F_CLIENT_HELLO
    F_CLIENT_MASTER_KEY
    F_D2I_SSL_SESSION
    F_GET_CLIENT_FINISHED
    F_GET_CLIENT_HELLO
    F_GET_CLIENT_MASTER_KEY
    F_GET_SERVER_FINISHED
    F_GET_SERVER_HELLO
    F_GET_SERVER_VERIFY
    F_I2D_SSL_SESSION
    F_READ_N
    F_REQUEST_CERTIFICATE
    F_SERVER_HELLO
    F_SSL_ACCEPT
    F_SSL_CERT_NEW
    F_SSL_CONNECT
    F_SSL_ENC_DES_CBC_INIT
    F_SSL_ENC_DES_CFB_INIT
    F_SSL_ENC_DES_EDE3_CBC_INIT
    F_SSL_ENC_IDEA_CBC_INIT
    F_SSL_ENC_NULL_INIT
    F_SSL_ENC_RC2_CBC_INIT
    F_SSL_ENC_RC4_INIT
    F_SSL_GET_NEW_SESSION
    F_SSL_MAKE_CIPHER_LIST
    F_SSL_NEW
    F_SSL_READ
    F_SSL_RSA_PRIVATE_DECRYPT
    F_SSL_RSA_PUBLIC_ENCRYPT
    F_SSL_SESSION_NEW
    F_SSL_SESSION_PRINT_FP
    F_SSL_SET_CERTIFICATE
    F_SSL_SET_FD
    F_SSL_SET_RFD
    F_SSL_SET_WFD
    F_SSL_STARTUP
    F_SSL_USE_CERTIFICATE
    F_SSL_USE_CERTIFICATE_ASN1
    F_SSL_USE_CERTIFICATE_FILE
    F_SSL_USE_PRIVATEKEY
    F_SSL_USE_PRIVATEKEY_ASN1
    F_SSL_USE_PRIVATEKEY_FILE
    F_SSL_USE_RSAPRIVATEKEY
    F_SSL_USE_RSAPRIVATEKEY_ASN1
    F_SSL_USE_RSAPRIVATEKEY_FILE
    F_WRITE_PENDING
    GEN_OTHERNAME
    GEN_EMAIL
    GEN_DNS
    GEN_X400
    GEN_DIRNAME
    GEN_EDIPARTY
    GEN_URI
    GEN_IPADD
    GEN_RID
    MAX_MASTER_KEY_LENGTH_IN_BITS
    MAX_RECORD_LENGTH_2_BYTE_HEADER
    MAX_RECORD_LENGTH_3_BYTE_HEADER
    MAX_SSL_SESSION_ID_LENGTH_IN_BYTES
    MIN_RSA_MODULUS_LENGTH_IN_BYTES
    MT_CLIENT_CERTIFICATE
    MT_CLIENT_FINISHED
    MT_CLIENT_HELLO
    MT_CLIENT_MASTER_KEY
    MT_ERROR
    MT_REQUEST_CERTIFICATE
    MT_SERVER_FINISHED
    MT_SERVER_HELLO
    MT_SERVER_VERIFY
    NOTHING
    NID_undef
    NID_algorithm
    NID_rsadsi
    NID_pkcs
    NID_md2
    NID_md5
    NID_rc4
    NID_rsaEncryption
    NID_md2WithRSAEncryption
    NID_md5WithRSAEncryption
    NID_pbeWithMD2AndDES_CBC
    NID_pbeWithMD5AndDES_CBC
    NID_X500
    NID_X509
    NID_commonName
    NID_countryName
    NID_localityName
    NID_stateOrProvinceName
    NID_organizationName
    NID_organizationalUnitName
    NID_rsa
    NID_pkcs7
    NID_pkcs7_data
    NID_pkcs7_signed
    NID_pkcs7_enveloped
    NID_pkcs7_signedAndEnveloped
    NID_pkcs7_digest
    NID_pkcs7_encrypted
    NID_pkcs3
    NID_dhKeyAgreement
    NID_des_ecb
    NID_des_cfb64
    NID_des_cbc
    NID_des_ede
    NID_des_ede3
    NID_idea_cbc
    NID_idea_cfb64
    NID_idea_ecb
    NID_rc2_cbc
    NID_rc2_ecb
    NID_rc2_cfb64
    NID_rc2_ofb64
    NID_sha
    NID_shaWithRSAEncryption
    NID_des_ede_cbc
    NID_des_ede3_cbc
    NID_des_ofb64
    NID_idea_ofb64
    NID_pkcs9
    NID_pkcs9_emailAddress
    NID_pkcs9_unstructuredName
    NID_pkcs9_contentType
    NID_pkcs9_messageDigest
    NID_pkcs9_signingTime
    NID_pkcs9_countersignature
    NID_pkcs9_challengePassword
    NID_pkcs9_unstructuredAddress
    NID_pkcs9_extCertAttributes
    NID_netscape
    NID_netscape_cert_extension
    NID_netscape_data_type
    NID_des_ede_cfb64
    NID_des_ede3_cfb64
    NID_des_ede_ofb64
    NID_des_ede3_ofb64
    NID_sha1
    NID_sha1WithRSAEncryption
    NID_dsaWithSHA
    NID_dsa_2
    NID_pbeWithSHA1AndRC2_CBC
    NID_id_pbkdf2
    NID_dsaWithSHA1_2
    NID_netscape_cert_type
    NID_netscape_base_url
    NID_netscape_revocation_url
    NID_netscape_ca_revocation_url
    NID_netscape_renewal_url
    NID_netscape_ca_policy_url
    NID_netscape_ssl_server_name
    NID_netscape_comment
    NID_netscape_cert_sequence
    NID_desx_cbc
    NID_id_ce
    NID_subject_key_identifier
    NID_key_usage
    NID_private_key_usage_period
    NID_subject_alt_name
    NID_issuer_alt_name
    NID_basic_constraints
    NID_crl_number
    NID_certificate_policies
    NID_authority_key_identifier
    NID_bf_cbc
    NID_bf_ecb
    NID_bf_cfb64
    NID_bf_ofb64
    NID_mdc2
    NID_mdc2WithRSA
    NID_rc4_40
    NID_rc2_40_cbc
    NID_givenName
    NID_surname
    NID_initials
    NID_uniqueIdentifier
    NID_crl_distribution_points
    NID_md5WithRSA
    NID_serialNumber
    NID_title
    NID_description
    NID_cast5_cbc
    NID_cast5_ecb
    NID_cast5_cfb64
    NID_cast5_ofb64
    NID_pbeWithMD5AndCast5_CBC
    NID_dsaWithSHA1
    NID_md5_sha1
    NID_sha1WithRSA
    NID_dsa
    NID_ripemd160
    NID_ripemd160WithRSA
    NID_rc5_cbc
    NID_rc5_ecb
    NID_rc5_cfb64
    NID_rc5_ofb64
    NID_rle_compression
    NID_zlib_compression
    NID_ext_key_usage
    NID_id_pkix
    NID_id_kp
    NID_server_auth
    NID_client_auth
    NID_code_sign
    NID_email_protect
    NID_time_stamp
    NID_ms_code_ind
    NID_ms_code_com
    NID_ms_ctl_sign
    NID_ms_sgc
    NID_ms_efs
    NID_ns_sgc
    NID_delta_crl
    NID_crl_reason
    NID_invalidity_date
    NID_sxnet
    NID_pbe_WithSHA1And128BitRC4
    NID_pbe_WithSHA1And40BitRC4
    NID_pbe_WithSHA1And3_Key_TripleDES_CBC
    NID_pbe_WithSHA1And2_Key_TripleDES_CBC
    NID_pbe_WithSHA1And128BitRC2_CBC
    NID_pbe_WithSHA1And40BitRC2_CBC
    NID_keyBag
    NID_pkcs8ShroudedKeyBag
    NID_certBag
    NID_crlBag
    NID_secretBag
    NID_safeContentsBag
    NID_friendlyName
    NID_localKeyID
    NID_x509Certificate
    NID_sdsiCertificate
    NID_x509Crl
    NID_pbes2
    NID_pbmac1
    NID_hmacWithSHA1
    NID_id_qt_cps
    NID_id_qt_unotice
    NID_rc2_64_cbc
    NID_SMIMECapabilities
    NID_pbeWithMD2AndRC2_CBC
    NID_pbeWithMD5AndRC2_CBC
    NID_pbeWithSHA1AndDES_CBC
    NID_ms_ext_req
    NID_ext_req
    NID_name
    NID_dnQualifier
    NID_id_pe
    NID_id_ad
    NID_info_access
    NID_ad_OCSP
    NID_ad_ca_issuers
    NID_OCSP_sign
    OPENSSL_VERSION_NUMBER
    PE_BAD_CERTIFICATE
    PE_NO_CERTIFICATE
    PE_NO_CIPHER
    PE_UNSUPPORTED_CERTIFICATE_TYPE
    READING
    RECEIVED_SHUTDOWN
    RWERR_BAD_MAC_DECODE
    RWERR_BAD_WRITE_RETRY
    RWERR_INTERNAL_ERROR
    R_BAD_AUTHENTICATION_TYPE
    R_BAD_CHECKSUM
    R_BAD_MAC_DECODE
    R_BAD_RESPONSE_ARGUMENT
    R_BAD_SSL_FILETYPE
    R_BAD_SSL_SESSION_ID_LENGTH
    R_BAD_STATE
    R_BAD_WRITE_RETRY
    R_CHALLENGE_IS_DIFFERENT
    R_CIPHER_CODE_TOO_LONG
    R_CIPHER_TABLE_SRC_ERROR
    R_CONECTION_ID_IS_DIFFERENT
    R_INVALID_CHALLENGE_LENGTH
    R_NO_CERTIFICATE_SET
    R_NO_CERTIFICATE_SPECIFIED
    R_NO_CIPHER_LIST
    R_NO_CIPHER_MATCH
    R_NO_CIPHER_WE_TRUST
    R_NO_PRIVATEKEY
    R_NO_PUBLICKEY
    R_NO_READ_METHOD_SET
    R_NO_WRITE_METHOD_SET
    R_NULL_SSL_CTX
    R_PEER_DID_NOT_RETURN_A_CERTIFICATE
    R_PEER_ERROR
    R_PEER_ERROR_CERTIFICATE
    R_PEER_ERROR_NO_CIPHER
    R_PEER_ERROR_UNSUPPORTED_CERTIFICATE_TYPE
    R_PERR_ERROR_NO_CERTIFICATE
    R_PUBLIC_KEY_ENCRYPT_ERROR
    R_PUBLIC_KEY_IS_NOT_RSA
    R_PUBLIC_KEY_NO_RSA
    R_READ_WRONG_PACKET_TYPE
    R_REVERSE_KEY_ARG_LENGTH_IS_WRONG
    R_REVERSE_MASTER_KEY_LENGTH_IS_WRONG
    R_REVERSE_SSL_SESSION_ID_LENGTH_IS_WRONG
    R_SHORT_READ
    R_SSL_SESSION_ID_IS_DIFFERENT
    R_UNABLE_TO_EXTRACT_PUBLIC_KEY
    R_UNDEFINED_INIT_STATE
    R_UNKNOWN_REMOTE_ERROR_TYPE
    R_UNKNOWN_STATE
    R_UNSUPORTED_CIPHER
    R_WRONG_PUBLIC_KEY_TYPE
    R_X509_LIB
    RSA_3
    RSA_F4
    SENT_SHUTDOWN
    SERVER_VERSION
    SESSION
    SESSION_ASN1_VERSION
    ST_ACCEPT
    ST_BEFORE
    ST_CLIENT_START_ENCRYPTION
    ST_CONNECT
    ST_GET_CLIENT_FINISHED_A
    ST_GET_CLIENT_FINISHED_B
    ST_GET_CLIENT_HELLO_A
    ST_GET_CLIENT_HELLO_B
    ST_GET_CLIENT_MASTER_KEY_A
    ST_GET_CLIENT_MASTER_KEY_B
    ST_GET_SERVER_FINISHED_A
    ST_GET_SERVER_FINISHED_B
    ST_GET_SERVER_HELLO_A
    ST_GET_SERVER_HELLO_B
    ST_GET_SERVER_VERIFY_A
    ST_GET_SERVER_VERIFY_B
    ST_INIT
    ST_OK
    ST_READ_BODY
    ST_READ_HEADER
    ST_SEND_CLIENT_CERTIFICATE_A
    ST_SEND_CLIENT_CERTIFICATE_B
    ST_SEND_CLIENT_CERTIFICATE_C
    ST_SEND_CLIENT_CERTIFICATE_D
    ST_SEND_CLIENT_FINISHED_A
    ST_SEND_CLIENT_FINISHED_B
    ST_SEND_CLIENT_HELLO_A
    ST_SEND_CLIENT_HELLO_B
    ST_SEND_CLIENT_MASTER_KEY_A
    ST_SEND_CLIENT_MASTER_KEY_B
    ST_SEND_REQUEST_CERTIFICATE_A
    ST_SEND_REQUEST_CERTIFICATE_B
    ST_SEND_REQUEST_CERTIFICATE_C
    ST_SEND_REQUEST_CERTIFICATE_D
    ST_SEND_SERVER_FINISHED_A
    ST_SEND_SERVER_FINISHED_B
    ST_SEND_SERVER_HELLO_A
    ST_SEND_SERVER_HELLO_B
    ST_SEND_SERVER_VERIFY_A
    ST_SEND_SERVER_VERIFY_B
    ST_SERVER_START_ENCRYPTION
    ST_X509_GET_CLIENT_CERTIFICATE
    ST_X509_GET_SERVER_CERTIFICATE
    TXT_DES_192_EDE3_CBC_WITH_MD5
    TXT_DES_192_EDE3_CBC_WITH_SHA
    TXT_DES_64_CBC_WITH_MD5
    TXT_DES_64_CBC_WITH_SHA
    TXT_DES_64_CFB64_WITH_MD5_1
    TXT_IDEA_128_CBC_WITH_MD5
    TXT_NULL
    TXT_NULL_WITH_MD5
    TXT_RC2_128_CBC_EXPORT40_WITH_MD5
    TXT_RC2_128_CBC_WITH_MD5
    TXT_RC4_128_EXPORT40_WITH_MD5
    TXT_RC4_128_WITH_MD5
    VERIFY_CLIENT_ONCE
    VERIFY_FAIL_IF_NO_PEER_CERT
    VERIFY_NONE
    VERIFY_PEER
    WRITING
    X509_LOOKUP
    X509_V_FLAG_CB_ISSUER_CHECK
    X509_V_FLAG_USE_CHECK_TIME
    X509_V_FLAG_CRL_CHECK
    X509_V_FLAG_CRL_CHECK_ALL
    X509_V_FLAG_IGNORE_CRITICAL
    CTX_new
    CTX_v2_new
    CTX_v3_new
    CTX_v23_new
    CTX_free
    new
    free
    accept
    clear
    connect
    set_fd
    set_rfd
    set_wfd
    get_fd
    read
    write
    peek
    use_RSAPrivateKey
    use_RSAPrivateKey_ASN1
    use_RSAPrivateKey_file
    CTX_use_RSAPrivateKey_file
    use_PrivateKey
    use_PrivateKey_ASN1
    use_PrivateKey_file
    use_certificate
    use_certificate_ASN1
    use_certificate_file
    CTX_use_certificate_file
    load_error_strings
    ERR_load_SSL_strings
    ERR_load_RAND_strings
    state_string
    rstate_string
    state_string_long
    rstate_string_long
    get_time
    set_time
    get_timeout
    set_timeout
    copy_session_id
    set_read_ahead
    get_read_ahead
    pending
    get_cipher_list
    set_cipher_list
    get_cipher
    get_shared_ciphers
    get_peer_certificate
    set_verify
    flush_sessions
    set_bio
    get_rbio
    get_wbio
    SESSION_new
    SESSION_print
    SESSION_free
    i2d_SSL_SESSION
    set_session
    add_session
    remove_session
    d2i_SSL_SESSION
    BIO_f_ssl
    BIO_new
    BIO_new_file
    BIO_s_mem
    BIO_free
    BIO_read
    BIO_write
    BIO_eof
    BIO_pending
    BIO_wpending
    ERR_get_error
    ERR_error_string
    err
    clear_error
    X509_get_issuer_name
    X509_get_subject_name
    X509_NAME_oneline
    X509_NAME_get_text_by_NID
    CTX_get_cert_store
    X509_STORE_add_cert
    X509_STORE_add_crl
    X509_STORE_CTX_set_flags
    X509_load_cert_file
    X509_load_crl_file
    X509_load_cert_crl_file
    PEM_read_bio_X509_CRL
    die_if_ssl_error
    die_now
    print_errs
    set_cert_and_key
    set_server_cert_and_key
    make_form
    make_headers
    do_https
    get_https
    post_https
    get_https4
    post_https4
    sslcat
    ssl_read_CRLF
    ssl_read_all
    ssl_read_until
    ssl_write_CRLF
    ssl_write_all
    get_http
    post_http
    get_httpx
    post_httpx
    get_https3
    post_https3
    get_http4
    post_http4
    get_httpx4
    post_httpx4
    tcpcat
    tcpxcat
    tcp_read_CRLF
    tcp_read_all
    tcp_read_until
    tcp_write_CRLF
    tcp_write_all
    dump_peer_certificate
    RSA_generate_key
    RSA_free
    X509_free
    SESSION_get_master_key
    get_client_random
    get_server_random
);

sub AUTOLOAD {
    # This AUTOLOAD is used to 'autoload' constants from the constant()
    # XS function.  If a constant is not found then control is passed
    # to the AUTOLOAD in AutoLoader.

    my $constname;
    ($constname = $AUTOLOAD) =~ s/.*:://;
    my $val = constant($constname);
    if ($! != 0) {
	if ($! =~ /((Invalid)|(not valid))/i || $!{EINVAL}) {
	    $AutoLoader::AUTOLOAD = $AUTOLOAD;
	    goto &AutoLoader::AUTOLOAD;
	}
	else {
	  croak "Your vendor has not defined SSLeay macro $constname";
	}
    }
    eval "sub $AUTOLOAD { $val }";
    goto &$AUTOLOAD;
}

eval {
	require XSLoader;
	XSLoader::load('Net::SSLeay', $VERSION);
	1;
} or do {
	require DynaLoader;
	push @ISA, 'DynaLoader';
	bootstrap Net::SSLeay $VERSION;
};

# Preloaded methods go here.

$CRLF = "\x0d\x0a";  # because \r\n is not fully portable

### Print SSLeay error stack

sub print_errs {
    my ($msg) = @_;
    my ($count, $err, $errs, $e) = (0,0,'');
    while ($err = ERR_get_error()) {
        $count ++;
	$e = "$msg $$: $count - " . ERR_error_string($err) . "\n";
	$errs .= $e;
	warn $e if $Net::SSLeay::trace;
    }
    return $errs;
}

# Death is conditional to SSLeay errors existing, i.e. this function checks
# for errors and only dies in affirmative.
# usage: Net::SSLeay::write($ssl, "foo") or die_if_ssl_error("SSL write ($!)");

sub die_if_ssl_error {
    my ($msg) = @_;    
    die "$$: $msg\n" if print_errs($msg);
}

# Unconditional death. Used to print SSLeay errors before dying.
# usage: Net::SSLeay::connect($ssl) or die_now("Failed SSL connect ($!)");

sub die_now {
    my ($msg) = @_;    
    print_errs($msg);
    die "$$: $msg\n";
}

# Perl 5.6.* unicode support causes that length() no longer reliably
# reflects the byte length of a string. This eval is to fix that.
# Thanks to Sean Burke for the snippet.

BEGIN{ 
eval 'use bytes; sub blength ($) { length $_[0] }'; 
$@ and eval '    sub blength ($) { length $_[0] }' ; 
}

# Autoload methods go after =cut, and are processed by the autosplit program.

1;
__END__
# Documentation. Use `perl-root/pod/pod2html SSLeay.pm` to output html

# ';

### Some methods that are macros in C

sub want_nothing { want(shift) == 1 }
sub want_read { want(shift) == 2 }
sub want_write { want(shift) == 3 }
sub want_X509_lookup { want(shift) == 4 }

###
### Open TCP stream to given host and port, looking up the details
### from system databases or DNS.
###

sub open_tcp_connection {
    my ($dest_serv, $port) = @_;
    my ($errs);
    
    $port = getservbyname($port, 'tcp') unless $port =~ /^\d+$/;
    my $dest_serv_ip = gethostbyname($dest_serv);
    unless (defined($dest_serv_ip)) {
	$errs = "$0 $$: open_tcp_connection: destination host not found:"
            . " `$dest_serv' (port $port) ($!)\n";
	warn $errs if $trace;
        return wantarray ? (0, $errs) : 0;
    }
    my $sin = sockaddr_in($port, $dest_serv_ip);
    
    warn "Opening connection to $dest_serv:$port (" .
	inet_ntoa($dest_serv_ip) . ")" if $trace>2;
    
    my $proto = getprotobyname('tcp');
    if (socket (SSLCAT_S, &PF_INET(), &SOCK_STREAM(), $proto)) {
        warn "next connect" if $trace>3;
        if (CORE::connect (SSLCAT_S, $sin)) {
            my $old_out = select (SSLCAT_S); $| = 1; select ($old_out);
            warn "connected to $dest_serv, $port" if $trace>3;
            return wantarray ? (1, undef) : 1; # Success
        }
    }
    $errs = "$0 $$: open_tcp_connection: failed `$dest_serv', $port ($!)\n";
    warn $errs if $trace;
    close SSLCAT_S;
    return wantarray ? (0, $errs) : 0; # Fail
}

### Open connection via standard web proxy, if one was defined
### using set_proxy().

sub open_proxy_tcp_connection {
    my ($dest_serv, $port) = @_;
    return open_tcp_connection($dest_serv, $port) if !$proxyhost;
    
    warn "Connect via proxy: $proxyhost:$proxyport" if $trace>2;
    my ($ret, $errs) = open_tcp_connection($proxyhost, $proxyport);
    return wantarray ? (0, $errs) : 0 if !$ret;  # Connection fail
    
    warn "Asking proxy to connect to $dest_serv:$port" if $trace>2;
    #print SSLCAT_S "CONNECT $dest_serv:$port HTTP/1.0$proxyauth$CRLF$CRLF";
    #my $line = <SSLCAT_S>;   # *** bug? Mixing stdio with syscall read?
    ($ret, $errs) =
	tcp_write_all("CONNECT $dest_serv:$port HTTP/1.0$proxyauth$CRLF$CRLF");
    return wantarray ? (0,$errs) : 0 if $errs;
    ($line, $errs) = tcp_read_until($CRLF . $CRLF, 1024);
    warn "Proxy response: $line" if $trace>2;
    return wantarray ? (0,$errs) : 0 if $errs;
    return wantarray ? (1,'') : 1;  # Success
}

###
### read and write helpers that block
###

sub debug_read {
    my ($replyr, $gotr) = @_;
    my $vm = $trace>2 && $linux_debug ?
	(split ' ', `cat /proc/$$/stat`)[22] : 'vm_unknown';
    warn "  got " . blength($$gotr) . ':'
	. blength($$replyr) . " bytes (VM=$vm).\n" if $trace == 3;
    warn "  got `$$gotr' (" . blength($$gotr) . ':'
	. blength($$replyr) . " bytes, VM=$vm)\n" if $trace>3;
}

sub ssl_read_all {
    my ($ssl,$how_much) = @_;
    $how_much = 2000000000 unless $how_much;
    my ($got, $errs);
    my $reply = '';

    while ($how_much > 0) {
        $got = Net::SSLeay::read($ssl,
                ($how_much > 32768) ? 32768 : $how_much
        );
        last if $errs = print_errs('SSL_read');
        $how_much -= blength($got);
        debug_read(\$reply, \$got) if $trace>1;
        last if $got eq '';  # EOF
        $reply .= $got;
    }

    return wantarray ? ($reply, $errs) : $reply;
}

sub tcp_read_all {
    my ($how_much) = @_;
    $how_much = 2000000000 unless $how_much;
    my ($n, $got, $errs);
    my $reply = '';

    my $bsize = 0x10000;
    while ($how_much > 0) {
	$n = sysread(SSLCAT_S,$got, (($bsize < $how_much) ? $bsize : $how_much));
	warn "Read error: $! ($n,$how_much)" unless defined $n;
	last if !$n;  # EOF
	$how_much -= $n;
	debug_read(\$reply, \$got) if $trace>1;
	$reply .= $got;
    }
    return wantarray ? ($reply, $errs) : $reply;
}

sub ssl_write_all {
    my $ssl = $_[0];    
    my ($data_ref, $errs);
    if (ref $_[1]) {
	$data_ref = $_[1];
    } else {
	$data_ref = \$_[1];
    }
    my ($wrote, $written, $to_write) = (0,0, blength($$data_ref));
    my $vm = $trace>2 && $linux_debug ?
	(split ' ', `cat /proc/$$/stat`)[22] : 'vm_unknown';
    warn "  write_all VM at entry=$vm\n" if $trace>2;
    while ($to_write) {
	#sleep 1; # *** DEBUG
	warn "partial `$$data_ref'\n" if $trace>3;
	$wrote = write_partial($ssl, $written, $to_write, $$data_ref);
	if (defined $wrote && ($wrote > 0)) {  # write_partial can return -1
	    $written += $wrote;
	    $to_write -= $wrote;
	} else {
	  if (defined $wrote) {
	    # check error conditions via SSL_get_error per man page
	    if ( my $sslerr = get_error($ssl, $wrote) ) {
	      my $errstr = ERR_error_string($sslerr);
	      my $errname = '';
	      SWITCH: {
		$sslerr == constant("ERROR_NONE") && do {
		  # according to map page SSL_get_error(3ssl):
		  #  The TLS/SSL I/O operation completed.  
		  #  This result code is returned if and only if ret > 0
                  # so if we received it here complain...
		  warn "ERROR_NONE unexpected with invalid return value!" 
		    if $trace;
		  $errname = "SSL_ERROR_NONE";
		};
		$sslerr == constant("ERROR_WANT_READ") && do {
		  # operation did not complete, call again later, so do not
		  # set errname and empty err_que since this is a known
		  # error that is expected but, we should continue to try
		  # writing the rest of our data with same io call and params.
		  warn "ERROR_WANT_READ (TLS/SSL Handshake, will continue)\n"
		    if $trace;
		  print_errs('SSL_write(want read)');
		  last SWITCH;
		};
		$sslerr == constant("ERROR_WANT_WRITE") && do {
		  # operation did not complete, call again later, so do not
		  # set errname and empty err_que since this is a known
		  # error that is expected but, we should continue to try
		  # writing the rest of our data with same io call and params.
		  warn "ERROR_WANT_WRITE (TLS/SSL Handshake, will continue)\n"
		    if $trace;
		  print_errs('SSL_write(want write)');
		  last SWITCH;
		};
		$sslerr == constant("ERROR_ZERO_RETURN") && do {
		  # valid protocol closure from other side, no longer able to
		  # write, since there is no longer a session...
		  warn "ERROR_ZERO_RETURN($wrote): TLS/SSLv3 Closure alert\n"
		    if $trace;
		  $errname = "SSL_ERROR_ZERO_RETURN";
		  last SWITCH;
		};
		$sslerr == constant("ERROR_SSL") && do {
		  # library/protocol error
		  warn "ERROR_SSL($wrote): Library/Protocol error occured\n"
		    if $trace;
		  $errname = "SSL_ERROR_SSL";
		  last SWITCH;
		};
		$sslerr == constant("ERROR_WANT_CONNECT") && do {
		  # according to man page, should never happen on call to
		  # SSL_write, so complain, but handle as known error type
		  warn "ERROR_WANT_CONNECT: Unexpected error for SSL_write\n"
		    if $trace;
		  $errname = "SSL_ERROR_WANT_CONNECT";
		  last SWITCH;
		};
		$sslerr == constant("ERROR_WANT_ACCEPT") && do { 
		  # according to man page, should never happen on call to
		  # SSL_write, so complain, but handle as known error type
		  warn "ERROR_WANT_ACCEPT: Unexpected error for SSL_write\n"
		    if $trace;
		  $errname = "SSL_ERROR_WANT_ACCEPT";
		  last SWITCH;
		};
		$sslerr == constant("ERROR_WANT_X509_LOOKUP") && do {
		  # operation did not complete: waiting on call back,  
		  # call again later, so do not set errname and empty err_que
		  # since this is a known error that is expected but, we should
		  # continue to try writing the rest of our data with same io
		  # call parameter.
		  warn "ERROR_WANT_X509_LOOKUP: (Cert Callback asked for in ".
		    "SSL_write will contine)\n" if $trace;
		  print_errs('SSL_write(want x509');
		  last SWITCH;
		};
		$sslerr == constant("ERROR_SYSCALL") && do {
		  # some IO error occured. According to man page: 
		  # Check retval, ERR, fallback to errno
		  if ($wrote==0) { # EOF
		    warn "ERROR_SYSCALL($wrote): EOF violates protocol.\n"
		      if $trace;
		    $errname = "SSL_ERROR_SYSCALL(EOF)";
		  } else { # -1 underlying BIO error reported.
		    # check error que for details, don't set errname since we
		    # are directly appending to errs
		    my $chkerrs = print_errs('SSL_write (syscall)');
		    if ($chkerrs) { 
		      warn "ERROR_SYSCALL($wrote): Have errors\n" if $trace;
		      $errs .= "ssl_write_all $$: 1 - ERROR_SYSCALL($wrote,".
			"$sslerr,$errstr,$!)\n$chkerrs";
		    } else { # que was empty, use errno
		      warn "ERROR_SYSCALL($wrote): errno($!)\n" if $trace;
		      $errs .= "ssl_write_all $$: 1 - ERROR_SYSCALL($wrote,".
			"$sslerr) : $!\n";
		    }
		  }
		  last SWITCH;
		};
		warn "Unhandled val $sslerr from SSL_get_error(SSL,$wrote)\n"
		  if $trace;
		$errname = "SSL_ERROR_?($sslerr)";
	      } # end of SWITCH block
	      if ($errname) { # if we had an errname set add the error
		$errs .= "ssl_write_all $$: 1 - $errname($wrote,$sslerr,".
		  "$errstr,$!)\n";
	      }	      
	    } # endif on have SSL_get_error val
	  } # endif on $wrote defined
	} # endelse on $wrote > 0
	$vm = $trace>2 && $linux_debug ?
	    (split ' ', `cat /proc/$$/stat`)[22] : 'vm_unknown';
	warn "  written so far $wrote:$written bytes (VM=$vm)\n" if $trace>2;
	# append remaining errors in que and report if errs exist
	$errs .= print_errs('SSL_write');
	return (wantarray ? (undef, $errs) : undef) if $errs;
    }
    return wantarray ? ($written, $errs) : $written;
}

sub tcp_write_all {
    my ($data_ref, $errs);
    if (ref $_[0]) {
	$data_ref = $_[0];
    } else {
	$data_ref = \$_[0];
    }
    my ($wrote, $written, $to_write) = (0,0, blength($$data_ref));
    my $vm = $trace>2 && $linux_debug ?
	(split ' ', `cat /proc/$$/stat`)[22] : 'vm_unknown';
    warn "  write_all VM at entry=$vm to_write=$to_write\n" if $trace>2;
    while ($to_write) {
	warn "partial `$$data_ref'\n" if $trace>3;
	$wrote = syswrite(SSLCAT_S, $$data_ref, $to_write, $written);
	if (defined $wrote && ($wrote > 0)) {  # write_partial can return -1
	    $written += $wrote;
	    $to_write -= $wrote;
	} elsif (!defined($wrote)) {
	    warn "tcp_write_all: $!";
	    return (wantarray ? (undef, "$!") : undef);
	}
	$vm = $trace>2 && $linux_debug ?
	    (split ' ', `cat /proc/$$/stat`)[22] : 'vm_unknown';
	warn "  written so far $wrote:$written bytes (VM=$vm)\n" if $trace>2;
    }
    return wantarray ? ($written, '') : $written;
}

### from patch by Clinton Wong <clintdw@netcom.com>

# ssl_read_until($ssl [, $delimit [, $max_length]])
#  if $delimit missing, use $/ if it exists, otherwise use \n
#  read until delimiter reached, up to $max_length chars if defined

sub ssl_read_until ($;$$) {
    my ($ssl,$delim, $max_length) = @_;
    local $[;

    # guess the delim string if missing
    if ( ! defined $delim ) {           
      if ( defined $/ && length $/  ) { $delim = $/ }
      else { $delim = "\n" }      # Note: \n,$/ value depends on the platform
    }
    my $len_delim = length $delim;

    my ($got);
    my $reply = '';
    
    # If we have OpenSSL 0.9.6a or later, we can use SSL_peek to
    # speed things up.
    # N.B. 0.9.6a has security problems, so the support for
    #      anything earlier than 0.9.6e will be dropped soon.
    if (&Net::SSLeay::OPENSSL_VERSION_NUMBER >= 0x0090601f) {
	$max_length = 2000000000 unless (defined $max_length);
	my ($pending, $peek_length, $found, $done);
	while (blength($reply) < $max_length and !$done) {
	    #Block if necessary until we get some data
	    $got = Net::SSLeay::peek($ssl,1);
	    last if print_errs('SSL_peek');

	    $pending = Net::SSLeay::pending($ssl) + blength($reply);
	    $peek_length = ($pending > $max_length) ? $max_length : $pending;
	    $peek_length -= blength($reply);
	    $got = Net::SSLeay::peek($ssl, $peek_length);
	    last if print_errs('SSL_peek');
	    $peek_length = blength($got);
	    
	    #$found = index($got, $delim);  # Old and broken
	    
	    # the delimiter may be split across two gets, so we prepend
	    # a little from the last get onto this one before we check
	    # for a match
	    my $match;
	    if(blength($reply) >= blength($delim) - 1) {
		#if what we've read so far is greater or equal
		#in length of what we need to prepatch
		$match = substr $reply, blength($reply) - blength($delim) + 1;
	    } else {
		$match = $reply;
	    }

	    $match .= $got;
	    $found = index($match, $delim);

	    if ($found > -1) {
		#$got = Net::SSLeay::read($ssl, $found+$len_delim);
		#read up to the end of the delimiter
		$got = Net::SSLeay::read($ssl,
					 $found + $len_delim
					 - ((blength $match) - (blength $got)));
		$done = 1;
	    } else {
		$got = Net::SSLeay::read($ssl, $peek_length);
		$done = 1 if ($peek_length == $max_length - blength($reply));
	    } 

	    last if print_errs('SSL_read');
	    debug_read(\$reply, \$got) if $trace>1;
	    last if $got eq '';
	    $reply .= $got;
	}
    } else {
	while (!defined $max_length || length $reply < $max_length) {
	    $got = Net::SSLeay::read($ssl,1);  # one by one
	    last if print_errs('SSL_read');
	    debug_read(\$reply, \$got) if $trace>1;
	    last if $got eq '';
	    $reply .= $got;
	    last if $len_delim
		&& substr($reply, blength($reply)-$len_delim) eq $delim;
	}
    }
    return $reply;
}

sub tcp_read_until {
    my ($delim, $max_length) = @_;
    local $[;

    # guess the delim string if missing
    if ( ! defined $delim ) {           
      if ( defined $/ && length $/  ) { $delim = $/ }
      else { $delim = "\n" }      # Note: \n,$/ value depends on the platform
    }
    my $len_delim = length $delim;

    my ($n,$got);
    my $reply = '';
    
    while (!defined $max_length || length $reply < $max_length) {
	$n = sysread(SSLCAT_S, $got, 1);  # one by one
	warn "tcp_read_until: $!" if !defined $n;
	debug_read(\$reply, \$got) if $trace>1;
	last if !$n;  # EOF
	$reply .= $got;
	last if $len_delim
	    && substr($reply, blength($reply)-$len_delim) eq $delim;
    }
    return $reply;
}

# ssl_read_CRLF($ssl [, $max_length])
sub ssl_read_CRLF ($;$) { ssl_read_until($_[0], $CRLF, $_[1]) }
sub tcp_read_CRLF { tcp_read_until($CRLF, $_[0]) }

# ssl_write_CRLF($ssl, $message) writes $message and appends CRLF
sub ssl_write_CRLF ($$) { 
  # the next line uses less memory but might use more network packets
  return ssl_write_all($_[0], $_[1]) + ssl_write_all($_[0], $CRLF);

  # the next few lines do the same thing at the expense of memory, with
  # the chance that it will use less packets, since CRLF is in the original
  # message and won't be sent separately.

  #my $data_ref;
  #if (ref $_[1]) { $data_ref = $_[1] }
  # else { $data_ref = \$_[1] }
  #my $message = $$data_ref . $CRLF;
  #return ssl_write_all($_[0], \$message);
}

sub tcp_write_CRLF { 
  # the next line uses less memory but might use more network packets
  return tcp_write_all($_[0]) + tcp_write_all($CRLF);

  # the next few lines do the same thing at the expense of memory, with
  # the chance that it will use less packets, since CRLF is in the original
  # message and won't be sent separately.

  #my $data_ref;
  #if (ref $_[1]) { $data_ref = $_[1] }
  # else { $data_ref = \$_[1] }
  #my $message = $$data_ref . $CRLF;
  #return tcp_write_all($_[0], \$message);
}

### Quickly print out with whom we're talking

sub dump_peer_certificate ($) {
    my ($ssl) = @_;
    my $cert = get_peer_certificate($ssl);
    return if print_errs('get_peer_certificate');
    print "no cert defined\n" if !defined($cert);
    # Cipher=NONE with empty cert fix
    if (!defined($cert) || ($cert == 0)) {
	warn "cert = `$cert'\n" if $trace;
	return "Subject Name: undefined\nIssuer  Name: undefined\n";
    } else {
	my $x = 'Subject Name: '
	    . X509_NAME_oneline(X509_get_subject_name($cert)) . "\n"
		. 'Issuer  Name: '
		    . X509_NAME_oneline(X509_get_issuer_name($cert))  . "\n";
	Net::SSLeay::X509_free($cert);
	return $x;
    }
}

### Arrange some randomness for eay PRNG

sub randomize (;$$) {
    my ($rn_seed_file, $seed, $egd_path) = @_;
    my $rnsf = defined($rn_seed_file) && -r $rn_seed_file;

	$egd_path = '';
    $egd_path = $ENV{'EGD_PATH'} if $ENV{'EGD_PATH'};
    
    RAND_seed(rand() + $$);  # Stir it with time and pid
    
    unless ($rnsf || -r $Net::SSLeay::random_device || $seed || -S $egd_path) {
	warn "Random number generator not seeded!!!" if $trace;
    }
    
    RAND_load_file($rn_seed_file, -s _) if $rnsf;
    RAND_seed($seed) if $seed;
    RAND_seed($ENV{RND_SEED}) if $ENV{RND_SEED};
    RAND_egd($egd_path) if -e $egd_path && -S _;
    RAND_load_file($Net::SSLeay::random_device, $Net::SSLeay::how_random/8)
	if -r $Net::SSLeay::random_device;
}

sub new_x_ctx {
    if    ($ssl_version == 2)  { $ctx = CTX_v2_new(); }
    elsif ($ssl_version == 3)  { $ctx = CTX_v3_new(); }
    elsif ($ssl_version == 10) { $ctx = CTX_tlsv1_new(); }
    else                       { $ctx = CTX_new(); }
    return $ctx;
}

###
### Basic request - response primitive (don't use for https)
###

sub sslcat { # address, port, message, $crt, $key --> reply / (reply,errs,cert)
    my ($dest_serv, $port, $out_message, $crt_path, $key_path) = @_;
    my ($ctx, $ssl, $got, $errs, $written);
    
    ($got, $errs) = open_proxy_tcp_connection($dest_serv, $port);
    return (wantarray ? (undef, $errs) : undef) unless $got;
    
    ### Do SSL negotiation stuff
	    
    warn "Creating SSL $ssl_version context...\n" if $trace>2;
    load_error_strings();         # Some bloat, but I'm after ease of use
    SSLeay_add_ssl_algorithms();  # and debuggability.
    randomize();
    
    $ctx = new_x_ctx();
    goto cleanup2 if $errs = print_errs('CTX_new') or !$ctx;

    CTX_set_options($ctx, &OP_ALL);
    goto cleanup2 if $errs = print_errs('CTX_set_options');

    warn "Cert `$crt_path' given without key" if $crt_path && !$key_path;
    set_cert_and_key($ctx, $crt_path, $key_path) if $crt_path;
    
    warn "Creating SSL connection (context was '$ctx')...\n" if $trace>2;
    $ssl = new($ctx);
    goto cleanup if $errs = print_errs('SSL_new') or !$ssl;
    
    warn "Setting fd (ctx $ctx, con $ssl)...\n" if $trace>2;
    set_fd($ssl, fileno(SSLCAT_S));
    goto cleanup if $errs = print_errs('set_fd');
    
    warn "Entering SSL negotiation phase...\n" if $trace>2;

    if ($trace>2) {
	my $i = 0;
	my $p = '';
	my $cipher_list = 'Cipher list: ';
	$p=Net::SSLeay::get_cipher_list($ssl,$i);
	$cipher_list .= $p if $p;
	do {
	    $i++;
	    $cipher_list .= ', ' . $p if $p;
	    $p=Net::SSLeay::get_cipher_list($ssl,$i);
	} while $p;
	$cipher_list .= '\n';
	warn $cipher_list;
    }
    
    $got = Net::SSLeay::connect($ssl);
    warn "SSLeay connect returned $got\n" if $trace>2;
    goto cleanup if $errs = print_errs('SSL_connect');
    
    my $server_cert = get_peer_certificate($ssl);
    print_errs('get_peer_certificate');
    if ($trace>1) {	    
	warn "Cipher `" . get_cipher($ssl) . "'\n";
	print_errs('get_ciper');
	warn dump_peer_certificate($ssl);
    }
    
    ### Connected. Exchange some data (doing repeated tries if necessary).
        
    warn "sslcat $$: sending " . blength($out_message) . " bytes...\n"
	if $trace==3;
    warn "sslcat $$: sending `$out_message' (" . blength($out_message)
	. " bytes)...\n" if $trace>3;
    ($written, $errs) = ssl_write_all($ssl, $out_message);
    goto cleanup unless $written;
    
    sleep $slowly if $slowly;  # Closing too soon can abort broken servers
    CORE::shutdown SSLCAT_S, 1;  # Half close --> No more output, send EOF to server
    
    warn "waiting for reply...\n" if $trace>2;
    ($got, $errs) = ssl_read_all($ssl);
    warn "Got " . blength($got) . " bytes.\n" if $trace==3;
    warn "Got `$got' (" . blength($got) . " bytes)\n" if $trace>3;

cleanup:	    
    free ($ssl);
    $errs .= print_errs('SSL_free');
cleanup2:
    CTX_free ($ctx);
    $errs .= print_errs('CTX_free');
    close SSLCAT_S;    
    return wantarray ? ($got, $errs, $server_cert) : $got;
}

sub tcpcat { # address, port, message, $crt, $key --> reply / (reply,errs,cert)
    my ($dest_serv, $port, $out_message) = @_;
    my ($got, $errs, $written);
    
    ($got, $errs) = open_proxy_tcp_connection($dest_serv, $port);
    return (wantarray ? (undef, $errs) : undef) unless $got;
    
    ### Connected. Exchange some data (doing repeated tries if necessary).
        
    warn "tcpcat $$: sending " . blength($out_message) . " bytes...\n"
	if $trace==3;
    warn "tcpcat $$: sending `$out_message' (" . blength($out_message)
	. " bytes)...\n" if $trace>3;
    ($written, $errs) = tcp_write_all($out_message);
    goto cleanup unless $written;
    
    sleep $slowly if $slowly;  # Closing too soon can abort broken servers
    CORE::shutdown SSLCAT_S, 1;  # Half close --> No more output, send EOF to server
    
    warn "waiting for reply...\n" if $trace>2;
    ($got, $errs) = tcp_read_all($ssl);
    warn "Got " . blength($got) . " bytes.\n" if $trace==3;
    warn "Got `$got' (" . blength($got) . " bytes)\n" if $trace>3;

cleanup:
    close SSLCAT_S;    
    return wantarray ? ($got, $errs) : $got;
}

sub tcpxcat {
    my ($usessl, $site, $port, $req, $crt_path, $key_path) = @_;
    if ($usessl) {
	return sslcat($site, $port, $req, $crt_path, $key_path);
    } else {
	return tcpcat($site, $port, $req);
    }
}

###
### Basic request - response primitive, this is different from sslcat
###                 because this does not shutdown the connection.
###

sub https_cat { # address, port, message --> returns reply / (reply,errs,cert)
    my ($dest_serv, $port, $out_message, $crt_path, $key_path) = @_;
    my ($ctx, $ssl, $got, $errs, $written);
    
    ($got, $errs) = open_proxy_tcp_connection($dest_serv, $port);
    return (wantarray ? (undef, $errs) : undef) unless $got;
	    
    ### Do SSL negotiation stuff
	    
    warn "Creating SSL $ssl_version context...\n" if $trace>2;
    load_error_strings();         # Some bloat, but I'm after ease of use
    SSLeay_add_ssl_algorithms();  # and debuggability.
    randomize();

    $ctx = new_x_ctx();
    goto cleanup2 if $errs = print_errs('CTX_new') or !$ctx;

    CTX_set_options($ctx, &OP_ALL);
    goto cleanup2 if $errs = print_errs('CTX_set_options');
    
    warn "Cert `$crt_path' given without key" if $crt_path && !$key_path;
    set_cert_and_key($ctx, $crt_path, $key_path) if $crt_path;
    
    warn "Creating SSL connection (context was '$ctx')...\n" if $trace>2;
    $ssl = new($ctx);
    goto cleanup if $errs = print_errs('SSL_new') or !$ssl;
    
    warn "Setting fd (ctx $ctx, con $ssl)...\n" if $trace>2;
    set_fd($ssl, fileno(SSLCAT_S));
    goto cleanup if $errs = print_errs('set_fd');
    
    warn "Entering SSL negotiation phase...\n" if $trace>2;
    
    if ($trace>2) {
	my $i = 0;
	my $p = '';
	my $cipher_list = 'Cipher list: ';
	$p=Net::SSLeay::get_cipher_list($ssl,$i);
	$cipher_list .= $p if $p;
	do {
	    $i++;
	    $cipher_list .= ', ' . $p if $p;
	    $p=Net::SSLeay::get_cipher_list($ssl,$i);
	} while $p;
	$cipher_list .= '\n';
	warn $cipher_list;
    }

    $got = Net::SSLeay::connect($ssl);
    warn "SSLeay connect failed" if $trace>2 && $got==0;
    goto cleanup if $errs = print_errs('SSL_connect');
    
    my $server_cert = get_peer_certificate($ssl);
    print_errs('get_peer_certificate');
    if ($trace>1) {	    
	warn "Cipher `" . get_cipher($ssl) . "'\n";
	print_errs('get_ciper');
	warn dump_peer_certificate($ssl);
    }
    
    ### Connected. Exchange some data (doing repeated tries if necessary).
        
    warn "https_cat $$: sending " . blength($out_message) . " bytes...\n"
	if $trace==3;
    warn "https_cat $$: sending `$out_message' (" . blength($out_message)
	. " bytes)...\n" if $trace>3;
    ($written, $errs) = ssl_write_all($ssl, $out_message);
    goto cleanup unless $written;
    
    warn "waiting for reply...\n" if $trace>2;
    ($got, $errs) = ssl_read_all($ssl);
    warn "Got " . blength($got) . " bytes.\n" if $trace==3;
    warn "Got `$got' (" . blength($got) . " bytes)\n" if $trace>3;

cleanup:
    free ($ssl);
    $errs .= print_errs('SSL_free');
cleanup2:
    CTX_free ($ctx);
    $errs .= print_errs('CTX_free');
    close SSLCAT_S;    
    return wantarray ? ($got, $errs, $server_cert) : $got;
}

sub http_cat { # address, port, message --> returns reply / (reply,errs,cert)
    my ($dest_serv, $port, $out_message) = @_;
    my ($got, $errs, $written);
    
    ($got, $errs) = open_proxy_tcp_connection($dest_serv, $port);
    return (wantarray ? (undef, $errs) : undef) unless $got;
	    
    ### Connected. Exchange some data (doing repeated tries if necessary).
        
    warn "http_cat $$: sending " . blength($out_message) . " bytes...\n"
	if $trace==3;
    warn "http_cat $$: sending `$out_message' (" . blength($out_message)
	. " bytes)...\n" if $trace>3;
    ($written, $errs) = tcp_write_all($out_message);
    goto cleanup unless $written;
    
    warn "waiting for reply...\n" if $trace>2;
    ($got, $errs) = tcp_read_all(200000);
    warn "Got " . blength($got) . " bytes.\n" if $trace==3;
    warn "Got `$got' (" . blength($got) . " bytes)\n" if $trace>3;

cleanup:
    close SSLCAT_S;    
    return wantarray ? ($got, $errs) : $got;
}

sub httpx_cat {
    my ($usessl, $site, $port, $req, $crt_path, $key_path) = @_;
    warn "httpx_cat: usessl=$usessl ($site:$port)" if $trace;
    if ($usessl) {
	return https_cat($site, $port, $req, $crt_path, $key_path);
    } else {
	return http_cat($site, $port, $req);
    }
}

###
### Easy set up of private key and certificate
###

sub set_cert_and_key ($$$) {
    my ($ctx, $cert_path, $key_path) = @_;    
    my $errs = '';
    # Following will ask password unless private key is not encrypted
    CTX_use_RSAPrivateKey_file ($ctx, $key_path, &FILETYPE_PEM);
    $errs .= print_errs("private key `$key_path' ($!)");
    CTX_use_certificate_file ($ctx, $cert_path, &FILETYPE_PEM);
    $errs .= print_errs("certificate `$cert_path' ($!)");
    return wantarray ? (undef, $errs) : ($errs eq '');
}

### Old deprecated API

sub set_server_cert_and_key ($$$) { &set_cert_and_key }

### Set up to use web proxy

sub set_proxy ($$;**) {
    ($proxyhost, $proxyport, $proxyuser, $proxypass) = @_;
    require MIME::Base64 if $proxyuser;
    $proxyauth = $CRLF . 'Proxy-authorization: Basic '
	. MIME::Base64::encode("$proxyuser:$proxypass", '')
	    if $proxyuser;
}

###
### Easy https manipulation routines
###

sub make_form {
    my (@fields) = @_;
    my $form;
    while (@fields) {
	my ($name, $data) = (shift(@fields), shift(@fields));
	$data =~ s/([^\w\-.\@\$ ])/sprintf("%%%2.2x",ord($1))/gse;
    	$data =~ tr[ ][+];
	$form .= "$name=$data&";
    }
    chop $form;
    return $form;
}

sub make_headers {
    my (@headers) = @_;
    my $headers;
    while (@headers) {
	my $header = shift(@headers);
	my $value = shift(@headers);
	$header =~ s/:$//;
	$value =~ s/\x0d?\x0a$//; # because we add it soon, see below
	$headers .= "$header: $value$CRLF";
    }
    return $headers;
}

sub do_httpx3 {
    my ($method, $usessl, $site, $port, $path, $headers,
	$content, $mime_type, $crt_path, $key_path) = @_;
    my ($response, $page, $h,$v);

    if ($content) {
	$mime_type = "application/x-www-form-urlencoded" unless $mime_type;
	my $len = blength($content);
	$content = "Content-Type: $mime_type$CRLF"
	    . "Content-Length: $len$CRLF$CRLF$content";
    } else {
	$content = "$CRLF$CRLF";
    }
    my $req = "$method $path HTTP/1.0$CRLF";
    unless (defined $headers && $headers =~ /^Host:/m) {
        $req .= "Host: $site";
        unless (($port == 80 && !$usessl) || ($port == 443 && $usessl)) {
            $req .= ":$port";
        }
        $req .= $CRLF;
	}
    $req .= (defined $headers ? $headers : '') . "Accept: */*$CRLF$content";    

    warn "do_httpx3($method,$usessl,$site:$port)" if $trace;
    my ($http, $errs, $server_cert)
	= httpx_cat($usessl, $site, $port, $req, $crt_path, $key_path);
    return (undef, "HTTP/1.0 900 NET OR SSL ERROR$CRLF$CRLF$errs") if $errs;
    
    $http = '' if !defined $http;
    ($headers, $page) = split /\s?\n\s?\n/, $http, 2;
    warn "headers >$headers< page >>$page<< http >>>$http<<<" if $trace>1;
    ($response, $headers) = split /\s?\n/, $headers, 2;
    return ($page, $response, $headers, $server_cert);
}

sub do_https3 { splice(@_,1,0) = 1; do_httpx3; }  # Legacy undocumented

### do_https2() is a legacy version in the sense that it is unable
### to return all instances of duplicate headers.

sub do_httpx2 {
    my ($page, $response, $headers, $server_cert) = &do_httpx3;
    X509_free($server_cert) if defined $server_cert;
    return ($page, $response,
	    map( { ($h,$v)=/^(\S+)\:\s*(.*)$/; (uc($h),$v); }
		split(/\s?\n/, $headers)
		)
	    );
}

sub do_https2 { splice(@_,1,0) = 1; do_httpx2; }  # Legacy undocumented

### Returns headers as a hash where multiple instances of same header
### are handled correctly.

sub do_httpx4 {
    my ($page, $response, $headers, $server_cert) = &do_httpx3;
    X509_free($server_cert) if defined $server_cert;
    my %hr = ();
    for my $hh (split /\s?\n/, $headers) {
	my ($h,$v)=/^(\S+)\:\s*(.*)$/;
	push @{$hr{uc($h)}}, $v;
    }
    return ($page, $response, \%hr);
}

sub do_https4 { splice(@_,1,0) = 1; do_httpx4; }  # Legacy undocumented

# https

sub get_https  { do_httpx2(GET  => 1, @_) }
sub post_https { do_httpx2(POST => 1, @_) }
sub put_https  { do_httpx2(PUT  => 1, @_) }
sub head_https { do_httpx2(HEAD => 1, @_) }

sub get_https3  { do_httpx3(GET  => 1, @_) }
sub post_https3 { do_httpx3(POST => 1, @_) }
sub put_https3  { do_httpx3(PUT  => 1, @_) }
sub head_https3 { do_httpx3(HEAD => 1, @_) }

sub get_https4  { do_httpx4(GET  => 1, @_) }
sub post_https4 { do_httpx4(POST => 1, @_) }
sub put_https4  { do_httpx4(PUT  => 1, @_) }
sub head_https4 { do_httpx4(HEAD => 1, @_) }

# http

sub get_http  { do_httpx2(GET  => 0, @_) }
sub post_http { do_httpx2(POST => 0, @_) }
sub put_http  { do_httpx2(PUT  => 0, @_) }
sub head_http { do_httpx2(HEAD => 0, @_) }

sub get_http3  { do_httpx3(GET  => 0, @_) }
sub post_http3 { do_httpx3(POST => 0, @_) }
sub put_http3  { do_httpx3(PUT  => 0, @_) }
sub head_http3 { do_httpx3(HEAD => 0, @_) }

sub get_http4  { do_httpx4(GET  => 0, @_) }
sub post_http4 { do_httpx4(POST => 0, @_) }
sub put_http4  { do_httpx4(PUT  => 0, @_) }
sub head_http4 { do_httpx4(HEAD => 0, @_) }

# Either https or http

sub get_httpx  { do_httpx2(GET  => @_) }
sub post_httpx { do_httpx2(POST => @_) }
sub put_httpx  { do_httpx2(PUT  => @_) }
sub head_httpx { do_httpx2(HEAD => @_) }

sub get_httpx3  { do_httpx3(GET  => @_) }
sub post_httpx3 { do_httpx3(POST => @_) }
sub put_httpx3  { do_httpx3(PUT  => @_) }
sub head_httpx3 { do_httpx3(HEAD => @_) }

sub get_httpx4  { do_httpx4(GET  => @_) }
sub post_httpx4 { do_httpx4(POST => @_) }
sub put_httpx4  { do_httpx4(PUT  => @_) }
sub head_httpx4 { do_httpx4(HEAD => @_) }

### Legacy, don't use
# ($page, $respone_or_err, %headers) = do_https(...);

sub do_https {
    my ($site, $port, $path, $method, $headers,
	$content, $mime_type, $crt_path, $key_path) = @_;

    do_https2($method, $site, $port, $path, $headers,
	     $content, $mime_type, $crt_path, $key_path);
}
 
1;
__END__