--- /dev/null
+# Net::SSLeay.pm - Perl module for using Eric Young's implementation of SSL
+#
+# Copyright (c) 1996-2003 Sampo Kellomaki <sampo@iki.fi>, All Rights Reserved.
+# Copyright (C) 2005 Florian Ragwitz <rafl@debian.org>, All Rights Reserved.
+# Copyright (C) 2005 Mike McCauley <mikem@open.com.au>, All Rights Reserved.
+#
+# $Id$
+#
+# Version 1.04, 31.3.1999
+# 30.7.1999, Tracking OpenSSL-0.9.3a changes, --Sampo
+# 31.7.1999, version 1.05 --Sampo
+# 7.4.2001, fixed input error upon 0, OpenSSL-0.9.6a, version 1.06 --Sampo
+# 18.4.2001, added TLSv1 support by Stephen C. Koehler
+# <koehler@securecomputing.com>, version 1.07, --Sampo
+# 25.4.2001, 64 bit fixes by Marko Asplund <aspa@kronodoc.fi> --Sampo
+# 17.4.2001, more error codes from aspa --Sampo
+# 25.9.2001, added heaps and piles of newer OpenSSL auxiliary functions --Sampo
+# 6.11.2001, got rid of $p_errs madness --Sampo
+# 9.11.2001, added EGD (entropy gathering daemon) reference info --Sampo
+# 7.12.2001, Added proxy support by Bruno De Wolf <bruno.dewolf@@pandora._be>
+# 6.1.2002, cosmetic fix to socket options from Kwindla Hultman Kramer <kwindla@@allafrica_.com>
+# 25.3.2002, added post_https_cert and friends per patch from
+# mock@@obscurity.ogr, --Sampo
+# 3.4.2002, added `use bytes' from Marcus Taylor <marcus@@semantico_.com>
+# This avoids unicode/utf8 (as may appear in some XML docs)
+# from fooling the length comuptations. Dropped support for
+# perl5.005_03 because I do not have opportunity to test it. --Sampo
+# 5.4.2002, improved Unicode gotcha eliminator to support old perls --Sampo
+# 8.4.2002, added a small line end fix from Petr Dousa (pdousa@@kerio_.com)
+# 17.5.2002, Added BIO_s_mem, BIO_new, BIO_free, BIO_write, BIO_read
+# BIO_eof, BIO_pending, BIO_wpending, RSA_generate_key, RSA_free
+# --mikem@open._com.au
+# 10.8.2002, Added SSL_peek patch to ssl_read_until from
+# Peter Behroozi <peter@@fhpwireless_.com> --Sampo
+# 21.8.2002, Added SESSION_get_master_key, SSL_get_client_random, SSL_get_server_random
+# --mikem@open.com_.au
+# 2.9.2002, Added SSL_CTX_get_cert_store, X509_STORE_add_cert, X509_STORE_add_crl
+# X509_STORE_set_flags, X509_load_cert_file, X509_load_crl_file
+# X509_load_cert_crl_file, PEM_read_bio_X509_CRL,
+# constants for X509_V_FLAG_* in order to support certificate revocation lists.
+# --mikem@open.com_.au
+# 6.9.2002, fixed X509_STORE_set_flags to X509_STORE_CTX_set_flags, --Sampo
+# 19.9.2002, applied patch from Tim Engler <tim@burntcouch_.com>
+# 18.2.2003, applied patch from Toni Andjelkovic <toni@soth._at>
+# 13.6.2003, partially applied leak patch by Marian Jancar <mjancar@suse._cz>
+# 25.6.2003, write_partial() return value patch from
+# Kim Minh Kaplan <kmkaplan@selfoffice._com>
+# 17.8.2003, added http support :-) --Sampo
+# 17.8.2003, started 1.25 dev --Sampo
+# 30.11.2005, Applied a patch by Peter Behroozi that adds get1_session() for session caching --Florian
+# 30.11.2005, Applied a patch by ex8k-hbn@asahi-net.or.jp that limits the chunk size for tcp_read_all --Florian
+# 30.11.2005, Applied a patch by ivan-cpan-rt@420.am that avoids adding a Host header if an own is specified in do_httpx3
+# 13.12.2005, Added comments re thread safety and resetting of default_passwd_callback after use
+# --mikem@open.com.au
+#
+# The distribution and use of this module are subject to the conditions
+# listed in LICENSE file at the root of OpenSSL-0.9.7b
+# distribution (i.e. free, but mandatory attribution and NO WARRANTY).
+
+package Net::SSLeay;
+
+use strict;
+use Carp;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD $CRLF);
+use Socket;
+use Errno;
+
+require Exporter;
+use AutoLoader;
+
+# 0=no warns, 1=only errors, 2=ciphers, 3=progress, 4=dump data
+$Net::SSLeay::trace = 0; # Do not change here, use
+ # $Net::SSLeay::trace = [1-4] in caller
+
+# 2 = insist on v2 SSL protocol
+# 3 = insist on v3 SSL
+# 10 = insist on TLSv1
+# 0 or undef = guess (v23)
+#
+$Net::SSLeay::ssl_version = 0; # don't change here, use
+ # Net::SSLeay::version=[2,3,0] in caller
+
+#define to enable the "cat /proc/$$/stat" stuff
+$Net::SSLeay::linux_debug = 0;
+
+# Number of seconds to sleep after sending message and before half
+# closing connection. Useful with antiquated broken servers.
+$Net::SSLeay::slowly = 0;
+
+# RANDOM NUMBER INITIALIZATION
+#
+# Edit to your taste. Using /dev/random would be more secure, but may
+# block if randomness is not available, thus the default is
+# /dev/urandom. $how_random determines how many bits of randomness to take
+# from the device. You should take enough (read SSLeay/doc/rand), but
+# beware that randomness is limited resource so you should not waste
+# it either or you may end up with randomness depletion (situation where
+# /dev/random would block and /dev/urandom starts to return predictable
+# numbers).
+#
+# N.B. /dev/urandom does not exit on all systems, such as Solaris 2.6. In that
+# case you should get a third party package that emulates /dev/urandom
+# (e.g. via named pipe) or supply a random number file. Some such
+# packages are documented in Caveat section of the POD documentation.
+
+$Net::SSLeay::random_device = '/dev/urandom';
+$Net::SSLeay::how_random = 512;
+
+$VERSION = '1.35';
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(
+ AT_MD5_WITH_RSA_ENCRYPTION
+ CB_ACCEPT_EXIT
+ CB_ACCEPT_LOOP
+ CB_CONNECT_EXIT
+ CB_CONNECT_LOOP
+ CK_DES_192_EDE3_CBC_WITH_MD5
+ CK_DES_192_EDE3_CBC_WITH_SHA
+ CK_DES_64_CBC_WITH_MD5
+ CK_DES_64_CBC_WITH_SHA
+ CK_DES_64_CFB64_WITH_MD5_1
+ CK_IDEA_128_CBC_WITH_MD5
+ CK_NULL
+ CK_NULL_WITH_MD5
+ CK_RC2_128_CBC_EXPORT40_WITH_MD5
+ CK_RC2_128_CBC_WITH_MD5
+ CK_RC4_128_EXPORT40_WITH_MD5
+ CK_RC4_128_WITH_MD5
+ CLIENT_VERSION
+ ERROR_NONE
+ ERROR_SSL
+ ERROR_SYSCALL
+ ERROR_WANT_CONNECT
+ ERROR_WANT_READ
+ ERROR_WANT_WRITE
+ ERROR_WANT_X509_LOOKUP
+ ERROR_ZERO_RETURN
+ CT_X509_CERTIFICATE
+ FILETYPE_ASN1
+ FILETYPE_PEM
+ F_CLIENT_CERTIFICATE
+ F_CLIENT_HELLO
+ F_CLIENT_MASTER_KEY
+ F_D2I_SSL_SESSION
+ F_GET_CLIENT_FINISHED
+ F_GET_CLIENT_HELLO
+ F_GET_CLIENT_MASTER_KEY
+ F_GET_SERVER_FINISHED
+ F_GET_SERVER_HELLO
+ F_GET_SERVER_VERIFY
+ F_I2D_SSL_SESSION
+ F_READ_N
+ F_REQUEST_CERTIFICATE
+ F_SERVER_HELLO
+ F_SSL_ACCEPT
+ F_SSL_CERT_NEW
+ F_SSL_CONNECT
+ F_SSL_ENC_DES_CBC_INIT
+ F_SSL_ENC_DES_CFB_INIT
+ F_SSL_ENC_DES_EDE3_CBC_INIT
+ F_SSL_ENC_IDEA_CBC_INIT
+ F_SSL_ENC_NULL_INIT
+ F_SSL_ENC_RC2_CBC_INIT
+ F_SSL_ENC_RC4_INIT
+ F_SSL_GET_NEW_SESSION
+ F_SSL_MAKE_CIPHER_LIST
+ F_SSL_NEW
+ F_SSL_READ
+ F_SSL_RSA_PRIVATE_DECRYPT
+ F_SSL_RSA_PUBLIC_ENCRYPT
+ F_SSL_SESSION_NEW
+ F_SSL_SESSION_PRINT_FP
+ F_SSL_SET_CERTIFICATE
+ F_SSL_SET_FD
+ F_SSL_SET_RFD
+ F_SSL_SET_WFD
+ F_SSL_STARTUP
+ F_SSL_USE_CERTIFICATE
+ F_SSL_USE_CERTIFICATE_ASN1
+ F_SSL_USE_CERTIFICATE_FILE
+ F_SSL_USE_PRIVATEKEY
+ F_SSL_USE_PRIVATEKEY_ASN1
+ F_SSL_USE_PRIVATEKEY_FILE
+ F_SSL_USE_RSAPRIVATEKEY
+ F_SSL_USE_RSAPRIVATEKEY_ASN1
+ F_SSL_USE_RSAPRIVATEKEY_FILE
+ F_WRITE_PENDING
+ GEN_OTHERNAME
+ GEN_EMAIL
+ GEN_DNS
+ GEN_X400
+ GEN_DIRNAME
+ GEN_EDIPARTY
+ GEN_URI
+ GEN_IPADD
+ GEN_RID
+ MAX_MASTER_KEY_LENGTH_IN_BITS
+ MAX_RECORD_LENGTH_2_BYTE_HEADER
+ MAX_RECORD_LENGTH_3_BYTE_HEADER
+ MAX_SSL_SESSION_ID_LENGTH_IN_BYTES
+ MIN_RSA_MODULUS_LENGTH_IN_BYTES
+ MT_CLIENT_CERTIFICATE
+ MT_CLIENT_FINISHED
+ MT_CLIENT_HELLO
+ MT_CLIENT_MASTER_KEY
+ MT_ERROR
+ MT_REQUEST_CERTIFICATE
+ MT_SERVER_FINISHED
+ MT_SERVER_HELLO
+ MT_SERVER_VERIFY
+ NOTHING
+ NID_undef
+ NID_algorithm
+ NID_rsadsi
+ NID_pkcs
+ NID_md2
+ NID_md5
+ NID_rc4
+ NID_rsaEncryption
+ NID_md2WithRSAEncryption
+ NID_md5WithRSAEncryption
+ NID_pbeWithMD2AndDES_CBC
+ NID_pbeWithMD5AndDES_CBC
+ NID_X500
+ NID_X509
+ NID_commonName
+ NID_countryName
+ NID_localityName
+ NID_stateOrProvinceName
+ NID_organizationName
+ NID_organizationalUnitName
+ NID_rsa
+ NID_pkcs7
+ NID_pkcs7_data
+ NID_pkcs7_signed
+ NID_pkcs7_enveloped
+ NID_pkcs7_signedAndEnveloped
+ NID_pkcs7_digest
+ NID_pkcs7_encrypted
+ NID_pkcs3
+ NID_dhKeyAgreement
+ NID_des_ecb
+ NID_des_cfb64
+ NID_des_cbc
+ NID_des_ede
+ NID_des_ede3
+ NID_idea_cbc
+ NID_idea_cfb64
+ NID_idea_ecb
+ NID_rc2_cbc
+ NID_rc2_ecb
+ NID_rc2_cfb64
+ NID_rc2_ofb64
+ NID_sha
+ NID_shaWithRSAEncryption
+ NID_des_ede_cbc
+ NID_des_ede3_cbc
+ NID_des_ofb64
+ NID_idea_ofb64
+ NID_pkcs9
+ NID_pkcs9_emailAddress
+ NID_pkcs9_unstructuredName
+ NID_pkcs9_contentType
+ NID_pkcs9_messageDigest
+ NID_pkcs9_signingTime
+ NID_pkcs9_countersignature
+ NID_pkcs9_challengePassword
+ NID_pkcs9_unstructuredAddress
+ NID_pkcs9_extCertAttributes
+ NID_netscape
+ NID_netscape_cert_extension
+ NID_netscape_data_type
+ NID_des_ede_cfb64
+ NID_des_ede3_cfb64
+ NID_des_ede_ofb64
+ NID_des_ede3_ofb64
+ NID_sha1
+ NID_sha1WithRSAEncryption
+ NID_dsaWithSHA
+ NID_dsa_2
+ NID_pbeWithSHA1AndRC2_CBC
+ NID_id_pbkdf2
+ NID_dsaWithSHA1_2
+ NID_netscape_cert_type
+ NID_netscape_base_url
+ NID_netscape_revocation_url
+ NID_netscape_ca_revocation_url
+ NID_netscape_renewal_url
+ NID_netscape_ca_policy_url
+ NID_netscape_ssl_server_name
+ NID_netscape_comment
+ NID_netscape_cert_sequence
+ NID_desx_cbc
+ NID_id_ce
+ NID_subject_key_identifier
+ NID_key_usage
+ NID_private_key_usage_period
+ NID_subject_alt_name
+ NID_issuer_alt_name
+ NID_basic_constraints
+ NID_crl_number
+ NID_certificate_policies
+ NID_authority_key_identifier
+ NID_bf_cbc
+ NID_bf_ecb
+ NID_bf_cfb64
+ NID_bf_ofb64
+ NID_mdc2
+ NID_mdc2WithRSA
+ NID_rc4_40
+ NID_rc2_40_cbc
+ NID_givenName
+ NID_surname
+ NID_initials
+ NID_uniqueIdentifier
+ NID_crl_distribution_points
+ NID_md5WithRSA
+ NID_serialNumber
+ NID_title
+ NID_description
+ NID_cast5_cbc
+ NID_cast5_ecb
+ NID_cast5_cfb64
+ NID_cast5_ofb64
+ NID_pbeWithMD5AndCast5_CBC
+ NID_dsaWithSHA1
+ NID_md5_sha1
+ NID_sha1WithRSA
+ NID_dsa
+ NID_ripemd160
+ NID_ripemd160WithRSA
+ NID_rc5_cbc
+ NID_rc5_ecb
+ NID_rc5_cfb64
+ NID_rc5_ofb64
+ NID_rle_compression
+ NID_zlib_compression
+ NID_ext_key_usage
+ NID_id_pkix
+ NID_id_kp
+ NID_server_auth
+ NID_client_auth
+ NID_code_sign
+ NID_email_protect
+ NID_time_stamp
+ NID_ms_code_ind
+ NID_ms_code_com
+ NID_ms_ctl_sign
+ NID_ms_sgc
+ NID_ms_efs
+ NID_ns_sgc
+ NID_delta_crl
+ NID_crl_reason
+ NID_invalidity_date
+ NID_sxnet
+ NID_pbe_WithSHA1And128BitRC4
+ NID_pbe_WithSHA1And40BitRC4
+ NID_pbe_WithSHA1And3_Key_TripleDES_CBC
+ NID_pbe_WithSHA1And2_Key_TripleDES_CBC
+ NID_pbe_WithSHA1And128BitRC2_CBC
+ NID_pbe_WithSHA1And40BitRC2_CBC
+ NID_keyBag
+ NID_pkcs8ShroudedKeyBag
+ NID_certBag
+ NID_crlBag
+ NID_secretBag
+ NID_safeContentsBag
+ NID_friendlyName
+ NID_localKeyID
+ NID_x509Certificate
+ NID_sdsiCertificate
+ NID_x509Crl
+ NID_pbes2
+ NID_pbmac1
+ NID_hmacWithSHA1
+ NID_id_qt_cps
+ NID_id_qt_unotice
+ NID_rc2_64_cbc
+ NID_SMIMECapabilities
+ NID_pbeWithMD2AndRC2_CBC
+ NID_pbeWithMD5AndRC2_CBC
+ NID_pbeWithSHA1AndDES_CBC
+ NID_ms_ext_req
+ NID_ext_req
+ NID_name
+ NID_dnQualifier
+ NID_id_pe
+ NID_id_ad
+ NID_info_access
+ NID_ad_OCSP
+ NID_ad_ca_issuers
+ NID_OCSP_sign
+ OPENSSL_VERSION_NUMBER
+ PE_BAD_CERTIFICATE
+ PE_NO_CERTIFICATE
+ PE_NO_CIPHER
+ PE_UNSUPPORTED_CERTIFICATE_TYPE
+ READING
+ RWERR_BAD_MAC_DECODE
+ RWERR_BAD_WRITE_RETRY
+ RWERR_INTERNAL_ERROR
+ R_BAD_AUTHENTICATION_TYPE
+ R_BAD_CHECKSUM
+ R_BAD_MAC_DECODE
+ R_BAD_RESPONSE_ARGUMENT
+ R_BAD_SSL_FILETYPE
+ R_BAD_SSL_SESSION_ID_LENGTH
+ R_BAD_STATE
+ R_BAD_WRITE_RETRY
+ R_CHALLENGE_IS_DIFFERENT
+ R_CIPHER_CODE_TOO_LONG
+ R_CIPHER_TABLE_SRC_ERROR
+ R_CONECTION_ID_IS_DIFFERENT
+ R_INVALID_CHALLENGE_LENGTH
+ R_NO_CERTIFICATE_SET
+ R_NO_CERTIFICATE_SPECIFIED
+ R_NO_CIPHER_LIST
+ R_NO_CIPHER_MATCH
+ R_NO_CIPHER_WE_TRUST
+ R_NO_PRIVATEKEY
+ R_NO_PUBLICKEY
+ R_NO_READ_METHOD_SET
+ R_NO_WRITE_METHOD_SET
+ R_NULL_SSL_CTX
+ R_PEER_DID_NOT_RETURN_A_CERTIFICATE
+ R_PEER_ERROR
+ R_PEER_ERROR_CERTIFICATE
+ R_PEER_ERROR_NO_CIPHER
+ R_PEER_ERROR_UNSUPPORTED_CERTIFICATE_TYPE
+ R_PERR_ERROR_NO_CERTIFICATE
+ R_PUBLIC_KEY_ENCRYPT_ERROR
+ R_PUBLIC_KEY_IS_NOT_RSA
+ R_PUBLIC_KEY_NO_RSA
+ R_READ_WRONG_PACKET_TYPE
+ R_REVERSE_KEY_ARG_LENGTH_IS_WRONG
+ R_REVERSE_MASTER_KEY_LENGTH_IS_WRONG
+ R_REVERSE_SSL_SESSION_ID_LENGTH_IS_WRONG
+ R_SHORT_READ
+ R_SSL_SESSION_ID_IS_DIFFERENT
+ R_UNABLE_TO_EXTRACT_PUBLIC_KEY
+ R_UNDEFINED_INIT_STATE
+ R_UNKNOWN_REMOTE_ERROR_TYPE
+ R_UNKNOWN_STATE
+ R_UNSUPORTED_CIPHER
+ R_WRONG_PUBLIC_KEY_TYPE
+ R_X509_LIB
+ RSA_3
+ RSA_F4
+ SERVER_VERSION
+ SESSION
+ SESSION_ASN1_VERSION
+ ST_ACCEPT
+ ST_BEFORE
+ ST_CLIENT_START_ENCRYPTION
+ ST_CONNECT
+ ST_GET_CLIENT_FINISHED_A
+ ST_GET_CLIENT_FINISHED_B
+ ST_GET_CLIENT_HELLO_A
+ ST_GET_CLIENT_HELLO_B
+ ST_GET_CLIENT_MASTER_KEY_A
+ ST_GET_CLIENT_MASTER_KEY_B
+ ST_GET_SERVER_FINISHED_A
+ ST_GET_SERVER_FINISHED_B
+ ST_GET_SERVER_HELLO_A
+ ST_GET_SERVER_HELLO_B
+ ST_GET_SERVER_VERIFY_A
+ ST_GET_SERVER_VERIFY_B
+ ST_INIT
+ ST_OK
+ ST_READ_BODY
+ ST_READ_HEADER
+ ST_SEND_CLIENT_CERTIFICATE_A
+ ST_SEND_CLIENT_CERTIFICATE_B
+ ST_SEND_CLIENT_CERTIFICATE_C
+ ST_SEND_CLIENT_CERTIFICATE_D
+ ST_SEND_CLIENT_FINISHED_A
+ ST_SEND_CLIENT_FINISHED_B
+ ST_SEND_CLIENT_HELLO_A
+ ST_SEND_CLIENT_HELLO_B
+ ST_SEND_CLIENT_MASTER_KEY_A
+ ST_SEND_CLIENT_MASTER_KEY_B
+ ST_SEND_REQUEST_CERTIFICATE_A
+ ST_SEND_REQUEST_CERTIFICATE_B
+ ST_SEND_REQUEST_CERTIFICATE_C
+ ST_SEND_REQUEST_CERTIFICATE_D
+ ST_SEND_SERVER_FINISHED_A
+ ST_SEND_SERVER_FINISHED_B
+ ST_SEND_SERVER_HELLO_A
+ ST_SEND_SERVER_HELLO_B
+ ST_SEND_SERVER_VERIFY_A
+ ST_SEND_SERVER_VERIFY_B
+ ST_SERVER_START_ENCRYPTION
+ ST_X509_GET_CLIENT_CERTIFICATE
+ ST_X509_GET_SERVER_CERTIFICATE
+ TXT_DES_192_EDE3_CBC_WITH_MD5
+ TXT_DES_192_EDE3_CBC_WITH_SHA
+ TXT_DES_64_CBC_WITH_MD5
+ TXT_DES_64_CBC_WITH_SHA
+ TXT_DES_64_CFB64_WITH_MD5_1
+ TXT_IDEA_128_CBC_WITH_MD5
+ TXT_NULL
+ TXT_NULL_WITH_MD5
+ TXT_RC2_128_CBC_EXPORT40_WITH_MD5
+ TXT_RC2_128_CBC_WITH_MD5
+ TXT_RC4_128_EXPORT40_WITH_MD5
+ TXT_RC4_128_WITH_MD5
+ VERIFY_CLIENT_ONCE
+ VERIFY_FAIL_IF_NO_PEER_CERT
+ VERIFY_NONE
+ VERIFY_PEER
+ WRITING
+ X509_LOOKUP
+ X509_V_FLAG_CB_ISSUER_CHECK
+ X509_V_FLAG_USE_CHECK_TIME
+ X509_V_FLAG_CRL_CHECK
+ X509_V_FLAG_CRL_CHECK_ALL
+ X509_V_FLAG_IGNORE_CRITICAL
+ CTX_new
+ CTX_v2_new
+ CTX_v3_new
+ CTX_v23_new
+ CTX_free
+ new
+ free
+ accept
+ clear
+ connect
+ set_fd
+ set_rfd
+ set_wfd
+ get_fd
+ read
+ write
+ peek
+ use_RSAPrivateKey
+ use_RSAPrivateKey_ASN1
+ use_RSAPrivateKey_file
+ CTX_use_RSAPrivateKey_file
+ use_PrivateKey
+ use_PrivateKey_ASN1
+ use_PrivateKey_file
+ use_certificate
+ use_certificate_ASN1
+ use_certificate_file
+ CTX_use_certificate_file
+ load_error_strings
+ ERR_load_SSL_strings
+ ERR_load_RAND_strings
+ state_string
+ rstate_string
+ state_string_long
+ rstate_string_long
+ get_time
+ set_time
+ get_timeout
+ set_timeout
+ copy_session_id
+ set_read_ahead
+ get_read_ahead
+ pending
+ get_cipher_list
+ set_cipher_list
+ get_cipher
+ get_shared_ciphers
+ get_peer_certificate
+ set_verify
+ flush_sessions
+ set_bio
+ get_rbio
+ get_wbio
+ SESSION_new
+ SESSION_print
+ SESSION_free
+ i2d_SSL_SESSION
+ set_session
+ add_session
+ remove_session
+ d2i_SSL_SESSION
+ BIO_f_ssl
+ BIO_new
+ BIO_new_file
+ BIO_s_mem
+ BIO_free
+ BIO_read
+ BIO_write
+ BIO_eof
+ BIO_pending
+ BIO_wpending
+ ERR_get_error
+ ERR_error_string
+ err
+ clear_error
+ X509_get_issuer_name
+ X509_get_subject_name
+ X509_NAME_oneline
+ X509_NAME_get_text_by_NID
+ CTX_get_cert_store
+ X509_STORE_add_cert
+ X509_STORE_add_crl
+ X509_STORE_CTX_set_flags
+ X509_load_cert_file
+ X509_load_crl_file
+ X509_load_cert_crl_file
+ PEM_read_bio_X509_CRL
+ die_if_ssl_error
+ die_now
+ print_errs
+ set_cert_and_key
+ set_server_cert_and_key
+ make_form
+ make_headers
+ do_https
+ get_https
+ post_https
+ get_https4
+ post_https4
+ sslcat
+ ssl_read_CRLF
+ ssl_read_all
+ ssl_read_until
+ ssl_write_CRLF
+ ssl_write_all
+ get_http
+ post_http
+ get_httpx
+ post_httpx
+ get_https3
+ post_https3
+ get_http4
+ post_http4
+ get_httpx4
+ post_httpx4
+ tcpcat
+ tcpxcat
+ tcp_read_CRLF
+ tcp_read_all
+ tcp_read_until
+ tcp_write_CRLF
+ tcp_write_all
+ dump_peer_certificate
+ RSA_generate_key
+ RSA_free
+ X509_free
+ SESSION_get_master_key
+ get_client_random
+ get_server_random
+);
+
+sub AUTOLOAD {
+ # This AUTOLOAD is used to 'autoload' constants from the constant()
+ # XS function. If a constant is not found then control is passed
+ # to the AUTOLOAD in AutoLoader.
+
+ my $constname;
+ ($constname = $AUTOLOAD) =~ s/.*:://;
+ my $val = constant($constname);
+ if ($! != 0) {
+ if ($! =~ /((Invalid)|(not valid))/i || $!{EINVAL}) {
+ $AutoLoader::AUTOLOAD = $AUTOLOAD;
+ goto &AutoLoader::AUTOLOAD;
+ }
+ else {
+ croak "Your vendor has not defined SSLeay macro $constname";
+ }
+ }
+ eval "sub $AUTOLOAD { $val }";
+ goto &$AUTOLOAD;
+}
+
+eval {
+ require XSLoader;
+ XSLoader::load('Net::SSLeay', $VERSION);
+ 1;
+} or do {
+ require DynaLoader;
+ push @ISA, 'DynaLoader';
+ bootstrap Net::SSLeay $VERSION;
+};
+
+# Preloaded methods go here.
+
+$CRLF = "\x0d\x0a"; # because \r\n is not fully portable
+
+### Print SSLeay error stack
+
+sub print_errs {
+ my ($msg) = @_;
+ my ($count, $err, $errs, $e) = (0,0,'');
+ while ($err = ERR_get_error()) {
+ $count ++;
+ $e = "$msg $$: $count - " . ERR_error_string($err) . "\n";
+ $errs .= $e;
+ warn $e if $Net::SSLeay::trace;
+ }
+ return $errs;
+}
+
+# Death is conditional to SSLeay errors existing, i.e. this function checks
+# for errors and only dies in affirmative.
+# usage: Net::SSLeay::write($ssl, "foo") or die_if_ssl_error("SSL write ($!)");
+
+sub die_if_ssl_error {
+ my ($msg) = @_;
+ die "$$: $msg\n" if print_errs($msg);
+}
+
+# Unconditional death. Used to print SSLeay errors before dying.
+# usage: Net::SSLeay::connect($ssl) or die_now("Failed SSL connect ($!)");
+
+sub die_now {
+ my ($msg) = @_;
+ print_errs($msg);
+ die "$$: $msg\n";
+}
+
+# Perl 5.6.* unicode support causes that length() no longer reliably
+# reflects the byte length of a string. This eval is to fix that.
+# Thanks to Sean Burke for the snippet.
+
+BEGIN{
+eval 'use bytes; sub blength ($) { length $_[0] }';
+$@ and eval ' sub blength ($) { length $_[0] }' ;
+}
+
+# Autoload methods go after =cut, and are processed by the autosplit program.
+
+1;
+__END__
+# Documentation. Use `perl-root/pod/pod2html SSLeay.pm` to output html
+
+=head1 NAME
+
+Net::SSLeay - Perl extension for using OpenSSL
+
+=head1 SYNOPSIS
+
+ use Net::SSLeay qw(get_https post_https sslcat make_headers make_form);
+
+ ($page) = get_https('www.bacus.pt', 443, '/'); # 1
+
+ ($page, $response, %reply_headers)
+ = get_https('www.bacus.pt', 443, '/', # 2
+ make_headers(User-Agent => 'Cryptozilla/5.0b1',
+ Referer => 'https://www.bacus.pt'
+ ));
+
+ ($page, $result, %headers) = # 2b
+ = get_https('www.bacus.pt', 443, '/protected.html',
+ make_headers(Authorization =>
+ 'Basic ' . MIME::Base64::encode("$user:$pass",''))
+ );
+
+ ($page, $response, %reply_headers)
+ = post_https('www.bacus.pt', 443, '/foo.cgi', '', # 3
+ make_form(OK => '1',
+ name => 'Sampo'
+ ));
+
+ $reply = sslcat($host, $port, $request); # 4
+
+ ($reply, $err, $server_cert) = sslcat($host, $port, $request); # 5
+
+ $Net::SSLeay::trace = 2; # 0=no debugging, 1=ciphers, 2=trace, 3=dump data
+
+=head1 DESCRIPTION
+
+There is a related module called C<Net::SSLeay::Handle> included in this
+distribution that you might want to use instead. It has its own pod
+documentation.
+
+This module offers some high level convinience functions for accessing
+web pages on SSL servers (for symmetry, same API is offered for
+accessing http servers, too), a C<sslcat()> function for writing your own
+clients, and finally access to the SSL api of SSLeay/OpenSSL package
+so you can write servers or clients for more complicated applications.
+
+For high level functions it is most convinient to import them to your
+main namespace as indicated in the synopsis.
+
+Case 1 demonstrates typical invocation of get_https() to fetch an HTML
+page from secure server. The first argument provides host name or ip
+in dotted decimal notation of the remote server to contact. Second
+argument is the TCP port at the remote end (your own port is picked
+arbitrarily from high numbered ports as usual for TCP). The third
+argument is the URL of the page without the host name part. If in
+doubt consult HTTP specifications at L<http://www.w3c.org>.
+
+Case 2 demonstrates full fledged use of C<get_https()>. As can be seen,
+C<get_https()> parses the response and response headers and returns them as
+a list, which can be captured in a hash for later reference. Also a
+fourth argument to C<get_https()> is used to insert some additional headers
+in the request. C<make_headers()> is a function that will convert a list or
+hash to such headers. By default C<get_https()> supplies C<Host> (make virtual
+hosting easy) and C<Accept> (reportedly needed by IIS) headers.
+
+Case 2b demonstrates how to get password protected page. Refer to
+HTTP protocol specifications for further details (e.g. RFC-2617).
+
+Case 3 invokes C<post_https()> to submit a HTML/CGI form to secure
+server. First four arguments are equal to C<get_https()> (note that empty
+string (C<''>) is passed as header argument). The fifth argument is the
+contents of the form formatted according to CGI specification. In this
+case the helper function C<make_https()> is used to do the formatting,
+but you could pass any string. The C<post_https()> automatically adds
+C<Content-Type> and C<Content-Length> headers to the request.
+
+Case 4 shows the fundamental C<sslcat()> function (inspired in spirit by
+C<netcat> utility :-). Its your swiss army knife that allows you to
+easily contact servers, send some data, and then get the response. You
+are responsible for formatting the data and parsing the response -
+C<sslcat()> is just a transport.
+
+Case 5 is a full invocation of C<sslcat()> which allows return of errors
+as well as the server (peer) certificate.
+
+The C<$trace> global variable can be used to control the verbosity of high
+level functions. Level 0 guarantees silence, level 1 (the default)
+only emits error messages.
+
+=head2 Alternate versions of the API
+
+The above mentioned functions actually return the response headers as
+a list, which only gets converted to hash upon assignment (this
+assignment looses information if the same header occurs twice, as may
+be the case with cookies). There are also other variants of the
+functions that return unprocessed headers and that return a reference
+to a hash.
+
+ ($page, $response, @headers) = get_https('www.bacus.pt', 443, '/');
+ for ($i = 0; $i < $#headers; $i+=2) {
+ print "$headers[$i] = " . $headers[$i+1] . "\n";
+ }
+
+ ($page, $response, $headers, $server_cert)
+ = get_https3('www.bacus.pt', 443, '/');
+ print "$headers\n";
+
+ ($page, $response, %headers_ref, $server_cert)
+ = get_https4('www.bacus.pt', 443, '/');
+ for $k (sort keys %{headers_ref}) {
+ for $v (@{$headers_ref{$k}}) {
+ print "$k = $v\n";
+ }
+ }
+
+All of the above code fragments accomplish the same thing: display all
+values of all headers. The API functions ending in "3" return the
+headers simply as a scalar string and it is up to the application to
+split them up. The functions ending in "4" return a reference to
+hash of arrays (see L<perlref> and L<perllol> if you are
+not familiar with complex perl data structures). To access single value
+of such header hash you would do something like
+
+ print $headers_ref{COOKIE}[0];
+
+The variants 3 and 4 also allow you to discover the server certificate
+in case you would like to store or display it, e.g.
+
+ ($p, $resp, $hdrs, $server_cert) = get_https3('www.bacus.pt', 443, '/');
+ if (!defined($server_cert) || ($server_cert == 0)) {
+ warn "Subject Name: undefined, Issuer Name: undefined";
+ } else {
+ warn 'Subject Name: '
+ . Net::SSLeay::X509_NAME_oneline(
+ Net::SSLeay::X509_get_subject_name($server_cert))
+ . 'Issuer Name: '
+ . Net::SSLeay::X509_NAME_oneline(
+ Net::SSLeay::X509_get_issuer_name($server_cert));
+ }
+
+Beware that this method only allows after the fact verification of
+the certificate: by the time C<get_https3()> has returned the https
+request has already been sent to the server, whether you decide to
+tryst it or not. To do the verification correctly you must either
+employ the OpenSSL certificate verification framework or use
+the lower level API to first connect and verify the certificate
+and only then send the http data. See implementation of C<ds_https3()>
+for guidance on how to do this.
+
+=head2 Using client certificates
+
+Secure web communications are encrypted using symmetric crypto keys
+exchanged using encryption based on the certificate of the
+server. Therefore in all SSL connections the server must have a
+certificate. This serves both to authenticate the server to the
+clients and to perform the key exchange.
+
+Sometimes it is necessary to authenticate the client as well. Two
+options are available: HTTP basic authentication and client side
+certificate. The basic authentication over HTTPS is actually quite
+safe because HTTPS guarantees that the password will not travel in
+clear. Never-the-less, problems like easily guessable passwords
+remain. The client certificate method involves authentication of the
+client at SSL level using a certificate. For this to work, both the
+client and the server will have certificates (which typically are
+different) and private keys.
+
+The API functions outlined above accept additional arguments that
+allow one to supply the client side certificate and key files. The
+format of these files is the same as used for server certificates and
+the caveat about encrypting private key applies.
+
+ ($page, $result, %headers) = # 2c
+ = get_https('www.bacus.pt', 443, '/protected.html',
+ make_headers(Authorization =>
+ 'Basic ' . MIME::Base64::encode("$user:$pass",'')),
+ '', $mime_type6, $path_to_crt7, $path_to_key8);
+
+ ($page, $response, %reply_headers)
+ = post_https('www.bacus.pt', 443, '/foo.cgi', # 3b
+ make_headers('Authorization' =>
+ 'Basic ' . MIME::Base64::encode("$user:$pass",'')),
+ make_form(OK => '1', name => 'Sampo'),
+ $mime_type6, $path_to_crt7, $path_to_key8);
+
+Case 2c demonstrates getting password protected page that also requires
+client certificate, i.e. it is possible to use both authentication
+methods simultaneously.
+
+Case 3b is full blown post to secure server that requires both password
+authentication and client certificate, just like in case 2c.
+
+Note: Client will not send a certificate unless the server requests one.
+This is typically achieved by setting verify mode to C<VERIFY_PEER> on the
+server:
+
+ Net::SSLeay::set_verify(ssl, Net::SSLeay::VERIFY_PEER, 0);
+
+See C<perldoc ~openssl/doc/ssl/SSL_CTX_set_verify.pod> for full description.
+
+=head2 Working through Web proxy
+
+C<Net::SSLeay> can use a web proxy to make its connections. You need to
+first set the proxy host and port using C<set_proxy()> and then just
+use the normal API functions, e.g:
+
+ Net::SSLeay::set_proxy('gateway.myorg.com', 8080);
+ ($page) = get_https('www.bacus.pt', 443, '/');
+
+If your proxy requires authentication, you can supply username and
+password as well
+
+ Net::SSLeay::set_proxy('gateway.myorg.com', 8080, 'joe', 'salainen');
+ ($page, $result, %headers) =
+ = get_https('www.bacus.pt', 443, '/protected.html',
+ make_headers(Authorization =>
+ 'Basic ' . MIME::Base64::encode("susie:pass",''))
+ );
+
+This example demonstrates case where we authenticate to the proxy as
+C<"joe"> and to the final web server as C<"susie">. Proxy authentication
+requires C<MIME::Base64> module to work.
+
+=head2 Certificate verification and Certificate Revoocation Lists (CRLs)
+
+OpenSSL supports the ability to verify peer certificates. It can also
+optionally check the peer certificate against a Certificate Revocation
+List (CRL) from the certificates issuer. A CRL is a file, created by
+the certificate issuer that lists all the certificates that it
+previously signed, but which it now revokes. CRLs are in PEM format.
+
+You can enable C<Net::SSLeay CRL> checking like this:
+
+ &Net::SSLeay::X509_STORE_CTX_set_flags
+ (&Net::SSLeay::CTX_get_cert_store($ssl),
+ &Net::SSLeay::X509_V_FLAG_CRL_CHECK);
+
+After setting this flag, if OpenSSL checks a peer's certificate, then
+it will attempt to find a CRL for the issuer. It does this by looking
+for a specially named file in the search directory specified by
+CTX_load_verify_locations. CRL files are named with the hash of the
+issuer's subject name, followed by C<.r0>, C<.r1> etc. For example
+C<ab1331b2.r0>, C<ab1331b2.r1>. It will read all the .r files for the
+issuer, and then check for a revocation of the peer cerificate in all
+of them. (You can also force it to look in a specific named CRL
+file., see below). You can find out the hash of the issuer subject
+name in a CRL with
+
+ openssl crl -in crl.pem -hash -noout
+
+If the peer certificate does not pass the revocation list, or if no
+CRL is found, then the handshaking fails with an error.
+
+You can also force OpenSSL to look for CRLs in one or more arbitrarily
+named files.
+
+ my $bio = Net::SSLeay::BIO_new_file($crlfilename, 'r');
+ my $crl = Net::SSLeay::PEM_read_bio_X509_CRL($bio);
+ if ($crl) {
+ Net::SSLeay::X509_STORE_add_crl(
+ Net::SSLeay::CTX_get_cert_store($ssl, $crl);
+ } else {
+ error reading CRL....
+ }
+
+
+=head2 Convenience routines
+
+To be used with Low level API
+
+ Net::SSLeay::randomize($rn_seed_file,$additional_seed);
+ Net::SSLeay::set_cert_and_key($ctx, $cert_path, $key_path);
+ $cert = Net::SSLeay::dump_peer_certificate($ssl);
+ Net::SSLeay::ssl_write_all($ssl, $message) or die "ssl write failure";
+ $got = Net::SSLeay::ssl_read_all($ssl) or die "ssl read failure";
+
+ $got = Net::SSLeay::ssl_read_CRLF($ssl [, $max_length]);
+ $got = Net::SSLeay::ssl_read_until($ssl [, $delimit [, $max_length]]);
+ Net::SSLeay::ssl_write_CRLF($ssl, $message);
+
+C<randomize()> seeds the eay PRNG with C</dev/urandom> (see top of C<SSLeay.pm>
+for how to change or configure this) and optionally with user provided
+data. It is very important to properly seed your random numbers, so
+do not forget to call this. The high level API functions automatically
+call C<randomize()> so it is not needed with them. See also caveats.
+
+C<set_cert_and_key()> takes two file names as arguments and sets
+the certificate and private key to those. This can be used to
+set either cerver certificates or client certificates.
+
+C<dump_peer_certificate()> allows you to get plaintext description of the
+certificate the peer (usually server) presented to us.
+
+C<ssl_read_all()> and C<ssl_write_all()> provide true blocking semantics for
+these operations (see limitation, below, for explanation). These are
+much preferred to the low level API equivalents (which implement BSD
+blocking semantics). The message argument to C<ssl_write_all()> can be
+reference. This is helpful to avoid unnecessary copy when writing
+something big, e.g:
+
+ $data = 'A' x 1000000000;
+ Net::SSLeay::ssl_write_all($ssl, \$data) or die "ssl write failed";
+
+C<ssl_read_CRLF()> uses C<ssl_read_all()> to read in a line terminated with a
+carriage return followed by a linefeed (CRLF). The CRLF is included in
+the returned scalar.
+
+C<ssl_read_until()> uses C<ssl_read_all()> to read from the SSL input
+stream until it encounters a programmer specified delimiter.
+If the delimiter is undefined, C<$/> is used. If C<$/> is undefined,
+C<\n> is used. One can optionally set a maximum length of bytes to read
+from the SSL input stream.
+
+C<ssl_write_CRLF()> writes C<$message> and appends CRLF to the SSL output stream.
+
+=head2 Low level API
+
+In addition to the high level functions outlined above, this module
+contains straight forward access to SSL part of OpenSSL C api. Only the SSL
+subpart of OpenSSL is implemented (if anyone wants to implement other
+parts, feel free to submit patches).
+
+See C<ssl.h> header from OpenSSL C distribution for list of low lever
+SSLeay functions to call (to check if some function has been
+implemented see directly in SSLeay.xs). The module strips SSLeay names
+of the initial C<"SSL_">, generally you should use C<Net::SSLeay::> in
+place. For example:
+
+In C:
+
+ #include <ssl.h>
+
+ err = SSL_set_verify (ssl, SSL_VERIFY_CLIENT_ONCE,
+ &your_call_back_here);
+
+In Perl:
+
+ use Net::SSLeay;
+
+ $err = Net::SSLeay::set_verify ($ssl,
+ Net::SSLeay::VERIFY_CLIENT_ONCE,
+ \&your_call_back_here);
+
+If the function does not start by C<SSL_> you should use the full
+function name, e.g.:
+
+ $err = Net::SSLeay::ERR_get_error;
+
+Following new functions behave in perlish way:
+
+ $got = Net::SSLeay::read($ssl);
+ # Performs SSL_read, but returns $got
+ # resized according to data received.
+ # Returns undef on failure.
+
+ Net::SSLeay::write($ssl, $foo) || die;
+ # Performs SSL_write, but automatically
+ # figures out the size of $foo
+
+In order to use the low level API you should start your programs with
+the following incantation:
+
+ use Net::SSLeay qw(die_now die_if_ssl_error);
+ Net::SSLeay::load_error_strings();
+ Net::SSLeay::SSLeay_add_ssl_algorithms(); # Important!
+ Net::SSLeay::ENGINE_load_builtin_engines(); # If you want built-in engines
+ Net::SSLeay::ENGINE_register_all_complete(); # If you want built-in engines
+ Net::SSLeay::randomize();
+
+C<die_now()> and C<die_if_ssl_error()> are used to conveniently print SSLeay error
+stack when something goes wrong, thusly:
+
+ Net::SSLeay::connect($ssl) or die_now("Failed SSL connect ($!)");
+ Net::SSLeay::write($ssl, "foo") or die_if_ssl_error("SSL write ($!)");
+
+You can also use C<Net::SSLeay::print_errs()> to dump the error stack without
+exiting the program. As can be seen, your code becomes much more readable
+if you import the error reporting functions to your main name space.
+
+I can not emphasize enough the need to check error returns. Use these
+functions even in most simple programs, they will reduce debugging
+time greatly. Do not ask questions in mailing list without having
+first sprinkled these in your code.
+
+=head2 Sockets
+
+Perl uses file handles for all I/O. While SSLeay has quite flexible BIO
+mechanism and perl has evolved PerlIO mechanism, this module still
+sticks to using file descriptors. Thus to attach SSLeay to socket you
+should use C<fileno()> to extract the underlying file descriptor:
+
+ Net::SSLeay::set_fd($ssl, fileno(S)); # Must use fileno
+
+You should also set C<$|> to 1 to eliminate STDIO buffering so you do not
+get confused if you use perl I/O functions to manipulate your socket
+handle.
+
+If you need to C<select(2)> on the socket, go right ahead, but be warned
+that OpenSSL does some internal buffering so SSL_read does not always
+return data even if socket selected for reading (just keep on
+selecting and trying to read). C<Net::SSLeay> is no different from the
+C language OpenSSL in this respect.
+
+=head2 Callbacks
+
+At this moment the implementation of verify_callback is crippeled in
+the sense that at any given time there can be only one call back which
+is shared by all SSL contexts, sessions and connections. This is
+due to having to keep the reference to the perl call back in a
+static variable so that the callback C glue can find it. To remove
+this restriction would require either a more complex data structure
+(like a hash?) in XSUB to map the call backs to their owners or,
+cleaner, adding a context pointer in the SSL structure. This context would
+then be passed to the C callback, which in our case would be the glue
+to look up the proper Perl function from the context and call it.
+
+---- inaccurate ----
+The verify call back looks like this in C:
+
+ int (*callback)(int ok,X509 *subj_cert,X509 *issuer_cert,
+ int depth,int errorcode,char *arg,STACK *cert_chain)
+
+The corresponding Perl function should be something like this:
+
+ sub verify {
+ my ($ok, $subj_cert, $issuer_cert, $depth, $errorcode,
+ $arg, $chain) = @_;
+ print "Verifying certificate...\n";
+ ...
+ return $ok;
+ }
+
+It is used like this:
+
+ Net::SSLeay::set_verify ($ssl, Net::SSLeay::VERIFY_PEER, \&verify);
+
+Callbacks for decrypting private keys are implemented, but have the
+same limitation as the verify_callback implementation (one password
+callback shared between all contexts.) You might use it something
+like this:
+
+ Net::SSLeay::CTX_set_default_passwd_cb($ctx, sub { "top-secret" });
+ Net::SSLeay::CTX_use_PrivateKey_file($ctx, "key.pem",
+ Net::SSLeay::FILETYPE_PEM)
+ or die "Error reading private key";
+ Net::SSLeay::CTX_set_default_passwd_cb($ctx, undef);
+
+No other callbacks are implemented. You do not need to use any
+callback for simple (i.e. normal) cases where the SSLeay built-in
+verify mechanism satisfies your needs.
+
+It is desirable to reset these callbacks to undef immediately after use to prevent
+thread safety problems and crashes on exit that can occur if different threads
+set different callbacks.
+
+---- end inaccurate ----
+
+If you want to use callback stuff, see examples/callback.pl! Its the
+only one I am able to make work reliably.
+
+=head2 X509 and RAND stuff
+
+This module largely lacks interface to the X509 and RAND routines, but
+as I was lazy and needed them, the following kludges are implemented:
+
+ $x509_name = Net::SSLeay::X509_get_subject_name($x509_cert);
+ $x509_name = Net::SSLeay::X509_get_issuer_name($x509_cert);
+ print Net::SSLeay::X509_NAME_oneline($x509_name);
+ $text = Net::SSLeay::X509_NAME_get_text_by_NID($name, $nid);
+
+ ($type1, $subject1, $type2, $subject2, ...) =
+ Net::SSLeay::X509_get_subjectAltNames($x509_cert)
+
+ subjectAltName types as per x509v3.h GEN_*, for example
+ GEN_DNS or GEN_IPADD which can be imported.
+
+ Net::SSLeay::RAND_seed($buf); # Perlishly figures out buf size
+ Net::SSLeay::RAND_bytes($buf, $num);
+ Net::SSLeay::RAND_pseudo_bytes($buf, $num);
+ Net::SSLeay::RAND_add($buf, $num, $entropy);
+ Net::SSLeay::RAND_poll();
+ Net::SSLeay::RAND_status();
+ Net::SSLeay::RAND_cleanup();
+ Net::SSLeay::RAND_file_name($num);
+ Net::SSLeay::RAND_load_file($file_name, $how_many_bytes);
+ Net::SSLeay::RAND_write_file($file_name);
+ Net::SSLeay::RAND_egd($path);
+ Net::SSLeay::RAND_egd_bytes($path, $bytes);
+
+Actually you should consider using the following helper functions:
+
+ print Net::SSLeay::dump_peer_certificate($ssl);
+ Net::SSLeay::randomize();
+
+=head2 RSA interface
+
+Some RSA functions are available:
+
+ $rsakey = Net::SSLeay::RSA_generate_key();
+ Net::SSLeay::CTX_set_tmp_rsa($ctx, $rsakey);
+ Net::SSLeay::RSA_free($rsakey);
+
+=head2 BIO interface
+
+Some BIO functions are available:
+
+ Net::SSLeay::BIO_s_mem();
+ $bio = Net::SSLeay::BIO_new(BIO_s_mem())
+ $bio = Net::SSLeay::BIO_new_file($filename, $mode);
+ Net::SSLeay::BIO_free($bio)
+ $count = Net::SSLeay::BIO_write($data);
+ $data = Net::SSLeay::BIO_read($bio);
+ $data = Net::SSLeay::BIO_read($bio, $maxbytes);
+ $is_eof = Net::SSLeay::BIO_eof($bio);
+ $count = Net::SSLeay::BIO_pending($bio);
+ $count = Net::SSLeay::BIO_wpending ($bio);
+
+=head2 Low level API
+
+Some very low level API functions are available:
+
+ $client_random = Net::SSLeay::get_client_random($ssl);
+ $server_random = Net::SSLeay::get_server_random($ssl);
+ $session = Net::SSLeay::get_session($ssl);
+ $master_key = Net::SSLeay::SESSION_get_master_key($session);
+ Net::SSLeay::SESSION_set_master_key($session, $master_secret);
+ $keyblocksize = Net::SSLeay::get_keyblock_size($session);
+
+=head2 HTTP (without S) API
+
+Over the years it has become clear that it would be convenient to use
+the light weight flavour API of C<Net::SSLeay> also for normal HTTP (see
+LWP for heavy weight object oriented approach). In fact it would be
+nice to be able to flip https on and off on the fly. Thus regular HTTP
+support was evolved.
+
+ use Net::SSLeay qw(get_http post_http tcpcat
+ get_httpx post_httpx tcpxcat
+ make_headers make_form);
+
+ ($page, $result, %headers) =
+ = get_http('www.bacus.pt', 443, '/protected.html',
+ make_headers(Authorization =>
+ 'Basic ' . MIME::Base64::encode("$user:$pass",''))
+ );
+
+ ($page, $response, %reply_headers)
+ = post_http('www.bacus.pt', 443, '/foo.cgi', '',
+ make_form(OK => '1',
+ name => 'Sampo'
+ ));
+
+ ($reply, $err) = tcpcat($host, $port, $request);
+
+ ($page, $result, %headers) =
+ = get_httpx($usessl, 'www.bacus.pt', 443, '/protected.html',
+ make_headers(Authorization =>
+ 'Basic ' . MIME::Base64::encode("$user:$pass",''))
+ );
+
+ ($page, $response, %reply_headers)
+ = post_httpx($usessl, 'www.bacus.pt', 443, '/foo.cgi', '',
+ make_form(OK => '1', name => 'Sampo' ));
+
+ ($reply, $err, $server_cert) = tcpxcat($usessl, $host, $port, $request);
+
+As can be seen, the C<"x"> family of APIs takes as first argument a flag
+which indicated whether SSL is used or not.
+
+=head1 EXAMPLES
+
+One very good example is to look at the implementation of C<sslcat()> in the
+C<SSLeay.pm> file.
+
+Following is a simple SSLeay client (with too little error checking :-(
+
+ #!/usr/local/bin/perl
+ use Socket;
+ use Net::SSLeay qw(die_now die_if_ssl_error) ;
+ Net::SSLeay::load_error_strings();
+ Net::SSLeay::SSLeay_add_ssl_algorithms();
+ Net::SSLeay::randomize();
+
+ ($dest_serv, $port, $msg) = @ARGV; # Read command line
+ $port = getservbyname ($port, 'tcp') unless $port =~ /^\d+$/;
+ $dest_ip = gethostbyname ($dest_serv);
+ $dest_serv_params = sockaddr_in($port, $dest_ip);
+
+ socket (S, &AF_INET, &SOCK_STREAM, 0) or die "socket: $!";
+ connect (S, $dest_serv_params) or die "connect: $!";
+ select (S); $| = 1; select (STDOUT); # Eliminate STDIO buffering
+
+ # The network connection is now open, lets fire up SSL
+
+ $ctx = Net::SSLeay::CTX_new() or die_now("Failed to create SSL_CTX $!");
+ Net::SSLeay::CTX_set_options($ctx, &Net::SSLeay::OP_ALL)
+ and die_if_ssl_error("ssl ctx set options");
+ $ssl = Net::SSLeay::new($ctx) or die_now("Failed to create SSL $!");
+ Net::SSLeay::set_fd($ssl, fileno(S)); # Must use fileno
+ $res = Net::SSLeay::connect($ssl) and die_if_ssl_error("ssl connect");
+ print "Cipher `" . Net::SSLeay::get_cipher($ssl) . "'\n";
+
+ # Exchange data
+
+ $res = Net::SSLeay::write($ssl, $msg); # Perl knows how long $msg is
+ die_if_ssl_error("ssl write");
+ CORE::shutdown S, 1; # Half close --> No more output, sends EOF to server
+ $got = Net::SSLeay::read($ssl); # Perl returns undef on failure
+ die_if_ssl_error("ssl read");
+ print $got;
+
+ Net::SSLeay::free ($ssl); # Tear down connection
+ Net::SSLeay::CTX_free ($ctx);
+ close S;
+
+Following is a simple SSLeay echo server (non forking):
+
+ #!/usr/local/bin/perl -w
+ use Socket;
+ use Net::SSLeay qw(die_now die_if_ssl_error);
+ Net::SSLeay::load_error_strings();
+ Net::SSLeay::SSLeay_add_ssl_algorithms();
+ Net::SSLeay::randomize();
+
+ $our_ip = "\0\0\0\0"; # Bind to all interfaces
+ $port = 1235;
+ $sockaddr_template = 'S n a4 x8';
+ $our_serv_params = pack ($sockaddr_template, &AF_INET, $port, $our_ip);
+
+ socket (S, &AF_INET, &SOCK_STREAM, 0) or die "socket: $!";
+ bind (S, $our_serv_params) or die "bind: $!";
+ listen (S, 5) or die "listen: $!";
+ $ctx = Net::SSLeay::CTX_new () or die_now("CTX_new ($ctx): $!");
+ Net::SSLeay::CTX_set_options($ctx, &Net::SSLeay::OP_ALL)
+ and die_if_ssl_error("ssl ctx set options");
+
+ # Following will ask password unless private key is not encrypted
+ Net::SSLeay::CTX_use_RSAPrivateKey_file ($ctx, 'plain-rsa.pem',
+ &Net::SSLeay::FILETYPE_PEM);
+ die_if_ssl_error("private key");
+ Net::SSLeay::CTX_use_certificate_file ($ctx, 'plain-cert.pem',
+ &Net::SSLeay::FILETYPE_PEM);
+ die_if_ssl_error("certificate");
+
+ while (1) {
+ print "Accepting connections...\n";
+ ($addr = accept (NS, S)) or die "accept: $!";
+ select (NS); $| = 1; select (STDOUT); # Piping hot!
+
+ ($af,$client_port,$client_ip) = unpack($sockaddr_template,$addr);
+ @inetaddr = unpack('C4',$client_ip);
+ print "$af connection from " .
+ join ('.', @inetaddr) . ":$client_port\n";
+
+ # We now have a network connection, lets fire up SSLeay...
+
+ $ssl = Net::SSLeay::new($ctx) or die_now("SSL_new ($ssl): $!");
+ Net::SSLeay::set_fd($ssl, fileno(NS));
+
+ $err = Net::SSLeay::accept($ssl) and die_if_ssl_error('ssl accept');
+ print "Cipher `" . Net::SSLeay::get_cipher($ssl) . "'\n";
+
+ # Connected. Exchange some data.
+
+ $got = Net::SSLeay::read($ssl); # Returns undef on fail
+ die_if_ssl_error("ssl read");
+ print "Got `$got' (" . length ($got) . " chars)\n";
+
+ Net::SSLeay::write ($ssl, uc ($got)) or die "write: $!";
+ die_if_ssl_error("ssl write");
+
+ Net::SSLeay::free ($ssl); # Tear down connection
+ close NS;
+ }
+
+Yet another echo server. This one runs from C</etc/inetd.conf> so it avoids
+all the socket code overhead. Only caveat is opening rsa key file -
+it had better be without any encryption or else it will not know where
+to ask for the password. Note how C<STDIN> and C<STDOUT> are wired to SSL.
+
+ #!/usr/local/bin/perl
+ # /etc/inetd.conf
+ # ssltst stream tcp nowait root /path/to/server.pl server.pl
+ # /etc/services
+ # ssltst 1234/tcp
+
+ use Net::SSLeay qw(die_now die_if_ssl_error);
+ Net::SSLeay::load_error_strings();
+ Net::SSLeay::SSLeay_add_ssl_algorithms();
+ Net::SSLeay::randomize();
+
+ chdir '/key/dir' or die "chdir: $!";
+ $| = 1; # Piping hot!
+ open LOG, ">>/dev/console" or die "Can't open log file $!";
+ select LOG; print "server.pl started\n";
+
+ $ctx = Net::SSLeay::CTX_new() or die_now "CTX_new ($ctx) ($!)";
+ $ssl = Net::SSLeay::new($ctx) or die_now "new ($ssl) ($!)";
+ Net::SSLeay::set_options($ssl, &Net::SSLeay::OP_ALL)
+ and die_if_ssl_error("ssl set options");
+
+ # We get already open network connection from inetd, now we just
+ # need to attach SSLeay to STDIN and STDOUT
+ Net::SSLeay::set_rfd($ssl, fileno(STDIN));
+ Net::SSLeay::set_wfd($ssl, fileno(STDOUT));
+
+ Net::SSLeay::use_RSAPrivateKey_file ($ssl, 'plain-rsa.pem',
+ Net::SSLeay::FILETYPE_PEM);
+ die_if_ssl_error("private key");
+ Net::SSLeay::use_certificate_file ($ssl, 'plain-cert.pem',
+ Net::SSLeay::FILETYPE_PEM);
+ die_if_ssl_error("certificate");
+
+ Net::SSLeay::accept($ssl) and die_if_ssl_err("ssl accept: $!");
+ print "Cipher `" . Net::SSLeay::get_cipher($ssl) . "'\n";
+
+ $got = Net::SSLeay::read($ssl);
+ die_if_ssl_error("ssl read");
+ print "Got `$got' (" . length ($got) . " chars)\n";
+
+ Net::SSLeay::write ($ssl, uc($got)) or die "write: $!";
+ die_if_ssl_error("ssl write");
+
+ Net::SSLeay::free ($ssl); # Tear down the connection
+ Net::SSLeay::CTX_free ($ctx);
+ close LOG;
+
+There are also a number of example/test programs in the examples directory:
+
+ sslecho.pl - A simple server, not unlike the one above
+ minicli.pl - Implements a client using low level SSLeay routines
+ sslcat.pl - Demonstrates using high level sslcat utility function
+ get_page.pl - Is a utility for getting html pages from secure servers
+ callback.pl - Demonstrates certificate verification and callback usage
+ stdio_bulk.pl - Does SSL over Unix pipes
+ ssl-inetd-serv.pl - SSL server that can be invoked from inetd.conf
+ httpd-proxy-snif.pl - Utility that allows you to see how a browser
+ sends https request to given server and what reply
+ it gets back (very educative :-)
+ makecert.pl - Creates a self signed cert (does not use this module)
+
+=head1 LIMITATIONS
+
+C<Net::SSLeay::read()> uses internal buffer of 32KB, thus no single read
+will return more. In practice one read returns much less, usually
+as much as fits in one network packet. To work around this,
+you should use a loop like this:
+
+ $reply = '';
+ while ($got = Net::SSLeay::read($ssl)) {
+ last if print_errs('SSL_read');
+ $reply .= $got;
+ }
+
+Although there is no built-in limit in C<Net::SSLeay::write()>, the network
+packet size limitation applies here as well, thus use:
+
+ $written = 0;
+
+ while ($written < length($message)) {
+ $written += Net::SSLeay::write($ssl, substr($message, $written));
+ last if print_errs('SSL_write');
+ }
+
+Or alternatively you can just use the following convinence functions:
+
+ Net::SSLeay::ssl_write_all($ssl, $message) or die "ssl write failure";
+ $got = Net::SSLeay::ssl_read_all($ssl) or die "ssl read failure";
+
+=head1 KNOWN BUGS AND CAVEATS
+
+Autoloader emits
+
+ Argument "xxx" isn't numeric in entersub at blib/lib/Net/SSLeay.pm'
+
+warning if die_if_ssl_error is made autoloadable. If you figure out why,
+drop me a line.
+
+Callback set using C<SSL_set_verify()> does not appear to work. This may
+well be eay problem (e.g. see C<ssl/ssl_lib.c> line 1029). Try using
+C<SSL_CTX_set_verify()> instead and do not be surprised if even this stops
+working in future versions.
+
+Callback and certificate verification stuff is generally too little tested.
+
+Random numbers are not initialized randomly enough, especially if you
+do not have C</dev/random> and/or C</dev/urandom> (such as in Solaris
+platforms - but I've been suggested that cryptorand daemon from SUNski
+package solves this). In this case you should investigate third party
+software that can emulate these devices, e.g. by way of a named pipe
+to some program.
+
+Another gotcha with random number initialization is randomness
+depletion. This phenomenon, which has been extensively discussed in
+OpenSSL, Apache-SSL, and Apache-mod_ssl forums, can cause your
+script to block if you use C</dev/random> or to operate insecurely
+if you use C</dev/urandom>. What happens is that when too much
+randomness is drawn from the operating system's randomness pool
+then randomness can temporarily be unavailable. C</dev/random> solves
+this problem by waiting until enough randomness can be gathered - and
+this can take a long time since blocking reduces activity in the
+machine and less activity provides less random events: a vicious circle.
+C</dev/urandom> solves this dilemma more pragmatically by simply returning
+predictable "random" numbers. SomeC< /dev/urandom> emulation software
+however actually seems to implement C</dev/random> semantics. Caveat emptor.
+
+I've been pointed to two such daemons by Mik Firestone <mik@@speed.stdio._com>
+who has used them on Solaris 8:
+
+=over
+
+=item 1
+
+Entropy Gathering Daemon (EGD) at L<http://www.lothar.com/tech/crypto/>
+
+=item 2
+
+Pseudo-random number generating daemon (PRNGD) at
+L<http://www.aet.tu-cottbus.de/personen/jaenicke/postfix_tls/prngd.html>
+
+=back
+
+If you are using the low level API functions to communicate with other
+SSL implementations, you would do well to call
+
+ Net::SSLeay::CTX_set_options($ctx, &Net::SSLeay::OP_ALL)
+ and die_if_ssl_error("ssl ctx set options");
+
+to cope with some well know bugs in some other SSL
+implementations. The high level API functions always set all known
+compatibility options.
+
+Sometimes C<sslcat()> (and the high level HTTPS functions that build on it)
+is too fast in signaling the EOF to legacy HTTPS servers. This causes
+the server to return empty page. To work around this problem you can
+set global variable
+
+ $Net::SSLeay::slowly = 1; # Add sleep so broken servers can keep up
+
+HTTP/1.1 is not supported. Specifically this module does not know to
+issue or serve multiple http requests per connection. This is a serious
+short coming, but using SSL session cache on your server helps to
+alleviate the CPU load somewhat.
+
+As of version 1.09 many newer OpenSSL auxiliary functions were
+added (from C<REM_AUTOMATICALLY_GENERATED_1_09> onwards in C<SSLeay.xs>).
+Unfortunately I have not had any opportunity to test these. Some of
+them are trivial enough that I believe they "just work", but others
+have rather complex interfaces with function pointers and all. In these
+cases you should proceed wit great caution.
+
+This module defaults to using OpenSSL automatic protocol negotiation
+code for automatically detecting the version of the SSL protocol
+that the other end talks. With most web servers this works just
+fine, but once in a while I get complaints from people that the module
+does not work with some web servers. Usually this can be solved
+by explicitly setting the protocol version, e.g.
+
+ $Net::SSLeay::ssl_version = 2; # Insist on SSLv2
+ $Net::SSLeay::ssl_version = 3; # Insist on SSLv3
+ $Net::SSLeay::ssl_version = 10; # Insist on TLSv1
+
+Although the autonegotiation is nice to have, the SSL standards
+do not formally specify any such mechanism. Most of the world has
+accepted the SSLeay/OpenSSL way of doing it as the de facto standard. But
+for the few that think differently, you have to explicitly speak
+the correct version. This is not really a bug, but rather a deficiency
+in the standards. If a site refuses to respond or sends back some
+nonsensical error codes (at SSL handshake level), try this option
+before mailing me.
+
+The high level API returns the certificate of the peer, thus allowing
+one to check what certificate was supplied. However, you will only be
+able to check the certificate after the fact, i.e. you already sent
+your form data by the time you find out that you did not trust them,
+oops.
+
+So, while being able to know the certificate after the fact is surely
+useful, the security minded would still choose to do the connection
+and certificate verification first and only after that exchange data
+with the site. Currently none of the high level API functions do
+this, thus you would have to program it using the low level API. A
+good place to start is to see how C<Net::SSLeay::http_cat()> function
+is implemented.
+
+The high level API functions use a global file handle C<SSLCAT_S>
+internally. This really should not be a problem because there is no
+way to interleave the high level API functions, unless you use threads
+(but threads are not very well supported in perl anyway (as of version
+5.6.1). However, you may run into problems if you call undocumented
+internal functions in an interleaved fashion.
+
+=head1 DIAGNOSTICS
+
+=over
+
+=item Random number generator not seeded!!!
+
+B<(W)> This warning indicates that C<randomize()> was not able to read
+C</dev/random> or C</dev/urandom>, possibly because your system does not
+have them or they are differently named. You can still use SSL, but
+the encryption will not be as strong.
+
+=item open_tcp_connection: destination host not found:`server' (port 123) ($!)
+
+Name lookup for host named C<server> failed.
+
+=item open_tcp_connection: failed `server', 123 ($!)
+
+The name was resolved, but establising the TCP connection failed.
+
+=item msg 123: 1 - error:140770F8:SSL routines:SSL23_GET_SERVER_HELLO:unknown proto
+
+SSLeay error string. First (123) number is PID, second number (1) indicates
+the position of the error message in SSLeay error stack. You often see
+a pile of these messages as errors cascade.
+
+=item msg 123: 1 - error:02001002::lib(2) :func(1) :reason(2)
+
+The same as above, but you didn't call load_error_strings() so SSLeay
+couldn't verbosely explain the error. You can still find out what it
+means with this command:
+
+ /usr/local/ssl/bin/ssleay errstr 02001002
+
+=item Password is being asked for private key
+
+This is normal behaviour if your private key is encrypted. Either
+you have to supply the password or you have to use unencrypted
+private key. Scan OpenSSL.org for the FAQ that explains how to
+do this (or just study examples/makecert.pl which is used
+during C<make test> to do just that).
+
+=back
+
+=head1 REPORTING BUGS AND SUPPORT
+
+Bug reports, patch submission, feature requests, subversion access to the latest
+source code etc can be obtained at
+L<http://alioth.debian.org/projects/net-ssleay>
+
+The developer mailing list (for people interested in contributin to the source code)
+can be found at
+L<http://lists.alioth.debian.org/mailman/listinfo/net-ssleay-devel>
+
+Commercial support for Net::SSLeay may be obtained from
+
+ Symlabs (netssleay@symlabs.com)
+ Tel: +351-214.222.630
+ Fax: +351-214.222.637
+
+=head1 VERSION
+
+There are currently two perl modules for using OpenSSL C
+library: C<Net::SSLeay> (maintaned by me) and C<SSLeay> (maintained by OpenSSL
+team). This module is the C<Net::SSLeay> variant.
+
+At the time of making this release, Eric's module was still quite
+sketchy and could not be used for real work, thus I felt motivated to
+make this maintenance release. This module is not planned to evolve to
+contain any further functionality, i.e. I will concentrate on just
+making a simple SSL connection over TCP socket. Presumably Eric's own
+module will offer full SSLeay API one day.
+
+This module uses OpenSSL-0.9.6c. It does not work with any earlier
+version and there is no guarantee that it will work with later
+versions either, though as long as C API does not change, it
+should. This module requires Perl 5.005 or newer, though I
+believe it would build with Perl 5.002 or newer.
+
+=head1 BUGS
+
+Please report any bugs or feature requests to
+C<bug-net_ssleay.pm at rt.cpan.org>, or through the web interface at
+L<http://rt.cpan.org/Public/Dist/Display.html?Name=Net_SSLeay.pm>.
+I will be notified, and then you'll automatically be notified of progress on
+your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the C<perldoc> command.
+
+ perldoc Net::SSLeay
+
+You can also look for information at:
+
+=over 4
+
+=item * AnnoCPAN: Annotated CPAN documentation
+
+L<http://annocpan.org/dist/Net_SSLeay.pm>
+
+=item * CPAN Ratings
+
+L<http://cpanratings.perl.org/d/Net_SSLeay.pm>
+
+=item * RT: CPAN's request tracker
+
+L<http://rt.cpan.org/Public/Dist/Display.html?Name=Net_SSLeay.pm>
+
+=item * Search CPAN
+
+L<http://search.cpan.org/dist/Net_SSLeay.pm>
+
+=back
+
+=head1 AUTHOR
+
+Maintained by Mike McCauley and Florian Ragwitz since November 2005
+
+Originally written by Sampo Kellomäki <sampo@symlabs.com>
+
+=head1 COPYRIGHT
+
+Copyright (c) 1996-2003 Sampo Kellomäki <sampo@symlabs.com>
+
+Copyright (C) 2005-2006 Florian Ragwitz <rafl@debian.org>
+
+Copyright (C) 2005 Mike McCauley <mikem@open.com.au>
+
+All Rights Reserved.
+
+Distribution and use of this module is under the same terms as the
+OpenSSL package itself (i.e. free, but mandatory attribution; NO
+WARRANTY). Please consult LICENSE file in the root of the OpenSSL
+distribution.
+
+While the source distribution of this perl module does not contain
+Eric's or OpenSSL's code, if you use this module you will use OpenSSL
+library. Please give Eric and OpenSSL team credit (as required by
+their licenses).
+
+And remember, you, and nobody else but you, are responsible for
+auditing this module and OpenSSL library for security problems,
+backdoors, and general suitability for your application.
+
+=head1 SEE ALSO
+
+ Net::SSLeay::Handle - File handle interface
+ ./Net_SSLeay/examples - Example servers and a clients
+ <http://symlabs.com/Net_SSLeay/index.html> - Net::SSLeay.pm home
+ <http://symlabs.com/Net_SSLeay/smime.html> - Another module using OpenSSL
+ <http://www.openssl.org/> - OpenSSL source, documentation, etc
+ openssl-users-request@openssl.org - General OpenSSL mailing list
+ <http://home.netscape.com/newsref/std/SSL.html> - SSL Draft specification
+ <http://www.w3c.org> - HTTP specifications
+ <http://www.ietf.org/rfc/rfc2617.txt> - How to send password
+ <http://www.lothar.com/tech/crypto/> - Entropy Gathering Daemon (EGD)
+ <http://www.aet.tu-cottbus.de/personen/jaenicke/postfix_tls/prngd.html>
+ - pseudo-random number generating daemon (PRNGD)
+ perl(1)
+ perlref(1)
+ perllol(1)
+ perldoc ~openssl/doc/ssl/SSL_CTX_set_verify.pod
+
+=cut
+
+# ';
+
+### Some methods that are macros in C
+
+sub want_nothing { want(shift) == 1 }
+sub want_read { want(shift) == 2 }
+sub want_write { want(shift) == 3 }
+sub want_X509_lookup { want(shift) == 4 }
+
+###
+### Open TCP stream to given host and port, looking up the details
+### from system databases or DNS.
+###
+
+sub open_tcp_connection {
+ my ($dest_serv, $port) = @_;
+ my ($errs);
+
+ $port = getservbyname($port, 'tcp') unless $port =~ /^\d+$/;
+ my $dest_serv_ip = gethostbyname($dest_serv);
+ unless (defined($dest_serv_ip)) {
+ $errs = "$0 $$: open_tcp_connection: destination host not found:"
+ . " `$dest_serv' (port $port) ($!)\n";
+ warn $errs if $trace;
+ return wantarray ? (0, $errs) : 0;
+ }
+ my $sin = sockaddr_in($port, $dest_serv_ip);
+
+ warn "Opening connection to $dest_serv:$port (" .
+ inet_ntoa($dest_serv_ip) . ")" if $trace>2;
+
+ my $proto = getprotobyname('tcp');
+ if (socket (SSLCAT_S, &PF_INET(), &SOCK_STREAM(), $proto)) {
+ warn "next connect" if $trace>3;
+ if (CORE::connect (SSLCAT_S, $sin)) {
+ my $old_out = select (SSLCAT_S); $| = 1; select ($old_out);
+ warn "connected to $dest_serv, $port" if $trace>3;
+ return wantarray ? (1, undef) : 1; # Success
+ }
+ }
+ $errs = "$0 $$: open_tcp_connection: failed `$dest_serv', $port ($!)\n";
+ warn $errs if $trace;
+ close SSLCAT_S;
+ return wantarray ? (0, $errs) : 0; # Fail
+}
+
+### Open connection via standard web proxy, if one was defined
+### using set_proxy().
+
+sub open_proxy_tcp_connection {
+ my ($dest_serv, $port) = @_;
+ return open_tcp_connection($dest_serv, $port) if !$proxyhost;
+
+ warn "Connect via proxy: $proxyhost:$proxyport" if $trace>2;
+ my ($ret, $errs) = open_tcp_connection($proxyhost, $proxyport);
+ return wantarray ? (0, $errs) : 0 if !$ret; # Connection fail
+
+ warn "Asking proxy to connect to $dest_serv:$port" if $trace>2;
+ #print SSLCAT_S "CONNECT $dest_serv:$port HTTP/1.0$proxyauth$CRLF$CRLF";
+ #my $line = <SSLCAT_S>; # *** bug? Mixing stdio with syscall read?
+ ($ret, $errs) =
+ tcp_write_all("CONNECT $dest_serv:$port HTTP/1.0$proxyauth$CRLF$CRLF");
+ return wantarray ? (0,$errs) : 0 if $errs;
+ ($line, $errs) = tcp_read_until($CRLF . $CRLF, 1024);
+ warn "Proxy response: $line" if $trace>2;
+ return wantarray ? (0,$errs) : 0 if $errs;
+ return wantarray ? (1,'') : 1; # Success
+}
+
+###
+### read and write helpers that block
+###
+
+sub debug_read {
+ my ($replyr, $gotr) = @_;
+ my $vm = $trace>2 && $linux_debug ?
+ (split ' ', `cat /proc/$$/stat`)[22] : 'vm_unknown';
+ warn " got " . blength($$gotr) . ':'
+ . blength($$replyr) . " bytes (VM=$vm).\n" if $trace == 3;
+ warn " got `$$gotr' (" . blength($$gotr) . ':'
+ . blength($$replyr) . " bytes, VM=$vm)\n" if $trace>3;
+}
+
+sub ssl_read_all {
+ my ($ssl,$how_much) = @_;
+ $how_much = 2000000000 unless $how_much;
+ my ($got, $errs);
+ my $reply = '';
+
+ while ($how_much > 0) {
+ $got = Net::SSLeay::read($ssl,
+ ($how_much > 32768) ? 32768 : $how_much
+ );
+ last if $errs = print_errs('SSL_read');
+ $how_much -= blength($got);
+ debug_read(\$reply, \$got) if $trace>1;
+ last if $got eq ''; # EOF
+ $reply .= $got;
+ }
+
+ return wantarray ? ($reply, $errs) : $reply;
+}
+
+sub tcp_read_all {
+ my ($how_much) = @_;
+ $how_much = 2000000000 unless $how_much;
+ my ($n, $got, $errs);
+ my $reply = '';
+
+ my $bsize = 0x10000;
+ while ($how_much > 0) {
+ $n = sysread(SSLCAT_S,$got, (($bsize < $how_much) ? $bsize : $how_much));
+ warn "Read error: $! ($n,$how_much)" unless defined $n;
+ last if !$n; # EOF
+ $how_much -= $n;
+ debug_read(\$reply, \$got) if $trace>1;
+ $reply .= $got;
+ }
+ return wantarray ? ($reply, $errs) : $reply;
+}
+
+sub ssl_write_all {
+ my $ssl = $_[0];
+ my ($data_ref, $errs);
+ if (ref $_[1]) {
+ $data_ref = $_[1];
+ } else {
+ $data_ref = \$_[1];
+ }
+ my ($wrote, $written, $to_write) = (0,0, blength($$data_ref));
+ my $vm = $trace>2 && $linux_debug ?
+ (split ' ', `cat /proc/$$/stat`)[22] : 'vm_unknown';
+ warn " write_all VM at entry=$vm\n" if $trace>2;
+ while ($to_write) {
+ #sleep 1; # *** DEBUG
+ warn "partial `$$data_ref'\n" if $trace>3;
+ $wrote = write_partial($ssl, $written, $to_write, $$data_ref);
+ if (defined $wrote && ($wrote > 0)) { # write_partial can return -1
+ $written += $wrote;
+ $to_write -= $wrote;
+ }
+ $vm = $trace>2 && $linux_debug ?
+ (split ' ', `cat /proc/$$/stat`)[22] : 'vm_unknown';
+ warn " written so far $wrote:$written bytes (VM=$vm)\n" if $trace>2;
+
+ $errs .= print_errs('SSL_write');
+ return (wantarray ? (undef, $errs) : undef) if $errs;
+ }
+ return wantarray ? ($written, $errs) : $written;
+}
+
+sub tcp_write_all {
+ my ($data_ref, $errs);
+ if (ref $_[0]) {
+ $data_ref = $_[0];
+ } else {
+ $data_ref = \$_[0];
+ }
+ my ($wrote, $written, $to_write) = (0,0, blength($$data_ref));
+ my $vm = $trace>2 && $linux_debug ?
+ (split ' ', `cat /proc/$$/stat`)[22] : 'vm_unknown';
+ warn " write_all VM at entry=$vm to_write=$to_write\n" if $trace>2;
+ while ($to_write) {
+ warn "partial `$$data_ref'\n" if $trace>3;
+ $wrote = syswrite(SSLCAT_S, $$data_ref, $to_write, $written);
+ if (defined $wrote && ($wrote > 0)) { # write_partial can return -1
+ $written += $wrote;
+ $to_write -= $wrote;
+ } elsif (!defined($wrote)) {
+ warn "tcp_write_all: $!";
+ return (wantarray ? (undef, "$!") : undef);
+ }
+ $vm = $trace>2 && $linux_debug ?
+ (split ' ', `cat /proc/$$/stat`)[22] : 'vm_unknown';
+ warn " written so far $wrote:$written bytes (VM=$vm)\n" if $trace>2;
+ }
+ return wantarray ? ($written, '') : $written;
+}
+
+### from patch by Clinton Wong <clintdw@netcom.com>
+
+# ssl_read_until($ssl [, $delimit [, $max_length]])
+# if $delimit missing, use $/ if it exists, otherwise use \n
+# read until delimiter reached, up to $max_length chars if defined
+
+sub ssl_read_until ($;$$) {
+ my ($ssl,$delim, $max_length) = @_;
+ local $[;
+
+ # guess the delim string if missing
+ if ( ! defined $delim ) {
+ if ( defined $/ && length $/ ) { $delim = $/ }
+ else { $delim = "\n" } # Note: \n,$/ value depends on the platform
+ }
+ my $len_delim = length $delim;
+
+ my ($got);
+ my $reply = '';
+
+ # If we have OpenSSL 0.9.6a or later, we can use SSL_peek to
+ # speed things up.
+ # N.B. 0.9.6a has security problems, so the support for
+ # anything earlier than 0.9.6e will be dropped soon.
+ if (&Net::SSLeay::OPENSSL_VERSION_NUMBER >= 0x0090601f) {
+ $max_length = 2000000000 unless (defined $max_length);
+ my ($pending, $peek_length, $found, $done);
+ while (blength($reply) < $max_length and !$done) {
+ #Block if necessary until we get some data
+ $got = Net::SSLeay::peek($ssl,1);
+ last if print_errs('SSL_peek');
+
+ $pending = Net::SSLeay::pending($ssl) + blength($reply);
+ $peek_length = ($pending > $max_length) ? $max_length : $pending;
+ $peek_length -= blength($reply);
+ $got = Net::SSLeay::peek($ssl, $peek_length);
+ last if print_errs('SSL_peek');
+ $peek_length = blength($got);
+
+ #$found = index($got, $delim); # Old and broken
+
+ # the delimiter may be split across two gets, so we prepend
+ # a little from the last get onto this one before we check
+ # for a match
+ my $match;
+ if(blength($reply) >= blength($delim) - 1) {
+ #if what we've read so far is greater or equal
+ #in length of what we need to prepatch
+ $match = substr $reply, blength($reply) - blength($delim) + 1;
+ } else {
+ $match = $reply;
+ }
+
+ $match .= $got;
+ $found = index($match, $delim);
+
+ if ($found > -1) {
+ #$got = Net::SSLeay::read($ssl, $found+$len_delim);
+ #read up to the end of the delimiter
+ $got = Net::SSLeay::read($ssl,
+ $found + $len_delim
+ - ((blength $match) - (blength $got)));
+ $done = 1;
+ } else {
+ $got = Net::SSLeay::read($ssl, $peek_length);
+ $done = 1 if ($peek_length == $max_length - blength($reply));
+ }
+
+ last if print_errs('SSL_read');
+ debug_read(\$reply, \$got) if $trace>1;
+ last if $got eq '';
+ $reply .= $got;
+ }
+ } else {
+ while (!defined $max_length || length $reply < $max_length) {
+ $got = Net::SSLeay::read($ssl,1); # one by one
+ last if print_errs('SSL_read');
+ debug_read(\$reply, \$got) if $trace>1;
+ last if $got eq '';
+ $reply .= $got;
+ last if $len_delim
+ && substr($reply, blength($reply)-$len_delim) eq $delim;
+ }
+ }
+ return $reply;
+}
+
+sub tcp_read_until {
+ my ($delim, $max_length) = @_;
+ local $[;
+
+ # guess the delim string if missing
+ if ( ! defined $delim ) {
+ if ( defined $/ && length $/ ) { $delim = $/ }
+ else { $delim = "\n" } # Note: \n,$/ value depends on the platform
+ }
+ my $len_delim = length $delim;
+
+ my ($n,$got);
+ my $reply = '';
+
+ while (!defined $max_length || length $reply < $max_length) {
+ $n = sysread(SSLCAT_S, $got, 1); # one by one
+ warn "tcp_read_until: $!" if !defined $n;
+ debug_read(\$reply, \$got) if $trace>1;
+ last if !$n; # EOF
+ $reply .= $got;
+ last if $len_delim
+ && substr($reply, blength($reply)-$len_delim) eq $delim;
+ }
+ return $reply;
+}
+
+# ssl_read_CRLF($ssl [, $max_length])
+sub ssl_read_CRLF ($;$) { ssl_read_until($_[0], $CRLF, $_[1]) }
+sub tcp_read_CRLF { tcp_read_until($CRLF, $_[0]) }
+
+# ssl_write_CRLF($ssl, $message) writes $message and appends CRLF
+sub ssl_write_CRLF ($$) {
+ # the next line uses less memory but might use more network packets
+ return ssl_write_all($_[0], $_[1]) + ssl_write_all($_[0], $CRLF);
+
+ # the next few lines do the same thing at the expense of memory, with
+ # the chance that it will use less packets, since CRLF is in the original
+ # message and won't be sent separately.
+
+ #my $data_ref;
+ #if (ref $_[1]) { $data_ref = $_[1] }
+ # else { $data_ref = \$_[1] }
+ #my $message = $$data_ref . $CRLF;
+ #return ssl_write_all($_[0], \$message);
+}
+
+sub tcp_write_CRLF {
+ # the next line uses less memory but might use more network packets
+ return tcp_write_all($_[0]) + tcp_write_all($CRLF);
+
+ # the next few lines do the same thing at the expense of memory, with
+ # the chance that it will use less packets, since CRLF is in the original
+ # message and won't be sent separately.
+
+ #my $data_ref;
+ #if (ref $_[1]) { $data_ref = $_[1] }
+ # else { $data_ref = \$_[1] }
+ #my $message = $$data_ref . $CRLF;
+ #return tcp_write_all($_[0], \$message);
+}
+
+### Quickly print out with whom we're talking
+
+sub dump_peer_certificate ($) {
+ my ($ssl) = @_;
+ my $cert = get_peer_certificate($ssl);
+ return if print_errs('get_peer_certificate');
+ print "no cert defined\n" if !defined($cert);
+ # Cipher=NONE with empty cert fix
+ if (!defined($cert) || ($cert == 0)) {
+ warn "cert = `$cert'\n" if $trace;
+ return "Subject Name: undefined\nIssuer Name: undefined\n";
+ } else {
+ my $x = 'Subject Name: '
+ . X509_NAME_oneline(X509_get_subject_name($cert)) . "\n"
+ . 'Issuer Name: '
+ . X509_NAME_oneline(X509_get_issuer_name($cert)) . "\n";
+ Net::SSLeay::X509_free($cert);
+ return $x;
+ }
+}
+
+### Arrange some randomness for eay PRNG
+
+sub randomize (;$$) {
+ my ($rn_seed_file, $seed, $egd_path) = @_;
+ my $rnsf = defined($rn_seed_file) && -r $rn_seed_file;
+
+ $egd_path = '';
+ $egd_path = $ENV{'EGD_PATH'} if $ENV{'EGD_PATH'};
+
+ RAND_seed(rand() + $$); # Stir it with time and pid
+
+ unless ($rnsf || -r $Net::SSLeay::random_device || $seed || -S $egd_path) {
+ warn "Random number generator not seeded!!!" if $trace;
+ }
+
+ RAND_load_file($rn_seed_file, -s _) if $rnsf;
+ RAND_seed($seed) if $seed;
+ RAND_seed($ENV{RND_SEED}) if $ENV{RND_SEED};
+ RAND_egd($egd_path) if -e $egd_path && -S _;
+ RAND_load_file($Net::SSLeay::random_device, $Net::SSLeay::how_random/8)
+ if -r $Net::SSLeay::random_device;
+}
+
+sub new_x_ctx {
+ if ($ssl_version == 2) { $ctx = CTX_v2_new(); }
+ elsif ($ssl_version == 3) { $ctx = CTX_v3_new(); }
+ elsif ($ssl_version == 10) { $ctx = CTX_tlsv1_new(); }
+ else { $ctx = CTX_new(); }
+ return $ctx;
+}
+
+###
+### Basic request - response primitive (don't use for https)
+###
+
+sub sslcat { # address, port, message, $crt, $key --> reply / (reply,errs,cert)
+ my ($dest_serv, $port, $out_message, $crt_path, $key_path) = @_;
+ my ($ctx, $ssl, $got, $errs, $written);
+
+ ($got, $errs) = open_proxy_tcp_connection($dest_serv, $port);
+ return (wantarray ? (undef, $errs) : undef) unless $got;
+
+ ### Do SSL negotiation stuff
+
+ warn "Creating SSL $ssl_version context...\n" if $trace>2;
+ load_error_strings(); # Some bloat, but I'm after ease of use
+ SSLeay_add_ssl_algorithms(); # and debuggability.
+ randomize();
+
+ $ctx = new_x_ctx();
+ goto cleanup2 if $errs = print_errs('CTX_new') or !$ctx;
+
+ CTX_set_options($ctx, &OP_ALL);
+ goto cleanup2 if $errs = print_errs('CTX_set_options');
+
+ warn "Cert `$crt_path' given without key" if $crt_path && !$key_path;
+ set_cert_and_key($ctx, $crt_path, $key_path) if $crt_path;
+
+ warn "Creating SSL connection (context was '$ctx')...\n" if $trace>2;
+ $ssl = new($ctx);
+ goto cleanup if $errs = print_errs('SSL_new') or !$ssl;
+
+ warn "Setting fd (ctx $ctx, con $ssl)...\n" if $trace>2;
+ set_fd($ssl, fileno(SSLCAT_S));
+ goto cleanup if $errs = print_errs('set_fd');
+
+ warn "Entering SSL negotiation phase...\n" if $trace>2;
+
+ if ($trace>2) {
+ my $i = 0;
+ my $p = '';
+ my $cipher_list = 'Cipher list: ';
+ $p=Net::SSLeay::get_cipher_list($ssl,$i);
+ $cipher_list .= $p if $p;
+ do {
+ $i++;
+ $cipher_list .= ', ' . $p if $p;
+ $p=Net::SSLeay::get_cipher_list($ssl,$i);
+ } while $p;
+ $cipher_list .= '\n';
+ warn $cipher_list;
+ }
+
+ $got = Net::SSLeay::connect($ssl);
+ warn "SSLeay connect returned $got\n" if $trace>2;
+ goto cleanup if $errs = print_errs('SSL_connect');
+
+ my $server_cert = get_peer_certificate($ssl);
+ print_errs('get_peer_certificate');
+ if ($trace>1) {
+ warn "Cipher `" . get_cipher($ssl) . "'\n";
+ print_errs('get_ciper');
+ warn dump_peer_certificate($ssl);
+ }
+
+ ### Connected. Exchange some data (doing repeated tries if necessary).
+
+ warn "sslcat $$: sending " . blength($out_message) . " bytes...\n"
+ if $trace==3;
+ warn "sslcat $$: sending `$out_message' (" . blength($out_message)
+ . " bytes)...\n" if $trace>3;
+ ($written, $errs) = ssl_write_all($ssl, $out_message);
+ goto cleanup unless $written;
+
+ sleep $slowly if $slowly; # Closing too soon can abort broken servers
+ CORE::shutdown SSLCAT_S, 1; # Half close --> No more output, send EOF to server
+
+ warn "waiting for reply...\n" if $trace>2;
+ ($got, $errs) = ssl_read_all($ssl);
+ warn "Got " . blength($got) . " bytes.\n" if $trace==3;
+ warn "Got `$got' (" . blength($got) . " bytes)\n" if $trace>3;
+
+cleanup:
+ free ($ssl);
+ $errs .= print_errs('SSL_free');
+cleanup2:
+ CTX_free ($ctx);
+ $errs .= print_errs('CTX_free');
+ close SSLCAT_S;
+ return wantarray ? ($got, $errs, $server_cert) : $got;
+}
+
+sub tcpcat { # address, port, message, $crt, $key --> reply / (reply,errs,cert)
+ my ($dest_serv, $port, $out_message) = @_;
+ my ($got, $errs, $written);
+
+ ($got, $errs) = open_proxy_tcp_connection($dest_serv, $port);
+ return (wantarray ? (undef, $errs) : undef) unless $got;
+
+ ### Connected. Exchange some data (doing repeated tries if necessary).
+
+ warn "tcpcat $$: sending " . blength($out_message) . " bytes...\n"
+ if $trace==3;
+ warn "tcpcat $$: sending `$out_message' (" . blength($out_message)
+ . " bytes)...\n" if $trace>3;
+ ($written, $errs) = tcp_write_all($out_message);
+ goto cleanup unless $written;
+
+ sleep $slowly if $slowly; # Closing too soon can abort broken servers
+ CORE::shutdown SSLCAT_S, 1; # Half close --> No more output, send EOF to server
+
+ warn "waiting for reply...\n" if $trace>2;
+ ($got, $errs) = tcp_read_all($ssl);
+ warn "Got " . blength($got) . " bytes.\n" if $trace==3;
+ warn "Got `$got' (" . blength($got) . " bytes)\n" if $trace>3;
+
+cleanup:
+ close SSLCAT_S;
+ return wantarray ? ($got, $errs) : $got;
+}
+
+sub tcpxcat {
+ my ($usessl, $site, $port, $req, $crt_path, $key_path) = @_;
+ if ($usessl) {
+ return sslcat($site, $port, $req, $crt_path, $key_path);
+ } else {
+ return tcpcat($site, $port, $req);
+ }
+}
+
+###
+### Basic request - response primitive, this is different from sslcat
+### because this does not shutdown the connection.
+###
+
+sub https_cat { # address, port, message --> returns reply / (reply,errs,cert)
+ my ($dest_serv, $port, $out_message, $crt_path, $key_path) = @_;
+ my ($ctx, $ssl, $got, $errs, $written);
+
+ ($got, $errs) = open_proxy_tcp_connection($dest_serv, $port);
+ return (wantarray ? (undef, $errs) : undef) unless $got;
+
+ ### Do SSL negotiation stuff
+
+ warn "Creating SSL $ssl_version context...\n" if $trace>2;
+ load_error_strings(); # Some bloat, but I'm after ease of use
+ SSLeay_add_ssl_algorithms(); # and debuggability.
+ randomize();
+
+ $ctx = new_x_ctx();
+ goto cleanup2 if $errs = print_errs('CTX_new') or !$ctx;
+
+ CTX_set_options($ctx, &OP_ALL);
+ goto cleanup2 if $errs = print_errs('CTX_set_options');
+
+ warn "Cert `$crt_path' given without key" if $crt_path && !$key_path;
+ set_cert_and_key($ctx, $crt_path, $key_path) if $crt_path;
+
+ warn "Creating SSL connection (context was '$ctx')...\n" if $trace>2;
+ $ssl = new($ctx);
+ goto cleanup if $errs = print_errs('SSL_new') or !$ssl;
+
+ warn "Setting fd (ctx $ctx, con $ssl)...\n" if $trace>2;
+ set_fd($ssl, fileno(SSLCAT_S));
+ goto cleanup if $errs = print_errs('set_fd');
+
+ warn "Entering SSL negotiation phase...\n" if $trace>2;
+
+ if ($trace>2) {
+ my $i = 0;
+ my $p = '';
+ my $cipher_list = 'Cipher list: ';
+ $p=Net::SSLeay::get_cipher_list($ssl,$i);
+ $cipher_list .= $p if $p;
+ do {
+ $i++;
+ $cipher_list .= ', ' . $p if $p;
+ $p=Net::SSLeay::get_cipher_list($ssl,$i);
+ } while $p;
+ $cipher_list .= '\n';
+ warn $cipher_list;
+ }
+
+ $got = Net::SSLeay::connect($ssl);
+ warn "SSLeay connect failed" if $trace>2 && $got==0;
+ goto cleanup if $errs = print_errs('SSL_connect');
+
+ my $server_cert = get_peer_certificate($ssl);
+ print_errs('get_peer_certificate');
+ if ($trace>1) {
+ warn "Cipher `" . get_cipher($ssl) . "'\n";
+ print_errs('get_ciper');
+ warn dump_peer_certificate($ssl);
+ }
+
+ ### Connected. Exchange some data (doing repeated tries if necessary).
+
+ warn "https_cat $$: sending " . blength($out_message) . " bytes...\n"
+ if $trace==3;
+ warn "https_cat $$: sending `$out_message' (" . blength($out_message)
+ . " bytes)...\n" if $trace>3;
+ ($written, $errs) = ssl_write_all($ssl, $out_message);
+ goto cleanup unless $written;
+
+ warn "waiting for reply...\n" if $trace>2;
+ ($got, $errs) = ssl_read_all($ssl);
+ warn "Got " . blength($got) . " bytes.\n" if $trace==3;
+ warn "Got `$got' (" . blength($got) . " bytes)\n" if $trace>3;
+
+cleanup:
+ free ($ssl);
+ $errs .= print_errs('SSL_free');
+cleanup2:
+ CTX_free ($ctx);
+ $errs .= print_errs('CTX_free');
+ close SSLCAT_S;
+ return wantarray ? ($got, $errs, $server_cert) : $got;
+}
+
+sub http_cat { # address, port, message --> returns reply / (reply,errs,cert)
+ my ($dest_serv, $port, $out_message) = @_;
+ my ($got, $errs, $written);
+
+ ($got, $errs) = open_proxy_tcp_connection($dest_serv, $port);
+ return (wantarray ? (undef, $errs) : undef) unless $got;
+
+ ### Connected. Exchange some data (doing repeated tries if necessary).
+
+ warn "http_cat $$: sending " . blength($out_message) . " bytes...\n"
+ if $trace==3;
+ warn "http_cat $$: sending `$out_message' (" . blength($out_message)
+ . " bytes)...\n" if $trace>3;
+ ($written, $errs) = tcp_write_all($out_message);
+ goto cleanup unless $written;
+
+ warn "waiting for reply...\n" if $trace>2;
+ ($got, $errs) = tcp_read_all(200000);
+ warn "Got " . blength($got) . " bytes.\n" if $trace==3;
+ warn "Got `$got' (" . blength($got) . " bytes)\n" if $trace>3;
+
+cleanup:
+ close SSLCAT_S;
+ return wantarray ? ($got, $errs) : $got;
+}
+
+sub httpx_cat {
+ my ($usessl, $site, $port, $req, $crt_path, $key_path) = @_;
+ warn "httpx_cat: usessl=$usessl ($site:$port)" if $trace;
+ if ($usessl) {
+ return https_cat($site, $port, $req, $crt_path, $key_path);
+ } else {
+ return http_cat($site, $port, $req);
+ }
+}
+
+###
+### Easy set up of private key and certificate
+###
+
+sub set_cert_and_key ($$$) {
+ my ($ctx, $cert_path, $key_path) = @_;
+ my $errs = '';
+ # Following will ask password unless private key is not encrypted
+ CTX_use_RSAPrivateKey_file ($ctx, $key_path, &FILETYPE_PEM);
+ $errs .= print_errs("private key `$key_path' ($!)");
+ CTX_use_certificate_file ($ctx, $cert_path, &FILETYPE_PEM);
+ $errs .= print_errs("certificate `$cert_path' ($!)");
+ return wantarray ? (undef, $errs) : ($errs eq '');
+}
+
+### Old deprecated API
+
+sub set_server_cert_and_key ($$$) { &set_cert_and_key }
+
+### Set up to use web proxy
+
+sub set_proxy ($$;**) {
+ ($proxyhost, $proxyport, $proxyuser, $proxypass) = @_;
+ require MIME::Base64 if $proxyuser;
+ $proxyauth = $CRLF . 'Proxy-authorization: Basic '
+ . MIME::Base64::encode("$proxyuser:$proxypass", '')
+ if $proxyuser;
+}
+
+###
+### Easy https manipulation routines
+###
+
+sub make_form {
+ my (@fields) = @_;
+ my $form;
+ while (@fields) {
+ my ($name, $data) = (shift(@fields), shift(@fields));
+ $data =~ s/([^\w\-.\@\$ ])/sprintf("%%%2.2x",ord($1))/gse;
+ $data =~ tr[ ][+];
+ $form .= "$name=$data&";
+ }
+ chop $form;
+ return $form;
+}
+
+sub make_headers {
+ my (@headers) = @_;
+ my $headers;
+ while (@headers) {
+ my $header = shift(@headers);
+ my $value = shift(@headers);
+ $header =~ s/:$//;
+ $value =~ s/\x0d?\x0a$//; # because we add it soon, see below
+ $headers .= "$header: $value$CRLF";
+ }
+ return $headers;
+}
+
+sub do_httpx3 {
+ my ($method, $usessl, $site, $port, $path, $headers,
+ $content, $mime_type, $crt_path, $key_path) = @_;
+ my ($response, $page, $h,$v);
+
+ if ($content) {
+ $mime_type = "application/x-www-form-urlencoded" unless $mime_type;
+ my $len = blength($content);
+ $content = "Content-Type: $mime_type$CRLF"
+ . "Content-Length: $len$CRLF$CRLF$content";
+ } else {
+ $content = "$CRLF$CRLF";
+ }
+ my $req = "$method $path HTTP/1.0$CRLF";
+ unless (defined $headers && $headers =~ /^Host:/m) {
+ $req .= "Host: $site";
+ unless (($port == 80 && !$usessl) || ($port == 443 && $usessl)) {
+ $req .= ":$port";
+ }
+ $req .= $CRLF;
+ }
+ $req .= (defined $headers ? $headers : '') . "Accept: */*$CRLF$content";
+
+ warn "do_httpx3($method,$usessl,$site:$port)" if $trace;
+ my ($http, $errs, $server_cert)
+ = httpx_cat($usessl, $site, $port, $req, $crt_path, $key_path);
+ return (undef, "HTTP/1.0 900 NET OR SSL ERROR$CRLF$CRLF$errs") if $errs;
+
+ $http = '' if !defined $http;
+ ($headers, $page) = split /\s?\n\s?\n/, $http, 2;
+ warn "headers >$headers< page >>$page<< http >>>$http<<<" if $trace>1;
+ ($response, $headers) = split /\s?\n/, $headers, 2;
+ return ($page, $response, $headers, $server_cert);
+}
+
+sub do_https3 { splice(@_,1,0) = 1; do_httpx3; } # Legacy undocumented
+
+### do_https2() is a legacy version in the sense that it is unable
+### to return all instances of duplicate headers.
+
+sub do_httpx2 {
+ my ($page, $response, $headers, $server_cert) = &do_httpx3;
+ X509_free($server_cert) if defined $server_cert;
+ return ($page, $response,
+ map( { ($h,$v)=/^(\S+)\:\s*(.*)$/; (uc($h),$v); }
+ split(/\s?\n/, $headers)
+ )
+ );
+}
+
+sub do_https2 { splice(@_,1,0) = 1; do_httpx2; } # Legacy undocumented
+
+### Returns headers as a hash where multiple instances of same header
+### are handled correctly.
+
+sub do_httpx4 {
+ my ($page, $response, $headers, $server_cert) = &do_httpx3;
+ X509_free($server_cert) if defined $server_cert;
+ my %hr = ();
+ for my $hh (split /\s?\n/, $headers) {
+ my ($h,$v)=/^(\S+)\:\s*(.*)$/;
+ push @{$hr{uc($h)}}, $v;
+ }
+ return ($page, $response, \%hr);
+}
+
+sub do_https4 { splice(@_,1,0) = 1; do_httpx4; } # Legacy undocumented
+
+# https
+
+sub get_https { do_httpx2(GET => 1, @_) }
+sub post_https { do_httpx2(POST => 1, @_) }
+sub put_https { do_httpx2(PUT => 1, @_) }
+sub head_https { do_httpx2(HEAD => 1, @_) }
+
+sub get_https3 { do_httpx3(GET => 1, @_) }
+sub post_https3 { do_httpx3(POST => 1, @_) }
+sub put_https3 { do_httpx3(PUT => 1, @_) }
+sub head_https3 { do_httpx3(HEAD => 1, @_) }
+
+sub get_https4 { do_httpx4(GET => 1, @_) }
+sub post_https4 { do_httpx4(POST => 1, @_) }
+sub put_https4 { do_httpx4(PUT => 1, @_) }
+sub head_https4 { do_httpx4(HEAD => 1, @_) }
+
+# http
+
+sub get_http { do_httpx2(GET => 0, @_) }
+sub post_http { do_httpx2(POST => 0, @_) }
+sub put_http { do_httpx2(PUT => 0, @_) }
+sub head_http { do_httpx2(HEAD => 0, @_) }
+
+sub get_http3 { do_httpx3(GET => 0, @_) }
+sub post_http3 { do_httpx3(POST => 0, @_) }
+sub put_http3 { do_httpx3(PUT => 0, @_) }
+sub head_http3 { do_httpx3(HEAD => 0, @_) }
+
+sub get_http4 { do_httpx4(GET => 0, @_) }
+sub post_http4 { do_httpx4(POST => 0, @_) }
+sub put_http4 { do_httpx4(PUT => 0, @_) }
+sub head_http4 { do_httpx4(HEAD => 0, @_) }
+
+# Either https or http
+
+sub get_httpx { do_httpx2(GET => @_) }
+sub post_httpx { do_httpx2(POST => @_) }
+sub put_httpx { do_httpx2(PUT => @_) }
+sub head_httpx { do_httpx2(HEAD => @_) }
+
+sub get_httpx3 { do_httpx3(GET => @_) }
+sub post_httpx3 { do_httpx3(POST => @_) }
+sub put_httpx3 { do_httpx3(PUT => @_) }
+sub head_httpx3 { do_httpx3(HEAD => @_) }
+
+sub get_httpx4 { do_httpx4(GET => @_) }
+sub post_httpx4 { do_httpx4(POST => @_) }
+sub put_httpx4 { do_httpx4(PUT => @_) }
+sub head_httpx4 { do_httpx4(HEAD => @_) }
+
+### Legacy, don't use
+# ($page, $respone_or_err, %headers) = do_https(...);
+
+sub do_https {
+ my ($site, $port, $path, $method, $headers,
+ $content, $mime_type, $crt_path, $key_path) = @_;
+
+ do_https2($method, $site, $port, $path, $headers,
+ $content, $mime_type, $crt_path, $key_path);
+}
+
+1;
+__END__
projects / dh-make-perl / blobdiff