home *** CD-ROM | disk | FTP | other *** search
/ PC World 2005 December (Special) / PCWorld_2005-12_Special_cd.bin / Bezpecnost / lsti / lsti.exe / framework-2.5.exe / SSLeay.pm < prev    next >
Text File  |  2003-06-13  |  71KB  |  2,038 lines

  1. # Net::SSLeay.pm - Perl module for using Eric Young's implementation of SSL
  2. #
  3. # Copyright (c) 1996-2003 Sampo Kellomaki <sampo@iki.fi>, All Rights Reserved.
  4. # $Id: SSLeay.pm,v 1.22 2003/02/18 04:08:41 sampo Exp $
  5. # Version 1.04, 31.3.1999
  6. # 30.7.1999, Tracking OpenSSL-0.9.3a changes, --Sampo
  7. # 31.7.1999, version 1.05 --Sampo
  8. # 7.4.2001,  fixed input error upon 0, OpenSSL-0.9.6a, version 1.06 --Sampo
  9. # 18.4.2001, added TLSv1 support by Stephen C. Koehler
  10. #            <koehler@securecomputing.com>, version 1.07, --Sampo
  11. # 25.4.2001, 64 bit fixes by Marko Asplund <aspa@kronodoc.fi> --Sampo
  12. # 17.4.2001, more error codes from aspa --Sampo
  13. # 25.9.2001, added heaps and piles of newer OpenSSL auxiliary functions --Sampo
  14. # 6.11.2001, got rid of $p_errs madness --Sampo
  15. # 9.11.2001, added EGD (entropy gathering daemon) reference info --Sampo
  16. # 7.12.2001, Added proxy support by Bruno De Wolf <bruno.dewolf@@pandora._be>
  17. # 6.1.2002,  cosmetic fix to socket options from Kwindla Hultman Kramer <kwindla@@allafrica_.com>
  18. # 25.3.2002, added post_https_cert and friends per patch from
  19. #            mock@@obscurity.ogr, --Sampo
  20. # 3.4.2002,  added `use bytes' from Marcus Taylor <marcus@@semantico_.com>
  21. #            This avoids unicode/utf8 (as may appear in some XML docs)
  22. #            from fooling the length comuptations. Dropped support for
  23. #            perl5.005_03 because I do not have opportunity to test it. --Sampo
  24. # 5.4.2002,  improved Unicode gotcha eliminator to support old perls --Sampo
  25. # 8.4.2002,  added a small line end fix from Petr Dousa (pdousa@@kerio_.com)
  26. # 17.5.2002, Added BIO_s_mem, BIO_new, BIO_free, BIO_write, BIO_read 
  27. #            BIO_eof, BIO_pending, BIO_wpending, RSA_generate_key, RSA_free
  28. #            --mikem@open._com.au
  29. # 10.8.2002, Added SSL_peek patch to ssl_read_until from 
  30. #            Peter Behroozi <peter@@fhpwireless_.com> --Sampo
  31. # 21.8.2002, Added SESSION_get_master_key, SSL_get_client_random, SSL_get_server_random
  32. #            --mikem@open.com_.au
  33. # 2.9.2002,  Added SSL_CTX_get_cert_store, X509_STORE_add_cert, X509_STORE_add_crl
  34. #            X509_STORE_set_flags, X509_load_cert_file, X509_load_crl_file
  35. #            X509_load_cert_crl_file, PEM_read_bio_X509_CRL,
  36. #            constants for X509_V_FLAG_* in order to support certificate revocation lists.
  37. #            --mikem@open.com_.au
  38. # 6.9.2002,  fixed X509_STORE_set_flags to X509_STORE_CTX_set_flags, --Sampo
  39. # 19.9.2002, applied patch from Tim Engler <tim@burntcouch_.com>
  40. # 18.2.2003, applied patch from Toni Andjelkovic <toni@soth._at>
  41. # 13.6.2003, partially applied leak patch by Marian Jancar <mjancar@suse._cz>
  42. #
  43. # The distribution and use of this module are subject to the conditions
  44. # listed in LICENSE file at the root of OpenSSL-0.9.6c
  45. # distribution (i.e. free, but mandatory attribution and NO WARRANTY).
  46.  
  47. package Net::SSLeay;
  48.  
  49. use strict;
  50. use Carp;
  51. use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD $CRLF);
  52. use Socket;
  53. use Errno;
  54.  
  55. require Exporter;
  56. require DynaLoader;
  57. use AutoLoader;
  58.  
  59. # 0=no warns, 1=only errors, 2=ciphers, 3=progress, 4=dump data
  60. $Net::SSLeay::trace = 0;  # Do not change here, use
  61.                           # $Net::SSLeay::trace = [1-4]  in caller
  62.  
  63. # 2 = insist on v2 SSL protocol
  64. # 3 = insist on v3 SSL
  65. # 10 = insist on TLSv1
  66. # 0 or undef = guess (v23)
  67. #
  68. $Net::SSLeay::ssl_version = 0;
  69.  
  70. #define to enable the "cat /proc/$$/stat" stuff
  71. $Net::SSLeay::linux_debug = 0;
  72.  
  73. # Number of seconds to sleep after sending message and before half
  74. # closing connection. Useful with antiquated broken servers.
  75. $Net::SSLeay::slowly = 0;  # don't change here, use 
  76.                            # Net::SSLeay::version=[2,3,0] in caller
  77.  
  78. # RANDOM NUMBER INITIALIZATION
  79. #
  80. # Edit to your taste. Using /dev/random would be more secure, but may
  81. # block if randomness is not available, thus the default is
  82. # /dev/urandom. $how_random determines how many bits of randomness to take
  83. # from the device. You should take enough (read SSLeay/doc/rand), but
  84. # beware that randomness is limited resource so you should not waste
  85. # it either or you may end up with randomness depletion (situation where
  86. # /dev/random would block and /dev/urandom starts to return predictable
  87. # numbers).
  88. #
  89. # N.B. /dev/urandom does not exit on all systems, such as Solaris 2.6. In that
  90. #      case you should get a third party package that emulates /dev/urandom
  91. #      (e.g. via named pipe) or supply a random number file. Some such
  92. #      packages are documented in Caveat section of the POD documentation.
  93.  
  94. $Net::SSLeay::random_device = '/dev/urandom';
  95. $Net::SSLeay::how_random = 512;
  96.  
  97. $VERSION = '1.23';
  98. @ISA = qw(Exporter DynaLoader);
  99. @EXPORT_OK = qw(
  100.     AT_MD5_WITH_RSA_ENCRYPTION
  101.     CB_ACCEPT_EXIT
  102.     CB_ACCEPT_LOOP
  103.     CB_CONNECT_EXIT
  104.     CB_CONNECT_LOOP
  105.     CK_DES_192_EDE3_CBC_WITH_MD5
  106.     CK_DES_192_EDE3_CBC_WITH_SHA
  107.     CK_DES_64_CBC_WITH_MD5
  108.     CK_DES_64_CBC_WITH_SHA
  109.     CK_DES_64_CFB64_WITH_MD5_1
  110.     CK_IDEA_128_CBC_WITH_MD5
  111.     CK_NULL
  112.     CK_NULL_WITH_MD5
  113.     CK_RC2_128_CBC_EXPORT40_WITH_MD5
  114.     CK_RC2_128_CBC_WITH_MD5
  115.     CK_RC4_128_EXPORT40_WITH_MD5
  116.     CK_RC4_128_WITH_MD5
  117.     CLIENT_VERSION
  118.     ERROR_NONE
  119.     ERROR_SSL
  120.     ERROR_SYSCALL
  121.     ERROR_WANT_CONNECT
  122.     ERROR_WANT_READ
  123.     ERROR_WANT_WRITE
  124.     ERROR_WANT_X509_LOOKUP
  125.     ERROR_ZERO_RETURN
  126.     CT_X509_CERTIFICATE
  127.     FILETYPE_ASN1
  128.     FILETYPE_PEM
  129.     F_CLIENT_CERTIFICATE
  130.     F_CLIENT_HELLO
  131.     F_CLIENT_MASTER_KEY
  132.     F_D2I_SSL_SESSION
  133.     F_GET_CLIENT_FINISHED
  134.     F_GET_CLIENT_HELLO
  135.     F_GET_CLIENT_MASTER_KEY
  136.     F_GET_SERVER_FINISHED
  137.     F_GET_SERVER_HELLO
  138.     F_GET_SERVER_VERIFY
  139.     F_I2D_SSL_SESSION
  140.     F_READ_N
  141.     F_REQUEST_CERTIFICATE
  142.     F_SERVER_HELLO
  143.     F_SSL_ACCEPT
  144.     F_SSL_CERT_NEW
  145.     F_SSL_CONNECT
  146.     F_SSL_ENC_DES_CBC_INIT
  147.     F_SSL_ENC_DES_CFB_INIT
  148.     F_SSL_ENC_DES_EDE3_CBC_INIT
  149.     F_SSL_ENC_IDEA_CBC_INIT
  150.     F_SSL_ENC_NULL_INIT
  151.     F_SSL_ENC_RC2_CBC_INIT
  152.     F_SSL_ENC_RC4_INIT
  153.     F_SSL_GET_NEW_SESSION
  154.     F_SSL_MAKE_CIPHER_LIST
  155.     F_SSL_NEW
  156.     F_SSL_READ
  157.     F_SSL_RSA_PRIVATE_DECRYPT
  158.     F_SSL_RSA_PUBLIC_ENCRYPT
  159.     F_SSL_SESSION_NEW
  160.     F_SSL_SESSION_PRINT_FP
  161.     F_SSL_SET_CERTIFICATE
  162.     F_SSL_SET_FD
  163.     F_SSL_SET_RFD
  164.     F_SSL_SET_WFD
  165.     F_SSL_STARTUP
  166.     F_SSL_USE_CERTIFICATE
  167.     F_SSL_USE_CERTIFICATE_ASN1
  168.     F_SSL_USE_CERTIFICATE_FILE
  169.     F_SSL_USE_PRIVATEKEY
  170.     F_SSL_USE_PRIVATEKEY_ASN1
  171.     F_SSL_USE_PRIVATEKEY_FILE
  172.     F_SSL_USE_RSAPRIVATEKEY
  173.     F_SSL_USE_RSAPRIVATEKEY_ASN1
  174.     F_SSL_USE_RSAPRIVATEKEY_FILE
  175.     F_WRITE_PENDING
  176.     MAX_MASTER_KEY_LENGTH_IN_BITS
  177.     MAX_RECORD_LENGTH_2_BYTE_HEADER
  178.     MAX_RECORD_LENGTH_3_BYTE_HEADER
  179.     MAX_SSL_SESSION_ID_LENGTH_IN_BYTES
  180.     MIN_RSA_MODULUS_LENGTH_IN_BYTES
  181.     MT_CLIENT_CERTIFICATE
  182.     MT_CLIENT_FINISHED
  183.     MT_CLIENT_HELLO
  184.     MT_CLIENT_MASTER_KEY
  185.     MT_ERROR
  186.     MT_REQUEST_CERTIFICATE
  187.     MT_SERVER_FINISHED
  188.     MT_SERVER_HELLO
  189.     MT_SERVER_VERIFY
  190.     NOTHING
  191.     OPENSSL_VERSION_NUMBER
  192.     PE_BAD_CERTIFICATE
  193.     PE_NO_CERTIFICATE
  194.     PE_NO_CIPHER
  195.     PE_UNSUPPORTED_CERTIFICATE_TYPE
  196.     READING
  197.     RWERR_BAD_MAC_DECODE
  198.     RWERR_BAD_WRITE_RETRY
  199.     RWERR_INTERNAL_ERROR
  200.     R_BAD_AUTHENTICATION_TYPE
  201.     R_BAD_CHECKSUM
  202.     R_BAD_MAC_DECODE
  203.     R_BAD_RESPONSE_ARGUMENT
  204.     R_BAD_SSL_FILETYPE
  205.     R_BAD_SSL_SESSION_ID_LENGTH
  206.     R_BAD_STATE
  207.     R_BAD_WRITE_RETRY
  208.     R_CHALLENGE_IS_DIFFERENT
  209.     R_CIPHER_CODE_TOO_LONG
  210.     R_CIPHER_TABLE_SRC_ERROR
  211.     R_CONECTION_ID_IS_DIFFERENT
  212.     R_INVALID_CHALLENGE_LENGTH
  213.     R_NO_CERTIFICATE_SET
  214.     R_NO_CERTIFICATE_SPECIFIED
  215.     R_NO_CIPHER_LIST
  216.     R_NO_CIPHER_MATCH
  217.     R_NO_CIPHER_WE_TRUST
  218.     R_NO_PRIVATEKEY
  219.     R_NO_PUBLICKEY
  220.     R_NO_READ_METHOD_SET
  221.     R_NO_WRITE_METHOD_SET
  222.     R_NULL_SSL_CTX
  223.     R_PEER_DID_NOT_RETURN_A_CERTIFICATE
  224.     R_PEER_ERROR
  225.     R_PEER_ERROR_CERTIFICATE
  226.     R_PEER_ERROR_NO_CIPHER
  227.     R_PEER_ERROR_UNSUPPORTED_CERTIFICATE_TYPE
  228.     R_PERR_ERROR_NO_CERTIFICATE
  229.     R_PUBLIC_KEY_ENCRYPT_ERROR
  230.     R_PUBLIC_KEY_IS_NOT_RSA
  231.     R_PUBLIC_KEY_NO_RSA
  232.     R_READ_WRONG_PACKET_TYPE
  233.     R_REVERSE_KEY_ARG_LENGTH_IS_WRONG
  234.     R_REVERSE_MASTER_KEY_LENGTH_IS_WRONG
  235.     R_REVERSE_SSL_SESSION_ID_LENGTH_IS_WRONG
  236.     R_SHORT_READ
  237.     R_SSL_SESSION_ID_IS_DIFFERENT
  238.     R_UNABLE_TO_EXTRACT_PUBLIC_KEY
  239.     R_UNDEFINED_INIT_STATE
  240.     R_UNKNOWN_REMOTE_ERROR_TYPE
  241.     R_UNKNOWN_STATE
  242.     R_UNSUPORTED_CIPHER
  243.     R_WRONG_PUBLIC_KEY_TYPE
  244.     R_X509_LIB
  245.     SERVER_VERSION
  246.     SESSION
  247.     SESSION_ASN1_VERSION
  248.     ST_ACCEPT
  249.     ST_BEFORE
  250.     ST_CLIENT_START_ENCRYPTION
  251.     ST_CONNECT
  252.     ST_GET_CLIENT_FINISHED_A
  253.     ST_GET_CLIENT_FINISHED_B
  254.     ST_GET_CLIENT_HELLO_A
  255.     ST_GET_CLIENT_HELLO_B
  256.     ST_GET_CLIENT_MASTER_KEY_A
  257.     ST_GET_CLIENT_MASTER_KEY_B
  258.     ST_GET_SERVER_FINISHED_A
  259.     ST_GET_SERVER_FINISHED_B
  260.     ST_GET_SERVER_HELLO_A
  261.     ST_GET_SERVER_HELLO_B
  262.     ST_GET_SERVER_VERIFY_A
  263.     ST_GET_SERVER_VERIFY_B
  264.     ST_INIT
  265.     ST_OK
  266.     ST_READ_BODY
  267.     ST_READ_HEADER
  268.     ST_SEND_CLIENT_CERTIFICATE_A
  269.     ST_SEND_CLIENT_CERTIFICATE_B
  270.     ST_SEND_CLIENT_CERTIFICATE_C
  271.     ST_SEND_CLIENT_CERTIFICATE_D
  272.     ST_SEND_CLIENT_FINISHED_A
  273.     ST_SEND_CLIENT_FINISHED_B
  274.     ST_SEND_CLIENT_HELLO_A
  275.     ST_SEND_CLIENT_HELLO_B
  276.     ST_SEND_CLIENT_MASTER_KEY_A
  277.     ST_SEND_CLIENT_MASTER_KEY_B
  278.     ST_SEND_REQUEST_CERTIFICATE_A
  279.     ST_SEND_REQUEST_CERTIFICATE_B
  280.     ST_SEND_REQUEST_CERTIFICATE_C
  281.     ST_SEND_REQUEST_CERTIFICATE_D
  282.     ST_SEND_SERVER_FINISHED_A
  283.     ST_SEND_SERVER_FINISHED_B
  284.     ST_SEND_SERVER_HELLO_A
  285.     ST_SEND_SERVER_HELLO_B
  286.     ST_SEND_SERVER_VERIFY_A
  287.     ST_SEND_SERVER_VERIFY_B
  288.     ST_SERVER_START_ENCRYPTION
  289.     ST_X509_GET_CLIENT_CERTIFICATE
  290.     ST_X509_GET_SERVER_CERTIFICATE
  291.     TXT_DES_192_EDE3_CBC_WITH_MD5
  292.     TXT_DES_192_EDE3_CBC_WITH_SHA
  293.     TXT_DES_64_CBC_WITH_MD5
  294.     TXT_DES_64_CBC_WITH_SHA
  295.     TXT_DES_64_CFB64_WITH_MD5_1
  296.     TXT_IDEA_128_CBC_WITH_MD5
  297.     TXT_NULL
  298.     TXT_NULL_WITH_MD5
  299.     TXT_RC2_128_CBC_EXPORT40_WITH_MD5
  300.     TXT_RC2_128_CBC_WITH_MD5
  301.     TXT_RC4_128_EXPORT40_WITH_MD5
  302.     TXT_RC4_128_WITH_MD5
  303.     VERIFY_CLIENT_ONCE
  304.     VERIFY_FAIL_IF_NO_PEER_CERT
  305.     VERIFY_NONE
  306.     VERIFY_PEER
  307.     WRITING
  308.     X509_LOOKUP
  309.     X509_V_FLAG_CB_ISSUER_CHECK
  310.     X509_V_FLAG_USE_CHECK_TIME
  311.     X509_V_FLAG_CRL_CHECK
  312.     X509_V_FLAG_CRL_CHECK_ALL
  313.     X509_V_FLAG_IGNORE_CRITICAL
  314.     CTX_new
  315.     CTX_v2_new
  316.     CTX_v3_new
  317.     CTX_v23_new
  318.     CTX_free
  319.     new
  320.     free
  321.     accept
  322.     clear
  323.     connect
  324.     set_fd
  325.     set_rfd
  326.     set_wfd
  327.     get_fd
  328.     read
  329.     write
  330.     peek
  331.     use_RSAPrivateKey
  332.     use_RSAPrivateKey_ASN1
  333.     use_RSAPrivateKey_file
  334.     CTX_use_RSAPrivateKey_file
  335.     use_PrivateKey
  336.     use_PrivateKey_ASN1
  337.     use_PrivateKey_file
  338.     use_certificate
  339.     use_certificate_ASN1
  340.     use_certificate_file
  341.     CTX_use_certificate_file
  342.     load_error_strings
  343.     ERR_load_SSL_strings
  344.     ERR_load_RAND_strings
  345.     state_string
  346.     rstate_string
  347.     state_string_long
  348.     rstate_string_long
  349.     get_time
  350.     set_time
  351.     get_timeout
  352.     set_timeout
  353.     copy_session_id
  354.     set_read_ahead
  355.     get_read_ahead
  356.     pending
  357.     get_cipher_list
  358.     set_cipher_list
  359.     get_cipher
  360.     get_shared_ciphers
  361.     get_peer_certificate
  362.     set_verify
  363.     flush_sessions
  364.     set_bio
  365.     get_rbio
  366.     get_wbio
  367.     SESSION_new
  368.     SESSION_print
  369.     SESSION_free
  370.     i2d_SSL_SESSION
  371.     set_session
  372.     add_session
  373.     remove_session
  374.     d2i_SSL_SESSION
  375.     BIO_f_ssl
  376.     BIO_new
  377.     BIO_new_file
  378.         BIO_s_mem
  379.         BIO_free
  380.         BIO_read
  381.         BIO_write
  382.     BIO_eof
  383.     BIO_pending
  384.     BIO_wpending
  385.     ERR_get_error
  386.     ERR_error_string
  387.     err
  388.     clear_error
  389.     X509_get_issuer_name
  390.     X509_get_subject_name
  391.         X509_NAME_oneline
  392.     X509_NAME_get_text_by_NID
  393.     CTX_get_cert_store
  394.     X509_STORE_add_cert
  395.     X509_STORE_add_crl
  396.     X509_STORE_CTX_set_flags
  397.     X509_load_cert_file
  398.     X509_load_crl_file
  399.     X509_load_cert_crl_file
  400.     PEM_read_bio_X509_CRL
  401.     die_if_ssl_error
  402.     die_now
  403.     print_errs
  404.     set_cert_and_key
  405.     set_server_cert_and_key
  406.         make_form
  407.         make_headers
  408.     do_https
  409.     get_https
  410.         post_https
  411.         sslcat
  412.     ssl_read_CRLF
  413.     ssl_read_all
  414.     ssl_read_until
  415.     ssl_write_CRLF
  416.         ssl_write_all
  417.         dump_peer_certificate
  418.     RSA_generate_key
  419.     RSA_free
  420.     X509_free
  421.     SESSION_get_master_key
  422.     get_client_random
  423.     get_server_random
  424. );
  425.  
  426. sub AUTOLOAD {
  427.     # This AUTOLOAD is used to 'autoload' constants from the constant()
  428.     # XS function.  If a constant is not found then control is passed
  429.     # to the AUTOLOAD in AutoLoader.
  430.  
  431.     my $constname;
  432.     ($constname = $AUTOLOAD) =~ s/.*:://;
  433.     my $val = constant($constname);
  434.     if ($! != 0) {
  435.     if ($! =~ /((Invalid)|(not valid))/i || $!{EINVAL}) {
  436.         $AutoLoader::AUTOLOAD = $AUTOLOAD;
  437.         goto &AutoLoader::AUTOLOAD;
  438.     }
  439.     else {
  440.       croak "Your vendor has not defined SSLeay macro $constname";
  441.     }
  442.     }
  443.     eval "sub $AUTOLOAD { $val }";
  444.     goto &$AUTOLOAD;
  445. }
  446.  
  447. bootstrap Net::SSLeay $VERSION;
  448.  
  449. # Preloaded methods go here.
  450.  
  451. $CRLF = "\x0d\x0a";  # because \r\n is not fully portable
  452.  
  453. ### Print SSLeay error stack
  454.  
  455. sub print_errs {
  456.     my ($msg) = @_;
  457.     my ($count, $err, $errs, $e) = (0,0,'');
  458.     while ($err = ERR_get_error()) {
  459.         $count ++;
  460.     $e = "$msg $$: $count - " . ERR_error_string($err) . "\n";
  461.     $errs .= $e;
  462.     warn $e if $Net::SSLeay::trace;
  463.     }
  464.     return $errs;
  465. }
  466.  
  467. # Death is conditional to SSLeay errors existing, i.e. this function checks
  468. # for errors and only dies in affirmative.
  469. # usage: Net::SSLeay::write($ssl, "foo") or die_if_ssl_error("SSL write ($!)");
  470.  
  471. sub die_if_ssl_error {
  472.     my ($msg) = @_;    
  473.     die "$$: $msg\n" if print_errs($msg);
  474. }
  475.  
  476. # Unconditional death. Used to print SSLeay errors before dying.
  477. # usage: Net::SSLeay:connect($ssl) or die_now("Failed SSL connect ($!)");
  478.  
  479. sub die_now {
  480.     my ($msg) = @_;    
  481.     print_errs($msg);
  482.     die "$$: $msg\n";
  483. }
  484.  
  485. # Perl 5.6.* unicode support causes that length() no longer reliably
  486. # reflects the byte length of a string. This eval is to fix that.
  487. # Thanks to Sean Burke for the snippet.
  488.  
  489. BEGIN{ 
  490. eval 'use bytes; sub blength ($) { length $_[0] }'; 
  491. $@ and eval '    sub blength ($) { length $_[0] }' ; 
  492. }
  493.  
  494. # Autoload methods go after =cut, and are processed by the autosplit program.
  495.  
  496. 1;
  497. __END__
  498. # Documentation. Use `perl-root/pod/pod2html SSLeay.pm` to output html
  499.  
  500. =head1 NAME
  501.  
  502. Net::SSLeay - Perl extension for using OpenSSL or SSLeay
  503.  
  504. =head1 SYNOPSIS
  505.  
  506.   use Net::SSLeay, qw(get_https post_https sslcat make_headers make_form);
  507.  
  508.   ($page) = get_https('www.bacus.pt', 443, '/');                 # 1
  509.  
  510.   ($page, $response, %reply_headers)
  511.      = get_https('www.bacus.pt', 443, '/',                   # 2
  512.          make_headers(User-Agent => 'Cryptozilla/5.0b1',
  513.                  Referer    => 'https://www.bacus.pt'
  514.         ));
  515.  
  516.   ($page, $result, %headers) =                                   # 2b
  517.          = get_https('www.bacus.pt', 443, '/protected.html',
  518.           make_headers(Authorization =>
  519.                'Basic ' . MIME::Base64::encode("$user:$pass",''))
  520.           );
  521.  
  522.   ($page, $response, %reply_headers)
  523.      = post_https('www.bacus.pt', 443, '/foo.cgi', '',       # 3
  524.         make_form(OK   => '1',
  525.               name => 'Sampo'
  526.         ));
  527.  
  528.   $reply = sslcat($host, $port, $request);                       # 4
  529.  
  530.   ($reply, $err, $server_cert) = sslcat($host, $port, $request); # 5
  531.  
  532.   $Net::SSLeay::trace = 2;  # 0=no debugging, 1=ciphers, 2=trace, 3=dump data
  533.  
  534. =head1 DESCRIPTION
  535.  
  536. There is a related module called Net::SSLeay::Handle included in this
  537. distribution that you might want to use instead. It has its own pod
  538. documentation.
  539.  
  540. This module offers some high level convinience functions for accessing
  541. web pages on SSL servers, a sslcat() function for writing your own
  542. clients, and finally access to the SSL api of SSLeay/OpenSSL package so you
  543. can write servers or clients for more complicated applications.
  544.  
  545. For high level functions it is most convinient to import them to your
  546. main namespace as indicated in the synopsis.
  547.  
  548. Case 1 demonstrates typical invocation of get_https() to fetch an HTML
  549. page from secure server. The first argument provides host name or ip
  550. in dotted decimal notation of the remote server to contact. Second
  551. argument is the TCP port at the remote end (your own port is picked
  552. arbitrarily from high numbered ports as usual for TCP). The third
  553. argument is the URL of the page without the host name part. If in
  554. doubt consult HTTP specifications at <http://www.w3c.org>
  555.  
  556. Case 2 demonstrates full fledged use of get_https(). As can be seen,
  557. get_https() parses the response and response headers and returns them as
  558. a list, which can be captured in a hash for later reference. Also a
  559. fourth argument to get_https() is used to insert some additional headers
  560. in the request. make_headers() is a function that will convert a list or
  561. hash to such headers. By default get_https() supplies Host (make virtual
  562. hosting easy) and Accept (reportedly needed by IIS) headers.
  563.  
  564. Case 2b demonstrates how to get password protected page. Refer to
  565. HTTP protocol specifications for further details (e.g. RFC2617).
  566.  
  567. Case 3 invokes post_https() to submit a HTML/CGI form to secure
  568. server. First four arguments are equal to get_https() (note that empty
  569. string ('') is passed as header argument). The fifth argument is the
  570. contents of the form formatted according to CGI specification. In this
  571. case the helper function make_https() is used to do the formatting,
  572. but you could pass any string. The post_https() automatically adds
  573. Content-Type and Content-Length headers to the request.
  574.  
  575. Case 4 shows the fundamental sslcat() function (inspired in spirit by
  576. netcat utility :-). Its your swiss army knife that allows you to
  577. easily contact servers, send some data, and then get the response. You
  578. are responsible for formatting the data and parsing the response -
  579. sslcat() is just a transport.
  580.  
  581. Case 5 is a full invocation of sslcat() which allows return of errors
  582. as well as the server (peer) certificate.
  583.  
  584. The $trace global variable can be used to control the verbosity of high
  585. level functions. Level 0 guarantees silence, level 1 (the default)
  586. only emits error messages.
  587.  
  588. =head2 Alternate versions of the API
  589.  
  590. The above mentioned functions actually return the response headers as
  591. a list, which only gets converted to hash upon assignment (this
  592. assignment looses information if the same header occurs twice, as may
  593. be the case with cookies). There are also other variants of the
  594. functions that return unprocessed headers and that return a reference
  595. to a hash.
  596.  
  597.   ($page, $response, @headers) = get_https('www.bacus.pt', 443, '/');
  598.   for ($i = 0; $i < $#headers; $i+=2) {
  599.       print "$headers[$i] = " . $headers[$i+1] . "\n";
  600.   }
  601.   
  602.   ($page, $response, $headers, $server_cert)
  603.     = get_https3('www.bacus.pt', 443, '/');
  604.   print "$headers\n";
  605.  
  606.   ($page, $response, %headers_ref, $server_cert)
  607.     = get_https4('www.bacus.pt', 443, '/');
  608.   for $k (sort keys %{headers_ref}) {
  609.       for $v (@{$headers_ref{$k}}) {
  610.       print "$k = $v\n";
  611.       }
  612.   }
  613.  
  614. All of the above code fragments accomplish the same thing: display all
  615. values of all headers. The API functions ending in "3" return the
  616. headers simply as a scalar string and it is up to the application to
  617. split them up. The functions ending in "4" return a reference to
  618. hash of arrays (see perlref and perllol manual pages if you are
  619. not familiar with complex perl data structures). To access single value
  620. of such header hash you would do something like
  621.  
  622.   print $headers_ref{COOKIE}[0];
  623.  
  624. The variants 3 and 4 also allow you to discover the server certificate
  625. in case you would like to store or display it, e.g.
  626.  
  627.   ($p, $resp, $hdrs, $server_cert) = get_https3('www.bacus.pt', 443, '/');
  628.   if (!defined($server_cert) || ($server_cert == 0)) {
  629.       warn "Subject Name: undefined, Issuer  Name: undefined";
  630.   } else {
  631.       warn 'Subject Name: '
  632.       . Net::SSLeay::X509_NAME_oneline(
  633.          Net::SSLeay::X509_get_subject_name($server_cert))
  634.           . 'Issuer  Name: '
  635.           . Net::SSLeay::X509_NAME_oneline(
  636.                          Net::SSLeay::X509_get_issuer_name($server_cert));
  637.   }
  638.  
  639. Beware that this method only allows after the fact verification of
  640. the certificate: by the time get_https3() has returned the https
  641. request has already been sent to the server, whether you decide to
  642. tryst it or not. To do the verification correctly you must either
  643. employ the OpenSSL certificate verification framework or use
  644. the lower level API to first connect and verify the certificate
  645. and only then send the http data. See implementation of ds_https3()
  646. for guidance on how to do this.
  647.  
  648. =head2 Using client certificates
  649.  
  650. Secure web communications are encrypted using symmetric crypto keys
  651. exchanged using encryption based on the certificate of the
  652. server. Therefore in all SSL connections the server must have a
  653. certificate. This serves both to authenticate the server to the
  654. clients and to perform the key exchange.
  655.  
  656. Sometimes it is necessary to authenticate the client as well. Two
  657. options are available: http basic authentication and client side
  658. certificate. The basic authentication over https is actually quite
  659. safe because https guarantees that the password will not travel in
  660. clear. Never-the-less, problems like easily guessable passwords
  661. remain. The client certificate method involves authentication of the
  662. client at SSL level using a certificate. For this to work, both the
  663. client and the server will have certificates (which typically are
  664. different) and private keys.
  665.  
  666. The API functions outlined above accept additional arguments that
  667. allow one to supply the client side certificate and key files. The
  668. format of these files is the same as used for server certificates and
  669. the caveat about encrypting private key applies.
  670.  
  671.   ($page, $result, %headers) =                                   # 2c
  672.          = get_https('www.bacus.pt', 443, '/protected.html',
  673.           make_headers(Authorization =>
  674.                'Basic ' . MIME::Base64::encode("$user:$pass",'')),
  675.           '', $mime_type6, $path_to_crt7, $path_to_key8);
  676.  
  677.   ($page, $response, %reply_headers)
  678.      = post_https('www.bacus.pt', 443, '/foo.cgi',           # 3b
  679.           make_headers('Authorization' =>
  680.                'Basic ' . MIME::Base64::encode("$user:$pass",'')),
  681.           make_form(OK   => '1', name => 'Sampo'),
  682.           $mime_type6, $path_to_crt7, $path_to_key8);
  683.  
  684. Case 2c demonstrates getting password protected page that also requires
  685. client certificate, i.e. it is possible to use both authentication
  686. methods simultaneously.
  687.  
  688. Case 3b is full blown post to secure server that requires both password
  689. authentication and client certificate, just like in case 2c.
  690.  
  691. Note: Client will not send a certificate unless the server requests one.
  692. This is typically achieved by setting verify mode to VERIFY_PEER on the
  693. server:
  694.  
  695.   Net::SSLeay::set_verify(ssl, Net::SSLeay::VERIFY_PEER, 0);
  696.  
  697. See perldoc ~openssl/doc/ssl/SSL_CTX_set_verify.pod for full description.
  698.  
  699. =head2 Working through Web proxy
  700.  
  701. Net::SSLeay can use a web proxy to make its connections. You need to
  702. first set the proxy host and port using set_proxy() and then just
  703. use the normal API functions, e.g:
  704.  
  705.   Net::SSLeay::set_proxy('gateway.myorg.com', 8080);
  706.   ($page) = get_https('www.bacus.pt', 443, '/');
  707.  
  708. If your proxy requires authentication, you can supply username and
  709. password as well
  710.  
  711.   Net::SSLeay::set_proxy('gateway.myorg.com', 8080, 'joe', 'salainen');
  712.   ($page, $result, %headers) =
  713.          = get_https('www.bacus.pt', 443, '/protected.html',
  714.           make_headers(Authorization =>
  715.                'Basic ' . MIME::Base64::encode("susie:pass",''))
  716.           );
  717.  
  718. This example demonstrates case where we authenticate to the proxy as
  719. "joe" and to the final web server as "susie". Proxy authentication
  720. requires MIME::Base64 module to work.
  721.  
  722. =head2 Certificate verification and Certificate Revoocation Lists (CRLs)
  723.  
  724. OpenSSL supports the ability to verify peer certificates. It can also
  725. optionally check the peer certificate against a Certificate Revocation
  726. List (CRL) from the certificates issuer. A CRL is a file, created by
  727. the certificate issuer that lists all the certificates that it
  728. previously signed, but which it now revokes. CRLs are in PEM format.
  729.  
  730. You can enable Net::SSLeay CRL checking like this:
  731.  
  732.         &Net::SSLeay::X509_STORE_CTX_set_flags
  733.         (&Net::SSLeay::CTX_get_cert_store($ssl), 
  734.          &Net::SSLeay::X509_V_FLAG_CRL_CHECK); 
  735.  
  736. After setting this flag, if OpenSSL checks a peer's certificate, then
  737. it will attempt to find a CRL for the issuer. It does this by looking
  738. for a specially named file in the search directory specified by
  739. CTX_load_verify_locations.  CRL files are named with the hash of the
  740. issuer's subject name, followed by .r0, .r1 etc.  For example
  741. ab1331b2.r0, ab1331b2.r1. It will read all the .r files for the
  742. issuer, and then check for a revocation of the peer cerificate in all
  743. of them.  (You can also force it to look in a specific named CRL
  744. file., see below).  You can find out the hash of the issuer subject
  745. name in a CRL with
  746.  
  747.     openssl crl -in crl.pem -hash -noout
  748.  
  749. If the peer certificate does not pass the revocation list, or if no
  750. CRL is found, then the handshaking fails with an error.
  751.  
  752. You can also force OpenSSL to look for CRLs in one or more arbitrarily
  753. named files.
  754.  
  755. my $bio = &Net::SSLeay::BIO_new_file($crlfilename, 'r');
  756. my $crl = &Net::SSLeay::PEM_read_bio_X509_CRL($bio);
  757. if ($crl)
  758. {
  759.     &Net::SSLeay::X509_STORE_add_crl(&Net::SSLeay::CTX_get_cert_store($ssl, $crl);
  760. }
  761. else
  762. {
  763.     error reading CRL....
  764. }
  765.  
  766.  
  767. =head2 Convenience routines
  768.  
  769. To be used with Low level API
  770.  
  771.     Net::SSLeay::randomize($rn_seed_file,$additional_seed);
  772.     Net::SSLeay::set_cert_and_key($ctx, $cert_path, $key_path);
  773.     $cert = Net::SSLeay::dump_peer_certificate($ssl);
  774.     Net::SSLeay::ssl_write_all($ssl, $message) or die "ssl write failure";
  775.     $got = Net::SSLeay::ssl_read_all($ssl) or die "ssl read failure";
  776.  
  777.     $got = Net::SSLeay::ssl_read_CRLF($ssl [, $max_length]);
  778.     $got = Net::SSLeay::ssl_read_until($ssl [, $delimit [, $max_length]]);
  779.     Net::SSLeay::ssl_write_CRLF($ssl, $message);
  780.  
  781. randomize() seeds the eay PRNG with /dev/urandom (see top of SSLeay.pm
  782. for how to change or configure this) and optionally with user provided
  783. data. It is very important to properly seed your random numbers, so
  784. do not forget to call this. The high level API functions automatically
  785. call randomize() so it is not needed with them. See also caveats.
  786.  
  787. set_cert_and_key() takes two file names as arguments and sets
  788. the certificate and private key to those. This can be used to
  789. set either cerver certificates or client certificates.
  790.  
  791. dump_peer_certificate() allows you to get plaintext description of the
  792. certificate the peer (usually server) presented to us.
  793.  
  794. ssl_read_all() and ssl_write_all() provide true blocking semantics for
  795. these operations (see limitation, below, for explanation). These are
  796. much preferred to the low level API equivalents (which implement BSD
  797. blocking semantics). The message argument to ssl_write_all() can be
  798. reference. This is helpful to avoid unnecessary copy when writing
  799. something big, e.g:
  800.  
  801.     $data = 'A' x 1000000000;
  802.     Net::SSLeay::ssl_write_all($ssl, \$data) or die "ssl write failed";
  803.  
  804. ssl_read_CRLF() uses ssl_read_all() to read in a line terminated with a
  805. carriage return followed by a linefeed (CRLF).  The CRLF is included in
  806. the returned scalar.
  807.  
  808. ssl_read_until() uses ssl_read_all() to read from the SSL input
  809. stream until it encounters a programmer specified delimiter.
  810. If the delimiter is undefined, $/ is used.  If $/ is undefined,
  811. \n is used.  One can optionally set a maximum length of bytes to read
  812. from the SSL input stream.
  813.  
  814. ssl_write_CRLF() writes $message and appends CRLF to the SSL output stream.
  815.  
  816. =head2 Low level API
  817.  
  818. In addition to the high level functions outlined above, this module
  819. contains straight forward access to SSL part of OpenSSL C api. Only the SSL
  820. subpart of OpenSSL is implemented (if anyone wants to implement other
  821. parts, feel free to submit patches).
  822.  
  823. See ssl.h header from OpenSSL C distribution for list of low lever
  824. SSLeay functions to call (to check if some function has been
  825. implemented see directly in SSLeay.xs). The module strips SSLeay names
  826. of the initial "SSL_", generally you should use Net::SSLeay:: in
  827. place. For example:
  828.  
  829. In C:
  830.  
  831.     #include <ssl.h>
  832.     
  833.     err = SSL_set_verify (ssl, SSL_VERIFY_CLIENT_ONCE,
  834.                    &your_call_back_here);
  835.     
  836. In perl:
  837.  
  838.     use Net::SSLeay;
  839.  
  840.     $err = Net::SSLeay::set_verify ($ssl,
  841.                     &Net::SSLeay::VERIFY_CLIENT_ONCE,
  842.                     \&your_call_back_here);
  843.  
  844. If the function does not start by SSL_ you should use the full
  845. function name, e.g.:
  846.  
  847.     $err = &Net::SSLeay::ERR_get_error;
  848.  
  849. Following new functions behave in perlish way:
  850.  
  851.     $got = Net::SSLeay::read($ssl);
  852.                                     # Performs SSL_read, but returns $got
  853.                                     # resized according to data received.
  854.                                     # Returns undef on failure.
  855.  
  856.     Net::SSLeay::write($ssl, $foo) || die;
  857.                                     # Performs SSL_write, but automatically
  858.                                     # figures out the size of $foo
  859.  
  860. In order to use the low level API you should start your programs with
  861. the following encantation:
  862.  
  863.     use Net::SSLeay qw(die_now die_if_ssl_error);
  864.     Net::SSLeay::load_error_strings();
  865.     Net::SSLeay::SSLeay_add_ssl_algorithms();   # Important!
  866.         Net::SSLeay::randomize();
  867.  
  868. die_now() and die_if_ssl_error() are used to conveniently print SSLeay error
  869. stack when something goes wrong, thusly:
  870.  
  871.     Net::SSLeay:connect($ssl) or die_now("Failed SSL connect ($!)");
  872.     Net::SSLeay::write($ssl, "foo") or die_if_ssl_error("SSL write ($!)");
  873.  
  874. You can also use Net::SSLeay::print_errs() to dump the error stack without
  875. exiting the program. As can be seen, your code becomes much more readable
  876. if you import the error reporting functions to your main name space.
  877.  
  878. I can not emphasize enough the need to check error returns. Use these
  879. functions even in most simple programs, they will reduce debugging
  880. time greatly. Do not ask questions in mailing list without having
  881. first sprinkled these in your code.
  882.  
  883. =head2 Sockets
  884.  
  885. Perl uses file handles for all I/O. While SSLeay has quite flexible BIO
  886. mechanism and perl has evolved PerlIO mechanism, this module still
  887. sticks to using file descriptors. Thus to attach SSLeay to socket you
  888. should use fileno() to extract the underlying file descriptor:
  889.  
  890.     Net::SSLeay::set_fd($ssl, fileno(S));   # Must use fileno
  891.  
  892. You should also use "$|=1;" to eliminate STDIO buffering so you do not
  893. get confused if you use perl I/O functions to manipulate your socket
  894. handle.
  895.  
  896. If you need to select(2) on the socket, go right ahead, but be warned
  897. that OpenSSL does some internal buffering so SSL_read does not always
  898. return data even if socket selected for reading (just keep on
  899. selecting and trying to read). Net::SSLeay.pm is no different from the
  900. C language OpenSSL in this respect.
  901.  
  902. =head2 Callbacks
  903.  
  904. WARNING: as of 1.04 the callbacks have changed and have not been tested.
  905.  
  906. At this moment the implementation of verify_callback is crippeled in
  907. the sense that at any given time there can be only one call back which
  908. is shared by all SSL contexts, sessions and connections. This is
  909. due to having to keep the reference to the perl call back in a
  910. static variable so that the callback C glue can find it. To remove
  911. this restriction would require either a more complex data structure
  912. (like a hash?) in XSUB to map the call backs to their owners or,
  913. cleaner, adding a context pointer in the SSL structure. This context would
  914. then be passed to the C callback, which in our case would be the glue
  915. to look up the proper Perl function from the context and call it.
  916.  
  917. ---- inaccurate ----
  918. The verify call back looks like this in C:
  919.  
  920.     int (*callback)(int ok,X509 *subj_cert,X509 *issuer_cert,
  921.                         int depth,int errorcode,char *arg,STACK *cert_chain)
  922.  
  923. The corresponding Perl function should be something like this:
  924.  
  925.     sub verify {
  926.         my ($ok, $subj_cert, $issuer_cert, $depth, $errorcode,
  927.         $arg, $chain) = @_;
  928.         print "Verifying certificate...\n";
  929.         ...
  930.         return $ok;
  931.     }
  932.  
  933. It is used like this:
  934.  
  935.     Net::SSLeay::set_verify ($ssl, Net::SSLeay::VERIFY_PEER, \&verify);
  936.  
  937. Callbacks for decrypting private keys are implemented, but have the
  938. same limitation as the verify_callback implementation (one password
  939. callback shared between all contexts.)  You might use it something
  940. like this:
  941.  
  942.         Net::SSLeay::CTX_set_default_passwd_cb($ctx, sub { "top-secret" });
  943.         Net::SSLeay::CTX_use_PrivateKey_file($ctx, "key.pem",
  944.                          Net::SSLeay::FILETYPE_PEM)
  945.             or die "Error reading private key";
  946.  
  947. No other callbacks are implemented. You do not need to use any
  948. callback for simple (i.e. normal) cases where the SSLeay built-in
  949. verify mechanism satisfies your needs.
  950. ---- end inaccurate ----
  951.  
  952. If you want to use callback stuff, see examples/callback.pl! Its the
  953. only one I am able to make work reliably.
  954.  
  955. =head2 X509 and RAND stuff
  956.  
  957. This module largely lacks interface to the X509 and RAND routines, but
  958. as I was lazy and needed them, the following kludges are implemented:
  959.  
  960.     $x509_name = Net::SSLeay::X509_get_subject_name($x509_cert);
  961.     $x509_name = Net::SSLeay::X509_get_issuer_name($x509_cert);
  962.     print Net::SSLeay::X509_NAME_oneline($x509_name);
  963.     $text = Net::SSLeay::X509_NAME_get_text_by_NID($name, $nid);
  964.  
  965.     Net::SSLeay::RAND_seed($buf);   # Perlishly figures out buf size
  966.     Net::SSLeay::RAND_bytes($buf, $num);
  967.     Net::SSLeay::RAND_pseudo_bytes($buf, $num);
  968.     Net::SSLeay::RAND_add($buf, $num, $entropy);
  969.     Net::SSLeay::RAND_poll();
  970.     Net::SSLeay::RAND_status();
  971.     Net::SSLeay::RAND_cleanup();
  972.     Net::SSLeay::RAND_file_name($num);
  973.     Net::SSLeay::RAND_load_file($file_name, $how_many_bytes);
  974.     Net::SSLeay::RAND_write_file($file_name);
  975.     Net::SSLeay::RAND_egd($path);
  976.     Net::SSLeay::RAND_egd_bytes($path, $bytes);
  977.  
  978. Actually you should consider using the following helper functions:
  979.  
  980.     print Net::SSLeay::dump_peer_certificate($ssl);
  981.     Net::SSLeay::randomize();
  982.  
  983. =head2 RSA interface
  984.  
  985. Some RSA functions are available:
  986.  
  987. $rsakey = Net::SSLeay::RSA_generate_key();
  988. Net::SSLeay::CTX_set_tmp_rsa($ctx, $rsakey);
  989. Net::SSLeay::RSA_free($rsakey);
  990.  
  991. =head2 BIO interface
  992.  
  993. Some BIO functions are available:
  994.  
  995.   Net::SSLeay::BIO_s_mem();
  996.   $bio = Net::SSLeay::BIO_new(BIO_s_mem())
  997.   $bio = Net::SSLeay::BIO_new_file($filename, $mode);
  998.   Net::SSLeay::BIO_free($bio)
  999.   $count = Net::SSLeay::BIO_write($data);
  1000.   $data = Net::SSLeay::BIO_read($bio);
  1001.   $data = Net::SSLeay::BIO_read($bio, $maxbytes);
  1002.   $is_eof = Net::SSLeay::BIO_eof($bio);
  1003.   $count = Net::SSLeay::BIO_pending($bio);
  1004.   $count = Net::SSLeay::BIO_wpending ($bio);
  1005.  
  1006. =head2 Low level API
  1007. Some very low level API functions are available:
  1008.     $client_random = &Net::SSLeay::get_client_random($ssl);
  1009.     $server_random = &Net::SSLeay::get_server_random($ssl);
  1010.     $session = &Net::SSLeay::get_session($ssl);
  1011.     $master_key = &Net::SSLeay::SESSION_get_master_key($session);
  1012.  
  1013. =head1 EXAMPLES
  1014.  
  1015. One very good example is to look at the implementation of sslcat() in the
  1016. SSLeay.pm file.
  1017.  
  1018. Following is a simple SSLeay client (with too little error checking :-(
  1019.  
  1020.     #!/usr/local/bin/perl
  1021.     use Socket;
  1022.     use Net::SSLeay qw(die_now die_if_ssl_error) ;
  1023.     Net::SSLeay::load_error_strings();
  1024.     Net::SSLeay::SSLeay_add_ssl_algorithms();
  1025.     Net::SSLeay::randomize();
  1026.  
  1027.     ($dest_serv, $port, $msg) = @ARGV;      # Read command line
  1028.     $port = getservbyname ($port, 'tcp') unless $port =~ /^\d+$/;
  1029.     $dest_ip = gethostbyname ($dest_serv);
  1030.     $dest_serv_params  = sockaddr_in($port, $dest_ip);
  1031.     
  1032.     socket  (S, &AF_INET, &SOCK_STREAM, 0)  or die "socket: $!";
  1033.     connect (S, $dest_serv_params)          or die "connect: $!";
  1034.     select  (S); $| = 1; select (STDOUT);   # Eliminate STDIO buffering
  1035.     
  1036.     # The network connection is now open, lets fire up SSL    
  1037.  
  1038.     $ctx = Net::SSLeay::CTX_new() or die_now("Failed to create SSL_CTX $!");
  1039.     Net::SSLeay::CTX_set_options($ctx, &Net::SSLeay::OP_ALL)
  1040.          and die_if_ssl_error("ssl ctx set options");
  1041.     $ssl = Net::SSLeay::new($ctx) or die_now("Failed to create SSL $!");
  1042.     Net::SSLeay::set_fd($ssl, fileno(S));   # Must use fileno
  1043.     $res = Net::SSLeay::connect($ssl) and die_if_ssl_error("ssl connect");
  1044.     print "Cipher `" . Net::SSLeay::get_cipher($ssl) . "'\n";
  1045.     
  1046.     # Exchange data
  1047.     
  1048.     $res = Net::SSLeay::write($ssl, $msg);  # Perl knows how long $msg is
  1049.     die_if_ssl_error("ssl write");
  1050.     CORE::shutdown S, 1;  # Half close --> No more output, sends EOF to server
  1051.     $got = Net::SSLeay::read($ssl);         # Perl returns undef on failure
  1052.     die_if_ssl_error("ssl read");
  1053.     print $got;
  1054.         
  1055.     Net::SSLeay::free ($ssl);               # Tear down connection
  1056.     Net::SSLeay::CTX_free ($ctx);
  1057.     close S;
  1058.  
  1059. Following is a simple SSLeay echo server (non forking):
  1060.  
  1061.     #!/usr/local/bin/perl -w
  1062.     use Socket;
  1063.     use Net::SSLeay qw(die_now die_if_ssl_error);
  1064.     Net::SSLeay::load_error_strings();
  1065.     Net::SSLeay::SSLeay_add_ssl_algorithms();
  1066.     Net::SSLeay::randomize();
  1067.  
  1068.     $our_ip = "\0\0\0\0"; # Bind to all interfaces
  1069.     $port = 1235;                             
  1070.     $sockaddr_template = 'S n a4 x8';
  1071.     $our_serv_params = pack ($sockaddr_template, &AF_INET, $port, $our_ip);
  1072.     
  1073.     socket (S, &AF_INET, &SOCK_STREAM, 0)  or die "socket: $!";
  1074.     bind (S, $our_serv_params)             or die "bind:   $!";
  1075.     listen (S, 5)                          or die "listen: $!";
  1076.     $ctx = Net::SSLeay::CTX_new ()         or die_now("CTX_new ($ctx): $!");
  1077.     Net::SSLeay::CTX_set_options($ctx, &Net::SSLeay::OP_ALL)
  1078.          and die_if_ssl_error("ssl ctx set options");
  1079.  
  1080.     # Following will ask password unless private key is not encrypted
  1081.     Net::SSLeay::CTX_use_RSAPrivateKey_file ($ctx, 'plain-rsa.pem',
  1082.                                              &Net::SSLeay::FILETYPE_PEM);
  1083.     die_if_ssl_error("private key");
  1084.     Net::SSLeay::CTX_use_certificate_file ($ctx, 'plain-cert.pem',
  1085.                             &Net::SSLeay::FILETYPE_PEM);
  1086.     die_if_ssl_error("certificate");
  1087.     
  1088.     while (1) {    
  1089.         print "Accepting connections...\n";
  1090.         ($addr = accept (NS, S))           or die "accept: $!";
  1091.         select (NS); $| = 1; select (STDOUT);  # Piping hot!
  1092.     
  1093.         ($af,$client_port,$client_ip) = unpack($sockaddr_template,$addr);
  1094.         @inetaddr = unpack('C4',$client_ip);
  1095.         print "$af connection from " .
  1096.         join ('.', @inetaddr) . ":$client_port\n";
  1097.     
  1098.     # We now have a network connection, lets fire up SSLeay...
  1099.  
  1100.         $ssl = Net::SSLeay::new($ctx)      or die_now("SSL_new ($ssl): $!");
  1101.         Net::SSLeay::set_fd($ssl, fileno(NS));
  1102.     
  1103.         $err = Net::SSLeay::accept($ssl) and die_if_ssl_error('ssl accept');
  1104.         print "Cipher `" . Net::SSLeay::get_cipher($ssl) . "'\n";
  1105.     
  1106.         # Connected. Exchange some data.
  1107.     
  1108.         $got = Net::SSLeay::read($ssl);     # Returns undef on fail
  1109.         die_if_ssl_error("ssl read");
  1110.         print "Got `$got' (" . length ($got) . " chars)\n";
  1111.         
  1112.         Net::SSLeay::write ($ssl, uc ($got)) or die "write: $!";
  1113.         die_if_ssl_error("ssl write");
  1114.     
  1115.         Net::SSLeay::free ($ssl);           # Tear down connection
  1116.         close NS;
  1117.     }
  1118.  
  1119. Yet another echo server. This one runs from /etc/inetd.conf so it avoids
  1120. all the socket code overhead. Only caveat is opening rsa key file -
  1121. it had better be without any encryption or else it will not know where
  1122. to ask for the password. Note how STDIN and STDOUT are wired to SSL.
  1123.  
  1124.     #!/usr/local/bin/perl
  1125.     # /etc/inetd.conf
  1126.     #    ssltst stream tcp nowait root /path/to/server.pl server.pl
  1127.     # /etc/services
  1128.     #    ssltst        1234/tcp
  1129.  
  1130.     use Net::SSLeay qw(die_now die_if_ssl_error);
  1131.     Net::SSLeay::load_error_strings();
  1132.     Net::SSLeay::SSLeay_add_ssl_algorithms();
  1133.     Net::SSLeay::randomize();
  1134.  
  1135.     chdir '/key/dir' or die "chdir: $!";
  1136.     $| = 1;  # Piping hot!
  1137.     open LOG, ">>/dev/console" or die "Can't open log file $!";
  1138.     select LOG; print "server.pl started\n";
  1139.     
  1140.     $ctx = Net::SSLeay::CTX_new()     or die_now "CTX_new ($ctx) ($!)";
  1141.     $ssl = Net::SSLeay::new($ctx)     or die_now "new ($ssl) ($!)";
  1142.     Net::SSLeay::set_options($ssl, &Net::SSLeay::OP_ALL)
  1143.          and die_if_ssl_error("ssl set options");
  1144.  
  1145.     # We get already open network connection from inetd, now we just
  1146.     # need to attach SSLeay to STDIN and STDOUT
  1147.     Net::SSLeay::set_rfd($ssl, fileno(STDIN));
  1148.     Net::SSLeay::set_wfd($ssl, fileno(STDOUT));
  1149.  
  1150.     Net::SSLeay::use_RSAPrivateKey_file ($ssl, 'plain-rsa.pem',
  1151.                                          &Net::SSLeay::FILETYPE_PEM);
  1152.     die_if_ssl_error("private key");
  1153.     Net::SSLeay::use_certificate_file ($ssl, 'plain-cert.pem',
  1154.                         &Net::SSLeay::FILETYPE_PEM);
  1155.     die_if_ssl_error("certificate");
  1156.  
  1157.     Net::SSLeay::accept($ssl) and die_if_ssl_err("ssl accept: $!");
  1158.     print "Cipher `" . Net::SSLeay::get_cipher($ssl) . "'\n";
  1159.     
  1160.     $got = Net::SSLeay::read($ssl);
  1161.     die_if_ssl_error("ssl read");
  1162.     print "Got `$got' (" . length ($got) . " chars)\n";
  1163.  
  1164.     Net::SSLeay::write ($ssl, uc($got)) or die "write: $!";
  1165.     die_if_ssl_error("ssl write");
  1166.  
  1167.     Net::SSLeay::free ($ssl);         # Tear down the connection
  1168.     Net::SSLeay::CTX_free ($ctx);
  1169.     close LOG;
  1170.  
  1171. There are also a number of example/test programs in the examples directory:
  1172.  
  1173.     sslecho.pl   -  A simple server, not unlike the one above
  1174.     minicli.pl   -  Implements a client using low level SSLeay routines
  1175.     sslcat.pl    -  Demonstrates using high level sslcat utility function
  1176.     get_page.pl  -  Is a utility for getting html pages from secure servers
  1177.     callback.pl  -  Demonstrates certificate verification and callback usage
  1178.     stdio_bulk.pl       - Does SSL over Unix pipes
  1179.     ssl-inetd-serv.pl   - SSL server that can be invoked from inetd.conf
  1180.     httpd-proxy-snif.pl - Utility that allows you to see how a browser
  1181.                           sends https request to given server and what reply
  1182.                           it gets back (very educative :-)
  1183.     makecert.pl  -  Creates a self signed cert (does not use this module)
  1184.  
  1185. =head1 LIMITATIONS
  1186.  
  1187. Net::SSLeay::read uses internal buffer of 32KB, thus no single read
  1188. will return more. In practice one read returns much less, usually
  1189. as much as fits in one network packet. To work around this,
  1190. you should use a loop like this:
  1191.  
  1192.     $reply = '';
  1193.     while ($got = Net::SSLeay::read($ssl)) {
  1194.     last if print_errs('SSL_read');
  1195.     $reply .= $got;
  1196.     }
  1197.  
  1198. Although there is no built-in limit in Net::SSLeay::write, the network
  1199. packet size limitation applies here as well, thus use:
  1200.  
  1201.     $written = 0;
  1202.  
  1203.     while ($written < length($message)) {
  1204.     $written += Net::SSLeay::write($ssl, substr($message, $written));
  1205.     last if print_errs('SSL_write');
  1206.     }
  1207.  
  1208. Or alternatively you can just use the following convinence functions:
  1209.  
  1210.     Net::SSLeay::ssl_write_all($ssl, $message) or die "ssl write failure";
  1211.     $got = Net::SSLeay::ssl_read_all($ssl) or die "ssl read failure";
  1212.  
  1213. =head1 KNOWN BUGS AND CAVEATS
  1214.  
  1215. Autoloader emits
  1216.  
  1217.     Argument "xxx" isn't numeric in entersub at blib/lib/Net/SSLeay.pm'
  1218.  
  1219. warning if die_if_ssl_error is made autoloadable. If you figure out why,
  1220. drop me a line.
  1221.  
  1222. Callback set using SSL_set_verify() does not appear to work. This may
  1223. well be eay problem (e.g. see ssl/ssl_lib.c line 1029). Try using
  1224. SSL_CTX_set_verify() instead and do not be surprised if even this stops
  1225. working in future versions.
  1226.  
  1227. Callback and certificate verification stuff is generally too little tested.
  1228.  
  1229. Random numbers are not initialized randomly enough, especially if you
  1230. do not have /dev/random and/or /dev/urandom (such as in Solaris
  1231. platforms - but I've been suggested that cryptorand daemon from SUNski
  1232. package solves this). In this case you should investigate third party
  1233. software that can emulate these devices, e.g. by way of a named pipe
  1234. to some program.
  1235.  
  1236. Another gotcha with random number initialization is randomness
  1237. depletion. This phenomenon, which has been extensively discussed in
  1238. OpenSSL, Apache-SSL, and Apache-mod_ssl forums, can cause your
  1239. script to block if you use /dev/random or to operate insecurely
  1240. if you use /dev/urandom. What happens is that when too much
  1241. randomness is drawn from the operating system's randomness pool
  1242. then randomness can temporarily be unavailable. /dev/random solves
  1243. this problem by waiting until enough randomness can be gathered - and
  1244. this can take a long time since blocking reduces activity in the
  1245. machine and less activity provides less random events: a vicious circle.
  1246. /dev/urandom solves this dilemma more pragmatically by simply returning
  1247. predictable "random" numbers. Some /dev/urandom emulation software
  1248. however actually seems to implement /dev/random semantics. Caveat emptor.
  1249.  
  1250. I've been pointed to two such daemons by Mik Firestone <mik@@speed.stdio._com>
  1251. who has used them on Solaris 8
  1252.  
  1253.    1. Entropy Gathering Daemon (EGD) at http://www.lothar.com/tech/crypto/
  1254.    2. Pseudo-random number generating daemon (PRNGD) at
  1255.         http://www.aet.tu-cottbus.de/personen/jaenicke/postfix_tls/prngd.html
  1256.  
  1257. If you are using the low level API functions to communicate with other
  1258. SSL implementations, you would do well to call
  1259.  
  1260.     Net::SSLeay::CTX_set_options($ctx, &Net::SSLeay::OP_ALL)
  1261.          and die_if_ssl_error("ssl ctx set options");
  1262.  
  1263. to cope with some well know bugs in some other SSL
  1264. implementations. The high level API functions always set all known
  1265. compatibility options.
  1266.  
  1267. Sometimes sslcat (and the high level https functions that build on it)
  1268. is too fast in signaling the EOF to legacy https servers. This causes
  1269. the server to return empty page. To work around this problem you can
  1270. set global variable
  1271.  
  1272.     $Net::SSLeay::slowly = 1;   # Add sleep so broken servers can keep up
  1273.  
  1274. http/1.1 is not supported. Specifically this module does not know to
  1275. issue or serve multiple http requests per connection. This is a serious
  1276. short coming, but using SSL session cache on your server helps to
  1277. alleviate the CPU load somewhat.
  1278.  
  1279. As of version 1.09 many newer OpenSSL auxiliary functions were
  1280. added (from REM_AUTOMATICALLY_GENERATED_1_09 onwards in SSLeay.xs).
  1281. Unfortunately I have not had any opportunity to test these. Some of
  1282. them are trivial enough that I believe they "just work", but others
  1283. have rather complex interfaces with function pointers and all. In these
  1284. cases you should proceed wit great caution.
  1285.  
  1286. This module defaults to using OpenSSL automatic protocol negotiation
  1287. code for automatically detecting the version of the SSL protocol
  1288. that the other end talks. With most web servers this works just
  1289. fine, but once in a while I get complaints from people that the module
  1290. does not work with some web servers. Usually this can be solved
  1291. by explicitly setting the protocol version, e.g.
  1292.  
  1293.    $Net::SSLeay::ssl_version = 2;  # Insist on SSLv2
  1294.    $Net::SSLeay::ssl_version = 3;  # Insist on SSLv3
  1295.    $Net::SSLeay::ssl_version = 10; # Insist on TLSv1
  1296.  
  1297. Although the autonegotiation is nice to have, the SSL standards
  1298. do not formally specify any such mechanism. Most of the world has
  1299. accepted the SSLeay/OpenSSL way of doing it as the de facto standard. But
  1300. for the few that think differently, you have to explicitly speak
  1301. the correct version. This is not really a bug, but rather a deficiency
  1302. in the standards. If a site refuses to respond or sends back some
  1303. nonsensical error codes (at SSL handshake level), try this option
  1304. before mailing me.
  1305.  
  1306. The high level API returns the certificate of the peer, thus allowing
  1307. one to check what certificate was supplied. However, you will only be
  1308. able to check the certificate after the fact, i.e. you already sent
  1309. your form data by the time you find out that you did not trust them,
  1310. oops.
  1311.  
  1312. So, while being able to know the certificate after the fact is surely
  1313. useful, the security minded would still choose to do the connection
  1314. and certificate verification first and only after that exchange data
  1315. with the site. Currently none of the high level API functions do
  1316. this, thus you would have to program it using the low level API. A
  1317. good place to start is to see how Net::SSLeay::http_cat() function
  1318. is implemented.
  1319.  
  1320. =head1 DIAGNOSTICS
  1321.  
  1322. "Random number generator not seeded!!!"
  1323.   This warning indicates that randomize() was not able to read
  1324.   /dev/random or /dev/urandom, possibly because your system does not
  1325.   have them or they are differently named. You can still use SSL, but
  1326.   the encryption will not be as strong.
  1327.  
  1328. "open_tcp_connection: destination host not found:`server' (port 123) ($!)"
  1329.   Name lookup for host named `server' failed.
  1330.  
  1331. "open_tcp_connection: failed `server', 123 ($!)"
  1332.   The name was resolved, but establising the TCP connection failed.
  1333.  
  1334. "msg 123: 1 - error:140770F8:SSL routines:SSL23_GET_SERVER_HELLO:unknown proto"
  1335.   SSLeay error string. First (123) number is PID, second number (1) indicates
  1336.   the position of the error message in SSLeay error stack. You often see
  1337.   a pile of these messages as errors cascade.
  1338.  
  1339. "msg 123: 1 - error:02001002::lib(2) :func(1) :reason(2)"
  1340.   The same as above, but you didn't call load_error_strings() so SSLeay
  1341.   couldn't verbosely explain the error. You can still find out what it
  1342.   means with this command:
  1343.  
  1344.      /usr/local/ssl/bin/ssleay errstr 02001002
  1345.  
  1346. Password is being asked for private key
  1347.   This is normal behaviour if your private key is encrypted. Either
  1348.   you have to supply the password or you have to use unencrypted
  1349.   private key. Scan OpenSSL.org for the FAQ that explains how to
  1350.   do this (or just study examples/makecert.pl which is used
  1351.   during `make test' to do just that).
  1352.  
  1353. =head1 REPORTING BUGS AND SUPPORT
  1354.  
  1355. Please see README for full bug reporting instructions. In general I do
  1356. not answer for free stupid questions or questions where you did not
  1357. do your home work.
  1358.  
  1359. Commercial support for Net::SSLeay may be obtained from
  1360.  
  1361.    Symlabs (netssleay@symlabs.com)
  1362.    Tel: +351-214.222.630
  1363.    Fax: +351-214.222.637
  1364.  
  1365. =head1 VERSION
  1366.  
  1367. This man page documents version 1.14, released on 25.3.2002.
  1368.  
  1369. There are currently two perl modules for using OpenSSL C
  1370. library: Net::SSLeay (maintaned by me) and SSLeay (maintained by OpenSSL
  1371. team). This module is the Net::SSLeay variant.
  1372.  
  1373. At the time of making this release, Eric's module was still quite
  1374. sketchy and could not be used for real work, thus I felt motivated to
  1375. make this maintenance release. This module is not planned to evolve to
  1376. contain any further functionality, i.e. I will concentrate on just
  1377. making a simple SSL connection over TCP socket. Presumably Eric's own
  1378. module will offer full SSLeay API one day.
  1379.  
  1380. This module uses OpenSSL-0.9.6c. It does not work with any earlier
  1381. version and there is no guarantee that it will work with later
  1382. versions either, though as long as C API does not change, it
  1383. should. This module requires perl5.005, or 5.6.0 (or better?) though I
  1384. believe it would build with any perl5.002 or newer.
  1385.  
  1386. =head1 AUTHOR
  1387.  
  1388. Sampo KellomΣki <sampo@symlabs.com>
  1389.  
  1390. Please send bug reports to the above address. General questions should be
  1391. sent either to me or to the mailing list (subscribe by sending mail
  1392. to openssl-users-request@openssl.org or using web interface at
  1393. http://www.openssl.org/support/).
  1394.  
  1395. =head1 COPYRIGHT
  1396.  
  1397. Copyright (c) 1996-2002 Sampo KellomΣki <sampo@symlabs.com>
  1398. All Rights Reserved.
  1399.  
  1400. Distribution and use of this module is under the same terms as the
  1401. OpenSSL package itself (i.e. free, but mandatory attribution; NO
  1402. WARRANTY). Please consult LICENSE file in the root of the OpenSSL
  1403. distribution.
  1404.  
  1405. While the source distribution of this perl module does not contain
  1406. Eric's or OpenSSL's code, if you use this module you will use OpenSSL
  1407. library. Please give Eric and OpenSSL team credit (as required by
  1408. their licenses).
  1409.  
  1410. And remember, you, and nobody else but you, are responsible for
  1411. auditing this module and OpenSSL library for security problems,
  1412. backdoors, and general suitability for your application.
  1413.  
  1414. =head1 SEE ALSO
  1415.  
  1416.   Net::SSLeay::Handle                      - File handle interface
  1417.   ./Net_SSLeay/examples                    - Example servers and a clients
  1418.   <http://symlabs.com/Net_SSLeay/index.html>  - Net::SSLeay.pm home
  1419.   <http://symlabs.com/Net_SSLeay/smime.html>  - Another module using OpenSSL
  1420.   <http://www.openssl.org/>                - OpenSSL source, documentation, etc
  1421.   openssl-users-request@openssl.org        - General OpenSSL mailing list
  1422.   <http://home.netscape.com/newsref/std/SSL.html>  - SSL Draft specification
  1423.   <http://www.w3c.org>                     - HTTP specifications
  1424.   <http://www.ietf.org/rfc/rfc2617.txt>    - How to send password
  1425.   <http://www.lothar.com/tech/crypto/>     - Entropy Gathering Daemon (EGD)
  1426.   <http://www.aet.tu-cottbus.de/personen/jaenicke/postfix_tls/prngd.html>
  1427.                            - pseudo-random number generating daemon (PRNGD)
  1428.   perl(1)
  1429.   perlref(1)
  1430.   perllol(1)
  1431.   perldoc ~openssl/doc/ssl/SSL_CTX_set_verify.pod
  1432.  
  1433. =cut
  1434.  
  1435. # ';
  1436.  
  1437. ### Some methods that are macros in C
  1438.  
  1439. sub want_nothing { want(shift) == 1 }
  1440. sub want_read { want(shift) == 2 }
  1441. sub want_write { want(shift) == 3 }
  1442. sub want_X509_lookup { want(shift) == 4 }
  1443.  
  1444. ###
  1445. ### Open TCP stream to given host and port, looking up the details
  1446. ### from system databases or DNS.
  1447. ###
  1448.  
  1449. sub open_tcp_connection {
  1450.     my ($dest_serv, $port) = @_;
  1451.     my ($errs);
  1452.     
  1453.     $port = getservbyname($port, 'tcp') unless $port =~ /^\d+$/;
  1454.     my $dest_serv_ip = gethostbyname($dest_serv);
  1455.     unless (defined($dest_serv_ip)) {
  1456.     $errs = "$0 $$: open_tcp_connection: destination host not found:"
  1457.             . " `$dest_serv' (port $port) ($!)\n";
  1458.     warn $errs if $trace;
  1459.         return wantarray ? (0, $errs) : 0;
  1460.     }
  1461.     my $sin = sockaddr_in($port, $dest_serv_ip);
  1462.     
  1463.     warn "Opening connection to $dest_serv:$port (" .
  1464.     inet_ntoa($dest_serv_ip) . ")" if $trace>2;
  1465.     
  1466.     my $proto = getprotobyname('tcp');
  1467.     if (socket (SSLCAT_S, &PF_INET(), &SOCK_STREAM(), $proto)) {
  1468.         warn "next connect" if $trace>3;
  1469.         if (CORE::connect (SSLCAT_S, $sin)) {
  1470.             my $old_out = select (SSLCAT_S); $| = 1; select ($old_out);
  1471.             warn "connected to $dest_serv, $port" if $trace>3;
  1472.             return wantarray ? (1, undef) : 1; # Success
  1473.         }
  1474.     }
  1475.     $errs = "$0 $$: open_tcp_connection: failed `$dest_serv', $port ($!)\n";
  1476.     warn $errs if $trace;
  1477.     close SSLCAT_S;
  1478.     return wantarray ? (0, $errs) : 0; # Fail
  1479. }
  1480.  
  1481. ### Open connection via standard web proxy, if one was defined
  1482. ### using set_proxy().
  1483.  
  1484. sub open_proxy_tcp_connection {
  1485.     my ($dest_serv, $port) = @_;
  1486.     
  1487.     return open_tcp_connection($dest_serv, $port) if !$proxyhost;
  1488.     
  1489.     warn "Connect via proxy: $proxyhost:$proxyport" if $trace>2;
  1490.     my @ret = open_tcp_connection($proxyhost, $proxyport);
  1491.     return wantarray ? @ret : 0 if !$ret[0];  # Connection fail
  1492.     
  1493.     warn "Asking proxy to connect to $dest_serv:$port" if $trace>2;
  1494.     print SSLCAT_S "CONNECT $dest_serv:$port HTTP/1.0$proxyauth$CRLF$CRLF";
  1495.     my $line = <SSLCAT_S>; 
  1496.     warn "Proxy response: $line" if $trace>2;
  1497.     
  1498.     return wantarray ? (1,undef) : 1;  # Success
  1499. }
  1500.  
  1501. ###
  1502. ### read and write helpers that block
  1503. ###
  1504.  
  1505. sub debug_read {
  1506.     my ($replyr, $gotr) = @_;
  1507.     my $vm = $trace>2 && $linux_debug ?
  1508.     (split ' ', `cat /proc/$$/stat`)[22] : 'vm_unknown';
  1509.     warn "  got " . blength($$gotr) . ':'
  1510.     . blength($$replyr) . " bytes (VM=$vm).\n" if $trace == 3;
  1511.     warn "  got `$$gotr' (" . blength($$gotr) . ':'
  1512.     . blength($$replyr) . " bytes, VM=$vm)\n" if $trace>3;
  1513. }
  1514.  
  1515. sub ssl_read_all {
  1516.     my ($ssl,$how_much) = @_;
  1517.     $how_much = 2000000000 unless $how_much;
  1518.     my ($got, $errs);
  1519.     my $reply = '';
  1520.  
  1521.     while ($how_much > 0) {
  1522.     $got = Net::SSLeay::read($ssl,$how_much);
  1523.     last if $errs = print_errs('SSL_read');
  1524.     $how_much -= blength($got);
  1525.     debug_read(\$reply, \$got) if $trace>1;
  1526.     last if $got eq '';  # EOF
  1527.     $reply .= $got;
  1528.     }
  1529.     return wantarray ? ($reply, $errs) : $reply;
  1530. }
  1531.  
  1532. sub ssl_write_all {
  1533.     my $ssl = $_[0];    
  1534.     my ($data_ref, $errs);
  1535.     if (ref $_[1]) {
  1536.     $data_ref = $_[1];
  1537.     } else {
  1538.     $data_ref = \$_[1];
  1539.     }
  1540.     my ($wrote, $written, $to_write) = (0,0, blength($$data_ref));
  1541.     my $vm = $trace>2 && $linux_debug ?
  1542.     (split ' ', `cat /proc/$$/stat`)[22] : 'vm_unknown';
  1543.     warn "  write_all VM at entry=$vm\n" if $trace>2;
  1544.     while ($to_write) {
  1545.     #sleep 1; # *** DEBUG
  1546.     warn "partial `$$data_ref'\n" if $trace>3;
  1547.     $wrote = write_partial($ssl, $written, $to_write, $$data_ref);
  1548.     $written += $wrote if defined $wrote;
  1549.     $to_write -= $wrote if defined $wrote;
  1550.     $vm = $trace>2 && $linux_debug ?
  1551.         (split ' ', `cat /proc/$$/stat`)[22] : 'vm_unknown';
  1552.     warn "  written so far $wrote:$written bytes (VM=$vm)\n" if $trace>2;
  1553.     
  1554.     $errs .= print_errs('SSL_write');
  1555.     return (wantarray ? (undef, $errs) : undef) if $errs;
  1556.     }
  1557.     return wantarray ? ($written, $errs) : $written;
  1558. }
  1559.  
  1560. ### from patch by Clinton Wong <clintdw@netcom.com>
  1561.  
  1562. # ssl_read_until($ssl [, $delimit [, $max_length]])
  1563. #  if $delimit missing, use $/ if it exists, otherwise use \n
  1564. #  read until delimiter reached, up to $max_length chars if defined
  1565.  
  1566. sub ssl_read_until ($;$$) {
  1567.     my ($ssl,$delim, $max_length) = @_;
  1568.     local $[;
  1569.  
  1570.     # guess the delim string if missing
  1571.     if ( ! defined $delim ) {           
  1572.       if ( defined $/ && length $/  ) { $delim = $/ }
  1573.       else { $delim = "\n" }      # Note: \n,$/ value depends on the platform
  1574.     }
  1575.     my $len_delim = length $delim;
  1576.  
  1577.     my ($got);
  1578.     my $reply = '';
  1579.     
  1580.     # If we have OpenSSL 0.9.6a or later, we can use SSL_peek to
  1581.     # speed things up.
  1582.     # N.B. 0.9.6a has security problems, so the support for
  1583.     #      anything earlier than 0.9.6e will be dropped soon.
  1584.     if (&Net::SSLeay::OPENSSL_VERSION_NUMBER >= 0x0090601f) {
  1585.     $max_length = 2000000000 unless (defined $max_length);
  1586.     my ($pending, $peek_length, $found, $done);
  1587.     while (blength($reply) < $max_length and !$done) {
  1588.         #Block if necessary until we get some data
  1589.         $got = Net::SSLeay::peek($ssl,1);
  1590.         last if print_errs('SSL_peek');
  1591.  
  1592.         $pending = Net::SSLeay::pending($ssl) + blength($reply);
  1593.         $peek_length = ($pending > $max_length) ? $max_length : $pending;
  1594.         $peek_length -= blength($reply);
  1595.         $got = Net::SSLeay::peek($ssl, $peek_length);
  1596.         last if print_errs('SSL_peek');
  1597.         $peek_length = blength($got);
  1598.         
  1599.         #$found = index($got, $delim);  # Old and broken
  1600.         
  1601.         # the delimiter may be split across two gets, so we prepend
  1602.         # a little from the last get onto this one before we check
  1603.         # for a match
  1604.         my $match;
  1605.         if(blength($reply) >= blength($delim) - 1) {
  1606.         #if what we've read so far is greater or equal
  1607.         #in length of what we need to prepatch
  1608.         $match = substr $reply, blength($reply) - blength($delim) + 1;
  1609.         } else {
  1610.         $match = $reply;
  1611.         }
  1612.  
  1613.         $match .= $got;
  1614.         $found = index($match, $delim);
  1615.  
  1616.         if ($found > -1) {
  1617.         #$got = Net::SSLeay::read($ssl, $found+$len_delim);
  1618.         #read up to the end of the delimiter
  1619.         $got = Net::SSLeay::read($ssl,
  1620.                      $found + $len_delim
  1621.                      - ((blength $match) - (blength $got)));
  1622.         $done = 1;
  1623.         } else {
  1624.         $got = Net::SSLeay::read($ssl, $peek_length);
  1625.         $done = 1 if ($peek_length == $max_length - blength($reply));
  1626.         } 
  1627.  
  1628.         last if print_errs('SSL_read');
  1629.         debug_read(\$reply, \$got) if $trace>1;
  1630.         last if $got eq '';
  1631.         $reply .= $got;
  1632.     }
  1633.     } else {
  1634.     while (!defined $max_length || length $reply < $max_length) {
  1635.         $got = Net::SSLeay::read($ssl,1);  # one by one
  1636.         last if print_errs('SSL_read');
  1637.         debug_read(\$reply, \$got) if $trace>1;
  1638.         last if $got eq '';
  1639.         $reply .= $got;
  1640.         last if $len_delim
  1641.         && substr($reply, blength($reply)-$len_delim) eq $delim;
  1642.     }
  1643.     }
  1644.     return $reply;
  1645. }
  1646.  
  1647. # ssl_read_CRLF($ssl [, $max_length])
  1648. sub ssl_read_CRLF ($;$) { ssl_read_until($_[0], $CRLF, $_[1]) }
  1649.  
  1650. # ssl_write_CRLF($ssl, $message) writes $message and appends CRLF
  1651. sub ssl_write_CRLF ($$) { 
  1652.   # the next line uses less memory but might use more network packets
  1653.   return ssl_write_all($_[0], $_[1]) + ssl_write_all($_[0], $CRLF);
  1654.  
  1655.   # the next few lines do the same thing at the expense of memory, with
  1656.   # the chance that it will use less packets, since CRLF is in the original
  1657.   # message and won't be sent separately.
  1658.  
  1659.   #my $data_ref;
  1660.   #if (ref $_[1]) { $data_ref = $_[1] }
  1661.   # else { $data_ref = \$_[1] }
  1662.   #my $message = $$data_ref . $CRLF;
  1663.   #return ssl_write_all($_[0], \$message);
  1664. }
  1665.  
  1666. ### Quickly print out with whom we're talking
  1667.  
  1668. sub dump_peer_certificate ($) {
  1669.     my ($ssl) = @_;
  1670.     my $cert = get_peer_certificate($ssl);
  1671.     return if print_errs('get_peer_certificate');
  1672.     print "no cert defined\n" if !defined($cert);
  1673.     # Cipher=NONE with empty cert fix
  1674.     if (!defined($cert) || ($cert == 0)) {
  1675.     warn "cert = `$cert'\n" if $trace;
  1676.     return "Subject Name: undefined\nIssuer  Name: undefined\n";
  1677.     } else {
  1678.     my $x = 'Subject Name: '
  1679.         . X509_NAME_oneline(X509_get_subject_name($cert)) . "\n"
  1680.         . 'Issuer  Name: '
  1681.             . X509_NAME_oneline(X509_get_issuer_name($cert))  . "\n";
  1682.     Net::SSLeay::X509_free($cert);
  1683.     return $x;
  1684.     }
  1685. }
  1686.  
  1687. ### Arrange some randomness for eay PRNG
  1688.  
  1689. sub randomize (;$$) {
  1690.     my ($rn_seed_file, $seed, $egd_path) = @_;
  1691.     my $rnsf = defined($rn_seed_file) && -r $rn_seed_file;
  1692.  
  1693.     $egd_path = $ENV{'EGD_PATH'} if $ENV{'EGD_PATH'};
  1694.     $egd_path = '/tmp/entropy'   unless $egd_path;
  1695.     
  1696.     RAND_seed(rand() + $$);  # Stir it with time and pid
  1697.     
  1698.     unless ($rnsf || -r $Net::SSLeay::random_device || $seed || -S $egd_path) {
  1699.     warn "Random number generator not seeded!!!" if $trace;
  1700.     }
  1701.     
  1702.     RAND_load_file($rn_seed_file, -s _) if $rnsf;
  1703.     RAND_seed($seed) if $seed;
  1704.     RAND_seed($ENV{RND_SEED}) if $ENV{RND_SEED};
  1705.     RAND_egd($egd_path) if -S $egd_path;
  1706.     RAND_load_file($Net::SSLeay::random_device, $Net::SSLeay::how_random/8)
  1707.     if -r $Net::SSLeay::random_device;
  1708. }
  1709.  
  1710. sub new_x_ctx {
  1711.     if    ($ssl_version == 2)  { $ctx = CTX_v2_new(); }
  1712.     elsif ($ssl_version == 3)  { $ctx = CTX_v3_new(); }
  1713.     elsif ($ssl_version == 10) { $ctx = CTX_tlsv1_new(); }
  1714.     else                       { $ctx = CTX_new(); }
  1715.     return $ctx;
  1716. }
  1717.  
  1718. ###
  1719. ### Basic request - response primitive (don't use for https)
  1720. ###
  1721.  
  1722. sub sslcat { # address, port, message, $crt, $key --> reply / (reply,errs,cert)
  1723.     my ($dest_serv, $port, $out_message, $crt_path, $key_path) = @_;
  1724.     my ($ctx, $ssl, $got, $errs, $written);
  1725.     
  1726.     ($got, $errs) = open_proxy_tcp_connection($dest_serv, $port);
  1727.     return (wantarray ? (undef, $errs) : undef) unless $got;
  1728.     
  1729.     ### Do SSL negotiation stuff
  1730.         
  1731.     warn "Creating SSL $ssl_version context...\n" if $trace>2;
  1732.     load_error_strings();         # Some bloat, but I'm after ease of use
  1733.     SSLeay_add_ssl_algorithms();  # and debuggability.
  1734.     randomize();
  1735.     
  1736.     $ctx = new_x_ctx();
  1737.     goto cleanup2 if $errs = print_errs('CTX_new') or !$ctx;
  1738.  
  1739.     CTX_set_options($ctx, &OP_ALL);
  1740.     goto cleanup2 if $errs = print_errs('CTX_set_options');
  1741.  
  1742.     warn "Cert `$crt_path' given without key" if $crt_path && !$key_path;
  1743.     set_cert_and_key($ctx, $crt_path, $key_path) if $crt_path;
  1744.     
  1745.     warn "Creating SSL connection (context was '$ctx')...\n" if $trace>2;
  1746.     $ssl = new($ctx);
  1747.     goto cleanup if $errs = print_errs('SSL_new') or !$ssl;
  1748.     
  1749.     warn "Setting fd (ctx $ctx, con $ssl)...\n" if $trace>2;
  1750.     set_fd($ssl, fileno(SSLCAT_S));
  1751.     goto cleanup if $errs = print_errs('set_fd');
  1752.     
  1753.     warn "Entering SSL negotiation phase...\n" if $trace>2;
  1754.  
  1755.     if ($trace>2) {
  1756.     my $i = 0;
  1757.     my $p = '';
  1758.     my $cipher_list = 'Cipher list: ';
  1759.     $p=Net::SSLeay::get_cipher_list($ssl,$i);
  1760.     $cipher_list .= $p if $p;
  1761.     do {
  1762.         $i++;
  1763.         $cipher_list .= ', ' . $p if $p;
  1764.         $p=Net::SSLeay::get_cipher_list($ssl,$i);
  1765.     } while $p;
  1766.     $cipher_list .= '\n';
  1767.     warn $cipher_list;
  1768.     }
  1769.     
  1770.     $got = Net::SSLeay::connect($ssl);
  1771.     warn "SSLeay connect returned $got\n" if $trace>2;
  1772.     goto cleanup if $errs = print_errs('SSL_connect');
  1773.     
  1774.     my $server_cert = get_peer_certificate($ssl);
  1775.     print_errs('get_peer_certificate');
  1776.     if ($trace>1) {        
  1777.     warn "Cipher `" . get_cipher($ssl) . "'\n";
  1778.     print_errs('get_ciper');
  1779.     warn dump_peer_certificate($ssl);
  1780.     }
  1781.     
  1782.     ### Connected. Exchange some data (doing repeated tries if necessary).
  1783.         
  1784.     warn "sslcat $$: sending " . blength($out_message) . " bytes...\n"
  1785.     if $trace==3;
  1786.     warn "sslcat $$: sending `$out_message' (" . blength($out_message)
  1787.     . " bytes)...\n" if $trace>3;
  1788.     ($written, $errs) = ssl_write_all($ssl, $out_message);
  1789.     goto cleanup unless $written;
  1790.     
  1791.     sleep $slowly if $slowly;  # Closing too soon can abort broken servers
  1792.     CORE::shutdown SSLCAT_S, 1;  # Half close --> No more output, send EOF to server
  1793.     
  1794.     warn "waiting for reply...\n" if $trace>2;
  1795.     ($got, $errs) = ssl_read_all($ssl);
  1796.     warn "Got " . blength($got) . " bytes.\n" if $trace==3;
  1797.     warn "Got `$got' (" . blength($got) . " bytes)\n" if $trace>3;
  1798.  
  1799. cleanup:        
  1800.     free ($ssl);
  1801.     $errs .= print_errs('SSL_free');
  1802. cleanup2:
  1803.     CTX_free ($ctx);
  1804.     $errs .= print_errs('CTX_free');
  1805.     close SSLCAT_S;    
  1806.     return wantarray ? ($got, $errs, $server_cert) : $got;
  1807. }
  1808.  
  1809. ###
  1810. ### Basic request - response primitive, this is different from sslcat
  1811. ###                 because this does not shutdown the connection.
  1812. ###
  1813.  
  1814. sub https_cat { # address, port, message --> returns reply / (reply,errs,cert)
  1815.     my ($dest_serv, $port, $out_message, $crt_path, $key_path) = @_;
  1816.     my ($ctx, $ssl, $got, $errs, $written);
  1817.     
  1818.     ($got, $errs) = open_proxy_tcp_connection($dest_serv, $port);
  1819.     return (wantarray ? (undef, $errs) : undef) unless $got;
  1820.         
  1821.     ### Do SSL negotiation stuff
  1822.         
  1823.     warn "Creating SSL $ssl_version context...\n" if $trace>2;
  1824.     load_error_strings();         # Some bloat, but I'm after ease of use
  1825.     SSLeay_add_ssl_algorithms();  # and debuggability.
  1826.     randomize();
  1827.  
  1828.     $ctx = new_x_ctx();
  1829.     goto cleanup2 if $errs = print_errs('CTX_new') or !$ctx;
  1830.  
  1831.     CTX_set_options($ctx, &OP_ALL);
  1832.     goto cleanup2 if $errs = print_errs('CTX_set_options');
  1833.     
  1834.     warn "Cert `$crt_path' given without key" if $crt_path && !$key_path;
  1835.     set_cert_and_key($ctx, $crt_path, $key_path) if $crt_path;
  1836.     
  1837.     warn "Creating SSL connection (context was '$ctx')...\n" if $trace>2;
  1838.     $ssl = new($ctx);
  1839.     goto cleanup if $errs = print_errs('SSL_new') or !$ssl;
  1840.     
  1841.     warn "Setting fd (ctx $ctx, con $ssl)...\n" if $trace>2;
  1842.     set_fd($ssl, fileno(SSLCAT_S));
  1843.     goto cleanup if $errs = print_errs('set_fd');
  1844.     
  1845.     warn "Entering SSL negotiation phase...\n" if $trace>2;
  1846.     
  1847.     if ($trace>2) {
  1848.     my $i = 0;
  1849.     my $p = '';
  1850.     my $cipher_list = 'Cipher list: ';
  1851.     $p=Net::SSLeay::get_cipher_list($ssl,$i);
  1852.     $cipher_list .= $p if $p;
  1853.     do {
  1854.         $i++;
  1855.         $cipher_list .= ', ' . $p if $p;
  1856.         $p=Net::SSLeay::get_cipher_list($ssl,$i);
  1857.     } while $p;
  1858.     $cipher_list .= '\n';
  1859.     warn $cipher_list;
  1860.     }
  1861.  
  1862.     $got = Net::SSLeay::connect($ssl);
  1863.     warn "SSLeay connect failed" if $trace>2 && $got==0;
  1864.     goto cleanup if $errs = print_errs('SSL_connect');
  1865.     
  1866.     my $server_cert = get_peer_certificate($ssl);
  1867.     print_errs('get_peer_certificate');
  1868.     if ($trace>1) {        
  1869.     warn "Cipher `" . get_cipher($ssl) . "'\n";
  1870.     print_errs('get_ciper');
  1871.     warn dump_peer_certificate($ssl);
  1872.     }
  1873.     
  1874.     ### Connected. Exchange some data (doing repeated tries if necessary).
  1875.         
  1876.     warn "sslcat $$: sending " . blength($out_message) . " bytes...\n"
  1877.     if $trace==3;
  1878.     warn "sslcat $$: sending `$out_message' (" . blength($out_message)
  1879.     . " bytes)...\n" if $trace>3;
  1880.     ($written, $errs) = ssl_write_all($ssl, $out_message);
  1881.     goto cleanup unless $written;
  1882.     
  1883.     warn "waiting for reply...\n" if $trace>2;
  1884.     ($got, $errs) = ssl_read_all($ssl);
  1885.     warn "Got " . blength($got) . " bytes.\n" if $trace==3;
  1886.     warn "Got `$got' (" . blength($got) . " bytes)\n" if $trace>3;
  1887.  
  1888. cleanup:
  1889.     free ($ssl);
  1890.     $errs .= print_errs('SSL_free');
  1891. cleanup2:
  1892.     CTX_free ($ctx);
  1893.     $errs .= print_errs('CTX_free');
  1894.     close SSLCAT_S;    
  1895.     return wantarray ? ($got, $errs, $server_cert) : $got;
  1896. }
  1897.  
  1898. ###
  1899. ### Easy set up of private key and certificate
  1900. ###
  1901.  
  1902. sub set_cert_and_key ($$$) {
  1903.     my ($ctx, $cert_path, $key_path) = @_;    
  1904.     my $errs = '';
  1905.     # Following will ask password unless private key is not encrypted
  1906.     CTX_use_RSAPrivateKey_file ($ctx, $key_path, &FILETYPE_PEM);
  1907.     $errs .= print_errs("private key `$key_path' ($!)");
  1908.     CTX_use_certificate_file ($ctx, $cert_path, &FILETYPE_PEM);
  1909.     $errs .= print_errs("certificate `$cert_path' ($!)");
  1910.     return wantarray ? (undef, $errs) : ($errs eq '');
  1911. }
  1912.  
  1913. ### Old deprecated API
  1914.  
  1915. sub set_server_cert_and_key ($$$) { &set_cert_and_key }
  1916.  
  1917. ### Set up to use web proxy
  1918.  
  1919. sub set_proxy ($$;**) {
  1920.     ($proxyhost, $proxyport, $proxyuser, $proxypass) = @_;
  1921.     require MIME::Base64 if $proxyuser;
  1922.     $proxyauth = $CRLF . 'Proxy-authorization: Basic '
  1923.     . MIME::Base64::encode("$proxyuser:$proxypass", '')
  1924.         if $proxyuser;
  1925. }
  1926.  
  1927. ###
  1928. ### Easy https manipulation routines
  1929. ###
  1930.  
  1931. sub make_form {
  1932.     my (@fields) = @_;
  1933.     my $form;
  1934.     while (@fields) {
  1935.     my ($name, $data) = (shift(@fields), shift(@fields));
  1936.     $data =~ s/([^\w\-.\@\$ ])/sprintf("%%%2.2x",ord($1))/gse;
  1937.         $data =~ tr[ ][+];
  1938.     $form .= "$name=$data&";
  1939.     }
  1940.     chop $form;
  1941.     return $form;
  1942. }
  1943.  
  1944. sub make_headers {
  1945.     my (@headers) = @_;
  1946.     my $headers;
  1947.     while (@headers) {
  1948.     my $header = shift(@headers);
  1949.     my $value = shift(@headers);
  1950.     $header =~ s/:$//;
  1951.     $value =~ s/\x0d?\x0a$//; # because we add it soon, see below
  1952.     $headers .= "$header: $value$CRLF";
  1953.     }
  1954.     return $headers;
  1955. }
  1956.  
  1957. sub do_https3 {
  1958.     my ($method, $site, $port, $path, $headers,
  1959.     $content, $mime_type, $crt_path, $key_path) = @_;
  1960.     my ($response, $page, $h,$v);
  1961.  
  1962.     if ($content) {
  1963.     $mime_type = "application/x-www-form-urlencoded" unless $mime_type;
  1964.     my $len = blength($content);
  1965.     $content = "Content-Type: $mime_type$CRLF"
  1966.         . "Content-Length: $len$CRLF$CRLF$content";
  1967.     } else {
  1968.     $content = "$CRLF$CRLF";
  1969.     }
  1970.     my $req = "$method $path HTTP/1.0$CRLF"."Host: $site:$port$CRLF"
  1971.       . (defined $headers ? $headers : '') . "Accept: */*$CRLF$content";    
  1972.  
  1973.     my ($http, $errs, $server_cert)
  1974.     = https_cat($site, $port, $req, $crt_path, $key_path);
  1975.     return (undef, "HTTP/1.0 900 NET OR SSL ERROR$CRLF$CRLF$errs") if $errs;
  1976.     
  1977.     $http = '' if !defined $http;
  1978.     ($headers, $page) = split /\s?\n\s?\n/, $http, 2;
  1979.     ($response, $headers) = split /\s?\n/, $headers, 2;
  1980.     return ($page, $response, $headers, $server_cert);
  1981. }
  1982.  
  1983. ### do_https2() is a legacy version in the sense that it is unable
  1984. ### to return all instances of duplicate headers.
  1985.  
  1986. sub do_https2 {
  1987.     my ($page, $response, $headers, $server_cert) = &do_https3;
  1988.     X509_free($server_cert) if defined $server_cert;
  1989.     return ($page, $response,
  1990.         map( { ($h,$v)=/^(\S+)\:\s*(.*)$/; (uc($h),$v); }
  1991.         split(/\s?\n/, $headers)
  1992.         )
  1993.         );
  1994. }
  1995.  
  1996. ### Returns headers as a hash where multiple instances of same header
  1997. ### are handled correctly.
  1998.  
  1999. sub do_https4 {
  2000.     my ($page, $response, $headers, $server_cert) = &do_https3;
  2001.     X509_free($server_cert) if defined $server_cert;
  2002.     my %hr = ();
  2003.     for my $hh (split /\s?\n/, $headers) {
  2004.     my ($h,$v)=/^(\S+)\:\s*(.*)$/;
  2005.     push @{$hr{uc($h)}}, $v;
  2006.     }
  2007.     return ($page, $response, \%hr);
  2008. }
  2009.  
  2010. sub get_https ($$$;***)  { do_https2(GET  => @_) }
  2011. sub post_https ($$$;***) { do_https2(POST => @_) }
  2012. sub put_https ($$$;***)  { do_https2(PUT  => @_) }
  2013. sub head_https ($$$;***) { do_https2(HEAD => @_) }
  2014.  
  2015. sub get_https3 ($$$;***)  { do_https3(GET  => @_) }
  2016. sub post_https3 ($$$;***) { do_https3(POST => @_) }
  2017. sub put_https3 ($$$;***)  { do_https3(PUT  => @_) }
  2018. sub head_https3 ($$$;***) { do_https3(HEAD => @_) }
  2019.  
  2020. sub get_https4 ($$$;***)  { do_https4(GET  => @_) }
  2021. sub post_https4 ($$$;***) { do_https4(POST => @_) }
  2022. sub put_https4 ($$$;***)  { do_https4(PUT  => @_) }
  2023. sub head_https4 ($$$;***) { do_https4(HEAD => @_) }
  2024.  
  2025. ### Legacy
  2026. # ($page, $respone_or_err, %headers) = do_https(...);
  2027.  
  2028. sub do_https {
  2029.     my ($site, $port, $path, $method, $headers,
  2030.     $content, $mime_type, $crt_path, $key_path) = @_;
  2031.  
  2032.     do_https2($method, $site, $port, $path, $headers,
  2033.          $content, $mime_type, $crt_path, $key_path);
  2034. }
  2035.  
  2036. 1;
  2037. __END__
  2038.