Net-SSLGlue-1.055/0000755000175100017510000000000012613146732012263 5ustar workworkNet-SSLGlue-1.055/examples/0000755000175100017510000000000012613146731014100 5ustar workworkNet-SSLGlue-1.055/examples/ftps-tests.pl0000644000175100017510000000700312263763474016563 0ustar workwork#!/usr/bin/perl use strict; use warnings; # This runs lots of tests with SSL against a test server # - plain # - with SSL upgrade and plain data connections # - with SSL upgrade and SSL data connections # - with SSL upgrade and downgrade after auth # - with direct SSL connection # setup stuff here # you need a server where you can write and read and create directories # SSL support is optional, but preferred # IPv6 support should be possible my $testhost = '127.0.0.1'; # where your test server is, IPv6 should be ok my $plain_port = 2021; # port where server listens for plain ftp my $user = 'foo'; # login as user my $pass = 'bar'; # with pass my $can_auth = 1; # does server support AUTH TLS my $ssl_port = 2090; # does server support direct SSL my %sslargs = ( # should be enabled if you want to verify certificates SSL_verify_mode => 1, # for CAs known to the system this might be maybe ommitted # otherwise set this or SSL_ca_path SSL_ca_file => 'ca.pem', # if the certificate has a different name then $testhost set it here SSL_verifycn_name => 'server.local', ); use Net::SSLGlue::FTP; use IO::Socket::SSL; use Carp 'croak'; my @test = ( # basic FTP server stuff { Passive => 0 }, { Passive => 1 }, $can_auth ? ( # SSL upgrade with data connections unprotected { Passive => 0, _starttls => 1, _prot => 'C' }, { Passive => 1, _starttls => 1, _prot => 'C' }, # SSL upgrade with data connections protected { Passive => 0, _starttls => 1 }, { Passive => 1, _starttls => 1 }, # SSL upgrade with SSL downgrade after auth { Passive => 0, _starttls => 1, _stoptls => 1 }, { Passive => 1, _starttls => 1, _stoptls => 1 }, ):(), # direct SSL on separate port $ssl_port ? ( { Passive => 0, SSL => 1, Port => $ssl_port }, { Passive => 1, SSL => 1, Port => $ssl_port }, ):(), ); my $testbase = sprintf("test-%04x%04x-",rand(2**16),rand(2**16)); for( my $i=0;$i<@test;$i++ ) { my %conf = %{$test[$i]}; my $starttls = delete $conf{_starttls}; my $stoptls = delete $conf{_stoptls}; my $prot = delete $conf{_prot}; my $dir = "$testbase$i"; print STDERR "------------ $dir\n"; my $ftp = Net::FTP->new( $testhost, Port => $plain_port, Debug => 1, %sslargs, %conf, ) or die "ftp connect failed"; my $ftperr = sub { my $msg = shift; croak "$msg failed (@_): ".$ftp->message; }; # upgrade to SSL $ftp->starttls or $ftperr->('auth tls', $SSL_ERROR) if $starttls; # login $ftp->login($user,$pass) or $ftperr->('login'); # downgrade from SSL $ftp->stoptls or $ftperr->('ccc') if $stoptls; # change protection level $ftp->prot($prot) or $ftperr->("PROT $prot") if $prot; # create directory for test and change into it $ftp->mkdir($dir) or $ftperr->('mkd'); $ftp->cwd($dir) or $ftperr->('cwd'); # check that dir is empty my @files = $ftp->ls; $ftp->ok or $ftperr->('nlst'); @files and die "directory should be empty"; # create a file in dir $ftp->put( _s2f( my $foo = 'foo' ,'<' ), 'foo.txt' ) or $ftperr->('stor'); # append some bytes to it $ftp->append( _s2f('bar'),'foo.txt' ) or $ftperr->('appe'); # check that it is there @files = $ftp->ls; "@files" eq 'foo.txt' or die "wrong ls: @files"; # retrieve file and verify content $ftp->get( 'foo.txt', _s2f( $foo = '','>' )); $foo eq 'foobar' or die "wrong data: 'foobar' != '$foo'"; $ftp->quit; } sub _s2f { open( my $fh,$_[1] || '<',\$_[0] ); return $fh } Net-SSLGlue-1.055/examples/lwp.pl0000644000175100017510000000033111127506117015231 0ustar workworkuse strict; use LWP::UserAgent; use Net::SSLGlue::LWP SSL_ca_path => '/etc/ssl/certs'; my $ua = LWP::UserAgent->new; $ua->env_proxy; my $resp = $ua->get( 'https://www.comdirect.de' ) || die $@; print $resp->content; Net-SSLGlue-1.055/examples/ftps-starttls.pl0000644000175100017510000000056312263526775017306 0ustar workworkuse strict; use warnings; use Net::SSLGlue::FTP; my $ftp = Net::FTP->new( 'ftp.example.com', Passive => 1, Debug => 1, ); $ftp->starttls( SSL_ca_path => '/etc/ssl/certs' ) or die "tls upgrade failed"; $ftp->login('foo','bar'); print $ftp->ls; # change protection to clear $ftp->prot('C'); $ftp->ls; # stop TLS on control channel $ftp->stoptls; $ftp->ls; Net-SSLGlue-1.055/examples/lwp_post.pl0000644000175100017510000000056111372331671016306 0ustar workworkuse strict; use LWP::UserAgent; use Net::SSLGlue::LWP SSL_ca_path => '/etc/ssl/certs', SSL_verify_mode => 0; my $ua = LWP::UserAgent->new; $ua->env_proxy; my $resp = $ua->post( 'https://service.gmx.net/de/cgi/login', { AREA => 1, EXT => 'redirect', EXT2 => '', uinguserid => '__uuid__', dlevel => 'c', id => 'a', p => 'b', }) || die $@; print $resp->as_string; Net-SSLGlue-1.055/examples/send-starttls-mail.pl0000644000175100017510000000061611405231030020150 0ustar workworkuse strict; use warnings; use Net::SSLGlue::SMTP; my $smtp = Net::SMTP->new( 'mail.gmx.net', Debug => 1 ) or die $@; $smtp->starttls( SSL_ca_path => "/etc/ssl/certs" ) or die $@; $smtp->auth( '123456','password' ); $smtp->mail( 'me@example.org' ); $smtp->to( 'you@example.org' ); $smtp->data; $smtp->datasend( <dataend; $smtp->quit; Net-SSLGlue-1.055/examples/send-ssl-mail.pl0000644000175100017510000000065211405230772017105 0ustar workworkuse strict; use warnings; use Net::SSLGlue::SMTP; my $smtp = Net::SMTP->new( 'mail.gmx.net', SSL => 1, SSL_ca_path => "/etc/ssl/certs", Debug => 1 ) or die $@; die $smtp->peerhost.':'.$smtp->peerport; $smtp->auth( '123456','password' ); $smtp->mail( 'me@example.org' ); $smtp->to( 'you@example.org' ); $smtp->data; $smtp->datasend( <dataend; $smtp->quit; Net-SSLGlue-1.055/examples/ftps-direct.pl0000644000175100017510000000034212263526772016670 0ustar workworkuse strict; use warnings; use Net::SSLGlue::FTP; my $ftp = Net::FTP->new( 'ftp.example.com', SSL => 1, SSL_ca_path => '/etc/ssl/certs', Passive => 1, Debug => 1, ); $ftp->login('foo','bar'); print $ftp->ls; Net-SSLGlue-1.055/COPYRIGHT0000644000175100017510000000030311126703227013546 0ustar workworkThese modules are copyright (c) 2008, Steffen Ullrich. All Rights Reserved. These modules are free software. They may be used, redistributed and/or modified under the same terms as Perl itself. Net-SSLGlue-1.055/META.json0000664000175100017510000000167212613146732013714 0ustar workwork{ "abstract" : "unknown", "author" : [ "unknown" ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version 2.120921", "license" : [ "unknown" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Net-SSLGlue", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "IO::Socket::SSL" : "1.19" } } }, "release_status" : "stable", "resources" : { "repository" : { "url" : "https://github.com/noxxi/p5-net-sslglue" } }, "version" : "1.055" } Net-SSLGlue-1.055/README0000644000175100017510000000017611405230305013133 0ustar workworkThis Module helps LWP, Net::SMTP and Net::LDAP to be either SSL aware at all or to offer way for proper certificate checking. Net-SSLGlue-1.055/MANIFEST0000644000175100017510000000122312613146732013412 0ustar workworkChanges COPYRIGHT examples/ftps-direct.pl examples/ftps-starttls.pl examples/ftps-tests.pl examples/lwp.pl examples/lwp_post.pl examples/send-ssl-mail.pl examples/send-starttls-mail.pl lib/Net/SSLGlue.pm lib/Net/SSLGlue/FTP.pm lib/Net/SSLGlue/LDAP.pm lib/Net/SSLGlue/LWP.pm lib/Net/SSLGlue/POP3.pm lib/Net/SSLGlue/SMTP.pm lib/Net/SSLGlue/Socket.pm Makefile.PL MANIFEST This list of files README t/01_load.t t/external/02_smtp.t t/external/03_lwp.t t/external/04_pop3.t t/external/05_ftp.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Net-SSLGlue-1.055/Changes0000644000175100017510000000610012613146707013555 0ustar workwork1.055 2015/10/25 - fix memory leak in Net::SSLGlue::Socket, RT#107816. Thanks to kasyap.mr[AT]gmail[DOT]com for reporting 1.054 2015/04/28 - if a version of libnet is detected which already supports TLS (i.e. libnet 3.0+) warn and use this instead. 1.053 2014/05/28 - if current LWP is detected is use this mostly unpatched - fix Net::SSLGlue::FTP to use the same hostname when verifying the certificate of the data connection 1.052 2014/01/16 - FTPS: reuse same SSL session for control and data channnel to work with default configuration of proftpd. 1.051 2014/01/10 - fixes to Net::FTP SSL support - examples/ftps-tests.pl has lots of tests for FTP against live server 1.05 2014/01/09 - added support for SSL+IPv6 in Net::FTP - new package Net::SSLGlue::Socket for a socket which combines plain,ssl,ipv6 - fixed some tests - some checks for bad certificates do not work anymore because these certs were fixed 1.04 2013/08/01 replace Net::Cmd::getline via Net::SSLGlue::POP3 because it assumed, that it just needs to wait for read events on the sockets - which is not the case for SSL (e.g. SSL_WANT_READ, SSL_WANT_WRITE). Fixes https://rt.cpan.org/Ticket/Display.html?id=87507. Thanks to MICHIELB for reporting 1.03 2013/05/15 fixed documentation for Net::SSLGlue::POP3 1.02 2013/05/14 added Net::SSLGlue::POP3 1.01 2012/01/31 Net::SSLGlue::LDAP as wrongly named Net::DNSGlue::LDAP 1.0 2012/01/30 Net::SSLGlue::SMTP: save hello domain from last hello call, so that the hello after the starttls uses the same domain argument. Thanks to zaucker[AT]oetiker[DOT]ch for reporting problem. 0.9 2012/01/24 Net::SSLGlue::SMTP: fixed stripping of port from host/ip for name verification. Added hello after successful starttls. Extented tests to check, if we can actually talk after starttls. Thanks to zaucker[AT]oetiker[DOT]ch for reporting problem. 0.8 2011/07/17 fixed wrong position for include encode_base64 and uri_unescape in *::LWP. Thanks to mtelle[AT]kamp-dsl[DOT]de for reporting 0.7 2011/05/27 strip port from host/ip for name verification in Net::SSLGlue::SMTP 0.6 2011/05/02 fixed english, thanks to dom, https://rt.cpan.org/Ticket/Display.html?id=46284 0.5 2011/02/03 documentation fixes: http://rt.cpan.org/Ticket/Display.html?id=65258 0.4 2010/06/13 added Changes, put examples into examples/ dir 0.3 2010/05/13 rewrite parts of Net::SSLGlue::LWP so that it sends the correct request to the peer even if https_proxy is used. In former version it ommitted the HTTP version number in the request (thus the request was invalid). Bug report by PMOONEY https://rt.cpan.org/Ticket/Display.html?id=57365 0.2_1 2010/05/11 document way to set different verification scheme for LWP requested by PMOONEY https://rt.cpan.org/Ticket/Display.html?57367 0.2 2009/01/02 https_proxy support for LWP, HTTPS_PROXY from Crypt::SSLeay did not work and the https_proxy from LWP was broken with both Crypt::SSLeay and IO::Socket::SSL (it did unencrypted https:// requests to the proxy). Fix it so that it now does CONNECT (this is the meaning of https_proxy for all other programs) 0.1 2008/12/31 initial release Net-SSLGlue-1.055/Makefile.PL0000644000175100017510000000104012265770130014226 0ustar workworkuse ExtUtils::MakeMaker; require 5.008; my $xt = prompt( "Should I do external tests?\n". "These tests will fail if there is no internet connection or if a firewall\n". "blocks some traffic.\n". "[y/N]", 'n' ); WriteMakefile( NAME => 'Net::SSLGlue', VERSION_FROM => 'lib/Net/SSLGlue.pm', PREREQ_PM => { 'IO::Socket::SSL' => 1.19, }, $xt =~m{^y}i ? ( test => { TESTS => 't/*.t t/external/*.t' }):(), META_MERGE => { resources => { repository => 'https://github.com/noxxi/p5-net-sslglue', }, }, ); Net-SSLGlue-1.055/t/0000755000175100017510000000000012613146731012525 5ustar workworkNet-SSLGlue-1.055/t/01_load.t0000644000175100017510000000052611126676765014151 0ustar workworkuse strict; use warnings; print "1..3\n"; for ( [ 'Net::SMTP','SMTP' ], [ 'LWP', 'LWP' ], [ 'Net::LDAP','LDAP' ], ) { my ($pkg,$glue) = @$_; eval "use $pkg"; if ( ! $@ ) { eval "use Net::SSLGlue::$glue"; print $@ ? "not ok # load $glue glue failed\n": "ok # load $glue glue\n" } else { print "ok # skip $glue glue\n" } } Net-SSLGlue-1.055/t/external/0000755000175100017510000000000012613146731014347 5ustar workworkNet-SSLGlue-1.055/t/external/02_smtp.t0000644000175100017510000000230612263531571016022 0ustar workwork use strict; use warnings; BEGIN { eval "use Net::SMTP"; if ( $@ ) { print "1..0 # no Net::SMTP\n"; exit } } use Net::SSLGlue::SMTP; my $capath = '/etc/ssl/certs/'; # unix? -d $capath or do { print "1..0 # cannot find system CA-path\n"; exit }; # first try to connect w/o smtp # plain diag( "connect inet to mail.gmx.net:25" ); IO::Socket::INET->new( 'mail.gmx.net:25' ) or do { print "1..0 # mail.gmx.net:25 not reachable\n"; exit }; # ssl to the right host diag( "connect ssl to mail.gmx.net:465" ); IO::Socket::SSL->new( PeerAddr => 'mail.gmx.net:465', SSL_ca_path => $capath, SSL_verify_mode => 1, SSL_verifycn_scheme => 'smtp' ) or do { print "1..0 # mail.gmx.net:465 not reachable with SSL\n"; exit }; print "1..3\n"; # first direct SSL my $smtp = Net::SMTP->new( 'mail.gmx.net', SSL => 1, SSL_ca_path => $capath, ); print $smtp ? "ok\n" : "not ok # smtp connect mail.gmx.net\n"; # then starttls $smtp = Net::SMTP->new( 'mail.gmx.net' ); my $ok = $smtp->starttls( SSL_ca_path => $capath ); print $ok ? "ok\n" : "not ok # smtp starttls mail.gmx.net\n"; # check that we can talk on connection print $smtp->quit ? "ok\n": "not ok # quit failed\n"; sub diag { #print STDERR "@_\n" } Net-SSLGlue-1.055/t/external/05_ftp.t0000644000175100017510000001634712517626625015654 0ustar workwork use strict; use warnings; use Test::More; my $server = 'test.rebex.net'; my $debug = 0; BEGIN { eval "use Net::FTP"; if ( $@ ) { print "1..0 # no Net::FTP\n"; exit } } use Net::SSLGlue::FTP; use IO::Socket::SSL; use File::Temp; # first try to connect w/o ftp # plain diag( "connect inet to $server:21" ); IO::Socket::INET->new( "$server:21" ) or do { plan skip_all => "$server:21 not reachable"; }; # ssl to the right host diag( "connect inet to $server:990" ); my $sock = IO::Socket::INET->new( "$server:990") or do { plan skip_all => "$server:990 not reachable"; }; # now we need CAs my $cafh = File::Temp->new( UNLINK => 0, SUFFIX => '.crt' ); my %sslargs = ( SSL_ca_file => $cafh->filename ); print $cafh ; close($cafh); diag( "upgrade to ssl $server:990" ); IO::Socket::SSL->start_SSL($sock, SSL_verify_mode => 1, SSL_verifycn_name => $server, SSL_verifycn_scheme => 'ftp', %sslargs, ) or do { plan skip_all => "$server:990 not upgradable to SSL: $SSL_ERROR"; }; plan tests => 9; # first direct SSL diag( "connect ftp over ssl to $server" ); my $ftp = Net::FTP->new($server, SSL => 1, %sslargs, Debug => $debug, Passive => 1, ); ok($ftp,"ftp ssl connect $server"); $ftp->login("anonymous",'net-sslglue-ftp@test.perl') or die "login to $server failed"; diag("logged in"); # check that we can talk on connection ok(~~$ftp->ls,"directory listing protected"); $ftp->prot('C'); ok(~~$ftp->ls,"directory listing clear"); # then TLS upgrade inside plain connection $ftp = Net::FTP->new($server, Passive => 1, Debug => $debug, %sslargs); ok($ftp,"ftp plain connect $server"); my $ok = $ftp->starttls(); ok($ok,"ssl upgrade"); $ftp->login("anonymous",'net-sslglue-ftp@test.perl') or die "login to $server failed"; diag("logged in"); # check that we can talk on connection ok(~~$ftp->ls,"directory listing protected"); $ftp->prot('C'); ok(~~$ftp->ls,"directory listing clear"); $ok = $ftp->stoptls; ok($ok,"ssl downgrade"); ok(~~$ftp->ls,"directory listing after downgrade"); __DATA__ # Subject: C=IL, O=StartCom Ltd., OU=Secure Digital Certificate Signing, CN=StartCom Class 2 Primary Intermediate Server CA # Issuer: C=IL, O=StartCom Ltd., OU=Secure Digital Certificate Signing, CN=StartCom Certification Authority -----BEGIN CERTIFICATE----- MIIGNDCCBBygAwIBAgIBGjANBgkqhkiG9w0BAQUFADB9MQswCQYDVQQGEwJJTDEW MBQGA1UEChMNU3RhcnRDb20gTHRkLjErMCkGA1UECxMiU2VjdXJlIERpZ2l0YWwg Q2VydGlmaWNhdGUgU2lnbmluZzEpMCcGA1UEAxMgU3RhcnRDb20gQ2VydGlmaWNh dGlvbiBBdXRob3JpdHkwHhcNMDcxMDI0MjA1NzA5WhcNMTcxMDI0MjA1NzA5WjCB jDELMAkGA1UEBhMCSUwxFjAUBgNVBAoTDVN0YXJ0Q29tIEx0ZC4xKzApBgNVBAsT IlNlY3VyZSBEaWdpdGFsIENlcnRpZmljYXRlIFNpZ25pbmcxODA2BgNVBAMTL1N0 YXJ0Q29tIENsYXNzIDIgUHJpbWFyeSBJbnRlcm1lZGlhdGUgU2VydmVyIENBMIIB IjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA4k85L6GMmoWtCA4IPlfyiAEh G5SpbOK426oZGEY6UqH1D/RujOqWjJaHeRNAUS8i8gyLhw9l33F0NENVsTUJm9m8 H/rrQtCXQHK3Q5Y9upadXVACHJuRjZzArNe7LxfXyz6CnXPrB0KSss1ks3RVG7RL hiEs93iHMuAW5Nq9TJXqpAp+tgoNLorPVavD5d1Bik7mb2VsskDPF125w2oLJxGE d2H2wnztwI14FBiZgZl1Y7foU9O6YekO+qIw80aiuckfbIBaQKwn7UhHM7BUxkYa 8zVhwQIpkFR+ZE3EMFICgtffziFuGJHXuKuMJxe18KMBL47SLoc6PbQpZ4rEAwID AQABo4IBrTCCAakwDwYDVR0TAQH/BAUwAwEB/zAOBgNVHQ8BAf8EBAMCAQYwHQYD VR0OBBYEFBHbI0X9VMxqcW+EigPXvvcBLyaGMB8GA1UdIwQYMBaAFE4L7xqkQFul F2mHMMo0aEPQQa7yMGYGCCsGAQUFBwEBBFowWDAnBggrBgEFBQcwAYYbaHR0cDov L29jc3Auc3RhcnRzc2wuY29tL2NhMC0GCCsGAQUFBzAChiFodHRwOi8vd3d3LnN0 YXJ0c3NsLmNvbS9zZnNjYS5jcnQwWwYDVR0fBFQwUjAnoCWgI4YhaHR0cDovL3d3 dy5zdGFydHNzbC5jb20vc2ZzY2EuY3JsMCegJaAjhiFodHRwOi8vY3JsLnN0YXJ0 c3NsLmNvbS9zZnNjYS5jcmwwgYAGA1UdIAR5MHcwdQYLKwYBBAGBtTcBAgEwZjAu BggrBgEFBQcCARYiaHR0cDovL3d3dy5zdGFydHNzbC5jb20vcG9saWN5LnBkZjA0 BggrBgEFBQcCARYoaHR0cDovL3d3dy5zdGFydHNzbC5jb20vaW50ZXJtZWRpYXRl LnBkZjANBgkqhkiG9w0BAQUFAAOCAgEAnQfh7pB2MWcWRXCMy4SLS1doRKWJwfJ+ yyiL9edwd9W29AshYKWhdHMkIoDW2LqNomJdCTVCKfs5Y0ULpLA4Gmj0lRPM4EOU 7Os5GuxXKdmZbfWEzY5zrsncavqenRZkkwjHHMKJVJ53gJD2uSl26xNnSFn4Ljox uMnTiOVfTtIZPUOO15L/zzi24VuKUx3OrLR2L9j3QGPV7mnzRX2gYsFhw3XtsntN rCEnME5ZRmqTF8rIOS0Bc2Vb6UGbERecyMhK76F2YC2uk/8M1TMTn08Tzt2G8fz4 NVQVqFvnhX76Nwn/i7gxSZ4Nbt600hItuO3Iw/G2QqBMl3nf/sOjn6H0bSyEd6Si BeEX/zHdmvO4esNSwhERt1Axin/M51qJzPeGmmGSTy+UtpjHeOBiS0N9PN7WmrQQ oUCcSyrcuNDUnv3xhHgbDlePaVRCaHvqoO91DweijHOZq1X1BwnSrzgDapADDC+P 4uhDwjHpb62H5Y29TiyJS1HmnExUdsASgVOb7KD8LJzaGJVuHjgmQid4YAjff20y 6NjAbx/rJnWfk/x7G/41kNxTowemP4NVCitOYoIlzmYwXSzg+RkbdbmdmFamgyd6 0Y+NWZP8P3PXLrQsldiL98l+x/ydrHIEH9LMF/TtNGCbnkqXBP7dcg5XVFEGcE3v qhykguAzx/Q= -----END CERTIFICATE----- # Subject: C=IL, O=StartCom Ltd., OU=Secure Digital Certificate Signing, CN=StartCom Certification Authority # Issuer: C=IL, O=StartCom Ltd., OU=Secure Digital Certificate Signing, CN=StartCom Certification Authority -----BEGIN CERTIFICATE----- MIIHhzCCBW+gAwIBAgIBLTANBgkqhkiG9w0BAQsFADB9MQswCQYDVQQGEwJJTDEW MBQGA1UEChMNU3RhcnRDb20gTHRkLjErMCkGA1UECxMiU2VjdXJlIERpZ2l0YWwg Q2VydGlmaWNhdGUgU2lnbmluZzEpMCcGA1UEAxMgU3RhcnRDb20gQ2VydGlmaWNh dGlvbiBBdXRob3JpdHkwHhcNMDYwOTE3MTk0NjM3WhcNMzYwOTE3MTk0NjM2WjB9 MQswCQYDVQQGEwJJTDEWMBQGA1UEChMNU3RhcnRDb20gTHRkLjErMCkGA1UECxMi U2VjdXJlIERpZ2l0YWwgQ2VydGlmaWNhdGUgU2lnbmluZzEpMCcGA1UEAxMgU3Rh cnRDb20gQ2VydGlmaWNhdGlvbiBBdXRob3JpdHkwggIiMA0GCSqGSIb3DQEBAQUA A4ICDwAwggIKAoICAQDBiNsJvGxGfHiflXu1M5DycmLWwTYgIiRezul38kMKogZk pMyONvg45iPwbm2xPN1yo4UcodM9tDMr0y+v/uqwQVlntsQGfQqedIXWeUyAN3rf OQVSWff0G0ZDpNKFhdLDcfN1YjS6LIp/Ho/u7TTQEceWzVI9ujPW3U3eCztKS5/C Ji/6tRYccjV3yjxd5srhJosaNnZcAdt0FCX+7bWgiA/deMotHweXMAEtcnn6RtYT Kqi5pquDSR3l8u/d5AGOGAqPY1MWhWKpDhk6zLVmpsJrdAfkK+F2PrRt2PZE4XNi HzvEvqBTViVsUQn3qqvKv3b9bZvzndu/PWa8DFaqr5hIlTpL36dYUNk4dalb6kMM Av+Z6+hsTXBbKWWc3apdzK8BMewM69KN6Oqce+Zu9ydmDBpI125C4z/eIT574Q1w +2OqqGwaVLRcJXrJosmLFqa7LH4XXgVNWG4SHQHuEhANxjJ/GP/89PrNbpHoNkm+ Gkhpi8KWTRoSsmkXwQqQ1vp5Iki/untp+HDH+no32NgN0nZPV/+Qt+OR0t3vwmC3 Zzrd/qqc8NSLf3Iizsafl7b4r4qgEKjZ+xjGtrVcUjyJthkqcwEKDwOzEmDyei+B 26Nu/yYwl/WL3YlXtq09s68rxbd2AvCl1iuahhQqcvbjM4xdCUsT37uMdBNSSwID AQABo4ICEDCCAgwwDwYDVR0TAQH/BAUwAwEB/zAOBgNVHQ8BAf8EBAMCAQYwHQYD VR0OBBYEFE4L7xqkQFulF2mHMMo0aEPQQa7yMB8GA1UdIwQYMBaAFE4L7xqkQFul F2mHMMo0aEPQQa7yMIIBWgYDVR0gBIIBUTCCAU0wggFJBgsrBgEEAYG1NwEBATCC ATgwLgYIKwYBBQUHAgEWImh0dHA6Ly93d3cuc3RhcnRzc2wuY29tL3BvbGljeS5w ZGYwNAYIKwYBBQUHAgEWKGh0dHA6Ly93d3cuc3RhcnRzc2wuY29tL2ludGVybWVk aWF0ZS5wZGYwgc8GCCsGAQUFBwICMIHCMCcWIFN0YXJ0IENvbW1lcmNpYWwgKFN0 YXJ0Q29tKSBMdGQuMAMCAQEagZZMaW1pdGVkIExpYWJpbGl0eSwgcmVhZCB0aGUg c2VjdGlvbiAqTGVnYWwgTGltaXRhdGlvbnMqIG9mIHRoZSBTdGFydENvbSBDZXJ0 aWZpY2F0aW9uIEF1dGhvcml0eSBQb2xpY3kgYXZhaWxhYmxlIGF0IGh0dHA6Ly93 d3cuc3RhcnRzc2wuY29tL3BvbGljeS5wZGYwEQYJYIZIAYb4QgEBBAQDAgAHMDgG CWCGSAGG+EIBDQQrFilTdGFydENvbSBGcmVlIFNTTCBDZXJ0aWZpY2F0aW9uIEF1 dGhvcml0eTANBgkqhkiG9w0BAQsFAAOCAgEAjo/n3JR5fPGFf59Jb2vKXfuM/gTF wWLRfUKKvFO3lANmMD+x5wqnUCBVJX92ehQN6wQOQOY+2IirByeDqXWmN3PH/UvS Ta0XQMhGvjt/UfzDtgUx3M2FIk5xt/JxXrAaxrqTi3iSSoX4eA+D/i+tLPfkpLst 0OcNOrg+zvZ49q5HJMqjNTbOx8aHmNrs++myziebiMMEofYLWWivydsQD032ZGNc pRJvkrKTlMeIFw6Ttn5ii5B/q06f/ON1FE8qMt9bDeD1e5MNq6HPh+GlBEXoPBKl CcWw0bdT82AUuoVpaiF8H3VhFyAXe2w7QSlc4axa0c2Mm+tgHRns9+Ww2vl5GKVF P0lDV9LdJNUso/2RjSe15esUBppMeyG7Oq0wBhjA2MFrLH9ZXF2RsXAiV+uKa0hK 1Q8p7MZAwC+ITGgBF3f0JBlPvfrhsiAhS90a2Cl9qrjeVOwhVYBsHvUwyKMQ5bLm KhQxw4UtjJixhlpPiVktucf3HMiKf8CdBUrmQk9io20ppB+Fq9vlgcitKj1MXVuE JnHEhV5xJMqlG2zYYdMa4FTbzrqpMrUi9nNBCV24F10OD5mQ1kfabwo6YigUZ4LZ 8dCAWZvLMdibD4x3TrVoivJs9iQOLWxwxXPR3hTQcY+203sC9uO41Alua551hDnm fyWl8kgAwKQB2j8= -----END CERTIFICATE----- Net-SSLGlue-1.055/t/external/04_pop3.t0000644000175100017510000000227612263531571015730 0ustar workwork use strict; use warnings; BEGIN { eval "use Net::POP3"; if ( $@ ) { print "1..0 # no Net::POP3\n"; exit } } use Net::SSLGlue::POP3; my $capath = '/etc/ssl/certs/'; # unix? -d $capath or do { print "1..0 # cannot find system CA-path\n"; exit }; # first try to connect w/o smtp # plain diag( "connect inet to pop.gmx.net:110" ); IO::Socket::INET->new( 'pop.gmx.net:110' ) or do { print "1..0 # pop.gmx.net:110 not reachable\n"; exit }; # ssl to the right host diag( "connect ssl to pop.gmx.net:995" ); IO::Socket::SSL->new( PeerAddr => 'pop.gmx.net:995', SSL_ca_path => $capath, SSL_verify_mode => 1, SSL_verifycn_scheme => 'smtp' ) or do { print "1..0 # pop.gmx.net:995 not reachable with SSL\n"; exit }; print "1..3\n"; # first direct SSL my $smtp = Net::POP3->new( 'pop.gmx.net', SSL => 1, SSL_ca_path => $capath, ); print $smtp ? "ok\n" : "not ok # smtp connect pop.gmx.net\n"; # then starttls $smtp = Net::POP3->new( 'pop.gmx.net' ); my $ok = $smtp->starttls( SSL_ca_path => $capath ); print $ok ? "ok\n" : "not ok # smtp starttls pop.gmx.net\n"; # check that we can talk on connection print $smtp->quit ? "ok\n": "not ok # quit failed\n"; sub diag { #print STDERR "@_\n" } Net-SSLGlue-1.055/t/external/03_lwp.t0000644000175100017510000000460412517627542015653 0ustar workwork use strict; use warnings; BEGIN { eval "use LWP"; if ( $@ ) { print "1..0 # no LWP\n"; exit } } use Net::SSLGlue::LWP; use IO::Socket::SSL; use LWP::Simple; my $goodhost = 'google.de'; my $badhost = 'badcert.maulwuff.de'; my $capath = '/etc/ssl/certs/'; # unix? -d $capath or do { print "1..0 # cannot find system CA-path\n"; exit }; Net::SSLGlue::LWP->import( SSL_ca_path => $capath, # LWP might define SSL_ca_file - remove it to avoid conflict SSL_ca_file => undef ); # # first check everything directly with IO::Socket::SSL # diag("connecting to $goodhost:443 with IO::Socket::INET"); my $sock = IO::Socket::INET->new( PeerAddr => "$goodhost:443", Timeout => 10 ) or do { print "1..0 # connect $goodhost failed: $!\n"; exit }; diag("ssl upgrade $goodhost"); IO::Socket::SSL->start_SSL( $sock, SSL_ca_path => $capath, SSL_verifycn_name => "$goodhost", SSL_verify_mode => 1, SSL_verifycn_scheme => 'http', ) or do { print "1..0 # ssl upgrade $goodhost failed: $SSL_ERROR\n"; exit }; diag("connecting to $badhost:443 with IO::Socket::INET"); if ( $sock = IO::Socket::INET->new( PeerAddr => "$badhost:443", Timeout => 10, )) { diag("upgrading to https - should fail because of bad certificate"); if ( IO::Socket::SSL->start_SSL( $sock, SSL_ca_path => $capath, SSL_verify_mode => 1, SSL_verifycn_scheme => 'http', SSL_verifycn_name => $badhost, )) { diag("certificate for $badhost unexpectly correct"); $badhost = undef; }; } else { diag("connect to $badhost failed: $!"); $badhost = undef; } # # and than check, that LWP uses the same checks # print "1..".( $badhost ? 3:1 )."\n"; # $goodhost -> should succeed diag("connecting to $goodhost:443 with LWP"); my $content = get( "https://$goodhost" ); print $content ? "ok\n": "not ok # lwp connect $goodhost: $@\n"; if ( $badhost ) { # $badhost -> should fail diag("connecting to $badhost:443 with LWP"); $content = get( "https://$badhost" ); print $content ? "not ok # lwp ssl connect $badhost should fail\n": "ok\n"; # $badhost -> should succeed if verify mode is 0 { local %Net::SSLGlue::LWP::SSLopts = %Net::SSLGlue::LWP::SSLopts; $Net::SSLGlue::LWP::SSLopts{SSL_verify_mode} = 0; $content = get( "https://$badhost" ); print $content ? "ok\n": "not ok # lwp ssl $badhost w/o ssl verify\n"; } } sub diag { print "# @_\n" } Net-SSLGlue-1.055/lib/0000755000175100017510000000000012613146731013030 5ustar workworkNet-SSLGlue-1.055/lib/Net/0000755000175100017510000000000012613146731013556 5ustar workworkNet-SSLGlue-1.055/lib/Net/SSLGlue/0000755000175100017510000000000012613146731015034 5ustar workworkNet-SSLGlue-1.055/lib/Net/SSLGlue/LDAP.pm0000644000175100017510000000434512517623462016124 0ustar workworkuse strict; use warnings; package Net::SSLGlue::LDAP; our $VERSION = '1.01'; use Net::LDAP; use IO::Socket::SSL 1.19; # can be reset with local our %SSLopts; # add SSL_verifycn_scheme to the SSL CTX args returned by # Net::LDAP::_SSL_context_init_args my $old = defined &Net::LDAP::_SSL_context_init_args && \&Net::LDAP::_SSL_context_init_args || die "cannot find Net::LDAP::_SSL_context_init_args"; no warnings 'redefine'; *Net::LDAP::_SSL_context_init_args = sub { my %arg = $old->(@_); $arg{SSL_verifycn_scheme} ||= 'ldap' if $arg{SSL_verify_mode}; while ( my ($k,$v) = each %SSLopts ) { $arg{$k} = $v; } return %arg; }; 1; =head1 NAME Net::SSLGlue::LDAP - proper certificate checking for ldaps in Net::LDAP =head1 SYNOPSIS use Net::SSLGlue::LDAP; local %Net::SSLGlue::LDAP = ( SSL_verifycn_name => $hostname_in_cert ); my $ldap = Net::LDAP->new( $hostname, capath => ... ); $ldap->start_tls; =head1 DESCRIPTION L modifies L so that it does proper certificate checking using the C SSL_verify_scheme from L. Because L does not have a mechanism to forward arbitrary parameters for the construction of the underlying socket these parameters can be set globally when including the package, or with local settings of the C<%Net::SSLGlue::LDAP::SSLopts> variable. All of the C parameters from L can be used; the following parameter is especially useful: =over 4 =item SSL_verifycn_name Usually the name given as the hostname in the constructor is used to verify the identity of the certificate. If you want to check the certificate against another name you can specify it with this parameter. =back C, C for L can be set with the C and C parameters of L and C can be set with C, but the meaning of the values differs (C is 0, e.g. disable certificate verification). =head1 SEE ALSO IO::Socket::SSL, LWP, Net::LDAP =head1 COPYRIGHT This module is copyright (c) 2008, Steffen Ullrich. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself. Net-SSLGlue-1.055/lib/Net/SSLGlue/SMTP.pm0000644000175100017510000001412112517626731016162 0ustar workworkuse strict; use warnings; package Net::SSLGlue::SMTP; use IO::Socket::SSL 1.19; use Net::SMTP; our $VERSION = 1.001; my $DONT; BEGIN { if (defined &Net::SMTP::starttls) { warn "using SSL support of Net::SMTP $Net::SMTP::VERSION instead of SSLGlue"; $DONT = 1; goto DONE; } ############################################################################## # mix starttls method into Net::SMTP which on SSL handshake success # upgrades the class to Net::SSLGlue::SMTP::_SSLified ############################################################################## *Net::SMTP::starttls = sub { my $self = shift; $self->_STARTTLS or return; my $host = $self->host; # for name verification strip port from domain:port, ipv4:port, [ipv6]:port $host =~s{(?start_SSL( $self, SSL_verify_mode => 1, SSL_verifycn_scheme => 'smtp', SSL_verifycn_name => $host, @_ ) or return; # another hello after starttls to read new ESMTP capabilities return $self->hello(${*$self}{net_smtp_hello_domain}); }; *Net::SMTP::_STARTTLS = sub { shift->command("STARTTLS")->response() == Net::SMTP::CMD_OK }; no warnings 'redefine'; my $old_new = \&Net::SMTP::new; *Net::SMTP::new = sub { my $class = shift; my %arg = @_ % 2 == 0 ? @_ : ( Host => shift,@_ ); if ( delete $arg{SSL} ) { $arg{Port} ||= 465; return Net::SSLGlue::SMTP::_SSLified->new(%arg); } else { return $old_new->($class,%arg); } }; my $old_hello = \&Net::SMTP::hello; *Net::SMTP::hello = sub { my ($self,$domain) = @_; ${*$self}{net_smtp_hello_domain} = $domain if $domain; goto &$old_hello; }; DONE: 1; } ############################################################################## # Socket class derived from IO::Socket::SSL # strict certificate verification per default ############################################################################## our %SSLopts; { package Net::SSLGlue::SMTP::_SSL_Socket; goto DONE if $DONT; our @ISA = 'IO::Socket::SSL'; *configure_SSL = sub { my ($self,$arg_hash) = @_; # set per default strict certificate verification $arg_hash->{SSL_verify_mode} = 1 if ! exists $arg_hash->{SSL_verify_mode}; $arg_hash->{SSL_verifycn_scheme} = 'smtp' if ! exists $arg_hash->{SSL_verifycn_scheme}; $arg_hash->{SSL_verifycn_name} = $self->host if ! exists $arg_hash->{SSL_verifycn_name}; # force keys from %SSLopts while ( my ($k,$v) = each %SSLopts ) { $arg_hash->{$k} = $v; } return $self->SUPER::configure_SSL($arg_hash) }; DONE: 1; } ############################################################################## # Net::SMTP derived from Net::SSLGlue::SMTP::_SSL_Socket instead of IO::Socket::INET # this talks SSL to the peer ############################################################################## { package Net::SSLGlue::SMTP::_SSLified; use Carp 'croak'; goto DONE if $DONT; # deriving does not work because we need to replace a superclass # from Net::SMTP, so just copy the class into the new one and then # change it # copy subs for ( keys %{Net::SMTP::} ) { no strict 'refs'; *{$_} = \&{ "Net::SMTP::$_" } if defined &{ "Net::SMTP::$_" }; } # copy + fix @ISA our @ISA = @Net::SMTP::ISA; grep { s{^IO::Socket::INET$}{Net::SSLGlue::SMTP::_SSL_Socket} } @ISA or die "cannot find and replace IO::Socket::INET superclass"; # we are already sslified no warnings 'redefine'; *starttls = sub { croak "have already TLS\n" }; my $old_new = \&new; *new = sub { my $class = shift; my %arg = @_ % 2 == 0 ? @_ : ( Host => shift,@_ ); local %SSLopts; $SSLopts{$_} = delete $arg{$_} for ( grep { /^SSL_/ } keys %arg ); return $old_new->($class,%arg); }; DONE: 1; } 1; =head1 NAME Net::SSLGlue::SMTP - make Net::SMTP able to use SSL =head1 SYNOPSIS use Net::SSLGlue::SMTP; my $smtp_ssl = Net::SMTP->new( $host, SSL => 1, SSL_ca_path => ... ); my $smtp_plain = Net::SMTP->new( $host ); $smtp_plain->starttls( SSL_ca_path => ... ); =head1 DESCRIPTION L extends L so one can either start directly with SSL or switch later to SSL using the STARTTLS command. By default it will take care to verify the certificate according to the rules for SMTP implemented in L. =head1 METHODS =over 4 =item new The method C of L is now able to start directly with SSL when the argument C< 1>> is given. In this case it will not create an L object but an L object. One can give the usual C parameter of L to C. =item starttls If the connection is not yet SSLified it will issue the STARTTLS command and change the object, so that SSL will now be used. The usual C parameter of L will be given. =item peer_certificate ... Once the SSL connection is established the object is derived from L so that you can use this method to get information about the certificate. See the L documentation. =back All of these methods can take the C parameter from L to change the behavior of the SSL connection. The following parameters are especially useful: =over 4 =item SSL_ca_path, SSL_ca_file Specifies the path or a file where the CAs used for checking the certificates are located. This is typically L on UNIX systems. =item SSL_verify_mode If set to 0, verification of the certificate will be disabled. By default it is set to 1 which means that the peer certificate is checked. =item SSL_verifycn_name Usually the name given as the hostname in the constructor is used to verify the identity of the certificate. If you want to check the certificate against another name you can specify it with this parameter. =back =head1 SEE ALSO IO::Socket::SSL, Net::SMTP =head1 COPYRIGHT This module is copyright (c) 2008, Steffen Ullrich. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself. Net-SSLGlue-1.055/lib/Net/SSLGlue/Socket.pm0000644000175100017510000001402012613146274016621 0ustar workwork package Net::SSLGlue::Socket; our $VERSION = 1.002; use strict; use warnings; use Carp 'croak'; use Symbol 'gensym'; use IO::Socket::SSL; my $IPCLASS; BEGIN { for(qw(IO::Socket::IP IO::Socket::INET6 IO::Socket::INET)) { $IPCLASS = $_,last if eval "require $_"; } } # this can be overwritten (with local) to get arguments passed around # to strict calls of the socket class new our %ARGS; sub new { my $class = shift; my %args = @_>1 ? @_ : ( PeerAddr => shift() ); %args = ( %args, %ARGS ); my %sslargs; for(keys %args) { $sslargs{$_} = delete $args{$_} if m{^SSL_}; } my $ssl = delete $args{SSL}; my $sock = $ssl ? IO::Socket::SSL->new(%args,%sslargs) : $IPCLASS->new(%args) or return; my $self = gensym(); bless $self,$class; ${*$self}{sock} = $sock; ${*$self}{ssl} = $ssl; ${*$self}{sslargs} = \%sslargs; tie *{$self}, "Net::SSLGlue::Socket::HANDLE", $self; return $self; } for my $sub (qw( fileno sysread syswrite close connect fcntl read write readline print printf getc say eof getline getlines blocking autoflush timeout sockhost sockport peerhost peerport sockdomain truncate stat setbuf setvbuf fdopen ungetc send recv )) { no strict 'refs'; *$sub = sub { my $self = shift; my $sock = ${*$self}{sock} or return; my $sock_sub = $sock->can($sub) or croak("$sock does not support $sub"); unshift @_,$sock; # warn "*** $sub called"; goto &$sock_sub; }; } sub accept { my ($self,$class) = @_; my $sock = ${*$self}{sock} or return; my $conn = $sock->accept(); return bless $conn,$class if $class && ! $class->isa('Net::SSLGlue::Socket'); $class ||= ref($self); my $wrap = gensym; *$wrap = *$conn; # clone original handle bless $wrap, $class; ${*$wrap}{sock} = $conn; ${*$wrap}{ssl} = ${*$self}{ssl}; ${*$wrap}{sslargs} = ${*$self}{sslargs}; return $wrap; }; sub start_SSL { my $self = shift; croak("start_SSL called on SSL socket") if ${*$self}{ssl}; IO::Socket::SSL->start_SSL(${*$self}{sock},%{${*$self}{sslargs}},@_) or return; ${*$self}{ssl} = 1; return $self; } sub stop_SSL { my $self = shift; croak("stop_SSL called on plain socket") if ! ${*$self}{ssl}; ${*$self}{sock}->stop_SSL(@_) or return; ${*$self}{ssl} = 0; return $self; } sub can_read { my ($self,$timeout) = @_; return 1 if ${*$self}{ssl} && ${*$self}{sock}->pending; vec( my $vec,fileno(${*$self}{sock}),1) = 1; return select($vec,undef,undef,$timeout); } sub peer_certificate { my $self = shift; return ${*$self}{ssl} && ${*$self}{sock}->peer_certificate(@_); } sub is_ssl { my $self = shift; return ${*$self}{ssl} && ${*$self}{sock}; } package Net::SSLGlue::Socket::HANDLE; use strict; use Errno 'EBADF'; use Scalar::Util 'weaken'; sub TIEHANDLE { my ($class, $handle) = @_; weaken($handle); bless \$handle, $class; } sub READ { ${shift()}->sysread(@_) } sub READLINE { ${shift()}->readline(@_) } sub GETC { ${shift()}->getc(@_) } sub PRINT { ${shift()}->print(@_) } sub PRINTF { ${shift()}->printf(@_) } sub WRITE { ${shift()}->syswrite(@_) } sub FILENO { ${shift()}->fileno(@_) } sub TELL { $! = EBADF; return -1 } sub BINMODE { return 0 } # not perfect, but better than not implementing the method sub CLOSE { #<---- Do not change this function! my $ssl = ${$_[0]}; local @_; $ssl->close(); } 1; =head1 NAME Net::SSLGlue::Socket - socket which can be either SSL or plain IP (IPv4/IPv6) =head1 SYNOPSIS use Net::SSLGlue::Socket; # SSL right from start my $ssl = Net::SSLGlue::Socket->new( PeerHost => ..., # IPv4|IPv6 address PeerPort => ..., SSL => 1, SSL_ca_path => ... ); # SSL through upgrade of plain connection my $plain = Net::SSLGlue::Socket->new(...); $plain->start_SSL( SSL_ca_path => ... ); ... $plain->stop_SSL =head1 DESCRIPTIONA First, it is recommended to use L directly instead of this module, since this kind of functionality is available in IO::Socket::SSL since version 1.994. L implements a socket which can be either plain or SSL. If IO::Socket::IP or IO::Socket::INET6 are installed it will also transparently handle IPv6 connections. A socket can be either start directly with SSL or it can be start plain and later be upgraded to SSL (because of a STARTTLS commando or similar) and also downgraded again. It is possible but not recommended to use the socket in non-blocking mode, because in this case special care must be taken with SSL (see documentation of L). Additionally to the usual socket methods the following methods are defined or extended: =head1 METHODS =over 4 =item new The method C of L can have the argument SSL. If this is true the SSL upgrade will be done immediatly. If not set any SSL_* args will still be saved and used at a later start_SSL call. =item start_SSL This will upgrade the plain socket to SSL. See L for arguments to C. Any SSL_* arguments given to new will be applied here too. =item stop_SSL This will downgrade the socket from SSL to plain. =item peer_certificate ... Once the SSL connection is established you can use this method to get information about the certificate. See the L documentation. =item can_read(timeout) This will check for available data. For a plain socket this will only use C