Commit b4eea3f71bf01457f2482086b5dd7f333a85ffb8 - libnet-sslglue-perl

Merge tag 'upstream/1.054' into upstream Upstream version 1.054 gregor herrmann 8 years ago

12 changed file(s) with 629 addition(s) and 495 deletion(s). Raw diff Collapse all Expand all

-0

Changes less more

	0	1.054 2015/04/28
	1	- if a version of libnet is detected which already supports TLS (i.e.
	2	libnet 3.0+) warn and use this instead.
	3
	4	1.053 2014/05/28
	5	- if current LWP is detected is use this mostly unpatched
	6	- fix Net::SSLGlue::FTP to use the same hostname when verifying the
	7	certificate of the data connection
	8
0	9	1.052 2014/01/16
1	10	- FTPS: reuse same SSL session for control and data channnel to work
2	11	with default configuration of proftpd.

-1

MANIFEST less more

21	21	t/external/03_lwp.t
22	22	t/external/04_pop3.t
23	23	t/external/05_ftp.t
24		META.yml Module meta-data (added by MakeMaker)
	24	META.yml Module YAML meta-data (added by MakeMaker)
	25	META.json Module JSON meta-data (added by MakeMaker)

+46

-0

META.json less more

	0	{
	1	"abstract" : "unknown",
	2	"author" : [
	3	"unknown"
	4	],
	5	"dynamic_config" : 1,
	6	"generated_by" : "ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version 2.120921",
	7	"license" : [
	8	"unknown"
	9	],
	10	"meta-spec" : {
	11	"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
	12	"version" : "2"
	13	},
	14	"name" : "Net-SSLGlue",
	15	"no_index" : {
	16	"directory" : [
	17	"t",
	18	"inc"
	19	]
	20	},
	21	"prereqs" : {
	22	"build" : {
	23	"requires" : {
	24	"ExtUtils::MakeMaker" : "0"
	25	}
	26	},
	27	"configure" : {
	28	"requires" : {
	29	"ExtUtils::MakeMaker" : "0"
	30	}
	31	},
	32	"runtime" : {
	33	"requires" : {
	34	"IO::Socket::SSL" : "1.19"
	35	}
	36	}
	37	},
	38	"release_status" : "stable",
	39	"resources" : {
	40	"repository" : {
	41	"url" : "https://github.com/noxxi/p5-net-sslglue"
	42	}
	43	},
	44	"version" : "1.054"
	45	}

+21

-20

META.yml less more

0		--- #YAML:1.0
1		name: Net-SSLGlue
2		version: 1.052
3		abstract: ~
4		author: []
5		license: unknown
6		distribution_type: module
	0	---
	1	abstract: unknown
	2	author:
	3	- unknown
	4	build_requires:
	5	ExtUtils::MakeMaker: 0
7	6	configure_requires:
8		ExtUtils::MakeMaker: 0
9		build_requires:
10		ExtUtils::MakeMaker: 0
	7	ExtUtils::MakeMaker: 0
	8	dynamic_config: 1
	9	generated_by: 'ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version 2.120921'
	10	license: unknown
	11	meta-spec:
	12	url: http://module-build.sourceforge.net/META-spec-v1.4.html
	13	version: 1.4
	14	name: Net-SSLGlue
	15	no_index:
	16	directory:
	17	- t
	18	- inc
11	19	requires:
12		IO::Socket::SSL: 1.19
	20	IO::Socket::SSL: 1.19
13	21	resources:
14		repository: https://github.com/noxxi/p5-net-sslglue
15		no_index:
16		directory:
17		- t
18		- inc
19		generated_by: ExtUtils::MakeMaker version 6.57_05
20		meta-spec:
21		url: http://module-build.sourceforge.net/META-spec-v1.4.html
22		version: 1.4
	22	repository: https://github.com/noxxi/p5-net-sslglue
	23	version: 1.054

+130

-129

lib/Net/SSLGlue/FTP.pm less more

7	7	use Net::SSLGlue::Socket;
8	8	use Socket 'AF_INET';
9	9
10		our $VERSION = 1.001;
	10	our $VERSION = 1.002;
