LWP-Protocol-https-6.07/000755 000765 000024 00000000000 13052453766 015146 5ustar00olafstaff000000 000000 LWP-Protocol-https-6.07/Changes000644 000765 000024 00000003263 13052453541 016434 0ustar00olafstaff000000 000000 Release history for LWP-Protocol-https 6.07 2017-02-19 - Cleaned up the Changes log - Explicitly add hostname for SNI to start_SSL (GH PR#17) - Fix the license name - Update some documentation on SSL args - Fix bug when checking for Mozilla::CA (GH PR#29) 6.06 2014-04-18 - Merge pull request #12 from drieux/subjectAltName - Merge pull request #9 from chorny/master - Updated libwww requirement to 6.06 to fix failing t/proxy.t test cases. - Getopt::Long isn't actually used - Merge pull request #7 from noxxi/master - better diagnostics in case of failures in apache.t - Merge pull request #8 from cpansprout/patch-1 - correct behavior for https_proxy, this goes together with change to - libwww-perl cb80c2ddb7, new method _upgrade_sock in LWP::Protocol::https - Typo fix: envirionment =~ s/io/o/ - support for subjectAltName 6.04 2013-04-29 - Fix IO::Socket::SSL warnings when not verifying hostname. - Doc spelling fix. 6.03 2012-02-18 - Skip test if offline [RT#74163] - Typo fixes - Restore perl-5.8.1 compatibility. 6.02 2011-03-27 - Initial release of LWP-Protocol-https as a separate distribution. There are no code changes besides setting the version number since libwww-perl-6.01. - The LWP::Protocol::https module used to be bundled with the libwww-perl distribution, but it was unbundled in v6.02 in order to be able to declare its dependencies properly for the CPAN tool chain. Applications that need https support can just declare their dependency on LWP::Protocol::https and will no longer need to know what underlying modules to install. LWP-Protocol-https-6.07/lib/000755 000765 000024 00000000000 13052453766 015714 5ustar00olafstaff000000 000000 LWP-Protocol-https-6.07/Makefile.PL000644 000765 000024 00000005144 12735173705 017123 0ustar00olafstaff000000 000000 #!perl -w require 5.008001; use strict; use ExtUtils::MakeMaker; my $developer = -f '.gitignore'; ExtUtils::MakeMaker->VERSION(6.98) if $developer; my %WriteMakefileArgs = ( NAME => 'LWP::Protocol::https', VERSION_FROM => 'lib/LWP/Protocol/https.pm', ABSTRACT_FROM => 'lib/LWP/Protocol/https.pm', AUTHOR => 'Gisle Aas ', LICENSE => 'perl_5', META_ADD => { prereqs => { configure => { requires => { 'ExtUtils::MakeMaker' => '0', }, }, runtime => { requires => { 'LWP::UserAgent' => '6.06', 'Net::HTTPS' => 6, 'IO::Socket::SSL' => "1.54", 'Mozilla::CA' => "20110101", 'perl' => '5.008001', }, }, test => { requires => { 'Test::More' => '0', 'Test::RequiresInternet' => 0, }, }, }, }, META_MERGE => { resources => { repository => 'http://github.com/libwww-perl/lwp-protocol-https', MailingList => 'mailto:libwww@perl.org', } }, ); my $eumm_version = eval $ExtUtils::MakeMaker::VERSION; for (qw(configure build test runtime)) { my $key = $_ eq 'runtime' ? 'PREREQ_PM' : uc $_.'_REQUIRES'; next unless exists $WriteMakefileArgs{META_ADD}{prereqs}{$_} or exists $WriteMakefileArgs{$key}; my $r = $WriteMakefileArgs{$key} = { %{$WriteMakefileArgs{META_ADD}{prereqs}{$_}{requires} || {}}, %{delete $WriteMakefileArgs{$key} || {}}, }; defined $r->{$_} or delete $r->{$_} for keys %$r; } # dynamic prereqs get added here. $WriteMakefileArgs{MIN_PERL_VERSION} = delete $WriteMakefileArgs{PREREQ_PM}{perl} || 0; die 'attention developer: you need to do a sane meta merge here!' if keys %{$WriteMakefileArgs{BUILD_REQUIRES}}; $WriteMakefileArgs{BUILD_REQUIRES} = { %{$WriteMakefileArgs{BUILD_REQUIRES} || {}}, %{delete $WriteMakefileArgs{TEST_REQUIRES}} } if $eumm_version < 6.63_03; $WriteMakefileArgs{PREREQ_PM} = { %{$WriteMakefileArgs{PREREQ_PM}}, %{delete $WriteMakefileArgs{BUILD_REQUIRES}} } if $eumm_version < 6.55_01; delete $WriteMakefileArgs{CONFIGURE_REQUIRES} if $eumm_version < 6.51_03; delete $WriteMakefileArgs{MIN_PERL_VERSION} if $eumm_version < 6.48; delete @WriteMakefileArgs{qw(META_ADD META_MERGE)} if $eumm_version < 6.46; delete $WriteMakefileArgs{LICENSE} if $eumm_version < 6.31; WriteMakefile(%WriteMakefileArgs); LWP-Protocol-https-6.07/MANIFEST000644 000765 000024 00000000544 13052453766 016302 0ustar00olafstaff000000 000000 Changes History of this package MANIFEST This file Makefile.PL Makefile generator README lib/LWP/Protocol/https.pm Access with HTTP/1.1 protocol over SSL t/apache.t t/https_proxy.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) LWP-Protocol-https-6.07/META.json000644 000765 000024 00000002526 13052453766 016574 0ustar00olafstaff000000 000000 { "abstract" : "Provide https support for LWP::UserAgent", "author" : [ "Gisle Aas " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150005", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "LWP-Protocol-https", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : {} }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "IO::Socket::SSL" : "1.54", "LWP::UserAgent" : "6.06", "Mozilla::CA" : "20110101", "Net::HTTPS" : "6", "perl" : "5.008001" } }, "test" : { "requires" : { "Test::More" : "0", "Test::RequiresInternet" : "0" } } }, "release_status" : "stable", "resources" : { "repository" : { "url" : "http://github.com/libwww-perl/lwp-protocol-https" }, "x_MailingList" : "mailto:libwww@perl.org" }, "version" : "6.07", "x_serialization_backend" : "JSON::PP version 2.27300" } LWP-Protocol-https-6.07/META.yml000644 000765 000024 00000001444 13052453766 016422 0ustar00olafstaff000000 000000 --- abstract: 'Provide https support for LWP::UserAgent' author: - 'Gisle Aas ' build_requires: Test::More: '0' Test::RequiresInternet: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150005' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: LWP-Protocol-https no_index: directory: - t - inc requires: IO::Socket::SSL: '1.54' LWP::UserAgent: '6.06' Mozilla::CA: '20110101' Net::HTTPS: '6' perl: '5.008001' resources: MailingList: mailto:libwww@perl.org repository: http://github.com/libwww-perl/lwp-protocol-https version: '6.07' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' LWP-Protocol-https-6.07/README000644 000765 000024 00000003150 12735173705 016024 0ustar00olafstaff000000 000000 ###################################################################### LWP::Protocol::https 6.06 ###################################################################### NAME LWP::Protocol::https - Provide https support for LWP::UserAgent SYNOPSIS use LWP::UserAgent; $ua = LWP::UserAgent->new(ssl_opts => { verify_hostname => 1 }); $res = $ua->get("https://www.example.com"); DESCRIPTION The LWP::Protocol::https module provides support for using https schemed URLs with LWP. This module is a plug-in to the LWP protocol handling, so you don't use it directly. Once the module is installed LWP is able to access sites using HTTP over SSL/TLS. If hostname verification is requested by LWP::UserAgent's "ssl_opts", and neither "SSL_ca_file" nor "SSL_ca_path" is set, then "SSL_ca_file" is implied to be the one provided by Mozilla::CA. If the Mozilla::CA module isn't available SSL requests will fail. Either install this module, set up an alternative "SSL_ca_file" or disable hostname verification. This module used to be bundled with the libwww-perl, but it was unbundled in v6.02 in order to be able to declare its dependencies properly for the CPAN tool-chain. Applications that need https support can just declare their dependency on LWP::Protocol::https and will no longer need to know what underlying modules to install. SEE ALSO IO::Socket::SSL, Crypt::SSLeay, Mozilla::CA COPYRIGHT Copyright 1997-2011 Gisle Aas. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. LWP-Protocol-https-6.07/t/000755 000765 000024 00000000000 13052453766 015411 5ustar00olafstaff000000 000000 LWP-Protocol-https-6.07/t/apache.t000644 000765 000024 00000001240 12735173705 017013 0ustar00olafstaff000000 000000 #!perl -w use strict; use Test::More; use Test::RequiresInternet 'www.apache.org' => 443; use LWP::UserAgent; my $ua = LWP::UserAgent->new( ssl_opts => {verify_hostname => 0} ); plan tests => 5; my $res = $ua->simple_request(HTTP::Request->new(GET => "https://www.apache.org")); ok($res->is_success); my $h = $res->header( 'X-Died' ); is($h, undef, "no X-Died header"); like($res->content, qr/Apache Software Foundation/); # test for RT #81948 my $warn = ''; $SIG{__WARN__} = sub { $warn = shift }; $res = $ua->simple_request(HTTP::Request->new(GET => "https://www.apache.org")); ok($res->is_success); is($warn, '', "no warning seen"); $res->dump(prefix => "# "); LWP-Protocol-https-6.07/t/https_proxy.t000644 000765 000024 00000023474 12735173705 020212 0ustar00olafstaff000000 000000 #!/usr/bin/perl # to run test with Net::SSL as backend set environment # PERL_NET_HTTPS_SSL_SOCKET_CLASS=Net::SSL use strict; use warnings; use Test::More; use File::Temp 'tempfile'; use IO::Socket::INET; use IO::Select; use Socket 'MSG_PEEK'; use LWP::UserAgent; use LWP::Protocol::https; plan skip_all => "fork not implemented on this platform" if grep { $^O =~m{$_} } qw( MacOS VOS vmesa riscos amigaos ); eval { require IO::Socket::SSL } and $IO::Socket::SSL::VERSION >= 1.953 and eval { require IO::Socket::SSL::Utils } or plan skip_all => "no recent version of IO::Socket::SSL::Utils"; IO::Socket::SSL::Utils->import; # create CA ------------------------------------------------------------- my ($cacert,$cakey) = CERT_create( CA => 1 ); my $cafile = do { my ($fh,$fname) = tempfile( CLEANUP => 1 ); print $fh PEM_cert2string($cacert); $fname }; # create two web servers ------------------------------------------------ my (@server,@saddr); for my $i (0,1) { my $server = IO::Socket::INET->new( LocalAddr => '127.0.0.1', LocalPort => 0, # let system pick port Listen => 10 ) or die "failed to create INET listener"; my $saddr = $server->sockhost.':'.$server->sockport; $server[$i] = $server; $saddr[$i] = $saddr; } my @childs; END { kill 9,@childs if @childs }; defined( my $pid = fork()) or die "fork failed: $!"; # child process runs _server and exits if ( ! $pid ) { @childs = (); exit( _server()); } # parent continues with closed server sockets push @childs,$pid; @server = (); # check which SSL implementation Net::HTTPS uses # Net::SSL behaves different than the default IO::Socket::SSL my $netssl = $Net::HTTPS::SSL_SOCKET_CLASS eq 'Net::SSL'; # do some tests ---------------------------------------------------------- my %ua; $ua{noproxy} = LWP::UserAgent->new( keep_alive => 10, # size of connection cache # server does not know the expected name and returns generic certificate ssl_opts => { verify_hostname => 0 } ); $ua{proxy} = LWP::UserAgent->new( keep_alive => 10, # size of connection cache ssl_opts => { # Net::SSL cannot verify hostnames :( verify_hostname => $netssl ? 0: 1, SSL_ca_file => $cafile } ); $ua{proxy_nokeepalive} = LWP::UserAgent->new( keep_alive => 0, ssl_opts => { # Net::SSL cannot verify hostnames :( verify_hostname => $netssl ? 0: 1, SSL_ca_file => $cafile } ); $ENV{http_proxy} = $ENV{https_proxy} = "http://foo:bar\@$saddr[0]"; $ua{proxy}->env_proxy; $ua{proxy_nokeepalive}->env_proxy; if ($netssl) { # Net::SSL cannot get user/pass from proxy url $ENV{HTTPS_PROXY_USERNAME} = 'foo'; $ENV{HTTPS_PROXY_PASSWORD} = 'bar'; } my @tests = ( # the expected ids are connid.reqid[tunnel_auth][req_auth]@sslhost # because we run different sets of test depending on the SSL class # used by Net::HTTPS we replace connid with a letter and later # match it to a number # keep-alive for non-proxy http # requests to same target use same connection, even if intermixed [ 'noproxy', "http://$saddr[0]/foo",'A.1@nossl' ], [ 'noproxy', "http://$saddr[0]/bar",'A.2@nossl' ], # reuse conn#1 [ 'noproxy', "http://$saddr[1]/foo",'B.1@nossl' ], [ 'noproxy', "http://$saddr[1]/bar",'B.2@nossl' ], # reuse conn#2 [ 'noproxy', "http://$saddr[0]/tor",'A.3@nossl' ], # reuse conn#1 again [ 'noproxy', "http://$saddr[1]/tor",'B.3@nossl' ], # reuse conn#2 again # keep-alive for proxy http # use the same proxy connection for all even if the target host differs [ 'proxy', "http://foo/foo",'C.1.auth@nossl' ], [ 'proxy', "http://foo/bar",'C.2.auth@nossl' ], [ 'proxy', "http://bar/foo",'C.3.auth@nossl' ], [ 'proxy', "http://bar/bar",'C.4.auth@nossl' ], [ 'proxy', "http://foo/tor",'C.5.auth@nossl' ], [ 'proxy', "http://bar/tor",'C.6.auth@nossl' ], # keep-alive for non-proxy https # requests to same target use same connection, even if intermixed [ 'noproxy', "https://$saddr[0]/foo",'D.1@direct.ssl.access' ], [ 'noproxy', "https://$saddr[0]/bar",'D.2@direct.ssl.access' ], [ 'noproxy', "https://$saddr[1]/foo",'E.1@direct.ssl.access' ], [ 'noproxy', "https://$saddr[1]/bar",'E.2@direct.ssl.access' ], [ 'noproxy', "https://$saddr[0]/tor",'D.3@direct.ssl.access' ], [ 'noproxy', "https://$saddr[1]/tor",'E.3@direct.ssl.access' ], # keep-alive for proxy https ! $netssl ? ( # note that we reuse proxy conn#C in first request. Although the last id # from this conn was C.6 the new one is C.8, because request C.7 was the # socket upgrade via CONNECT request [ 'proxy', "https://foo/foo",'C.8.Tauth@foo' ], [ 'proxy', "https://foo/bar",'C.9.Tauth@foo' ], # if the target of the tunnel is different we need another connection # note that it starts with F.2, because F.1 is the CONNECT request which # established the tunnel [ 'proxy', "https://bar/foo",'F.2.Tauth@bar' ], [ 'proxy', "https://bar/bar",'F.3.Tauth@bar' ], [ 'proxy', "https://foo/tor",'C.10.Tauth@foo' ], [ 'proxy', "https://bar/tor",'F.4.Tauth@bar' ], ):( # Net::SSL will cannot reuse socket for CONNECT, but once inside tunnel # keep-alive is possible [ 'proxy', "https://foo/foo",'G.2.Tauth@foo' ], [ 'proxy', "https://foo/bar",'G.3.Tauth@foo' ], [ 'proxy', "https://bar/foo",'F.2.Tauth@bar' ], [ 'proxy', "https://bar/bar",'F.3.Tauth@bar' ], [ 'proxy', "https://foo/tor",'G.4.Tauth@foo' ], [ 'proxy', "https://bar/tor",'F.4.Tauth@bar' ], ), # non-keep alive for proxy https [ 'proxy_nokeepalive', "https://foo/foo",'H.2.Tauth@foo' ], [ 'proxy_nokeepalive', "https://foo/bar",'I.2.Tauth@foo' ], [ 'proxy_nokeepalive', "https://bar/foo",'J.2.Tauth@bar' ], [ 'proxy_nokeepalive', "https://bar/bar",'K.2.Tauth@bar' ], ); plan tests => 2*@tests; my (%conn2id,%id2conn); for my $test (@tests) { my ($uatype,$url,$expect_id) = @$test; my $ua = $ua{$uatype} or die "no such ua: $uatype"; # Net::SSL uses only the environment to decide about proxy, so we need the # proxy/non-proxy environment for each request if ( $netssl && $url =~m{^https://} ) { $ENV{https_proxy} = $uatype =~m{^proxy} ? "http://$saddr[0]":"" } my $response = $ua->get($url) or die "no response"; if ( $response->is_success and ( my $body = $response->content()) =~m{^ID: *(\d+)\.(\S+)}m ) { my $id = [ $1,$2 ]; my $xid = [ $expect_id =~m{(\w+)\.(\S+)} ]; if ( my $x = $id2conn{$id->[0]} ) { $id->[0] = $x; } elsif ( ! $conn2id{$xid->[0]} ) { $conn2id{ $xid->[0] } = $id->[0]; $id2conn{ $id->[0] } = $xid->[0]; $id->[0] = $xid->[0]; } is("$id->[0].$id->[1]",$expect_id,"$uatype $url -> $expect_id") or diag($response->as_string); # inside proxy tunnel and for non-proxy there should be only absolute # URI in request w/o scheme my $expect_rqurl = $url; $expect_rqurl =~s{^\w+://[^/]+}{} if $uatype eq 'noproxy' or $url =~m{^https://}; my ($rqurl) = $body =~m{^GET (\S+) HTTP/}m; is($rqurl,$expect_rqurl,"URL in request -> $expect_rqurl"); } else { die "unexpected response: ".$response->as_string } } # ------------------------------------------------------------------------ # simple web server with keep alive and SSL, which can also simulate proxy # ------------------------------------------------------------------------ sub _server { my $connid = 0; my %certs; # generated certificates ACCEPT: my ($server) = IO::Select->new(@server)->can_read(); my $cl = $server->accept or goto ACCEPT; # peek into socket to determine if this is direct SSL or not # minimal request is "GET / HTTP/1.1\n\n" my $buf = ''; while (length($buf)<15) { my $lbuf; if ( ! IO::Select->new($cl)->can_read(30) or ! defined recv($cl,$lbuf,20,MSG_PEEK)) { warn "not enough data for request ($buf): $!"; goto ACCEPT; } $buf .= $lbuf; } my $ssl_host = ''; if ( $buf !~m{\A[A-Z]{3,} } ) { # does not look like HTTP, assume direct SSL $ssl_host = "direct.ssl.access"; } $connid++; defined( my $pid = fork()) or die "failed to fork: $!"; if ( $pid ) { push @childs,$pid; goto ACCEPT; # wait for next connection } # child handles requests @server = (); my $reqid = 0; my $tunnel_auth = ''; SSL_UPGRADE: if ( $ssl_host ) { my ($cert,$key) = @{ $certs{$ssl_host} ||= do { diag("creating cert for $ssl_host"); my ($c,$k) = CERT_create( subject => { commonName => $ssl_host }, issuer_cert => $cacert, issuer_key => $cakey, # just reuse cakey as key for certificate key => $cakey, ); [ $c,$k ]; }; }; IO::Socket::SSL->start_SSL( $cl, SSL_server => 1, SSL_cert => $cert, SSL_key => $key, ) or do { diag("SSL handshake failed: ".IO::Socket::SSL->errstr); exit(1); }; } REQUEST: # read header my $req = ''; while (<$cl>) { $_ eq "\r\n" and last; $req .= $_; } $reqid++; my $req_auth = $req =~m{^Proxy-Authorization:}mi ? '.auth':''; if ( $req =~m{\ACONNECT ([^\s:]+)} ) { if ( $ssl_host ) { diag("CONNECT inside SSL tunnel"); exit(1); } $ssl_host = $1; $tunnel_auth = $req_auth ? '.Tauth':''; #diag($req); # simulate proxy and establish SSL tunnel print $cl "HTTP/1.0 200 ok\r\n\r\n"; goto SSL_UPGRADE; } if ( $req =~m{^Content-length: *(\d+)}mi ) { read($cl,my $buf,$1) or die "eof while reading request body"; } my $keep_alive = $req =~m{^(?:Proxy-)?Connection: *(?:(keep-alive)|close)}mi ? $1 : $req =~m{\A.*HTTP/1\.1} ? 1 : 0; # just echo request back, including connid and reqid my $body = "ID: $connid.$reqid$tunnel_auth$req_auth\@" . ( $ssl_host || 'nossl' )."\n" . "---------\n$req"; print $cl "HTTP/1.1 200 ok\r\nContent-type: text/plain\r\n" . "Connection: ".( $keep_alive ? 'keep-alive':'close' )."\r\n" . "Content-length: ".length($body)."\r\n" . "\r\n" . $body; goto REQUEST if $keep_alive; exit(0); # done handling requests } LWP-Protocol-https-6.07/lib/LWP/000755 000765 000024 00000000000 13052453766 016356 5ustar00olafstaff000000 000000 LWP-Protocol-https-6.07/lib/LWP/Protocol/000755 000765 000024 00000000000 13052453766 020157 5ustar00olafstaff000000 000000 LWP-Protocol-https-6.07/lib/LWP/Protocol/https.pm000644 000765 000024 00000015116 13052453541 021652 0ustar00olafstaff000000 000000 package LWP::Protocol::https; use strict; our $VERSION = "6.07"; require LWP::Protocol::http; our @ISA = qw(LWP::Protocol::http); require Net::HTTPS; sub socket_type { return "https"; } sub _extra_sock_opts { my $self = shift; my %ssl_opts = %{$self->{ua}{ssl_opts} || {}}; if (delete $ssl_opts{verify_hostname}) { $ssl_opts{SSL_verify_mode} ||= 1; $ssl_opts{SSL_verifycn_scheme} = 'www'; } else { $ssl_opts{SSL_verify_mode} = 0; } if ($ssl_opts{SSL_verify_mode}) { unless (exists $ssl_opts{SSL_ca_file} || exists $ssl_opts{SSL_ca_path}) { eval { require Mozilla::CA; }; if ($@) { if ($@ =~ /^Can't locate Mozilla\/CA\.pm/) { $@ = <<'EOT'; Can't verify SSL peers without knowing which Certificate Authorities to trust This problem can be fixed by either setting the PERL_LWP_SSL_CA_FILE environment variable or by installing the Mozilla::CA module. To disable verification of SSL peers set the PERL_LWP_SSL_VERIFY_HOSTNAME environment variable to 0. If you do this you can't be sure that you communicate with the expected peer. EOT } die $@; } $ssl_opts{SSL_ca_file} = Mozilla::CA::SSL_ca_file(); } } $self->{ssl_opts} = \%ssl_opts; return (%ssl_opts, $self->SUPER::_extra_sock_opts); } #------------------------------------------------------------ # _cn_match($common_name, $san_name) # common_name: an IA5String # san_name: subjectAltName # initially we were only concerned with the dNSName # and the 'left-most' only wildcard as noted in # https://tools.ietf.org/html/rfc6125#section-6.4.3 # this method does not match any wildcarding in the # domain name as listed in section-6.4.3.3 # sub _cn_match { my( $me, $common_name, $san_name ) = @_; # /CN has a '*.' prefix # MUST be an FQDN -- fishing? return 0 if( $common_name =~ /^\*\./ ); my $re = q{}; # empty string # turn a leading "*." into a regex if( $san_name =~ /^\*\./ ) { $san_name =~ s/\*//; $re = "[^.]+"; } # quotemeta the rest and match anchored if( $common_name =~ /^$re\Q$san_name\E$/ ) { return 1; } return 0; } #------------------------------------------------------- # _in_san( cn, cert ) # 'cn' of the form /CN=host_to_check ( "Common Name" form ) # 'cert' any object that implements a peer_certificate('subjectAltNames') method # which will return an array of ( type-id, value ) pairings per # http://tools.ietf.org/html/rfc5280#section-4.2.1.6 # if there is no subjectAltNames there is nothing more to do. # currently we have a _cn_match() that will allow for simple compare. sub _in_san { my($me, $cn, $cert) = @_; # we can return early if there are no SAN options. my @sans = $cert->peer_certificate('subjectAltNames'); return unless scalar @sans; (my $common_name = $cn) =~ s/.*=//; # strip off the prefix. # get the ( type-id, value ) pairwise # currently only the basic CN to san_name check while( my ( $type_id, $value ) = splice( @sans, 0, 2 ) ) { return 'ok' if $me->_cn_match($common_name,$value); } return; } sub _check_sock { my($self, $req, $sock) = @_; my $check = $req->header("If-SSL-Cert-Subject"); if (defined $check) { my $cert = $sock->get_peer_certificate || die "Missing SSL certificate"; my $subject = $cert->subject_name; unless ( $subject =~ /$check/ ) { my $ok = $self->_in_san( $check, $cert); die "Bad SSL certificate subject: '$subject' !~ /$check/" unless $ok; } $req->remove_header("If-SSL-Cert-Subject"); # don't pass it on } } sub _get_sock_info { my $self = shift; $self->SUPER::_get_sock_info(@_); my($res, $sock) = @_; $res->header("Client-SSL-Cipher" => $sock->get_cipher); my $cert = $sock->get_peer_certificate; if ($cert) { $res->header("Client-SSL-Cert-Subject" => $cert->subject_name); $res->header("Client-SSL-Cert-Issuer" => $cert->issuer_name); } if (!$self->{ssl_opts}{SSL_verify_mode}) { $res->push_header("Client-SSL-Warning" => "Peer certificate not verified"); } elsif (!$self->{ssl_opts}{SSL_verifycn_scheme}) { $res->push_header("Client-SSL-Warning" => "Peer hostname match with certificate not verified"); } $res->header("Client-SSL-Socket-Class" => $Net::HTTPS::SSL_SOCKET_CLASS); } # upgrade plain socket to SSL, used for CONNECT tunnel when proxying https # will only work if the underlying socket class of Net::HTTPS is # IO::Socket::SSL, but code will only be called in this case if ( $Net::HTTPS::SSL_SOCKET_CLASS->can('start_SSL')) { *_upgrade_sock = sub { my ($self,$sock,$url) = @_; $sock = LWP::Protocol::https::Socket->start_SSL( $sock, SSL_verifycn_name => $url->host, SSL_hostname => $url->host, $self->_extra_sock_opts, ); $@ = LWP::Protocol::https::Socket->errstr if ! $sock; return $sock; } } #----------------------------------------------------------- package LWP::Protocol::https::Socket; our @ISA = qw(Net::HTTPS LWP::Protocol::http::SocketMethods); 1; __END__ =head1 NAME LWP::Protocol::https - Provide https support for LWP::UserAgent =head1 SYNOPSIS use LWP::UserAgent; $ua = LWP::UserAgent->new(ssl_opts => { verify_hostname => 1 }); $res = $ua->get("https://www.example.com"); # specify a CA path $ua = LWP::UserAgent->new( ssl_opts => { SSL_ca_path => '/etc/ssl/certs', verify_hostname => 1, } ); =head1 DESCRIPTION The LWP::Protocol::https module provides support for using https schemed URLs with LWP. This module is a plug-in to the LWP protocol handling, so you don't use it directly. Once the module is installed LWP is able to access sites using HTTP over SSL/TLS. If hostname verification is requested by LWP::UserAgent's C, and neither C nor C is set, then C is implied to be the one provided by Mozilla::CA. If the Mozilla::CA module isn't available SSL requests will fail. Either install this module, set up an alternative C or disable hostname verification. This module used to be bundled with the libwww-perl, but it was unbundled in v6.02 in order to be able to declare its dependencies properly for the CPAN tool-chain. Applications that need https support can just declare their dependency on LWP::Protocol::https and will no longer need to know what underlying modules to install. =head1 SEE ALSO L, L, L =head1 COPYRIGHT Copyright 1997-2011 Gisle Aas. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.