vcs.maemo.org Git - pkg-perl/blob - deb-src/libnet-ssleay-perl/libnet-ssleay-perl-1.35/lib/Net/SSLeay.pm

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