-
Notifications
You must be signed in to change notification settings - Fork 0
/
SSLeay.pm
1415 lines (1243 loc) · 50.8 KB
/
SSLeay.pm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
# 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@airspayce.com>, All Rights Reserved.
#
# $Id: SSLeay.pm 406 2014-05-10 21:39:46Z mikem-guest $
#
# Change data removed from here. See Changes
# 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 5.005_000;
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
# 11 = insist on TLSv1.1
# 12 = insist on TLSv1.2
# 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.61'; # Dont foget to set version in META.yml too
@ISA = qw(Exporter);
#BEWARE:
# 3-columns part of @EXPORT_OK related to constants is the output of command:
# perl helper_script/regen_openssl_constants.pl -gen-pod
# if you add/remove any constant you need to update it manually
@EXPORT_OK = qw(
ASN1_STRFLGS_ESC_CTRL NID_ext_req OP_CISCO_ANYCONNECT
ASN1_STRFLGS_ESC_MSB NID_friendlyName OP_COOKIE_EXCHANGE
ASN1_STRFLGS_ESC_QUOTE NID_givenName OP_CRYPTOPRO_TLSEXT_BUG
ASN1_STRFLGS_RFC2253 NID_hmacWithSHA1 OP_DONT_INSERT_EMPTY_FRAGMENTS
CB_ACCEPT_EXIT NID_id_ad OP_EPHEMERAL_RSA
CB_ACCEPT_LOOP NID_id_ce OP_LEGACY_SERVER_CONNECT
CB_CONNECT_EXIT NID_id_kp OP_MICROSOFT_BIG_SSLV3_BUFFER
CB_CONNECT_LOOP NID_id_pbkdf2 OP_MICROSOFT_SESS_ID_BUG
ERROR_NONE NID_id_pe OP_MSIE_SSLV2_RSA_PADDING
ERROR_SSL NID_id_pkix OP_NETSCAPE_CA_DN_BUG
ERROR_SYSCALL NID_id_qt_cps OP_NETSCAPE_CHALLENGE_BUG
ERROR_WANT_ACCEPT NID_id_qt_unotice OP_NETSCAPE_DEMO_CIPHER_CHANGE_BUG
ERROR_WANT_CONNECT NID_idea_cbc OP_NETSCAPE_REUSE_CIPHER_CHANGE_BUG
ERROR_WANT_READ NID_idea_cfb64 OP_NON_EXPORT_FIRST
ERROR_WANT_WRITE NID_idea_ecb OP_NO_COMPRESSION
ERROR_WANT_X509_LOOKUP NID_idea_ofb64 OP_NO_QUERY_MTU
ERROR_ZERO_RETURN NID_info_access OP_NO_SESSION_RESUMPTION_ON_RENEGOTIATION
EVP_PKS_DSA NID_initials OP_NO_SSLv2
EVP_PKS_EC NID_invalidity_date OP_NO_SSLv3
EVP_PKS_RSA NID_issuer_alt_name OP_NO_TICKET
EVP_PKT_ENC NID_keyBag OP_NO_TLSv1
EVP_PKT_EXCH NID_key_usage OP_NO_TLSv1_1
EVP_PKT_EXP NID_localKeyID OP_NO_TLSv1_2
EVP_PKT_SIGN NID_localityName OP_PKCS1_CHECK_1
EVP_PK_DH NID_md2 OP_PKCS1_CHECK_2
EVP_PK_DSA NID_md2WithRSAEncryption OP_SINGLE_DH_USE
EVP_PK_EC NID_md5 OP_SINGLE_ECDH_USE
EVP_PK_RSA NID_md5WithRSA OP_SSLEAY_080_CLIENT_DH_BUG
FILETYPE_ASN1 NID_md5WithRSAEncryption OP_SSLREF2_REUSE_CERT_TYPE_BUG
FILETYPE_PEM NID_md5_sha1 OP_TLS_BLOCK_PADDING_BUG
F_CLIENT_CERTIFICATE NID_mdc2 OP_TLS_D5_BUG
F_CLIENT_HELLO NID_mdc2WithRSA OP_TLS_ROLLBACK_BUG
F_CLIENT_MASTER_KEY NID_ms_code_com READING
F_D2I_SSL_SESSION NID_ms_code_ind RECEIVED_SHUTDOWN
F_GET_CLIENT_FINISHED NID_ms_ctl_sign RSA_3
F_GET_CLIENT_HELLO NID_ms_efs RSA_F4
F_GET_CLIENT_MASTER_KEY NID_ms_ext_req R_BAD_AUTHENTICATION_TYPE
F_GET_SERVER_FINISHED NID_ms_sgc R_BAD_CHECKSUM
F_GET_SERVER_HELLO NID_name R_BAD_MAC_DECODE
F_GET_SERVER_VERIFY NID_netscape R_BAD_RESPONSE_ARGUMENT
F_I2D_SSL_SESSION NID_netscape_base_url R_BAD_SSL_FILETYPE
F_READ_N NID_netscape_ca_policy_url R_BAD_SSL_SESSION_ID_LENGTH
F_REQUEST_CERTIFICATE NID_netscape_ca_revocation_url R_BAD_STATE
F_SERVER_HELLO NID_netscape_cert_extension R_BAD_WRITE_RETRY
F_SSL_CERT_NEW NID_netscape_cert_sequence R_CHALLENGE_IS_DIFFERENT
F_SSL_GET_NEW_SESSION NID_netscape_cert_type R_CIPHER_TABLE_SRC_ERROR
F_SSL_NEW NID_netscape_comment R_INVALID_CHALLENGE_LENGTH
F_SSL_READ NID_netscape_data_type R_NO_CERTIFICATE_SET
F_SSL_RSA_PRIVATE_DECRYPT NID_netscape_renewal_url R_NO_CERTIFICATE_SPECIFIED
F_SSL_RSA_PUBLIC_ENCRYPT NID_netscape_revocation_url R_NO_CIPHER_LIST
F_SSL_SESSION_NEW NID_netscape_ssl_server_name R_NO_CIPHER_MATCH
F_SSL_SESSION_PRINT_FP NID_ns_sgc R_NO_PRIVATEKEY
F_SSL_SET_FD NID_organizationName R_NO_PUBLICKEY
F_SSL_SET_RFD NID_organizationalUnitName R_NULL_SSL_CTX
F_SSL_SET_WFD NID_pbeWithMD2AndDES_CBC R_PEER_DID_NOT_RETURN_A_CERTIFICATE
F_SSL_USE_CERTIFICATE NID_pbeWithMD2AndRC2_CBC R_PEER_ERROR
F_SSL_USE_CERTIFICATE_ASN1 NID_pbeWithMD5AndCast5_CBC R_PEER_ERROR_CERTIFICATE
F_SSL_USE_CERTIFICATE_FILE NID_pbeWithMD5AndDES_CBC R_PEER_ERROR_NO_CIPHER
F_SSL_USE_PRIVATEKEY NID_pbeWithMD5AndRC2_CBC R_PEER_ERROR_UNSUPPORTED_CERTIFICATE_TYPE
F_SSL_USE_PRIVATEKEY_ASN1 NID_pbeWithSHA1AndDES_CBC R_PUBLIC_KEY_ENCRYPT_ERROR
F_SSL_USE_PRIVATEKEY_FILE NID_pbeWithSHA1AndRC2_CBC R_PUBLIC_KEY_IS_NOT_RSA
F_SSL_USE_RSAPRIVATEKEY NID_pbe_WithSHA1And128BitRC2_CBC R_READ_WRONG_PACKET_TYPE
F_SSL_USE_RSAPRIVATEKEY_ASN1 NID_pbe_WithSHA1And128BitRC4 R_SHORT_READ
F_SSL_USE_RSAPRIVATEKEY_FILE NID_pbe_WithSHA1And2_Key_TripleDES_CBC R_SSL_SESSION_ID_IS_DIFFERENT
F_WRITE_PENDING NID_pbe_WithSHA1And3_Key_TripleDES_CBC R_UNABLE_TO_EXTRACT_PUBLIC_KEY
GEN_DIRNAME NID_pbe_WithSHA1And40BitRC2_CBC R_UNKNOWN_REMOTE_ERROR_TYPE
GEN_DNS NID_pbe_WithSHA1And40BitRC4 R_UNKNOWN_STATE
GEN_EDIPARTY NID_pbes2 R_X509_LIB
GEN_EMAIL NID_pbmac1 SENT_SHUTDOWN
GEN_IPADD NID_pkcs SESSION_ASN1_VERSION
GEN_OTHERNAME NID_pkcs3 ST_ACCEPT
GEN_RID NID_pkcs7 ST_BEFORE
GEN_URI NID_pkcs7_data ST_CONNECT
GEN_X400 NID_pkcs7_digest ST_INIT
MBSTRING_ASC NID_pkcs7_encrypted ST_OK
MBSTRING_BMP NID_pkcs7_enveloped ST_READ_BODY
MBSTRING_FLAG NID_pkcs7_signed ST_READ_HEADER
MBSTRING_UNIV NID_pkcs7_signedAndEnveloped VERIFY_CLIENT_ONCE
MBSTRING_UTF8 NID_pkcs8ShroudedKeyBag VERIFY_FAIL_IF_NO_PEER_CERT
MIN_RSA_MODULUS_LENGTH_IN_BYTES NID_pkcs9 VERIFY_NONE
MODE_ACCEPT_MOVING_WRITE_BUFFER NID_pkcs9_challengePassword VERIFY_PEER
MODE_AUTO_RETRY NID_pkcs9_contentType WRITING
MODE_ENABLE_PARTIAL_WRITE NID_pkcs9_countersignature X509_LOOKUP
MODE_RELEASE_BUFFERS NID_pkcs9_emailAddress X509_PURPOSE_ANY
NID_OCSP_sign NID_pkcs9_extCertAttributes X509_PURPOSE_CRL_SIGN
NID_SMIMECapabilities NID_pkcs9_messageDigest X509_PURPOSE_NS_SSL_SERVER
NID_X500 NID_pkcs9_signingTime X509_PURPOSE_OCSP_HELPER
NID_X509 NID_pkcs9_unstructuredAddress X509_PURPOSE_SMIME_ENCRYPT
NID_ad_OCSP NID_pkcs9_unstructuredName X509_PURPOSE_SMIME_SIGN
NID_ad_ca_issuers NID_private_key_usage_period X509_PURPOSE_SSL_CLIENT
NID_algorithm NID_rc2_40_cbc X509_PURPOSE_SSL_SERVER
NID_authority_key_identifier NID_rc2_64_cbc X509_PURPOSE_TIMESTAMP_SIGN
NID_basic_constraints NID_rc2_cbc X509_TRUST_COMPAT
NID_bf_cbc NID_rc2_cfb64 X509_TRUST_EMAIL
NID_bf_cfb64 NID_rc2_ecb X509_TRUST_OBJECT_SIGN
NID_bf_ecb NID_rc2_ofb64 X509_TRUST_OCSP_REQUEST
NID_bf_ofb64 NID_rc4 X509_TRUST_OCSP_SIGN
NID_cast5_cbc NID_rc4_40 X509_TRUST_SSL_CLIENT
NID_cast5_cfb64 NID_rc5_cbc X509_TRUST_SSL_SERVER
NID_cast5_ecb NID_rc5_cfb64 X509_TRUST_TSA
NID_cast5_ofb64 NID_rc5_ecb X509_V_FLAG_ALLOW_PROXY_CERTS
NID_certBag NID_rc5_ofb64 X509_V_FLAG_CB_ISSUER_CHECK
NID_certificate_policies NID_ripemd160 X509_V_FLAG_CHECK_SS_SIGNATURE
NID_client_auth NID_ripemd160WithRSA X509_V_FLAG_CRL_CHECK
NID_code_sign NID_rle_compression X509_V_FLAG_CRL_CHECK_ALL
NID_commonName NID_rsa X509_V_FLAG_EXPLICIT_POLICY
NID_countryName NID_rsaEncryption X509_V_FLAG_EXTENDED_CRL_SUPPORT
NID_crlBag NID_rsadsi X509_V_FLAG_IGNORE_CRITICAL
NID_crl_distribution_points NID_safeContentsBag X509_V_FLAG_INHIBIT_ANY
NID_crl_number NID_sdsiCertificate X509_V_FLAG_INHIBIT_MAP
NID_crl_reason NID_secretBag X509_V_FLAG_NOTIFY_POLICY
NID_delta_crl NID_serialNumber X509_V_FLAG_POLICY_CHECK
NID_des_cbc NID_server_auth X509_V_FLAG_POLICY_MASK
NID_des_cfb64 NID_sha X509_V_FLAG_USE_CHECK_TIME
NID_des_ecb NID_sha1 X509_V_FLAG_USE_DELTAS
NID_des_ede NID_sha1WithRSA X509_V_FLAG_X509_STRICT
NID_des_ede3 NID_sha1WithRSAEncryption X509_V_OK
NID_des_ede3_cbc NID_shaWithRSAEncryption XN_FLAG_COMPAT
NID_des_ede3_cfb64 NID_stateOrProvinceName XN_FLAG_DN_REV
NID_des_ede3_ofb64 NID_subject_alt_name XN_FLAG_DUMP_UNKNOWN_FIELDS
NID_des_ede_cbc NID_subject_key_identifier XN_FLAG_FN_ALIGN
NID_des_ede_cfb64 NID_surname XN_FLAG_FN_LN
NID_des_ede_ofb64 NID_sxnet XN_FLAG_FN_MASK
NID_des_ofb64 NID_time_stamp XN_FLAG_FN_NONE
NID_description NID_title XN_FLAG_FN_OID
NID_desx_cbc NID_undef XN_FLAG_FN_SN
NID_dhKeyAgreement NID_uniqueIdentifier XN_FLAG_MULTILINE
NID_dnQualifier NID_x509Certificate XN_FLAG_ONELINE
NID_dsa NID_x509Crl XN_FLAG_RFC2253
NID_dsaWithSHA NID_zlib_compression XN_FLAG_SEP_COMMA_PLUS
NID_dsaWithSHA1 NOTHING XN_FLAG_SEP_CPLUS_SPC
NID_dsaWithSHA1_2 OPENSSL_VERSION_NUMBER XN_FLAG_SEP_MASK
NID_dsa_2 OP_ALL XN_FLAG_SEP_MULTILINE
NID_email_protect OP_ALLOW_UNSAFE_LEGACY_RENEGOTIATION XN_FLAG_SEP_SPLUS_SPC
NID_ext_key_usage OP_CIPHER_SERVER_PREFERENCE XN_FLAG_SPC_EQ
BIO_eof
BIO_f_ssl
BIO_free
BIO_new
BIO_new_file
BIO_pending
BIO_read
BIO_s_mem
BIO_wpending
BIO_write
CTX_free
CTX_get_cert_store
CTX_new
CTX_use_RSAPrivateKey_file
CTX_use_certificate_file
CTX_v23_new
CTX_v2_new
CTX_v3_new
ERR_error_string
ERR_get_error
ERR_load_RAND_strings
ERR_load_SSL_strings
PEM_read_bio_X509_CRL
RSA_free
RSA_generate_key
SESSION
SESSION_free
SESSION_get_master_key
SESSION_new
SESSION_print
X509_NAME_get_text_by_NID
X509_NAME_oneline
X509_STORE_CTX_set_flags
X509_STORE_add_cert
X509_STORE_add_crl
X509_free
X509_get_issuer_name
X509_get_subject_name
X509_load_cert_crl_file
X509_load_cert_file
X509_load_crl_file
accept
add_session
clear
clear_error
connect
copy_session_id
d2i_SSL_SESSION
die_if_ssl_error
die_now
do_https
dump_peer_certificate
err
flush_sessions
free
get_cipher
get_cipher_list
get_client_random
get_fd
get_http
get_http4
get_https
get_https3
get_https4
get_httpx
get_httpx4
get_peer_certificate
get_peer_cert_chain
get_rbio
get_read_ahead
get_server_random
get_shared_ciphers
get_time
get_timeout
get_wbio
i2d_SSL_SESSION
load_error_strings
make_form
make_headers
new
peek
pending
post_http
post_http4
post_https
post_https3
post_https4
post_httpx
post_httpx4
print_errs
read
remove_session
rstate_string
rstate_string_long
set_bio
set_cert_and_key
set_cipher_list
set_fd
set_read_ahead
set_rfd
set_server_cert_and_key
set_session
set_time
set_timeout
set_verify
set_wfd
ssl_read_CRLF
ssl_read_all
ssl_read_until
ssl_write_CRLF
ssl_write_all
sslcat
state_string
state_string_long
tcp_read_CRLF
tcp_read_all
tcp_read_until
tcp_write_CRLF
tcp_write_all
tcpcat
tcpxcat
use_PrivateKey
use_PrivateKey_ASN1
use_PrivateKey_file
use_RSAPrivateKey
use_RSAPrivateKey_ASN1
use_RSAPrivateKey_file
use_certificate
use_certificate_ASN1
use_certificate_file
write
d2i_OCSP_RESPONSE
i2d_OCSP_RESPONSE
OCSP_RESPONSE_free
d2i_OCSP_REQUEST
i2d_OCSP_REQUEST
OCSP_REQUEST_free
OCSP_cert2ids
OCSP_ids2req
OCSP_response_status
OCSP_response_status_str
OCSP_response_verify
OCSP_response_results
OCSP_RESPONSE_STATUS_INTERNALERROR
OCSP_RESPONSE_STATUS_MALFORMEDREQUEST
OCSP_RESPONSE_STATUS_SIGREQUIRED
OCSP_RESPONSE_STATUS_SUCCESSFUL
OCSP_RESPONSE_STATUS_TRYLATER
OCSP_RESPONSE_STATUS_UNAUTHORIZED
TLSEXT_STATUSTYPE_ocsp
V_OCSP_CERTSTATUS_GOOD
V_OCSP_CERTSTATUS_REVOKED
V_OCSP_CERTSTATUS_UNKNOWN
);
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 ($) { defined $_[0] ? length $_[0] : 0 }';
$@ and eval ' sub blength ($) { defined $_[0] ? length $_[0] : 0 }' ;
}
# Autoload methods go after __END__, and are processed by the autosplit program.
1;
__END__
### Some methods that are macros in C
sub want_nothing { want(shift) == 1 }
sub want_read { want(shift) == 2 }
sub want_write { want(shift) == 3 }
sub want_X509_lookup { want(shift) == 4 }
###
### Open TCP stream to given host and port, looking up the details
### from system databases or DNS.
###
sub open_tcp_connection {
my ($dest_serv, $port) = @_;
my ($errs);
$port = getservbyname($port, 'tcp') unless $port =~ /^\d+$/;
my $dest_serv_ip = gethostbyname($dest_serv);
unless (defined($dest_serv_ip)) {
$errs = "$0 $$: open_tcp_connection: destination host not found:"
. " `$dest_serv' (port $port) ($!)\n";
warn $errs if $trace;
return wantarray ? (0, $errs) : 0;
}
my $sin = sockaddr_in($port, $dest_serv_ip);
warn "Opening connection to $dest_serv:$port (" .
inet_ntoa($dest_serv_ip) . ")" if $trace>2;
my $proto = getprotobyname('tcp');
if (socket (SSLCAT_S, &PF_INET(), &SOCK_STREAM(), $proto)) {
warn "next connect" if $trace>3;
if (CORE::connect (SSLCAT_S, $sin)) {
my $old_out = select (SSLCAT_S); $| = 1; select ($old_out);
warn "connected to $dest_serv, $port" if $trace>3;
return wantarray ? (1, undef) : 1; # Success
}
}
$errs = "$0 $$: open_tcp_connection: failed `$dest_serv', $port ($!)\n";
warn $errs if $trace;
close SSLCAT_S;
return wantarray ? (0, $errs) : 0; # Fail
}
### Open connection via standard web proxy, if one was defined
### using set_proxy().
sub open_proxy_tcp_connection {
my ($dest_serv, $port) = @_;
return open_tcp_connection($dest_serv, $port) if !$proxyhost;
warn "Connect via proxy: $proxyhost:$proxyport" if $trace>2;
my ($ret, $errs) = open_tcp_connection($proxyhost, $proxyport);
return wantarray ? (0, $errs) : 0 if !$ret; # Connection fail
warn "Asking proxy to connect to $dest_serv:$port" if $trace>2;
#print SSLCAT_S "CONNECT $dest_serv:$port HTTP/1.0$proxyauth$CRLF$CRLF";
#my $line = <SSLCAT_S>; # *** bug? Mixing stdio with syscall read?
($ret, $errs) =
tcp_write_all("CONNECT $dest_serv:$port HTTP/1.0$proxyauth$CRLF$CRLF");
return wantarray ? (0,$errs) : 0 if $errs;
($line, $errs) = tcp_read_until($CRLF . $CRLF, 1024);
warn "Proxy response: $line" if $trace>2;
return wantarray ? (0,$errs) : 0 if $errs;
return wantarray ? (1,'') : 1; # Success
}
###
### read and write helpers that block
###
sub debug_read {
my ($replyr, $gotr) = @_;
my $vm = $trace>2 && $linux_debug ?
(split ' ', `cat /proc/$$/stat`)[22] : 'vm_unknown';
warn " got " . blength($$gotr) . ':'
. blength($$replyr) . " bytes (VM=$vm).\n" if $trace == 3;
warn " got `$$gotr' (" . blength($$gotr) . ':'
. blength($$replyr) . " bytes, VM=$vm)\n" if $trace>3;
}
sub ssl_read_all {
my ($ssl,$how_much) = @_;
$how_much = 2000000000 unless $how_much;
my ($got, $errs);
my $reply = '';
while ($how_much > 0) {
$got = Net::SSLeay::read($ssl,
($how_much > 32768) ? 32768 : $how_much
);
last if $errs = print_errs('SSL_read');
$how_much -= blength($got);
debug_read(\$reply, \$got) if $trace>1;
last if $got eq ''; # EOF
$reply .= $got;
}
return wantarray ? ($reply, $errs) : $reply;
}
sub tcp_read_all {
my ($how_much) = @_;
$how_much = 2000000000 unless $how_much;
my ($n, $got, $errs);
my $reply = '';
my $bsize = 0x10000;
while ($how_much > 0) {
$n = sysread(SSLCAT_S,$got, (($bsize < $how_much) ? $bsize : $how_much));
warn "Read error: $! ($n,$how_much)" unless defined $n;
last if !$n; # EOF
$how_much -= $n;
debug_read(\$reply, \$got) if $trace>1;
$reply .= $got;
}
return wantarray ? ($reply, $errs) : $reply;
}
sub ssl_write_all {
my $ssl = $_[0];
my ($data_ref, $errs);
if (ref $_[1]) {
$data_ref = $_[1];
} else {
$data_ref = \$_[1];
}
my ($wrote, $written, $to_write) = (0,0, blength($$data_ref));
my $vm = $trace>2 && $linux_debug ?
(split ' ', `cat /proc/$$/stat`)[22] : 'vm_unknown';
warn " write_all VM at entry=$vm\n" if $trace>2;
while ($to_write) {
#sleep 1; # *** DEBUG
warn "partial `$$data_ref'\n" if $trace>3;
$wrote = write_partial($ssl, $written, $to_write, $$data_ref);
if (defined $wrote && ($wrote > 0)) { # write_partial can return -1
$written += $wrote;
$to_write -= $wrote;
} else {
if (defined $wrote) {
# check error conditions via SSL_get_error per man page
if ( my $sslerr = get_error($ssl, $wrote) ) {
my $errstr = ERR_error_string($sslerr);
my $errname = '';
SWITCH: {
$sslerr == constant("ERROR_NONE") && do {
# according to map page SSL_get_error(3ssl):
# The TLS/SSL I/O operation completed.
# This result code is returned if and only if ret > 0
# so if we received it here complain...
warn "ERROR_NONE unexpected with invalid return value!"
if $trace;
$errname = "SSL_ERROR_NONE";
};
$sslerr == constant("ERROR_WANT_READ") && do {
# operation did not complete, call again later, so do not
# set errname and empty err_que since this is a known
# error that is expected but, we should continue to try
# writing the rest of our data with same io call and params.
warn "ERROR_WANT_READ (TLS/SSL Handshake, will continue)\n"
if $trace;
print_errs('SSL_write(want read)');
last SWITCH;
};
$sslerr == constant("ERROR_WANT_WRITE") && do {
# operation did not complete, call again later, so do not
# set errname and empty err_que since this is a known
# error that is expected but, we should continue to try
# writing the rest of our data with same io call and params.
warn "ERROR_WANT_WRITE (TLS/SSL Handshake, will continue)\n"
if $trace;
print_errs('SSL_write(want write)');
last SWITCH;
};
$sslerr == constant("ERROR_ZERO_RETURN") && do {
# valid protocol closure from other side, no longer able to
# write, since there is no longer a session...
warn "ERROR_ZERO_RETURN($wrote): TLS/SSLv3 Closure alert\n"
if $trace;
$errname = "SSL_ERROR_ZERO_RETURN";
last SWITCH;
};
$sslerr == constant("ERROR_SSL") && do {
# library/protocol error
warn "ERROR_SSL($wrote): Library/Protocol error occured\n"
if $trace;
$errname = "SSL_ERROR_SSL";
last SWITCH;
};
$sslerr == constant("ERROR_WANT_CONNECT") && do {
# according to man page, should never happen on call to
# SSL_write, so complain, but handle as known error type
warn "ERROR_WANT_CONNECT: Unexpected error for SSL_write\n"
if $trace;
$errname = "SSL_ERROR_WANT_CONNECT";
last SWITCH;
};
$sslerr == constant("ERROR_WANT_ACCEPT") && do {
# according to man page, should never happen on call to
# SSL_write, so complain, but handle as known error type
warn "ERROR_WANT_ACCEPT: Unexpected error for SSL_write\n"
if $trace;
$errname = "SSL_ERROR_WANT_ACCEPT";
last SWITCH;
};
$sslerr == constant("ERROR_WANT_X509_LOOKUP") && do {
# operation did not complete: waiting on call back,
# call again later, so do not set errname and empty err_que
# since this is a known error that is expected but, we should
# continue to try writing the rest of our data with same io
# call parameter.
warn "ERROR_WANT_X509_LOOKUP: (Cert Callback asked for in ".
"SSL_write will contine)\n" if $trace;
print_errs('SSL_write(want x509');
last SWITCH;
};
$sslerr == constant("ERROR_SYSCALL") && do {
# some IO error occured. According to man page:
# Check retval, ERR, fallback to errno
if ($wrote==0) { # EOF
warn "ERROR_SYSCALL($wrote): EOF violates protocol.\n"
if $trace;
$errname = "SSL_ERROR_SYSCALL(EOF)";
} else { # -1 underlying BIO error reported.
# check error que for details, don't set errname since we
# are directly appending to errs
my $chkerrs = print_errs('SSL_write (syscall)');
if ($chkerrs) {
warn "ERROR_SYSCALL($wrote): Have errors\n" if $trace;
$errs .= "ssl_write_all $$: 1 - ERROR_SYSCALL($wrote,".
"$sslerr,$errstr,$!)\n$chkerrs";
} else { # que was empty, use errno
warn "ERROR_SYSCALL($wrote): errno($!)\n" if $trace;
$errs .= "ssl_write_all $$: 1 - ERROR_SYSCALL($wrote,".
"$sslerr) : $!\n";
}
}
last SWITCH;
};
warn "Unhandled val $sslerr from SSL_get_error(SSL,$wrote)\n"
if $trace;
$errname = "SSL_ERROR_?($sslerr)";
} # end of SWITCH block
if ($errname) { # if we had an errname set add the error
$errs .= "ssl_write_all $$: 1 - $errname($wrote,$sslerr,".
"$errstr,$!)\n";
}
} # endif on have SSL_get_error val
} # endif on $wrote defined
} # endelse on $wrote > 0
$vm = $trace>2 && $linux_debug ?
(split ' ', `cat /proc/$$/stat`)[22] : 'vm_unknown';
warn " written so far $wrote:$written bytes (VM=$vm)\n" if $trace>2;
# append remaining errors in que and report if errs exist
$errs .= print_errs('SSL_write');
return (wantarray ? (undef, $errs) : undef) if $errs;
}
return wantarray ? ($written, $errs) : $written;
}
sub tcp_write_all {
my ($data_ref, $errs);
if (ref $_[0]) {
$data_ref = $_[0];
} else {
$data_ref = \$_[0];
}
my ($wrote, $written, $to_write) = (0,0, blength($$data_ref));
my $vm = $trace>2 && $linux_debug ?
(split ' ', `cat /proc/$$/stat`)[22] : 'vm_unknown';
warn " write_all VM at entry=$vm to_write=$to_write\n" if $trace>2;
while ($to_write) {
warn "partial `$$data_ref'\n" if $trace>3;
$wrote = syswrite(SSLCAT_S, $$data_ref, $to_write, $written);
if (defined $wrote && ($wrote > 0)) { # write_partial can return -1
$written += $wrote;
$to_write -= $wrote;
} elsif (!defined($wrote)) {
warn "tcp_write_all: $!";
return (wantarray ? (undef, "$!") : undef);
}
$vm = $trace>2 && $linux_debug ?
(split ' ', `cat /proc/$$/stat`)[22] : 'vm_unknown';
warn " written so far $wrote:$written bytes (VM=$vm)\n" if $trace>2;
}
return wantarray ? ($written, '') : $written;
}
### from patch by Clinton Wong <clintdw@netcom.com>
# ssl_read_until($ssl [, $delimit [, $max_length]])
# if $delimit missing, use $/ if it exists, otherwise use \n
# read until delimiter reached, up to $max_length chars if defined
sub ssl_read_until ($;$$) {
my ($ssl,$delim, $max_length) = @_;
# 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) = @_;
# 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) {
my $poll_retval = Net::SSLeay::RAND_poll();
warn "Random number generator not seeded!!!" if $trace && !$poll_retval;
}
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) {
unless (exists &Net::SSLeay::CTX_v2_new) {
warn "ssl_version has been set to 2, but this version of OpenSSL has been compiled without SSLv2 support";
return undef;
}
$ctx = CTX_v2_new();
}
elsif ($ssl_version == 3) { $ctx = CTX_v3_new(); }
elsif ($ssl_version == 10) { $ctx = CTX_tlsv1_new(); }
elsif ($ssl_version == 11) {
unless (exists &Net::SSLeay::CTX_tlsv1_1_new) {
warn "ssl_version has been set to 11, but this version of OpenSSL has been compiled without TLSv1.1 support";
return undef;
}
$ctx = CTX_tlsv1_1_new;
}
elsif ($ssl_version == 12) {
unless (exists &Net::SSLeay::CTX_tlsv1_2_new) {
warn "ssl_version has been set to 12, but this version of OpenSSL has been compiled without TLSv1.2 support";
return undef;
}
$ctx = CTX_tlsv1_2_new;
}
else { $ctx = CTX_new(); }
return $ctx;
}
###
### Standard initialisation. Initialise the ssl library in the usual way
### at most once. Override this if you need differnet initialisation
### SSLeay_add_ssl_algorithms is also protected against multiple runs in SSLeay.xs
### and is also mutex protected in threading perls
###
my $library_initialised;
sub initialize
{
if (!$library_initialised)
{
load_error_strings(); # Some bloat, but I'm after ease of use
SSLeay_add_ssl_algorithms(); # and debuggability.
randomize();
$library_initialised++;
}
}
###
### 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;
initialize(); # Will init at most once
$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);