11	11
12	12	BEGIN {
	13	require Net::FTP;
	14	if (defined &Net::FTP::starttls) {
	15	warn "using SSL support of Net::FTP $Net::FTP::VERSION instead of SSLGlue";
	16	goto DONE;
	17	}
	18
	19	$Net::FTP::VERSION eq '2.77'
	20	or warn "Not tested with Net::FTP version $Net::FTP::VERSION";
	21
	22	require Net::FTP::dataconn;
13	23	for my $class (qw(Net::FTP Net::FTP::dataconn)) {
14		eval "require $class" or die "failed to load $class";
15	24	no strict 'refs';
16	25	my $fixed;
17	26	for( @{ "${class}::ISA" } ) {

23	32	die "cannot replace IO::Socket::INET with Net::SSLGlue::Socket in ${class}::ISA"
24	33	if ! $fixed;
25	34	}
26		$Net::FTP::VERSION eq '2.77'
27		or warn "Not tested with Net::FTP version $Net::FTP::VERSION";
28		}
29
30		# redefine Net::FTP::new so that it understands SSL => 1 and connects directly
31		# with SSL to the server
32		{
	35
	36	# redefine Net::FTP::new so that it understands SSL => 1 and connects directly
	37	# with SSL to the server
33	38	no warnings 'redefine';
34	39	my $onew = Net::FTP->can('new');
35	40	*Net::FTP::new = sub {

52	57	${*$self}{net_ftp_tlsargs} = \%sslargs;
53	58	return $self;
54	59	};
55		}
56
57		# add starttls method to upgrade connection to SSL: AUTH TLS
58		sub Net::FTP::starttls {
59		my $self = shift;
60		$self->is_ssl and croak("called starttls within SSL session");
61		$self->_AUTH('TLS') == Net::FTP::CMD_OK or return;
62
63		my $host = $self->host;
64		# for name verification strip port from domain:port, ipv4:port, [ipv6]:port
65		$host =~s{(?<!:):\d+$}{};
66
67		my %args = (
68		SSL_verify_mode => 1,
69		SSL_verifycn_scheme => 'ftp',
70		SSL_verifycn_name => $host,
71		# reuse SSL session of control connection in data connections
72		SSL_session_cache => Net::SSLGlue::FTP::SingleSessionCache->new,
73		%{ ${*$self}{net_ftp_tlsargs}},
74		@_
75		);
76
77		$self->start_SSL(%args) or return;
78		${*$self}{net_ftp_tlsargs} = \%args;
79		$self->prot('P');
80		return 1;
81		}
82
83		# add prot method to set protection level (PROT C\|P)
84		sub Net::FTP::prot {
85		my ($self,$type) = @_;
86		$type eq 'C' or $type eq 'P' or croak("type must by C or P");
87		$self->_PBSZ(0) or return;
88		$self->_PROT($type) or return;
89		${*$self}{net_ftp_tlstype} = $type;
90		return 1;
91		}
92
93		# add stoptls method to downgrade connection from SSL: CCC
94		sub Net::FTP::stoptls {
95		my $self = shift;
96		$self->is_ssl or croak("called stoptls outside SSL session");
97		$self->_CCC() or return;
98		$self->stop_SSL();
99		return 1;
100		}
101
102		# add EPSV for new style passive mode (incl. IPv6)
103		sub Net::FTP::epsv {
104		my $self = shift;
105		@_ and croak 'usage: $ftp->epsv()';
106		delete ${*$self}{net_ftp_intern_port};
107
108		$self->_EPSV && $self->message =~ m{$([\x33-\x7e])\1\1(\d+)\1$}
109		? ${*$self}{'net_ftp_pasv'} = [ $self->peerhost, $2 ]
110		: undef;
111		}
112
113		# redefine PASV so that it uses EPSV on IPv6
114		# also net_ftp_pasv contains now the parsed [ip,port]
115		{
116		no warnings 'redefine';
	60
	61	# add starttls method to upgrade connection to SSL: AUTH TLS
	62	*Net::FTP::starttls = sub {
	63	my $self = shift;
	64	$self->is_ssl and croak("called starttls within SSL session");
	65	$self->_AUTH('TLS') == &Net::FTP::CMD_OK or return;
	66
	67	my $host = $self->host;
	68	# for name verification strip port from domain:port, ipv4:port, [ipv6]:port
	69	$host =~s{(?<!:):\d+$}{};
	70
	71	my %args = (
	72	SSL_verify_mode => 1,
	73	SSL_verifycn_scheme => 'ftp',
	74	SSL_verifycn_name => $host,
	75	# reuse SSL session of control connection in data connections
	76	SSL_session_cache => Net::SSLGlue::FTP::SingleSessionCache->new,
	77	%{ ${*$self}{net_ftp_tlsargs}},
	78	@_
	79	);
	80
	81	$self->start_SSL(%args) or return;
	82	${*$self}{net_ftp_tlsargs} = \%args;
	83	$self->prot('P');
	84	return 1;
	85	};
	86
	87	# add prot method to set protection level (PROT C\|P)
	88	*Net::FTP::prot = sub {
	89	my ($self,$type) = @_;
	90	$type eq 'C' or $type eq 'P' or croak("type must by C or P");
	91	$self->_PBSZ(0) or return;
	92	$self->_PROT($type) or return;
	93	${*$self}{net_ftp_tlstype} = $type;
	94	return 1;
	95	};
	96
	97	# add stoptls method to downgrade connection from SSL: CCC
	98	*Net::FTP::stoptls = sub {
	99	my $self = shift;
	100	$self->is_ssl or croak("called stoptls outside SSL session");
	101	$self->_CCC() or return;
	102	$self->stop_SSL();
	103	return 1;
	104	};
	105
	106	# add EPSV for new style passive mode (incl. IPv6)
	107	*Net::FTP::epsv = sub {
	108	my $self = shift;
	109	@_ and croak 'usage: $ftp->epsv()';
	110	delete ${*$self}{net_ftp_intern_port};
	111
	112	$self->_EPSV && $self->message =~ m{$([\x33-\x7e])\1\1(\d+)\1$}
	113	? ${*$self}{'net_ftp_pasv'} = [ $self->peerhost, $2 ]
	114	: undef;
	115	};
	116
	117	# redefine PASV so that it uses EPSV on IPv6
	118	# also net_ftp_pasv contains now the parsed [ip,port]
117	119	*Net::FTP::pasv = sub {
118	120	my $self = shift;
119	121	@_ and croak 'usage: $ftp->port()';

128	130	}
129	131	return;
130	132	};
131		}
132
133		# add EPRT for new style passive mode (incl. IPv6)
134		sub Net::FTP::eprt {
135		@_ == 1 \|\| @_ == 2 or croak 'usage: $self->eprt([PORT])';
136		return _eprt('EPRT',@_);
137		}
138
139		# redefine PORT to use EPRT for IPv6
140		{
141		no warnings 'redefine';
	133
	134	# add EPRT for new style passive mode (incl. IPv6)
	135	*Net::FTP::eprt = sub {
	136	@_ == 1 \|\| @_ == 2 or croak 'usage: $self->eprt([PORT])';
	137	return _eprt('EPRT',@_);
	138	};
	139
	140	# redefine PORT to use EPRT for IPv6
142	141	*Net::FTP::port = sub {
143	142	@_ == 1 \|\| @_ == 2 or croak 'usage: $self->port([PORT])';
144	143	return _eprt('PORT',@_);
145	144	};
146		}
147
148		sub _eprt {
149		my ($cmd,$self,$port) = @_;
150		delete ${*$self}{net_ftp_intern_port};
151		unless ($port) {
152		my $listen = ${*$self}{net_ftp_listen} \|\|= Net::SSLGlue::Socket->new(
153		Listen => 1,
154		Timeout => $self->timeout,
155		LocalAddr => $self->sockhost,
156		);
157		${*$self}{net_ftp_intern_port} = 1;
158		my $fam = ($listen->sockdomain == AF_INET) ? 1:2;
159		if ( $cmd eq 'EPRT' \|\| $fam == 2 ) {
160		$port = "\|$fam\|".$listen->sockhost."\|".$listen->sockport."\|";
161		$cmd = 'EPRT';
162		} else {
163		my $p = $listen->sockport;
164		$port = join(',',split(m{\.},$listen->sockhost),$p >> 8,$p & 0xff);
165		}
166		}
167		my $ok = $cmd eq 'EPRT' ? $self->_EPRT($port) : $self->_PORT($port);
168		${*$self}{net_ftp_port} = $port if $ok;
169		return $ok;
170		}
171
172
173
174		for my $cmd (qw(PBSZ PROT CCC EPRT EPSV)) {
175		no strict 'refs';
176		*{"Net::FTP::_$cmd"} = sub {
177		shift->command("$cmd @_")->response() == Net::FTP::CMD_OK
178		}
179		}
180
181		# redefine _dataconn to
182		# - support IPv6
183		# - upgrade data connection to SSL if PROT P
184		{
185
186		no warnings 'redefine';
	145
	146	sub _eprt {
	147	my ($cmd,$self,$port) = @_;
	148	delete ${*$self}{net_ftp_intern_port};
	149	unless ($port) {
	150	my $listen = ${*$self}{net_ftp_listen} \|\|= Net::SSLGlue::Socket->new(
	151	Listen => 1,
	152	Timeout => $self->timeout,
	153	LocalAddr => $self->sockhost,
	154	);
	155	${*$self}{net_ftp_intern_port} = 1;
	156	my $fam = ($listen->sockdomain == AF_INET) ? 1:2;
	157	if ( $cmd eq 'EPRT' \|\| $fam == 2 ) {
	158	$port = "\|$fam\|".$listen->sockhost."\|".$listen->sockport."\|";
	159	$cmd = 'EPRT';
	160	} else {
	161	my $p = $listen->sockport;
	162	$port = join(',',split(m{\.},$listen->sockhost),$p >> 8,$p & 0xff);
	163	}
	164	}
	165	my $ok = $cmd eq 'EPRT' ? $self->_EPRT($port) : $self->_PORT($port);
	166	${*$self}{net_ftp_port} = $port if $ok;
	167	return $ok;
	168	}
	169
	170
	171
	172	for my $cmd (qw(PBSZ PROT CCC EPRT EPSV)) {
	173	no strict 'refs';
	174	*{"Net::FTP::_$cmd"} = sub {
	175	shift->command("$cmd @_")->response() == &Net::FTP::CMD_OK
	176	}
	177	}
	178
	179
	180	# redefine _dataconn to
	181	# - support IPv6
	182	# - upgrade data connection to SSL if PROT P
187	183	*Net::FTP::_dataconn = sub {
188	184	my $self = shift;
189	185	my $pkg = "Net::FTP::" . $self->type;

204	200	}
205	201
206	202	if (( ${*$self}{net_ftp_tlstype} \|\| '') eq 'P'
207		&& ! $conn->start_SSL( $self->is_ssl
208		? ( SSL_reuse_ctx => $self )
209		: ( %{${*$self}{net_ftp_tlsargs}} )
210		) ) {
	203	&& ! $conn->start_SSL( $self->is_ssl ? (
	204	SSL_reuse_ctx => $self,
	205	SSL_verifycn_name => ${*$self}{net_ftp_tlsargs}->{SSL_verifycn_name}
	206	):(
	207	%{${*$self}{net_ftp_tlsargs}}
	208	)
	209	)) {
211	210	croak("failed to ssl upgrade dataconn: $SSL_ERROR");
212	211	return;
213	212	}

219	218	${$conn}{net_ftp_blksize} = ${$self}{net_ftp_blksize};
220	219	return $conn;
221	220	};
	221
	222	DONE:
	223	1;
222	224	}
223	225
224	226	{

287	289	=item starttls
288	290
289	291	If the connection is not yet SSLified it will issue the "AUTH TLS" command and
290		change the object, so that SSL will now be used. The usual C<SSL_*> parameter of
291		L<IO::Socket::SSL> will be given.
	292	change the object, so that SSL will now be used.
292	293
293	294	=item peer_certificate ...
294	295

+12

-12

lib/Net/SSLGlue/LDAP.pm less more

11	11	# Net::LDAP::_SSL_context_init_args
12	12
13	13	my $old = defined &Net::LDAP::_SSL_context_init_args
14		&& \&Net::LDAP::_SSL_context_init_args
15		\|\| die "cannot find Net::LDAP::_SSL_context_init_args";
	14	&& \&Net::LDAP::_SSL_context_init_args
	15	\|\| die "cannot find Net::LDAP::_SSL_context_init_args";
16	16	no warnings 'redefine';
17	17	*Net::LDAP::_SSL_context_init_args = sub {
18		my %arg = $old->(@_);
19		$arg{SSL_verifycn_scheme} \|\|= 'ldap' if $arg{SSL_verify_mode};
20		while ( my ($k,$v) = each %SSLopts ) {
21		$arg{$k} = $v;
22		}
23		return %arg;
	18	my %arg = $old->(@_);
	19	$arg{SSL_verifycn_scheme} \|\|= 'ldap' if $arg{SSL_verify_mode};
	20	while ( my ($k,$v) = each %SSLopts ) {
	21	$arg{$k} = $v;
	22	}
	23	return %arg;
24	24	};
25	25
26	26	1;

31	31
32	32	=head1 SYNOPSIS
33	33
34		use Net::SSLGlue::LDAP;
35		local %Net::SSLGlue::LDAP = ( SSL_verifycn_name => $hostname_in_cert );
36		my $ldap = Net::LDAP->new( $hostname, capath => ... );
37		$ldap->start_tls;
	34	use Net::SSLGlue::LDAP;
	35	local %Net::SSLGlue::LDAP = ( SSL_verifycn_name => $hostname_in_cert );
	36	my $ldap = Net::LDAP->new( $hostname, capath => ... );
	37	$ldap->start_tls;
38	38
39	39
40	40	=head1 DESCRIPTION

+159

-125

lib/Net/SSLGlue/LWP.pm less more

0	0	use strict;
1	1	use warnings;
2	2	package Net::SSLGlue::LWP;
3		our $VERSION = 0.4;
	3	our $VERSION = 0.5;
4	4	use LWP::UserAgent '5.822';
5	5	use IO::Socket::SSL 1.19;
6	6	use URI;
7	7
8	8	# force Net::SSLGlue::LWP::Socket as superclass of Net::HTTPS, because
9	9	# only it can verify certificates
	10	my $use_existent;
10	11	BEGIN {
	12	require LWP::Protocol::https;
	13	$use_existent = $LWP::Protocol::https::VERSION >= 6.06
	14	&& $LWP::UserAgent::VERSION >= 6.06;
	15	if ($use_existent) {
	16	my $oc = $Net::HTTPS::SSL_SOCKET_CLASS \|\|
	17	$ENV{PERL_NET_HTTPS_SSL_SOCKET_CLASS};
	18	$use_existent = 0 if $oc && $oc ne 'IO::Socket::SSL';
	19	}
	20	if ($use_existent) {
	21	warn "Your LWP::UserAgent/LWP::Protocol::https looks fine.\n".
	22	"Will use it instead of Net::SSLGLue::LWP\n";
	23	} else {
11	24	my $oc = $Net::HTTPS::SSL_SOCKET_CLASS;
12	25	$Net::HTTPS::SSL_SOCKET_CLASS = my $need = 'Net::SSLGlue::LWP::Socket';
13	26	require Net::HTTPS;
14		require LWP::Protocol::https;
	27
15	28	if ( ( my $oc = $Net::HTTPS::SSL_SOCKET_CLASS ) ne $need ) {
16		# was probably loaded before, change ISA
17		grep { s{^\Q$oc\E$}{$need} } @Net::HTTPS::ISA
	29	# was probably loaded before, change ISA
	30	grep { s{^\Q$oc\E$}{$need} } @Net::HTTPS::ISA
18	31	}
19	32	die "cannot force $need into Net::HTTPS"
20		if $Net::HTTPS::SSL_SOCKET_CLASS ne $need;
21		}
	33	if $Net::HTTPS::SSL_SOCKET_CLASS ne $need;
	34	}
	35	}
	36
22	37
23	38	our %SSLopts; # set by local and import
24	39	sub import {
25		shift;
26		%SSLopts = @_;
	40	shift;
	41	%SSLopts = @_;
	42	}
	43
	44	if (!$use_existent) {
	45	# add SSL options
	46	my $old_eso = UNIVERSAL::can( 'LWP::Protocol::https','_extra_sock_opts' );
	47	no warnings 'redefine';
	48	*LWP::Protocol::https::_extra_sock_opts = sub {
	49	return (
	50	$old_eso ? ( $old_eso->(@_) ):(),
	51	SSL_verify_mode => 1,
	52	SSL_verifycn_scheme => 'http',
	53	HTTPS_proxy => $_[0]->{ua}{https_proxy},
	54	%SSLopts,
	55	);
	56	};
	57
	58	# fix https_proxy handling - forward it to a variable handled by me
	59	my $old_proxy = defined &LWP::UserAgent::proxy && \&LWP::UserAgent::proxy
	60	or die "cannot find LWP::UserAgent::proxy";
	61	*LWP::UserAgent::proxy = sub {
	62	my ($self,$key,$val) = @_;
	63	goto &$old_proxy if ref($key) \|\| $key ne 'https';
	64	if (@_>2) {
	65	my $rv = &$old_proxy;
	66	$self->{https_proxy} = delete $self->{proxy}{https}
	67	\|\| die "https proxy not set?";
	68	}
	69	return $self->{https_proxy};
	70	};
	71
	72	} else {
	73	# wrapper around LWP::Protocol::https::_extra_sock_opts to support %SSLopts
	74	my $old_eso = UNIVERSAL::can( 'LWP::Protocol::https','_extra_sock_opts' )
	75	or die "no LWP::Protocol::https::_extra_sock_opts found";
	76	no warnings 'redefine';
	77	*LWP::Protocol::https::_extra_sock_opts = sub {
	78	return (
	79	$old_eso->(@_),
	80	%SSLopts,
	81	);
	82	};
27	83	}
28	84
29	85	{
30		# add SSL options
31		my $old_eso = UNIVERSAL::can( 'LWP::Protocol::https','_extra_sock_opts' );
32		no warnings 'redefine';
33		*LWP::Protocol::https::_extra_sock_opts = sub {
34		return (
35		$old_eso ? ( $old_eso->(@_) ):(),
36		SSL_verify_mode => 1,
37		SSL_verifycn_scheme => 'http',
38		HTTPS_proxy => $_[0]->{ua}{https_proxy},
39		%SSLopts,
40		);
	86
	87	package Net::SSLGlue::LWP::Socket;
	88	use IO::Socket::SSL;
	89	use base 'IO::Socket::SSL';
	90	my $sockclass = 'IO::Socket::INET';
	91	use URI::Escape 'uri_unescape';
	92	use MIME::Base64 'encode_base64';
	93	$sockclass .= '6' if eval "require IO::Socket::INET6";
	94
	95	sub configure {
	96	my ($self,$args) = @_;
	97	my $phost = delete $args->{HTTPS_proxy}
	98	or return $self->SUPER::configure($args);
	99	$phost = URI->new($phost) if ! ref $phost;
	100
	101	my $port = $args->{PeerPort};
	102	my $host = $args->{PeerHost} \|\| $args->{PeerAddr};
	103	if ( ! $port ) {
	104	$host =~s{:(\w+)$}{};
	105	$port = $args->{PeerPort} = $1;
	106	$args->{PeerHost} = $host;
	107	}
	108	if ( $phost->scheme ne 'http' ) {
	109	$@ = "scheme ".$phost->scheme." not supported for https_proxy";
	110	return;
	111	}
	112	my $auth = '';
	113	if ( my ($user,$pass) = split( ':', $phost->userinfo \|\| '' ) ) {
	114	$auth = "Proxy-authorization: Basic ".
	115	encode_base64( uri_unescape($user).':'.uri_unescape($pass),'' ).
	116	"\r\n";
	117	}
	118
	119	my $pport = $phost->port;
	120	$phost = $phost->host;
	121
	122	# temporally downgrade $self so that the right connect chain
	123	# gets called w/o doing SSL stuff. If we don't do it it will
	124	# try to call IO::Socket::SSL::connect
	125	my $ssl_class = ref($self);
	126	bless $self,$sockclass;
	127	$self->configure({ %$args, PeerAddr => $phost, PeerPort => $pport }) or do {
	128	$@ = "connect to proxy $phost port $pport failed";
	129	return;
41	130	};
42		}
43
44		{
45		# fix https_proxy handling - forward it to a variable handled by me
46		my $old_proxy = defined &LWP::UserAgent::proxy && \&LWP::UserAgent::proxy
47		or die "cannot find LWP::UserAgent::proxy";
48		no warnings 'redefine';
49		*LWP::UserAgent::proxy = sub {
50		my ($self,$key,$val) = @_;
51		goto &$old_proxy if ref($key) \|\| $key ne 'https';
52		if (@_>2) {
53		my $rv = &$old_proxy;
54		$self->{https_proxy} = delete $self->{proxy}{https}
55		\|\| die "https proxy not set?";
56		}
57		return $self->{https_proxy};
58		}
59		}
60
61		{
62
63		package Net::SSLGlue::LWP::Socket;
64		use IO::Socket::SSL;
65		use base 'IO::Socket::SSL';
66		my $sockclass = 'IO::Socket::INET';
67		use URI::Escape 'uri_unescape';
68		use MIME::Base64 'encode_base64';
69		$sockclass .= '6' if eval "require IO::Socket::INET6";
70
71		sub configure {
72		my ($self,$args) = @_;
73		my $phost = delete $args->{HTTPS_proxy}
74		or return $self->SUPER::configure($args);
75		$phost = URI->new($phost) if ! ref $phost;
76
77		my $port = $args->{PeerPort};
78		my $host = $args->{PeerHost} \|\| $args->{PeerAddr};
79		if ( ! $port ) {
80		$host =~s{:(\w+)$}{};
81		$port = $args->{PeerPort} = $1;
82		$args->{PeerHost} = $host;
83		}
84		if ( $phost->scheme ne 'http' ) {
85		$@ = "scheme ".$phost->scheme." not supported for https_proxy";
86		return;
87		}
88		my $auth = '';
89		if ( my ($user,$pass) = split( ':', $phost->userinfo \|\| '' ) ) {
90		$auth = "Proxy-authorization: Basic ".
91		encode_base64( uri_unescape($user).':'.uri_unescape($pass),'' ).
92		"\r\n";
93		}
94
95		my $pport = $phost->port;
96		$phost = $phost->host;
97
98		# temporally downgrade $self so that the right connect chain
99		# gets called w/o doing SSL stuff. If we don't do it it will
100		# try to call IO::Socket::SSL::connect
101		my $ssl_class = ref($self);
102		bless $self,$sockclass;
103		$self->configure({ %$args, PeerAddr => $phost, PeerPort => $pport }) or do {
104		$@ = "connect to proxy $phost port $pport failed";
105		return;
106		};
107		print $self "CONNECT $host:$port HTTP/1.0\r\n$auth\r\n";
108		my $hdr = '';
109		while (<$self>) {
110		$hdr .= $_;
111		last if $_ eq "\n" or $_ eq "\r\n";
112		}
113		if ( $hdr !~m{\AHTTP/1.\d 2\d\d} ) {
114		# error
115		$@ = "non 2xx response to CONNECT: $hdr";
116		return;
117		}
118
119		# and upgrade self by calling start_SSL
120		$ssl_class->start_SSL( $self,
121		SSL_verifycn_name => $host,
122		%$args
123		) or do {
124		$@ = "start SSL failed: $SSL_ERROR";
125		return;
126		};
127		return $self;
	131	print $self "CONNECT $host:$port HTTP/1.0\r\n$auth\r\n";
	132	my $hdr = '';
	133	while (<$self>) {
	134	$hdr .= $_;
	135	last if $_ eq "\n" or $_ eq "\r\n";
	136	}
	137	if ( $hdr !~m{\AHTTP/1.\d 2\d\d} ) {
	138	# error
	139	$@ = "non 2xx response to CONNECT: $hdr";
	140	return;
	141	}
	142
	143	# and upgrade self by calling start_SSL
	144	$ssl_class->start_SSL( $self,
	145	SSL_verifycn_name => $host,
	146	%$args
	147	) or do {
	148	$@ = "start SSL failed: $SSL_ERROR";
	149	return;
128	150	};
	151	return $self;
	152	};
129	153	}
130	154
131	155	1;

135	159	Net::SSLGlue::LWP - proper certificate checking for https in LWP
136	160
137	161	=head1 SYNOPSIS
138
139		use Net::SSLGlue::LWP SSL_ca_path => ...;
140		use LWP::Simple;
141		get( 'https://www....' );
142
143		{
144		local %Net::SSLGlue::LWP::SSLopts = %Net::SSLGlue::LWP::SSLopts;
145
146		# switch off verification
147		$Net::SSLGlue::LWP::SSLopts{SSL_verify_mode} = 0;
148
149		# or: set different verification policy, because cert does
150		# not conform to RFC (wildcards in CN are not allowed for https,
151		# but some servers do it anyway)
152		$Net::SSLGlue::LWP::SSLopts{SSL_verifycn_scheme} = {
153		wildcards_in_cn => 'anywhere',
154		check_cn => 'always',
155		};
156		}
	162	u
	163	use Net::SSLGlue::LWP SSL_ca_path => ...;
	164	use LWP::Simple;
	165	get( 'https://www....' );
	166
	167	{
	168	local %Net::SSLGlue::LWP::SSLopts = %Net::SSLGlue::LWP::SSLopts;
	169
	170	# switch off verification
	171	$Net::SSLGlue::LWP::SSLopts{SSL_verify_mode} = 0;
	172
	173	# or: set different verification policy, because cert does
	174	# not conform to RFC (wildcards in CN are not allowed for https,
	175	# but some servers do it anyway)
	176	$Net::SSLGlue::LWP::SSLopts{SSL_verifycn_scheme} = {
	177	wildcards_in_cn => 'anywhere',
	178	check_cn => 'always',
	179	};
	180	}
157	181
158	182
159	183	=head1 DESCRIPTION

163	187	and that L<LWP::Protocol::https> does proper certificate checking using the
164	188	C<http> SSL_verify_scheme from L<IO::Socket::SSL>.
165	189
	190	This module should only be used for older LWP version, see B<Supported LWP
	191	versions> below.
	192
166	193	Because L<LWP> does not have a mechanism to forward arbitrary parameters for
167	194	the construction of the underlying socket these parameters can be set globally
168	195	when including the package, or with local settings of the

191	218
192	219	=back
193	220
	221	=head1 Supported LWP versions
	222
	223	This module should be used for older LWP version only. Starting with version
	224	6.06 it is recommended to use LWP directly. If a recent version is found
	225	Net::SSLGlue::LWP will print out a warning and not monkey patch too much into
	226	LWP (only as much as necessary to still support C<%Net::SSLGlue::LWP::SSLopts>).
	227
194	228	=head1 SEE ALSO
195	229
196	230	IO::Socket::SSL, LWP, Net::HTTPS, LWP::Protocol::https
197	231
198	232	=head1 COPYRIGHT
199	233
200		This module is copyright (c) 2008, Steffen Ullrich.
	234	This module is copyright (c) 2008..2015, Steffen Ullrich.
201	235	All Rights Reserved.
202	236	This module is free software. It may be used, redistributed and/or modified
203	237	under the same terms as Perl itself.

+108

-88

lib/Net/SSLGlue/POP3.pm less more

3	3	package Net::SSLGlue::POP3;
4	4	use IO::Socket::SSL 1.19;
5	5	use Net::POP3;
6		our $VERSION = 0.91;
7
8		##############################################################################
9		# mix starttls method into Net::POP3 which on SSL handshake success
10		# upgrades the class to Net::POP3::_SSLified
11		##############################################################################
12		sub Net::POP3::starttls {
	6	our $VERSION = 0.911;
	7
	8	my $DONT;
	9	BEGIN {
	10	if (defined &Net::POP3::starttls) {
	11	warn "using SSL support of Net::POP3 $Net::POP3::VERSION instead of SSLGlue";
	12	$DONT = 1;
	13	goto DONE;
	14	}
	15
	16	##############################################################################
	17	# mix starttls method into Net::POP3 which on SSL handshake success
	18	# upgrades the class to Net::SSLGlue::POP3::_SSLified
	19	##############################################################################
	20	*Net::POP3::starttls = sub {
13	21	my $self = shift;
14	22	$self->_STLS or return;
15	23	my $host = $self->host;
16	24	# for name verification strip port from domain:port, ipv4:port, [ipv6]:port
17	25	$host =~s{(?<!:):\d+$}{};
18	26
19		Net::POP3::_SSLified->start_SSL( $self,
20		SSL_verify_mode => 1,
21		SSL_verifycn_scheme => 'pop3',
22		SSL_verifycn_name => $host,
23		@_
	27	Net::SSLGlue::POP3::_SSLified->start_SSL( $self,
	28	SSL_verify_mode => 1,
	29	SSL_verifycn_scheme => 'pop3',
	30	SSL_verifycn_name => $host,
	31	@_
24	32	) or return;
25		}
26		sub Net::POP3::_STLS {
	33	};
	34
	35	*Net::POP3::_STLS = sub {
27	36	shift->command("STLS")->response() == Net::POP3::CMD_OK
28		}
29
30		no warnings 'redefine';
31		my $old_new = \&Net::POP3::new;
32		*Net::POP3::new = sub {
	37	};
	38
	39	no warnings 'redefine';
	40	my $old_new = \&Net::POP3::new;
	41	*Net::POP3::new = sub {
33	42	my $class = shift;
34	43	my %arg = @_ % 2 == 0 ? @_ : ( Host => shift,@_ );
35	44	if ( delete $arg{SSL} ) {
36		$arg{Port} \|\|= 995;
37		return Net::POP3::_SSLified->new(%arg);
	45	$arg{Port} \|\|= 995;
	46	return Net::SSLGlue::POP3::_SSLified->new(%arg);
38	47	} else {
39		return $old_new->($class,%arg);
	48	return $old_new->($class,%arg);
40	49	}
41		};
	50	};
	51
	52	DONE:
	53	1;
	54	}
42	55
43	56	##############################################################################
44	57	# Socket class derived from IO::Socket::SSL

46	59	##############################################################################
47	60	our %SSLopts;
48	61	{
49		package Net::POP3::_SSL_Socket;
50		our @ISA = 'IO::Socket::SSL';
51		sub configure_SSL {
52		my ($self,$arg_hash) = @_;
53
54		# set per default strict certificate verification
55		$arg_hash->{SSL_verify_mode} = 1
56		if ! exists $arg_hash->{SSL_verify_mode};
57		$arg_hash->{SSL_verifycn_scheme} = 'pop3'
58		if ! exists $arg_hash->{SSL_verifycn_scheme};
59		$arg_hash->{SSL_verifycn_name} = $self->host
60		if ! exists $arg_hash->{SSL_verifycn_name};
61
62		# force keys from %SSLopts
63		while ( my ($k,$v) = each %SSLopts ) {
64		$arg_hash->{$k} = $v;
65		}
66		return $self->SUPER::configure_SSL($arg_hash)
	62	package Net::SSLGlue::POP3::_SSL_Socket;
	63	goto DONE if $DONT;
	64	our @ISA = 'IO::Socket::SSL';
	65	*configure_SSL = sub {
	66	my ($self,$arg_hash) = @_;
	67
	68	# set per default strict certificate verification
	69	$arg_hash->{SSL_verify_mode} = 1
	70	if ! exists $arg_hash->{SSL_verify_mode};
	71	$arg_hash->{SSL_verifycn_scheme} = 'pop3'
	72	if ! exists $arg_hash->{SSL_verifycn_scheme};
	73	$arg_hash->{SSL_verifycn_name} = $self->host
	74	if ! exists $arg_hash->{SSL_verifycn_name};
	75
	76	# force keys from %SSLopts
	77	while ( my ($k,$v) = each %SSLopts ) {
	78	$arg_hash->{$k} = $v;
67	79	}
	80	return $self->SUPER::configure_SSL($arg_hash)
	81	};
	82
	83	DONE:
	84	1;
68	85	}
69	86
70	87

73	90	# this talks SSL to the peer
74	91	##############################################################################
75	92	{
76		package Net::POP3::_SSLified;
77		use Carp 'croak';
78
79		# deriving does not work because we need to replace a superclass
80		# from Net::POP3, so just copy the class into the new one and then
81		# change it
82
83		# copy subs
84		for ( keys %{Net::POP3::} ) {
85		no strict 'refs';
86		eval { {$Net::POP3::{$_}} && {$Net::POP3::{$_}}{CODE} } or next;
87		*{$_} = \&{ "Net::POP3::$_" };
88		}
89
90		# copy + fix @ISA
91		our @ISA = @Net::POP3::ISA;
92		grep { s{^IO::Socket::INET$}{Net::POP3::_SSL_Socket} } @ISA
93		or die "cannot find and replace IO::Socket::INET superclass";
94
95		# we are already sslified
96		no warnings 'redefine';
97		sub starttls { croak "have already TLS\n" }
98
99		my $old_new = \&new;
100		*Net::POP3::_SSLified::new = sub {
101		my $class = shift;
102		my %arg = @_ % 2 == 0 ? @_ : ( Host => shift,@_ );
103		local %SSLopts;
104		$SSLopts{$_} = delete $arg{$_} for ( grep { /^SSL_/ } keys %arg );
105		return $old_new->($class,%arg);
106		};
107
108		# Net::Cmd getline uses select, but this is not sufficient with SSL
109		# note that this does no EBCDIC etc conversions
110		*Net::POP3::_SSLified::getline = sub {
111		my $self = shift;
112		# skip Net::POP3 getline and go directly to IO::Socket::SSL
113		return $self->IO::Socket::SSL::getline(@_);
114		};
	93	package Net::SSLGlue::POP3::_SSLified;
	94	use Carp 'croak';
	95	goto DONE if $DONT;
	96
	97	# deriving does not work because we need to replace a superclass
	98	# from Net::POP3, so just copy the class into the new one and then
	99	# change it
	100
	101	# copy subs
	102	for ( keys %{Net::POP3::} ) {
	103	no strict 'refs';
	104	*{$_} = \&{ "Net::POP3::$_" } if defined &{ "Net::POP3::$_" };
	105	}
	106
	107	# copy + fix @ISA
	108	our @ISA = @Net::POP3::ISA;
	109	grep { s{^IO::Socket::INET$}{Net::SSLGlue::POP3::_SSL_Socket} } @ISA
	110	or die "cannot find and replace IO::Socket::INET superclass";
	111
	112	# we are already sslified
	113	no warnings 'redefine';
	114	*starttls = sub { croak "have already TLS\n" };
	115
	116	my $old_new = \&new;
	117	*new = sub {
	118	my $class = shift;
	119	my %arg = @_ % 2 == 0 ? @_ : ( Host => shift,@_ );
	120	local %SSLopts;
	121	$SSLopts{$_} = delete $arg{$_} for ( grep { /^SSL_/ } keys %arg );
	122	return $old_new->($class,%arg);
	123	};
	124
	125	# Net::Cmd getline uses select, but this is not sufficient with SSL
	126	# note that this does no EBCDIC etc conversions
	127	*getline = sub {
	128	my $self = shift;
	129	# skip Net::POP3 getline and go directly to IO::Socket::SSL
	130	return $self->IO::Socket::SSL::getline(@_);
	131	};
	132
	133	DONE:
	134	1;
115	135	}
116	136
117	137	1;

122	142
123	143	=head1 SYNOPSIS
124	144
125		use Net::SSLGlue::POP3;
126		my $pop3s = Net::POP3->new( $host,
127		SSL => 1,
128		SSL_ca_path => ...
129		);
130
131		my $pop3 = Net::POP3->new( $host );
132		$pop3->starttls( SSL_ca_path => ... );
	145	use Net::SSLGlue::POP3;
	146	my $pop3s = Net::POP3->new( $host,
	147	SSL => 1,
	148	SSL_ca_path => ...
	149	);
	150
	151	my $pop3 = Net::POP3->new( $host );
	152	$pop3->starttls( SSL_ca_path => ... );
133	153
134	154	=head1 DESCRIPTION
135	155

+105

-84

lib/Net/SSLGlue/SMTP.pm less more

3	3	package Net::SSLGlue::SMTP;
4	4	use IO::Socket::SSL 1.19;
5	5	use Net::SMTP;
6		our $VERSION = 1.0;
7
8		##############################################################################
9		# mix starttls method into Net::SMTP which on SSL handshake success
10		# upgrades the class to Net::SMTP::_SSLified
11		##############################################################################
12		sub Net::SMTP::starttls {
	6	our $VERSION = 1.001;
	7
	8	my $DONT;
	9	BEGIN {
	10	if (defined &Net::SMTP::starttls) {
	11	warn "using SSL support of Net::SMTP $Net::SMTP::VERSION instead of SSLGlue";
	12	$DONT = 1;
	13	goto DONE;
	14	}
	15
	16	##############################################################################
	17	# mix starttls method into Net::SMTP which on SSL handshake success
	18	# upgrades the class to Net::SSLGlue::SMTP::_SSLified
	19	##############################################################################
	20	*Net::SMTP::starttls = sub {
13	21	my $self = shift;
14	22	$self->_STARTTLS or return;
15	23	my $host = $self->host;
16	24	# for name verification strip port from domain:port, ipv4:port, [ipv6]:port
17	25	$host =~s{(?<!:):\d+$}{};
18	26
19		Net::SMTP::_SSLified->start_SSL( $self,
20		SSL_verify_mode => 1,
21		SSL_verifycn_scheme => 'smtp',
22		SSL_verifycn_name => $host,
23		@_
	27	Net::SSLGlue::SMTP::_SSLified->start_SSL( $self,
	28	SSL_verify_mode => 1,
	29	SSL_verifycn_scheme => 'smtp',
	30	SSL_verifycn_name => $host,
	31	@_
24	32	) or return;
25	33
26	34	# another hello after starttls to read new ESMTP capabilities
27	35	return $self->hello(${*$self}{net_smtp_hello_domain});
28		}
29		sub Net::SMTP::_STARTTLS {
	36	};
	37
	38	*Net::SMTP::_STARTTLS = sub {
30	39	shift->command("STARTTLS")->response() == Net::SMTP::CMD_OK
31		}
32
33		no warnings 'redefine';
34		my $old_new = \&Net::SMTP::new;
35		*Net::SMTP::new = sub {
	40	};
	41
	42	no warnings 'redefine';
	43	my $old_new = \&Net::SMTP::new;
	44	*Net::SMTP::new = sub {
36	45	my $class = shift;
37	46	my %arg = @_ % 2 == 0 ? @_ : ( Host => shift,@_ );
38	47	if ( delete $arg{SSL} ) {
39		$arg{Port} \|\|= 465;
40		return Net::SMTP::_SSLified->new(%arg);
	48	$arg{Port} \|\|= 465;
	49	return Net::SSLGlue::SMTP::_SSLified->new(%arg);
41	50	} else {
42		return $old_new->($class,%arg);
	51	return $old_new->($class,%arg);
43	52	}
44		};
45
46		my $old_hello = \&Net::SMTP::hello;
47		*Net::SMTP::hello = sub {
	53	};
	54
	55	my $old_hello = \&Net::SMTP::hello;
	56	*Net::SMTP::hello = sub {
48	57	my ($self,$domain) = @_;
49	58	${*$self}{net_smtp_hello_domain} = $domain if $domain;
50	59	goto &$old_hello;
51		};
	60	};
	61
	62	DONE:
	63	1;
	64	}
52	65
53	66	##############################################################################
54	67	# Socket class derived from IO::Socket::SSL

56	69	##############################################################################
57	70	our %SSLopts;
58	71	{
59		package Net::SMTP::_SSL_Socket;
60		our @ISA = 'IO::Socket::SSL';
61		sub configure_SSL {
62		my ($self,$arg_hash) = @_;
63
64		# set per default strict certificate verification
65		$arg_hash->{SSL_verify_mode} = 1
66		if ! exists $arg_hash->{SSL_verify_mode};
67		$arg_hash->{SSL_verifycn_scheme} = 'smtp'
68		if ! exists $arg_hash->{SSL_verifycn_scheme};
69		$arg_hash->{SSL_verifycn_name} = $self->host
70		if ! exists $arg_hash->{SSL_verifycn_name};
71
72		# force keys from %SSLopts
73		while ( my ($k,$v) = each %SSLopts ) {
74		$arg_hash->{$k} = $v;
75		}
76		return $self->SUPER::configure_SSL($arg_hash)
	72	package Net::SSLGlue::SMTP::_SSL_Socket;
	73	goto DONE if $DONT;
	74	our @ISA = 'IO::Socket::SSL';
	75	*configure_SSL = sub {
	76	my ($self,$arg_hash) = @_;
	77
	78	# set per default strict certificate verification
	79	$arg_hash->{SSL_verify_mode} = 1
	80	if ! exists $arg_hash->{SSL_verify_mode};
	81	$arg_hash->{SSL_verifycn_scheme} = 'smtp'
	82	if ! exists $arg_hash->{SSL_verifycn_scheme};
	83	$arg_hash->{SSL_verifycn_name} = $self->host
	84	if ! exists $arg_hash->{SSL_verifycn_name};
	85
	86	# force keys from %SSLopts
	87	while ( my ($k,$v) = each %SSLopts ) {
	88	$arg_hash->{$k} = $v;
77	89	}
	90	return $self->SUPER::configure_SSL($arg_hash)
	91	};
	92
	93	DONE:
	94	1;
78	95	}
79	96
80	97
81	98	##############################################################################
82		# Net::SMTP derived from Net::SMTP::_SSL_Socket instead of IO::Socket::INET
	99	# Net::SMTP derived from Net::SSLGlue::SMTP::_SSL_Socket instead of IO::Socket::INET
83	100	# this talks SSL to the peer
84	101	##############################################################################
85	102	{
86		package Net::SMTP::_SSLified;
87		use Carp 'croak';
88
89		# deriving does not work because we need to replace a superclass
90		# from Net::SMTP, so just copy the class into the new one and then
91		# change it
92
93		# copy subs
94		for ( keys %{Net::SMTP::} ) {
95		no strict 'refs';
96		{$_} = \&{ "Net::SMTP::$_" } if {$Net::SMTP::{$_}}{CODE};
97		}
98
99		# copy + fix @ISA
100		our @ISA = @Net::SMTP::ISA;
101		grep { s{^IO::Socket::INET$}{Net::SMTP::_SSL_Socket} } @ISA
102		or die "cannot find and replace IO::Socket::INET superclass";
103
104		# we are already sslified
105		no warnings 'redefine';
106		sub starttls { croak "have already TLS\n" }
107
108		my $old_new = \&new;
109		*Net::SMTP::_SSLified::new = sub {
110		my $class = shift;
111		my %arg = @_ % 2 == 0 ? @_ : ( Host => shift,@_ );
112		local %SSLopts;
113		$SSLopts{$_} = delete $arg{$_} for ( grep { /^SSL_/ } keys %arg );
114		return $old_new->($class,%arg);
115		};
	103	package Net::SSLGlue::SMTP::_SSLified;
	104	use Carp 'croak';
	105	goto DONE if $DONT;
	106
	107	# deriving does not work because we need to replace a superclass
	108	# from Net::SMTP, so just copy the class into the new one and then
	109	# change it
	110
	111	# copy subs
	112	for ( keys %{Net::SMTP::} ) {
	113	no strict 'refs';
	114	*{$_} = \&{ "Net::SMTP::$_" } if defined &{ "Net::SMTP::$_" };
	115	}
	116
	117	# copy + fix @ISA
	118	our @ISA = @Net::SMTP::ISA;
	119	grep { s{^IO::Socket::INET$}{Net::SSLGlue::SMTP::_SSL_Socket} } @ISA
	120	or die "cannot find and replace IO::Socket::INET superclass";
	121
	122	# we are already sslified
	123	no warnings 'redefine';
	124	*starttls = sub { croak "have already TLS\n" };
	125
	126	my $old_new = \&new;
	127	*new = sub {
	128	my $class = shift;
	129	my %arg = @_ % 2 == 0 ? @_ : ( Host => shift,@_ );
	130	local %SSLopts;
	131	$SSLopts{$_} = delete $arg{$_} for ( grep { /^SSL_/ } keys %arg );
	132	return $old_new->($class,%arg);
	133	};
	134
	135	DONE:
	136	1;
116	137	}
117	138
118	139	1;

123	144
124	145	=head1 SYNOPSIS
125	146
126		use Net::SSLGlue::SMTP;
127		my $smtp_ssl = Net::SMTP->new( $host,
128		SSL => 1,
129		SSL_ca_path => ...
130		);
131
132		my $smtp_plain = Net::SMTP->new( $host );
133		$smtp_plain->starttls( SSL_ca_path => ... );
	147	use Net::SSLGlue::SMTP;
	148	my $smtp_ssl = Net::SMTP->new( $host,
	149	SSL => 1,
	150	SSL_ca_path => ...
	151	);
	152
	153	my $smtp_plain = Net::SMTP->new( $host );
	154	$smtp_plain->starttls( SSL_ca_path => ... );
134	155
135	156	=head1 DESCRIPTION
136	157

-2

lib/Net/SSLGlue.pm less more

0	0	package Net::SSLGlue;
1		our $VERSION = '1.052';
	1	our $VERSION = '1.054';
2	2
3	3	=head1 NAME
4	4

24	24
25	25	=item Net::LDAP - add proper certificate checking
26	26
27		=item LWP - add proper certificate checking
	27	=item LWP - add proper certificate checking for older LWP versions
28	28
29	29	=back
30	30

-4

t/external/03_lwp.t less more

14	14	use LWP::Simple;
15	15
16	16	my $goodhost = 'google.de';
17		# this does not work any longer - will be skipped in test
18		my $badhost = 'www.fedora.org';
	17	my $badhost = 'badcert.maulwuff.de';
19	18
20	19	my $capath = '/etc/ssl/certs/'; # unix?
21	20	-d $capath or do {

60	59	if ( IO::Socket::SSL->start_SSL( $sock,
61	60	SSL_ca_path => $capath,
62	61	SSL_verify_mode => 1,
	62	SSL_verifycn_scheme => 'http',
	63	SSL_verifycn_name => $badhost,
63	64	)) {
64	65	diag("certificate for $badhost unexpectly correct");
65	66	$badhost = undef;

83	84	if ( $badhost ) {
84	85	# $badhost -> should fail
85	86	diag("connecting to $badhost:443 with LWP");
86		$content = get( 'https://$badhost' );
	87	$content = get( "https://$badhost" );
87	88	print $content ? "not ok # lwp ssl connect $badhost should fail\n": "ok\n";
88	89
89	90	# $badhost -> should succeed if verify mode is 0
90	91	{
91	92	local %Net::SSLGlue::LWP::SSLopts = %Net::SSLGlue::LWP::SSLopts;
92	93	$Net::SSLGlue::LWP::SSLopts{SSL_verify_mode} = 0;
93		$content = get( 'https://$badhost' );
	94	$content = get( "https://$badhost" );
94	95	print $content ? "ok\n": "not ok # lwp ssl $badhost w/o ssl verify\n";
95	96	}
96	97	}

+30

-30

t/external/05_ftp.t less more

2	2	use warnings;
3	3	use Test::More;
4	4
5		my $server = 'ftp.rebex.net';
	5	my $server = 'test.rebex.net';
6	6	my $debug = 0;
7	7
8	8	BEGIN {

27	27	# ssl to the right host
28	28	diag( "connect inet to $server:990" );
29	29	my $sock = IO::Socket::INET->new( "$server:990") or do {
30		plan skip_all => "$server:999 not reachable";
	30	plan skip_all => "$server:990 not reachable";
31	31	};
32	32
33	33	# now we need CAs

38	38
39	39	diag( "upgrade to ssl $server:990" );
40	40	IO::Socket::SSL->start_SSL($sock,
41		%sslargs,
42	41	SSL_verify_mode => 1,
43	42	SSL_verifycn_name => $server,
44		SSL_verifycn_scheme => 'ftp'
	43	SSL_verifycn_scheme => 'ftp',
	44	%sslargs,
45	45	) or do {
46		plan skip_all => "$server:999 not upgradable to SSL: $SSL_ERROR";
	46	plan skip_all => "$server:990 not upgradable to SSL: $SSL_ERROR";
47	47	};
48	48
49	49	plan tests => 9;

66	66	ok(~~$ftp->ls,"directory listing clear");
67	67
68	68	# then TLS upgrade inside plain connection
69		$ftp = Net::FTP->new($server, Passive => 1, Debug => $debug);
	69	$ftp = Net::FTP->new($server, Passive => 1, Debug => $debug, %sslargs);
70	70	ok($ftp,"ftp plain connect $server");
71		my $ok = $ftp->starttls(%sslargs);
	71	my $ok = $ftp->starttls();
72	72	ok($ok,"ssl upgrade");
73	73	$ftp->login("anonymous",'net-sslglue-ftp@test.perl')
74	74	or die "login to $server failed";

83	83
84	84
85	85	__DATA__
86		# Subject: C=IL, O=StartCom Ltd., OU=Secure Digital Certificate Signing, CN=StartCom Class 1 Primary Intermediate Server CA
	86	# Subject: C=IL, O=StartCom Ltd., OU=Secure Digital Certificate Signing, CN=StartCom Class 2 Primary Intermediate Server CA
87	87	# Issuer: C=IL, O=StartCom Ltd., OU=Secure Digital Certificate Signing, CN=StartCom Certification Authority
88	88	-----BEGIN CERTIFICATE-----
89		MIIGNDCCBBygAwIBAgIBGDANBgkqhkiG9w0BAQUFADB9MQswCQYDVQQGEwJJTDEW
	89	MIIGNDCCBBygAwIBAgIBGjANBgkqhkiG9w0BAQUFADB9MQswCQYDVQQGEwJJTDEW
90	90	MBQGA1UEChMNU3RhcnRDb20gTHRkLjErMCkGA1UECxMiU2VjdXJlIERpZ2l0YWwg
91	91	Q2VydGlmaWNhdGUgU2lnbmluZzEpMCcGA1UEAxMgU3RhcnRDb20gQ2VydGlmaWNh
92		dGlvbiBBdXRob3JpdHkwHhcNMDcxMDI0MjA1NDE3WhcNMTcxMDI0MjA1NDE3WjCB
	92	dGlvbiBBdXRob3JpdHkwHhcNMDcxMDI0MjA1NzA5WhcNMTcxMDI0MjA1NzA5WjCB
93	93	jDELMAkGA1UEBhMCSUwxFjAUBgNVBAoTDVN0YXJ0Q29tIEx0ZC4xKzApBgNVBAsT
94	94	IlNlY3VyZSBEaWdpdGFsIENlcnRpZmljYXRlIFNpZ25pbmcxODA2BgNVBAMTL1N0
95		YXJ0Q29tIENsYXNzIDEgUHJpbWFyeSBJbnRlcm1lZGlhdGUgU2VydmVyIENBMIIB
96		IjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEAtonGrO8JUngHrJJj0PREGBiE
97		gFYfka7hh/oyULTTRwbw5gdfcA4Q9x3AzhA2NIVaD5Ksg8asWFI/ujjo/OenJOJA
98		pgh2wJJuniptTT9uYSAK21ne0n1jsz5G/vohURjXzTCm7QduO3CHtPn66+6CPAVv
99		kvek3AowHpNz/gfK11+AnSJYUq4G2ouHI2mw5CrY6oPSvfNx23BaKA+vWjhwRRI/
100		ME3NO68X5Q/LoKldSKqxYVDLNM08XMML6BDAjJvwAwNi/rJsPnIO7hxDKslIDlc5
101		xDEhyBDBLIf+VJVSH1I8MRKbf+fAoKVZ1eKPPvDVqOHXcDGpxLPPr21TLwb0pwID
	95	YXJ0Q29tIENsYXNzIDIgUHJpbWFyeSBJbnRlcm1lZGlhdGUgU2VydmVyIENBMIIB
	96	IjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA4k85L6GMmoWtCA4IPlfyiAEh
	97	G5SpbOK426oZGEY6UqH1D/RujOqWjJaHeRNAUS8i8gyLhw9l33F0NENVsTUJm9m8
	98	H/rrQtCXQHK3Q5Y9upadXVACHJuRjZzArNe7LxfXyz6CnXPrB0KSss1ks3RVG7RL
	99	hiEs93iHMuAW5Nq9TJXqpAp+tgoNLorPVavD5d1Bik7mb2VsskDPF125w2oLJxGE
	100	d2H2wnztwI14FBiZgZl1Y7foU9O6YekO+qIw80aiuckfbIBaQKwn7UhHM7BUxkYa
	101	8zVhwQIpkFR+ZE3EMFICgtffziFuGJHXuKuMJxe18KMBL47SLoc6PbQpZ4rEAwID
102	102	AQABo4IBrTCCAakwDwYDVR0TAQH/BAUwAwEB/zAOBgNVHQ8BAf8EBAMCAQYwHQYD
103		VR0OBBYEFOtCNNCYsKuf9BtrCPfMZC7vDixFMB8GA1UdIwQYMBaAFE4L7xqkQFul
	103	VR0OBBYEFBHbI0X9VMxqcW+EigPXvvcBLyaGMB8GA1UdIwQYMBaAFE4L7xqkQFul
104	104	F2mHMMo0aEPQQa7yMGYGCCsGAQUFBwEBBFowWDAnBggrBgEFBQcwAYYbaHR0cDov
105	105	L29jc3Auc3RhcnRzc2wuY29tL2NhMC0GCCsGAQUFBzAChiFodHRwOi8vd3d3LnN0
106	106	YXJ0c3NsLmNvbS9zZnNjYS5jcnQwWwYDVR0fBFQwUjAnoCWgI4YhaHR0cDovL3d3

108	108	c3NsLmNvbS9zZnNjYS5jcmwwgYAGA1UdIAR5MHcwdQYLKwYBBAGBtTcBAgEwZjAu
109	109	BggrBgEFBQcCARYiaHR0cDovL3d3dy5zdGFydHNzbC5jb20vcG9saWN5LnBkZjA0
110	110	BggrBgEFBQcCARYoaHR0cDovL3d3dy5zdGFydHNzbC5jb20vaW50ZXJtZWRpYXRl
111		LnBkZjANBgkqhkiG9w0BAQUFAAOCAgEAIQlJPqWIbuALi0jaMU2P91ZXouHTYlfp
112		tVbzhUV1O+VQHwSL5qBaPucAroXQ+/8gA2TLrQLhxpFy+KNN1t7ozD+hiqLjfDen
113		xk+PNdb01m4Ge90h2c9W/8swIkn+iQTzheWq8ecf6HWQTd35RvdCNPdFWAwRDYSw
114		xtpdPvkBnufh2lWVvnQce/xNFE+sflVHfXv0pQ1JHpXo9xLBzP92piVH0PN1Nb6X
115		t1gW66pceG/sUzCv6gRNzKkC4/C2BBL2MLERPZBOVmTX3DxDX3M570uvh+v2/miI
116		RHLq0gfGabDBoYvvF0nXYbFFSF87ICHpW7LM9NfpMfULFWE7epTj69m8f5SuauNi
117		YpaoZHy4h/OZMn6SolK+u/hlz8nyMPyLwcKmltdfieFcNID1j0cHL7SRv7Gifl9L
118		WtBbnySGBVFaaQNlQ0lxxeBvlDRr9hvYqbBMflPrj0jfyjO1SPo2ShpTpjMM0InN
119		SRXNiTE8kMBy12VLUjWKRhFEuT2OKGWmPnmeXAhEKa2wNREuIU640ucQPl2Eg7PD
120		wuTSxv0JS3QJ3fGz0xk+gA2iCxnwOOfFwq/iI9th4p1cbiCJSS4jarJiwUW0n6+L
121		p/EiO/h94pDQehn7Skzj0n1fSoMD7SfWI55rjbRZotnvbIIp3XUZPD9MEI3vu3Un
122		0q6Dp6jOW6c=
	111	LnBkZjANBgkqhkiG9w0BAQUFAAOCAgEAnQfh7pB2MWcWRXCMy4SLS1doRKWJwfJ+
	112	yyiL9edwd9W29AshYKWhdHMkIoDW2LqNomJdCTVCKfs5Y0ULpLA4Gmj0lRPM4EOU
	113	7Os5GuxXKdmZbfWEzY5zrsncavqenRZkkwjHHMKJVJ53gJD2uSl26xNnSFn4Ljox
	114	uMnTiOVfTtIZPUOO15L/zzi24VuKUx3OrLR2L9j3QGPV7mnzRX2gYsFhw3XtsntN
	115	rCEnME5ZRmqTF8rIOS0Bc2Vb6UGbERecyMhK76F2YC2uk/8M1TMTn08Tzt2G8fz4
	116	NVQVqFvnhX76Nwn/i7gxSZ4Nbt600hItuO3Iw/G2QqBMl3nf/sOjn6H0bSyEd6Si
	117	BeEX/zHdmvO4esNSwhERt1Axin/M51qJzPeGmmGSTy+UtpjHeOBiS0N9PN7WmrQQ
	118	oUCcSyrcuNDUnv3xhHgbDlePaVRCaHvqoO91DweijHOZq1X1BwnSrzgDapADDC+P
	119	4uhDwjHpb62H5Y29TiyJS1HmnExUdsASgVOb7KD8LJzaGJVuHjgmQid4YAjff20y
	120	6NjAbx/rJnWfk/x7G/41kNxTowemP4NVCitOYoIlzmYwXSzg+RkbdbmdmFamgyd6
	121	0Y+NWZP8P3PXLrQsldiL98l+x/ydrHIEH9LMF/TtNGCbnkqXBP7dcg5XVFEGcE3v
	122	qhykguAzx/Q=
123	123	-----END CERTIFICATE-----
124	124	# Subject: C=IL, O=StartCom Ltd., OU=Secure Digital Certificate Signing, CN=StartCom Certification Authority
125	125	# Issuer: C=IL, O=StartCom Ltd., OU=Secure Digital Certificate Signing, CN=StartCom Certification Authority