├── .github └── workflows │ └── test.yml ├── .gitignore ├── .travis.yml ├── BUGS ├── Changes ├── MANIFEST ├── MANIFEST.SKIP ├── Makefile.PL ├── README ├── docs └── debugging.txt ├── example ├── async_https_server.pl ├── lwp-with-verifycn.pl ├── simulate_proxy.pl ├── ssl_client.pl ├── ssl_mitm.pl └── ssl_server.pl ├── lib └── IO │ └── Socket │ ├── SSL.pm │ ├── SSL.pod │ └── SSL │ ├── Intercept.pm │ ├── PublicSuffix.pm │ └── Utils.pm ├── t ├── 01loadmodule.t ├── acceptSSL-timeout.t ├── alpn.t ├── auto_verify_hostname.t ├── cert_formats.t ├── cert_no_file.t ├── certs │ ├── c.pem │ ├── client-cert.pem │ ├── client-key.enc │ ├── client-key.pem │ ├── create-certs.pl │ ├── proxyca.pem │ ├── server-cert.der │ ├── server-cert.pem │ ├── server-ecc-cert.pem │ ├── server-ecc-key.pem │ ├── server-key.der │ ├── server-key.enc │ ├── server-key.pem │ ├── server-wildcard.pem │ ├── server.p12 │ ├── server2-cert.pem │ ├── server2-key.pem │ ├── server_enc.p12 │ ├── sub-server.pem │ ├── test-ca.pem │ └── test-subca.pem ├── compatibility.t ├── connectSSL-timeout.t ├── core.t ├── dhe.t ├── ecdhe.t ├── external │ ├── fingerprint.pl │ ├── ocsp.t │ └── usable_ca.t ├── io-socket-inet6.t ├── io-socket-ip.t ├── memleak_bad_handshake.t ├── mitm.t ├── multiple-cert-rsa-ecc.t ├── nonblock.t ├── npn.t ├── plain_upgrade_downgrade.t ├── protocol_version.t ├── psk.t ├── public_suffix_lib.pl ├── public_suffix_lib_encode_idn.t ├── public_suffix_lib_libidn.t ├── public_suffix_lib_uri.t ├── public_suffix_ssl.t ├── readline.t ├── session_cache.t ├── session_ticket.t ├── sessions.t ├── set_curves.t ├── signal-readline.t ├── sni.t ├── sni_verify.t ├── sni_verify_old.t ├── start-stopssl.t ├── startssl-failed.t ├── startssl.t ├── sysread_write.t ├── testlib.pl ├── verify_fingerprint.t ├── verify_hostname.t ├── verify_hostname_standalone.t └── verify_partial_chain.t └── tls_fingerprint ├── JAX.pm ├── README ├── client.pl ├── fp_from_pcap.pl └── server.pl /.github/workflows/test.yml: -------------------------------------------------------------------------------- 1 | name: Test IO::Socket::SSL 2 | 3 | on: 4 | push: 5 | branches-ignore: 6 | - '*travis*' 7 | - '*appveyor*' 8 | - '*doozer*' 9 | pull_request: 10 | workflow_dispatch: 11 | 12 | jobs: 13 | test: 14 | name: Test on ${{ matrix.config_name }} 15 | runs-on: ${{ matrix.os }} 16 | strategy: 17 | fail-fast: false 18 | matrix: 19 | include: 20 | - config_name: ubuntu-22.04 21 | os: ubuntu-22.04 22 | - config_name: ubuntu-24.04 23 | os: ubuntu-24.04 24 | - config_name: macos-13 25 | os: macos-13 26 | - config_name: macos-14 27 | os: macos-14 28 | - config_name: macos-15 29 | os: macos-15 30 | - config_name: windows-latest 31 | os: windows-latest 32 | allow-failure: true 33 | continue-on-error: ${{ matrix.allow-failure == true }} 34 | 35 | steps: 36 | - uses: actions/checkout@v4 37 | with: 38 | clean: false 39 | show-progress: false 40 | - name: System packages on Ubuntu 41 | run: | 42 | sudo apt-get update -qq 43 | sudo apt-get install -y --no-install-recommends cpanminus libssl-dev zlib1g-dev 44 | if: "startsWith(matrix.os, 'ubuntu-')" 45 | - name: System packages on Windows 46 | run: | 47 | choco install openssl.light 48 | if: "startsWith(matrix.os, 'windows-')" 49 | 50 | - name: Install cpanminus on Mac 51 | run: | 52 | brew install cpanminus 53 | cpanm --sudo --quiet --notest --installdeps . 54 | if: "startsWith(matrix.os, 'macos-')" 55 | 56 | - name: Install perl dependencies on Unix-like systems 57 | run: | 58 | cpanm --sudo --quiet --installdeps --notest . || ( cat /root/.cpanm/work/*/build.log; false ) 59 | if: "!startsWith(matrix.os, 'windows-')" 60 | - name: Install perl dependencies on Windows 61 | run: | 62 | cpanm --quiet --installdeps --notest . 63 | if: "startsWith(matrix.os, 'windows-')" 64 | 65 | - name: Build 66 | run: | 67 | perl Makefile.PL 68 | make -j4 69 | 70 | - name: Build on Unix-like systems 71 | run: | 72 | make test 73 | if: "!startsWith(matrix.os, 'windows-')" 74 | - name: Build on Windows 75 | run: | 76 | make test HARNESS_VERBOSE=1 77 | timeout-minutes: 3 78 | if: "startsWith(matrix.os, 'windows-')" 79 | 80 | test_in_container: 81 | name: Test with ${{ matrix.image }} 82 | runs-on: ubuntu-latest 83 | strategy: 84 | fail-fast: false 85 | matrix: 86 | include: 87 | - image: perl:5.8.9-threaded-stretch 88 | allow-failure: true 89 | - image: perl:5.10.1-buster 90 | - image: perl:5.12.5-stretch 91 | - image: perl:5.14.4-stretch 92 | - image: perl:5.16.3-buster 93 | - image: perl:5.18.4-buster 94 | - image: perl:5.22.4-stretch 95 | - image: perl:5.36.0-slim-bullseye 96 | - image: perl:5.38.0-slim-bookworm 97 | - image: perl:5.40.0-slim-bookworm 98 | ## use debian:* images only if there's no suitable perl:* image 99 | #- image: debian:bookworm 100 | - image: ubuntu:focal 101 | - image: rockylinux:9 102 | - image: fedora:41 103 | continue-on-error: ${{ matrix.allow-failure == true }} 104 | 105 | steps: 106 | # Note: checkout@v4 does not work with older debians (e.g.stretch), so do this step *outside* the container 107 | - uses: actions/checkout@v4 108 | - name: Preinstall, Configure, Build and Test 109 | run: | 110 | docker run --quiet -v $(pwd):$(pwd) ${{ matrix.image }} sh -c "cd $(pwd); "' 111 | set -ex 112 | export HARNESS_TIMER=1 113 | export HARNESS_OPTIONS=j8 114 | which cpanm 2>/dev/null || if which apt-get 2>/dev/null >/dev/null 115 | then 116 | DEBIAN_FRONTEND=noninteractive apt-get update -qq && apt-get install -qy --no-install-recommends cpanminus libssl-dev openssl zlib1g-dev make gcc 117 | else 118 | yum -y install perl-App-cpanminus "perl(Test::More)" openssl-devel openssl zlib-devel 119 | fi 120 | cpanm --quiet --installdeps --notest . || ( cat /root/.cpanm/work/*/build.log; false ) 121 | perl Makefile.PL 122 | make -j4 123 | make test 124 | ' 125 | 126 | test_freebsd: 127 | name: Test on FreeBSD ${{ matrix.osvers }} 128 | runs-on: ubuntu-24.04 129 | strategy: 130 | fail-fast: false 131 | matrix: 132 | include: 133 | - osvers: '13.4' 134 | - osvers: '14.2' 135 | steps: 136 | - uses: actions/checkout@v4 137 | with: 138 | clean: false 139 | show-progress: false 140 | - uses: cross-platform-actions/action@v0.26.0 141 | with: 142 | operating_system: freebsd 143 | version: '${{ matrix.osvers }}' 144 | run: | 145 | sudo pkg update 146 | sudo pkg install -y perl5 p5-App-cpanminus 147 | cpanm --sudo --quiet --notest --installdeps . 148 | perl Makefile.PL 149 | make -j4 150 | make test 151 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.orig 2 | *.bak 3 | stuff/ 4 | blib/ 5 | pm_to_blib 6 | Makefile 7 | Makefile.old 8 | *.tar.gz 9 | MYMETA.* 10 | 11 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | os: linux 2 | dist: trusty 3 | sudo: false 4 | 5 | language: perl 6 | 7 | perl: 8 | - "5.34" 9 | - "5.32" 10 | - "5.30" 11 | - "5.28" 12 | - "5.26" 13 | - "5.24" 14 | - "5.22" 15 | - "5.20" 16 | - "5.18" 17 | - "5.16" 18 | - "5.14" 19 | - "5.12" 20 | - "5.10" 21 | - "5.8" 22 | 23 | env: 24 | global: 25 | - JOBS=3 26 | - PERL_MM_USE_DEFAULT=1 27 | - AUTOMATED_TESTING=1 28 | - RELEASE_TESTING=0 29 | - NET_SSLEAY=1.91 30 | matrix: 31 | - OPENSSL_VERSION=openssl-3.0.1 32 | - OPENSSL_VERSION=openssl-1.1.1k 33 | - OPENSSL_VERSION=libressl-3.3.3 34 | - OPENSSL_VERSION=openssl-1.1.1d 35 | - OPENSSL_VERSION=openssl-1.1.0l 36 | - OPENSSL_VERSION=openssl-1.0.2u 37 | - OPENSSL_VERSION=openssl-1.0.1u 38 | - OPENSSL_VERSION=openssl-1.0.0s 39 | - OPENSSL_VERSION=openssl-0.9.8zh 40 | - OPENSSL_VERSION=libressl-3.2.2 41 | - OPENSSL_VERSION=libressl-3.1.2 42 | - OPENSSL_VERSION=libressl-3.0.2 43 | - OPENSSL_VERSION=libressl-2.9.2 44 | 45 | matrix: 46 | exclude: 47 | - perl: "5.8" 48 | env: OPENSSL_VERSION=openssl-1.1.0l 49 | - perl: "5.8" 50 | env: OPENSSL_VERSION=openssl-1.1.1d 51 | 52 | cache: 53 | directories: 54 | - openssl_version_cache 55 | - net_ssleay_cache 56 | 57 | before_install: 58 | - mkdir -p openssl_version_cache/src 59 | - mkdir -p openssl_version_cache/build 60 | - mkdir -p net_ssleay_cache/src 61 | - mkdir -p net_ssleay_cache/build 62 | 63 | install: 64 | - | 65 | if [ ! -f openssl_version_cache/src/$OPENSSL_VERSION.tar.gz ]; then 66 | echo $OPENSSL_VERSION | grep -q libressl 67 | if [ $? -eq 0 ]; then 68 | url=https://ftp.openbsd.org/pub/OpenBSD/LibreSSL/$OPENSSL_VERSION.tar.gz 69 | else 70 | url=https://www.openssl.org/source/$OPENSSL_VERSION.tar.gz 71 | fi 72 | wget -k -P openssl_version_cache/src $url 73 | fi 74 | - if [ ! -f net_ssleay_cache/src/$NET_SSLEAY.zip ]; then wget -k -P net_ssleay_cache/src https://github.com/noxxi/p5-net-ssleay/archive/$NET_SSLEAY.zip; fi 75 | 76 | before_script: 77 | - | 78 | if [ ! -d openssl_version_cache/build/$OPENSSL_VERSION ]; then 79 | if [ ! -d openssl_version_cache/src/$OPENSSL_VERSION ]; then 80 | cd openssl_version_cache/src 81 | tar xzf $OPENSSL_VERSION.tar.gz || exit 1 82 | cd ../.. 83 | fi 84 | if [ ! -d openssl_version_cache/src/$OPENSSL_VERSION ]; then 85 | echo "ERROR Dir openssl_version_cache/src/$OPENSSL_VERSION does not exist" && exit 1 86 | fi 87 | cd openssl_version_cache/src/$OPENSSL_VERSION 88 | echo $OPENSSL_VERSION | grep -q libressl 89 | if [ $? -eq 0 ]; then 90 | ./configure --prefix=$PWD/../../build/$OPENSSL_VERSION 91 | make install > build.log 2>&1 || (cat build.log && exit 1) 92 | elif [ "$OPENSSL_VERSION" = "openssl-1.0.0s" ] || [ "$OPENSSL_VERSION" = "openssl-0.9.8zh" ]; then 93 | ./Configure linux-x86_64 --prefix=$PWD/../../build/$OPENSSL_VERSION --openssldir=$PWD/../../build/$OPENSSL_VERSION/ssl shared -Wa,--noexecstack > build.log 2>&1 || (cat build.log && exit 1) 94 | make > build.log 2>&1 || (cat build.log && exit 1) 95 | make install_sw > build.log 2>&1 || (cat build.log && exit 1) 96 | make install_ssldirs > build.log 2>&1 || (cat build.log && exit 1) 97 | else 98 | ./Configure linux-x86_64 --prefix=$PWD/../../build/$OPENSSL_VERSION --openssldir=$PWD/../../build/$OPENSSL_VERSION/ssl enable-shared -Wa,--noexecstack > build.log 2>&1 || (cat build.log && exit 1) 99 | make -j$JOBS > build.log 2>&1 || (cat build.log && exit 1) 100 | make install_sw > build.log 2>&1 || (cat build.log && exit 1) 101 | make install_ssldirs > build.log 2>&1 || (cat build.log && exit 1) 102 | fi 103 | cd ../../.. 104 | fi 105 | - | 106 | DIR=$PWD 107 | cd net_ssleay_cache/build/ 108 | rm -rf p5-net-ssleay-$NET_SSLEAY 109 | unzip ../src/$NET_SSLEAY.zip 110 | cd p5-net-ssleay-$NET_SSLEAY 111 | OPENSSL_PREFIX=$DIR/openssl_version_cache/build/$OPENSSL_VERSION LD_LIBRARY_PATH=$DIR/openssl_version_cache/build/$OPENSSL_VERSION/lib perl Makefile.PL 112 | make test 113 | cd $DIR 114 | 115 | script: 116 | - | 117 | export PERL5OPT=-Mblib=$DIR/net_ssleay_cache/build/p5-net-ssleay-$NET_SSLEAY/blib 118 | perl Makefile.PL 119 | make 120 | make TEST_VERBOSE=1 test 121 | -------------------------------------------------------------------------------- /BUGS: -------------------------------------------------------------------------------- 1 | See documentation. 2 | Following are some common errors to watch out for: 3 | 4 | 5 | It doesn't work together with Storable::fd_retrieve|fd_store, see 6 | https://rt.cpan.org/Ticket/Display.html?id=23419. 7 | You need to use freeze/nfreeze/thaw and syswrite/sysread the data 8 | yourself. See the bug for examples how to do it. 9 | 10 | --------------------- 11 | 12 | Note that a random number generator is required for the proper 13 | operation of this module. Systems that have /dev/random or 14 | /dev/urandom are fine, but those that do not, like most versions 15 | of Solaris, will need to fetch one before installing IO::Socket::SSL. 16 | If you don't already have a favorite, try EGD (egd.sourceforge.net). 17 | 18 | --------------------- 19 | 20 | Versions of perl-ldap below v0.26 do not work with this version 21 | of IO::Socket::SSL because they contain a workaround for old 22 | versions of IO::Socket::SSL that breaks new versions. 23 | 24 | --------------------- 25 | 26 | One user mentioned that the following did not work as it should in 27 | IO::Socket::SSL, but worked in IO::Socket::INET: 28 | 29 | chomp($var = <$socket>); 30 | print ord(chop($var)); # Prints "10" for people using ASCII 31 | 32 | This is due to a bug in Perl that is fixed in 5.8.1. If you need 33 | a workaround, try one of the following: 34 | 35 | chomp($var = $socket->getline()); 36 | chomp($var = scalar <$socket>); 37 | chomp($var = $var = <$socket>); 38 | 39 | Any function that returns the value of <$socket> (in scalar context) 40 | unchanged will work. 41 | 42 | --------------------- 43 | 44 | If you have 384-bit RSA keys you need to use Diffie Hellman Key Exchange. 45 | See the parameter SSL_dh_file or SSL_dh for how to use it and 46 | http://groups.google.de/group/mailing.openssl.users/msg/d60330cfa7a6034b 47 | for an explanation why you need it. 48 | 49 | -- 50 | Steffen Ullrich (sullr at cpan.org) 51 | Peter Behroozi (behrooz at fas.harvard.edu) 52 | -------------------------------------------------------------------------------- /MANIFEST: -------------------------------------------------------------------------------- 1 | BUGS 2 | Changes 3 | docs/debugging.txt 4 | example/async_https_server.pl 5 | example/lwp-with-verifycn.pl 6 | example/simulate_proxy.pl 7 | example/ssl_client.pl 8 | example/ssl_mitm.pl 9 | example/ssl_server.pl 10 | lib/IO/Socket/SSL/Intercept.pm 11 | lib/IO/Socket/SSL.pm 12 | lib/IO/Socket/SSL.pod 13 | lib/IO/Socket/SSL/PublicSuffix.pm 14 | lib/IO/Socket/SSL/Utils.pm 15 | Makefile.PL 16 | MANIFEST This list of files 17 | README 18 | t/01loadmodule.t 19 | t/acceptSSL-timeout.t 20 | t/alpn.t 21 | t/auto_verify_hostname.t 22 | t/cert_formats.t 23 | t/cert_no_file.t 24 | t/certs/client-cert.pem 25 | t/certs/client-key.enc 26 | t/certs/client-key.pem 27 | t/certs/create-certs.pl 28 | t/certs/proxyca.pem 29 | t/certs/server2-cert.pem 30 | t/certs/server2-key.pem 31 | t/certs/server-cert.der 32 | t/certs/server-cert.pem 33 | t/certs/server-ecc-cert.pem 34 | t/certs/server-ecc-key.pem 35 | t/certs/server_enc.p12 36 | t/certs/server-key.der 37 | t/certs/server-key.enc 38 | t/certs/server-key.pem 39 | t/certs/server.p12 40 | t/certs/server-wildcard.pem 41 | t/certs/sub-server.pem 42 | t/certs/test-ca.pem 43 | t/certs/test-subca.pem 44 | t/compatibility.t 45 | t/connectSSL-timeout.t 46 | t/core.t 47 | t/dhe.t 48 | t/ecdhe.t 49 | t/external/fingerprint.pl 50 | t/external/ocsp.t 51 | t/external/usable_ca.t 52 | t/io-socket-inet6.t 53 | t/io-socket-ip.t 54 | t/memleak_bad_handshake.t 55 | t/mitm.t 56 | t/multiple-cert-rsa-ecc.t 57 | t/nonblock.t 58 | t/npn.t 59 | t/plain_upgrade_downgrade.t 60 | t/protocol_version.t 61 | t/psk.t 62 | t/public_suffix_lib_encode_idn.t 63 | t/public_suffix_lib_libidn.t 64 | t/public_suffix_lib.pl 65 | t/public_suffix_lib_uri.t 66 | t/public_suffix_ssl.t 67 | t/readline.t 68 | t/session_cache.t 69 | t/sessions.t 70 | t/session_ticket.t 71 | t/set_curves.t 72 | t/signal-readline.t 73 | t/sni.t 74 | t/sni_verify.t 75 | t/startssl-failed.t 76 | t/startssl.t 77 | t/start-stopssl.t 78 | t/sysread_write.t 79 | t/testlib.pl 80 | t/verify_fingerprint.t 81 | t/verify_hostname_standalone.t 82 | t/verify_hostname.t 83 | t/verify_partial_chain.t 84 | -------------------------------------------------------------------------------- /MANIFEST.SKIP: -------------------------------------------------------------------------------- 1 | ^blib/ 2 | ^Makefile$ 3 | stuff 4 | \.git.* 5 | \.(old|bak|orig)$ 6 | \.tar.gz$ 7 | ^MYMETA\. 8 | ^MANIFEST\. 9 | ^pm_to_blib$ 10 | -------------------------------------------------------------------------------- /Makefile.PL: -------------------------------------------------------------------------------- 1 | # vim: set sts=4 sw=4 ts=8 ai: 2 | 3 | use 5.008; 4 | use ExtUtils::MakeMaker; 5 | 6 | # Test to make sure that Net::SSLeay can be properly seeded! 7 | unless (defined $ENV{EGD_PATH}) { 8 | foreach (qw(/var/run/egd-pool /dev/egd-pool /etc/egd-pool /etc/entropy)) { 9 | if (-S) { $ENV{EGD_PATH}=$_; last } 10 | } 11 | } 12 | 13 | $| = 1; 14 | 15 | my $yesno = sub { 16 | my ($msg,$default) = @_; 17 | return $default if defined $default && $ENV{PERL_MM_USE_DEFAULT}; 18 | # Taken from ExtUtils::MakeMaker 6.16 (Michael Schwern) so that 19 | # the prompt() function can be emulated for older versions of ExtUtils::MakeMaker. 20 | while ( -t STDIN && (-t STDOUT || !(-f STDOUT || -c STDOUT))) { 21 | print "$msg "; 22 | my $choice = ; 23 | $choice =~s{\s+$}{}; 24 | $choice ||= $default; 25 | next if $choice !~m{^\s*([yn])}i; 26 | return lc($1); 27 | } 28 | 29 | return $default; 30 | }; 31 | 32 | { 33 | # issue warning, if Net::SSLeay cannot find random generator 34 | # redefine __WARN__ only locally to allow detection of failures 35 | # in PREREQ_PM 36 | local $SIG{__WARN__} = sub { 37 | undef $SIG{__WARN__}; 38 | my $warning = shift; 39 | return unless $warning =~ /random/i; 40 | print "Net::SSLeay could not find a random number generator on\n"; 41 | print "your system. This will likely cause most of the tests\n"; 42 | print "to fail. Please see the README file for more information.\n"; 43 | print "the message from Net::SSLeay was: $warning\n"; 44 | 45 | $yesno->("Do you REALLY want to continue? y/[N]","n") eq 'y' 46 | or die "Install cancelled.\n"; 47 | }; 48 | 49 | if (! defined $ENV{SKIP_RNG_TEST}) { 50 | eval { require Net::SSLeay; $Net::SSLeay::trace=1; Net::SSLeay::randomize(); }; 51 | die $@ if $@ =~ /cancelled/; 52 | } else { 53 | print "Random Number Generator test skipped.\n"; 54 | } 55 | } 56 | 57 | if (my $compiled = eval { 58 | require Net::SSLeay; 59 | Net::SSLeay::OPENSSL_VERSION_NUMBER() 60 | }) { 61 | # don't support too old OpenSSL versions anymore, only causes trouble 62 | die sprintf( 63 | "minimal required version for OpenSSL is 0.9.8, but your Net::SSLeay reports 0x%08x", 64 | $compiled) if $compiled < 0x00908000; 65 | 66 | my $linked = Net::SSLeay::SSLeay(); 67 | 68 | # OpenSSL 1.1.1e introduced behavior changes breaking various code 69 | # will likely be reverted in 1.1.1f - enforce to not use this version 70 | if ($linked == 0x1010105f) { 71 | die "detected OpenSSL 1.1.1e - please use a different version\n"; 72 | } 73 | 74 | # For old versions we need to be rather strict, however OpenSSL explicitly 75 | # declares that from 3.0 on x.y versions are for all y ABI-compatible. 76 | # https://www.openssl.org/policies/releasestrat.html 77 | if ($linked < 0x30000000) { 78 | if (($compiled ^ $linked) >= 0x00001000) { 79 | die sprintf("API-different OpenSSL versions compiled in (0x%08x) vs linked (0x%08x)", 80 | $compiled,$linked); 81 | } 82 | } else { 83 | if (($compiled ^ $linked) >= 0x10000000) { 84 | die sprintf("API-different OpenSSL versions compiled in (0x%08x) vs linked (0x%08x)", 85 | $compiled,$linked); 86 | } 87 | } 88 | } 89 | 90 | # make sure that we have dualvar from the XS Version of Scalar::Util 91 | if ( eval { require Scalar::Util } ) { 92 | eval { Scalar::Util::dualvar( 0,'' ) }; 93 | die "You need the XS Version of Scalar::Util for dualvar() support" if ($@); 94 | } 95 | 96 | # check if we have something which handles IDN 97 | if ( ! eval { require Net::IDN::Encode } and ! eval { require Net::LibIDN } and ! eval { require URI; URI->VERSION(1.50) }) { 98 | warn <<'EOM'; 99 | 100 | WARNING 101 | No library for handling international domain names found. 102 | It will work but croak if you try to verify an international name against 103 | a certificate. 104 | It's recommended to install URI version>=1.50. 105 | Net::IDN::Encode and Net::LibIDN are also still supported. 106 | 107 | EOM 108 | } 109 | 110 | # check if we have usable CA store 111 | # on windows we might need to install Mozilla::CA 112 | # settings for default path from openssl crypto/cryptlib.h 113 | my %usable_ca; 114 | { 115 | my $openssldir = eval { 116 | require Net::SSLeay; 117 | Net::SSLeay::SSLeay_version(Net::SSLeay::SSLEAY_DIR()) =~m{^OPENSSLDIR: "(.+)"$} && $1 || ''; 118 | } || eval { 119 | require Net::SSLeay; 120 | Net::SSLeay::SSLeay_version(5) =~m{^OPENSSLDIR: "(.+)"$} && $1 || ''; 121 | }; 122 | my $dir = $ENV{SSL_CERT_DIR} 123 | || ( $^O =~m{vms}i ? "SSLCERTS:":"$openssldir/certs" ); 124 | if ( opendir(my $dh,$dir)) { 125 | FILES: for my $f ( grep { m{^[a-f\d]{8}(\.\d+)?$} } readdir($dh) ) { 126 | open( my $fh,'<',"$dir/$f") or next; 127 | while (<$fh>) { 128 | m{^-+BEGIN (X509 |TRUSTED |)CERTIFICATE-} or next; 129 | $usable_ca{SSL_ca_path} = $dir; 130 | last FILES; 131 | } 132 | } 133 | } 134 | my $file = $ENV{SSL_CERT_FILE} 135 | || ( $^O =~m{vms}i ? "SSLCERTS:cert.pem":"$openssldir/cert.pem" ); 136 | if ( open(my $fh,'<',$file)) { 137 | while (<$fh>) { 138 | m{^-+BEGIN (X509 |TRUSTED |)CERTIFICATE-} or next; 139 | $usable_ca{SSL_ca_file} = $file; 140 | last; 141 | } 142 | } 143 | } 144 | 145 | my $xt = $ENV{NO_NETWORK_TESTING} && 'n'; 146 | $xt ||= $yesno->( "Should I do external tests?\n". 147 | "These test will detect if there are network problems and fail soft,\n". 148 | "so please disable them only if you definitely don't want to have any\n". 149 | "network traffic to external sites. [Y/n]", 'y' ); 150 | 151 | 152 | # See lib/ExtUtils/MakeMaker.pm for details of how to influence 153 | # the contents of the Makefile that is written. 154 | WriteMakefile( 155 | 'NAME' => 'IO::Socket::SSL', 156 | 'ABSTRACT' => 'Nearly transparent SSL encapsulation for IO::Socket::INET.', 157 | 'AUTHOR' => 'Steffen Ullrich , Peter Behroozi, Marko Asplund', 158 | 'LICENSE' => 'perl', 159 | 'DISTNAME' => 'IO-Socket-SSL', 160 | 'VERSION_FROM' => 'lib/IO/Socket/SSL.pm', 161 | 'PREREQ_PM' => { 162 | 'Net::SSLeay' => 1.46, 163 | 'Scalar::Util' => 0, 164 | ! %usable_ca ? ( 'Mozilla::CA' => 0 ):(), 165 | }, 166 | 'dist' => { COMPRESS => 'gzip', SUFFIX => 'gz', }, 167 | $xt eq 'y' ? ( test => { TESTS => 't/*.t t/external/*.t' }):(), 168 | $ExtUtils::MakeMaker::VERSION >= 6.46 ? ( 169 | 'META_MERGE' => { 170 | resources => { 171 | license => 'http://dev.perl.org/licenses/', 172 | repository => 'https://github.com/noxxi/p5-io-socket-ssl', 173 | homepage => 'https://github.com/noxxi/p5-io-socket-ssl', 174 | bugtracker => 'https://github.com/noxxi/p5-io-socket-ssl/issues', 175 | }, 176 | }, 177 | ):(), 178 | $ExtUtils::MakeMaker::VERSION >= 6.52 ? ( 179 | 'CONFIGURE_REQUIRES' => { 180 | "ExtUtils::MakeMaker" => 0, 181 | 'Net::SSLeay' => 1.46, 182 | }, 183 | ):(), 184 | ); 185 | -------------------------------------------------------------------------------- /README: -------------------------------------------------------------------------------- 1 | 2 | IO::Socket::SSL is a class implementing an object oriented 3 | interface to SSL sockets. The class is a descendent of 4 | IO::Socket::INET. 5 | 6 | In order to use IO::Socket::SSL you need to have Net::SSLeay 7 | v1.46 or newer installed. 8 | 9 | To use ECDH curves (needed for perfect forward secrecy) you need 10 | to use Net::SSLeay >= 1.56. 11 | 12 | To use OCSP to check for certificate revocations you need 13 | OpenSSL 1.0.0 or better and Net::SSLeay>=1.59. 14 | 15 | For those who do not have a built-in random number generator 16 | (including most users of Solaris), you should install one 17 | before attempting to install IO::Socket::SSL. If you don't 18 | already have a favorite, try "egd" (egd.sourceforge.net) or 19 | one of the other "Related Projects" listed on its home page. 20 | If you want to bypass the test for existence of the RNG, then 21 | set the "SKIP_RNG_TEST" environment variable to a true value. 22 | 23 | In addition to providing a general OO interface to SSL sockets, 24 | this package can be used with libwww-perl. 25 | 26 | installation: 27 | perl Makefile.PL 28 | make 29 | make test 30 | make install 31 | 32 | -- 33 | Steffen Ullrich, Steffen_Ullrich at genua.de 34 | Peter Behroozi, behrooz at fas.harvard.edu 35 | (Originally by Marko Asplund, marko.asplund at kronodoc.fi) 36 | -------------------------------------------------------------------------------- /docs/debugging.txt: -------------------------------------------------------------------------------- 1 | 2 | - check that IO::Socket::SSL and Net::SSLeay are properly installed, 3 | and that the versions are recently new: 4 | perl -MIO::Socket::SSL -e 'print "$IO::Socket::SSL::VERSION\n"' 5 | perl -MNet::SSLeay -e 'print "$Net::SSLeay::VERSION\n"' 6 | 7 | - run the tests in IO::Socket::SSL directory 8 | try running the tests with 'make test'. if some of the tests fail run 9 | the scripts one by one e.g.: 10 | perl -Ilib t/core.t 11 | 12 | - try running the demos using the DEBUG option 13 | 14 | - use the OpenSSL client and server for debugging the demo client and server. 15 | 'openssl s_client' and 'openssl s_server' against tests/demos 16 | testing the demo server: 17 | openssl s_client -connect localhost:9000 \ 18 | -key certs/client-key.pem -cert certs/client-cert.pem -verify 1 19 | testing the demo client: 20 | openssl s_server -accept 9000 \ 21 | -key certs/server-key.pem -cert certs/server-cert.pem -verify 1 22 | also, try these commands without the verify argument. 23 | 24 | 25 | 26 | -------------------------------------------------------------------------------- /example/async_https_server.pl: -------------------------------------------------------------------------------- 1 | ########################################################## 2 | # example HTTPS server using nonblocking sockets 3 | # requires Event::Lib 4 | # at the moment the response consists only of the HTTP 5 | # request, send back as text/plain 6 | ########################################################## 7 | 8 | use strict; 9 | use IO::Socket; 10 | use IO::Socket::SSL; 11 | use Event::Lib; 12 | use Errno ':POSIX'; 13 | 14 | #$Net::SSLeay::trace=3; 15 | 16 | eval 'use Debug'; 17 | *{DEBUG} = sub {} if !defined(&DEBUG); 18 | 19 | # create server socket 20 | my $server = IO::Socket::INET->new( 21 | LocalAddr => '0.0.0.0:9000', 22 | Listen => 10, 23 | Reuse => 1, 24 | Blocking => 0, 25 | ) || die $!; 26 | 27 | event_new( $server, EV_READ|EV_PERSIST, \&_s_accept )->add(); 28 | event_mainloop; 29 | 30 | ########################################################## 31 | ### accept new client on server socket 32 | ########################################################## 33 | sub _s_accept { 34 | my $fds = shift->fh; 35 | my $fdc = $fds->accept || return; 36 | DEBUG( "new client" ); 37 | 38 | $fdc = IO::Socket::SSL->start_SSL( $fdc, 39 | SSL_startHandshake => 0, 40 | SSL_server => 1, 41 | ) || die $!; 42 | 43 | $fdc->blocking(0); 44 | _ssl_accept( undef,$fdc ); 45 | } 46 | 47 | ########################################################## 48 | ### ssl handshake with client 49 | ### called again and again until the handshake is done 50 | ### this is called first from _s_accept w/o an event 51 | ### and later enters itself as new event until the 52 | ### handshake is done 53 | ### if the handshake is done it inits the buffers for the 54 | ### client socket and adds an event for reading the HTTP header 55 | ########################################################## 56 | sub _ssl_accept { 57 | my ($event,$fdc) = @_; 58 | $fdc ||= $event->fh; 59 | if ( $fdc->accept_SSL ) { 60 | DEBUG( "new client ssl handshake done" ); 61 | # setup the client 62 | ${*$fdc}{rbuf} = ${*$fdc}{wbuf} = ''; 63 | event_new( $fdc, EV_READ, \&_client_read_header )->add; 64 | } elsif ( $! != EWOULDBLOCK && $! != EAGAIN ) { 65 | die "new client failed: $!|$SSL_ERROR"; 66 | } else { 67 | DEBUG( "new client need to retry accept: $SSL_ERROR" ); 68 | my $what = 69 | $SSL_ERROR == SSL_WANT_READ ? EV_READ : 70 | $SSL_ERROR == SSL_WANT_WRITE ? EV_WRITE : 71 | die "unknown error"; 72 | event_new( $fdc, $what, \&_ssl_accept )->add; 73 | } 74 | } 75 | 76 | 77 | ########################################################## 78 | ### read http header 79 | ### this will re-add itself as an event until the full 80 | ### http header was read 81 | ### after reading the header it will setup the response 82 | ### which will for now just send the header back as text/plain 83 | ########################################################## 84 | sub _client_read_header { 85 | my $event = shift; 86 | my $fdc = $event->fh; 87 | DEBUG( "reading header" ); 88 | my $rbuf_ref = \${*$fdc}{rbuf}; 89 | my $n = sysread( $fdc,$$rbuf_ref,16384,length($$rbuf_ref)); 90 | if ( !defined($n)) { 91 | die $! if $! != EWOULDBLOCK && $! != EAGAIN; 92 | DEBUG( $SSL_ERROR ); 93 | if ( $SSL_ERROR == SSL_WANT_WRITE ) { 94 | # retry read once I can write 95 | event_new( $fdc, EV_WRITE, \&_client_read_header )->add; 96 | } else { 97 | $event->add; # retry 98 | } 99 | } elsif ( $n == 0 ) { 100 | DEBUG( "connection closed" ); 101 | close($fdc); 102 | } else { 103 | # check if we have the whole http header 104 | my $i = index( $$rbuf_ref,"\r\n\r\n" ); # check \r\n\r\n 105 | $i = index( $$rbuf_ref,"\n\n" ) if $i<0; # bad clients send \n\n only 106 | if ( $i<0 ) { 107 | $event->add; # read more from header 108 | return; 109 | } 110 | 111 | # got full header, send request back (we don't serve real pages yet) 112 | my $header = substr( $$rbuf_ref,0,$i,'' ); 113 | DEBUG( "got header:\n$header" ); 114 | my $wbuf_ref = \${*$fdc}{wbuf}; 115 | $$wbuf_ref = "HTTP/1.0 200 Ok\r\nContent-type: text/plain\r\n\r\n".$header; 116 | DEBUG( "will send $$wbuf_ref" ); 117 | event_new( $fdc, EV_WRITE, \&_client_write_response )->add; 118 | } 119 | } 120 | 121 | ########################################################## 122 | ### this is called to write the response to the client 123 | ### this will re-add itself as an event as until the full 124 | ### response was send 125 | ### if it's done it will just close the socket 126 | ########################################################## 127 | sub _client_write_response { 128 | my $event = shift; 129 | DEBUG( "writing response" ); 130 | my $fdc = $event->fh; 131 | my $wbuf_ref = \${*$fdc}{wbuf}; 132 | my $n = syswrite( $fdc,$$wbuf_ref ); 133 | if ( !defined($n) && ( $! == EWOULDBLOCK || $! == EAGAIN ) ) { 134 | # retry 135 | DEBUG( $SSL_ERROR ); 136 | if ( $SSL_ERROR == SSL_WANT_READ ) { 137 | # retry write once we can read 138 | event_new( $fdc, EV_READ, \&_client_write_response )->add; 139 | } else { 140 | $event->add; # retry again 141 | } 142 | } elsif ( $n == 0 ) { 143 | DEBUG( "connection closed: $!" ); 144 | close($fdc); 145 | } else { 146 | DEBUG( "wrote $n bytes" ); 147 | substr($$wbuf_ref,0,$n,'' ); 148 | if ($$wbuf_ref eq '') { 149 | DEBUG( "done" ); 150 | close($fdc); 151 | } else { 152 | # send more 153 | $event->add 154 | } 155 | } 156 | } 157 | 158 | -------------------------------------------------------------------------------- /example/lwp-with-verifycn.pl: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | ## !!! make sure that Net::SSL never gets loaded, otherwise it will 5 | ## be used instead of IO::Socket::SSL from LWP 6 | 7 | use IO::Socket::SSL 'debug0'; 8 | use LWP::Simple; 9 | 10 | IO::Socket::SSL::set_ctx_defaults( 11 | SSL_verifycn_scheme => 'www', 12 | SSL_verify_mode => 1, 13 | SSL_ca_file => 'verisign.pem', # root CA of verisign 14 | ); 15 | print get( 'https://signin.ebay.com' ); 16 | 17 | 18 | 19 | -------------------------------------------------------------------------------- /example/ssl_client.pl: -------------------------------------------------------------------------------- 1 | # 2 | # a test client for testing IO::Socket::SSL-class's behavior 3 | 4 | use strict; 5 | use warnings; 6 | use IO::Socket::SSL; 7 | use Getopt::Long qw(:config posix_default bundling); 8 | use Digest::MD5 'md5_hex'; 9 | 10 | my ($cert_file,$key_file,$key_pass,$ca,$name,$no_verify); 11 | GetOptions( 12 | 'd|debug:i' => \$IO::Socket::SSL::DEBUG, 13 | 'h|help' => sub { usage() }, 14 | 'C|cert=s' => \$cert_file, 15 | 'K|key=s' => \$key_file, 16 | 'P|pass=s' => \$key_pass, 17 | 'ca=s' => \$ca, 18 | 'name=s' => \$name, 19 | 'no-verify' => \$no_verify, 20 | ) or usage("bad option"); 21 | 22 | sub usage { 23 | print STDERR "Error: @_\n" if @_; 24 | print STDERR <new( 45 | PeerAddr => $addr, 46 | $ca ? ( -d $ca ? ( SSL_ca_path => $ca ):( SSL_ca_file => $ca ) ):(), 47 | $name ? ( SSL_hostname => $name ):(), 48 | $no_verify ? ( SSL_verify_mode => 0 ):(), 49 | $cert_file ? ( 50 | SSL_cert_file => $cert_file, 51 | SSL_key_file => $key_file, 52 | defined($key_pass) ? ( SSL_passwd_cb => sub { $key_pass } ):(), 53 | ):(), 54 | SSL_startHandshake => 0, 55 | ) or die "failed to connect to $addr: $!,$SSL_ERROR"; 56 | 57 | my $ja3s; 58 | $cl->set_msg_callback(\&msgcb, \$ja3s); 59 | $cl->connect_SSL() or die "failed SSL handshake: $SSL_ERROR"; 60 | 61 | warn "new SSL connection with cipher=".$cl->get_cipher." version=".$cl->get_sslversion." certificate:\n". 62 | "\tsubject=".$cl->peer_certificate('subject')."\n". 63 | "\tissuer=".$cl->peer_certificate('issuer')."\n". 64 | "\tja3s=".md5_hex($ja3s)." $ja3s\n"; 65 | 66 | 67 | sub msgcb { 68 | my ($self, $direction, $ssl_ver, $content_type, $buf, $len, $ssl, $ja3s_r) = @_; 69 | $content_type == 22 or return; # TLS handshake 70 | # 1 byte: msg type 71 | # 3 byte: length 72 | (my $msg_type, $buf) = unpack('c x3 a*', $buf); 73 | if ($msg_type == 2) { # Server Hello 74 | $self->set_msg_callback(undef); # no need to look further 75 | 76 | # 2 byte: protocol version 77 | # 32 byte: random 78 | # 1/... : session id 79 | # 2 byte: cipher suite 80 | # 1 byte: compression method 81 | # 2/... : extensions 82 | my ($ver, $cipher, $ext) = unpack("n x32 c/x n x n/a", $buf); 83 | 84 | my @ext; 85 | while (length($ext)>2) { 86 | # 2 byte: extension type 87 | # 2|... : extension data 88 | (my $ext_type, $ext) = unpack("n n/x a*", $ext); 89 | push @ext, $ext_type; 90 | } 91 | $$ja3s_r = join(",", 92 | $ver, 93 | $cipher, 94 | join("-", @ext) 95 | ); 96 | } 97 | } 98 | -------------------------------------------------------------------------------- /example/ssl_mitm.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | # simple HTTPS proxy with SSL bridging, uses Net::PcapWriter to 3 | # to log unencrypted traffic 4 | 5 | my $listen = '127.0.0.1:8443'; # where to listen 6 | my $connect = 'www.google.com:443'; # where to connect 7 | 8 | use strict; 9 | use warnings; 10 | use IO::Socket::SSL; 11 | use IO::Socket::SSL::Intercept; 12 | use IO::Socket::SSL::Utils; 13 | 14 | my ($proxy_cert,$proxy_key) = CERT_create( 15 | CA => 1, 16 | subject => { commonName => 'foobar' } 17 | ); 18 | 19 | 20 | my $mitm = IO::Socket::SSL::Intercept->new( 21 | proxy_cert => $proxy_cert, 22 | proxy_key => $proxy_key, 23 | ); 24 | 25 | my $listener = IO::Socket::INET->new( 26 | LocalAddr => $listen, 27 | Listen => 10, 28 | Reuse => 1, 29 | ) or die "failed to create listener: $!"; 30 | 31 | while (1) { 32 | # get connection from client 33 | my $toc = $listener->accept or next; 34 | 35 | # create new connection to server 36 | my $tos = IO::Socket::SSL->new( 37 | PeerAddr => $connect, 38 | SSL_verify_mode => 1, 39 | SSL_ca_path => '/etc/ssl/certs', 40 | ) or die "ssl connect to $connect failed: $!,$SSL_ERROR"; 41 | 42 | # clone cert from server 43 | my ($cert,$key) = $mitm->clone_cert( $tos->peer_certificate ); 44 | 45 | # and upgrade connection to client to SSL with cloned cert 46 | IO::Socket::SSL->start_SSL($toc, 47 | SSL_server => 1, 48 | SSL_cert => $cert, 49 | SSL_key => $key, 50 | ) or die "failed to ssl upgrade: $SSL_ERROR"; 51 | 52 | # transfer data 53 | my $readmask = ''; 54 | vec($readmask,fileno($tos),1) = 1; 55 | vec($readmask,fileno($toc),1) = 1; 56 | while (1) { 57 | select( my $can_read = $readmask,undef,undef,undef ) >0 or die $!; 58 | # try to read the maximum frame size of SSL to avoid issues 59 | # with pending data 60 | if ( vec($can_read,fileno($tos),1)) { 61 | sysread($tos,my $buf,16384) or last; 62 | print $toc $buf; 63 | } 64 | if ( vec($can_read,fileno($toc),1)) { 65 | sysread($toc,my $buf,16384) or last; 66 | print $tos $buf; 67 | } 68 | } 69 | } 70 | 71 | 72 | -------------------------------------------------------------------------------- /example/ssl_server.pl: -------------------------------------------------------------------------------- 1 | # 2 | # a test server for testing IO::Socket::SSL-class's behavior 3 | 4 | use strict; 5 | use warnings; 6 | use IO::Socket::SSL; 7 | use Getopt::Long qw(:config posix_default bundling); 8 | use Digest::MD5 'md5_hex'; 9 | 10 | my ($cert_file,$key_file,$key_pass,$ca,$http); 11 | GetOptions( 12 | 'd|debug:i' => \$IO::Socket::SSL::DEBUG, 13 | 'h|help' => sub { usage() }, 14 | 'C|cert=s' => \$cert_file, 15 | 'K|key=s' => \$key_file, 16 | 'P|pass=s' => \$key_pass, 17 | 'ca=s' => \$ca, 18 | 'http' => \$http, 19 | ) or usage("bad option"); 20 | 21 | sub usage { 22 | print STDERR "Error: @_\n" if @_; 23 | print STDERR <new( 45 | Listen => 5, 46 | LocalAddr => $addr, 47 | ReuseAddr => 1, 48 | ) or die "failed to create SSL server at $addr: $!"; 49 | 50 | my $ctx = IO::Socket::SSL::SSL_Context->new( 51 | SSL_server => 1, 52 | SSL_cert_file => $cert_file, 53 | SSL_key_file => $key_file, 54 | defined($key_pass) ? ( SSL_passwd_cb => sub { $key_pass } ):(), 55 | $ca ? ( 56 | SSL_verify_mode => SSL_VERIFY_PEER, 57 | -d $ca ? ( SSL_ca_path => $ca ):( SSL_ca_file => $ca, SSL_client_ca_file => $ca ) 58 | ):(), 59 | ) or die "cannot create context: $SSL_ERROR"; 60 | 61 | while (1) { 62 | warn "waiting for next connection.\n"; 63 | my $cl = $server->accept or do { 64 | warn "failed to accept: $!\n"; 65 | next; 66 | }; 67 | 68 | IO::Socket::SSL->start_SSL($cl, 69 | SSL_server => 1, 70 | SSL_reuse_ctx => $ctx, 71 | SSL_startHandshake => 0 72 | ) or do { 73 | warn "ssl handshake failed: $SSL_ERROR\n"; 74 | next; 75 | }; 76 | 77 | my $ja3; 78 | $cl->set_msg_callback(\&msgcb, \$ja3); 79 | $cl->accept_SSL() or do { 80 | warn "failed SSL handshake: $SSL_ERROR\n"; 81 | next; 82 | }; 83 | 84 | my $info = "cipher=".$cl->get_cipher 85 | . " version=".$cl->get_sslversion 86 | . " ja3=".md5_hex($ja3)." $ja3"; 87 | 88 | if ( $cl->peer_certificate ) { 89 | warn "new SSL connection with client certificate\n". 90 | "\tsubject=".$cl->peer_certificate('subject')."\n". 91 | "\tissuer=".$cl->peer_certificate('issuer')."\n". 92 | $info."\n"; 93 | } else { 94 | warn "new SSL connection without client certificate\n". 95 | $info."\n"; 96 | } 97 | 98 | if ($http) { 99 | sysread($cl, my $buf, 8192); 100 | $buf =~s{\n\r?\n.*}{\n}s; 101 | $info =~s{\b\w+=}{\n$&}mg; 102 | $info .= "\n\n-------\n\n$buf"; 103 | print $cl "HTTP/1.0 200 ok\r\n". 104 | "Content-type: text/plain\r\n". 105 | "Content-length: ".length($info)."\r\n". 106 | "\r\n". 107 | $info; 108 | } else { 109 | print $cl "connect with $info\n"; 110 | } 111 | } 112 | 113 | 114 | sub msgcb { 115 | my ($self, $direction, $ssl_ver, $content_type, $buf, $len, $ssl, $ja3_r) = @_; 116 | $content_type == 22 or return; # TLS handshake 117 | # 1 byte: msg type 118 | # 3 byte: length 119 | (my $msg_type, $buf) = unpack('c x3 a*', $buf); 120 | if ($msg_type == 1) { # Client Hello 121 | $self->set_msg_callback(undef); # no need to look further 122 | 123 | my %grease = map { $_ =>1 } ( 124 | 0x0a0a, 0x1a1a, 0x2a2a, 0x3a3a, 0x4a4a, 0x5a5a, 0x6a6a, 0x7a7a, 125 | 0x8a8a, 0x9a9a, 0xaaaa, 0xbaba, 0xcaca, 0xdada, 0xeaea, 0xfafa, 126 | ); 127 | 128 | # 2 byte: protocol version 129 | # 32 byte: random 130 | # 1/.. : session id 131 | # 2/... : cipher suites 132 | # 1/... : compression methods 133 | # 2/... : extensions 134 | my ($ver, $ciphers, $ext) = unpack("n x32 c/x n/a c/x n/a", $buf); 135 | 136 | my @ciphers = grep { !$grease{$_} } unpack("n*", $ciphers); 137 | 138 | my (@ext, @elliptic_curve, @elliptic_curve_point_format); 139 | while (length($ext)>2) { 140 | # 2 byte: extension value 141 | # 2|... : extension data 142 | (my $ext_val, my $ext_data, $ext) = unpack("n n/a a*", $ext); 143 | next if $grease{$ext_val}; 144 | push @ext, $ext_val; 145 | if ($ext_val == 0x0a) { 146 | # Elliptic curve points 147 | @elliptic_curve = unpack("x2 n*", $ext_data); 148 | } elsif ($ext_val == 0x0b) { 149 | # Elliptic curve point formats 150 | @elliptic_curve_point_format = unpack("x c*", $ext_data); 151 | } 152 | } 153 | 154 | $$ja3_r = join(",", 155 | $ver, 156 | join("-", @ciphers), 157 | join("-", @ext), 158 | join("-", @elliptic_curve), 159 | join("-", @elliptic_curve_point_format), 160 | ); 161 | } 162 | } 163 | -------------------------------------------------------------------------------- /t/01loadmodule.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | no warnings 'once'; 4 | use Test::More; 5 | 6 | plan tests => 3; 7 | 8 | ok( eval { require IO::Socket::SSL },"loaded"); 9 | 10 | diag( sprintf( "openssl version compiled=0x%0x linked=0x%0x -- %s", 11 | Net::SSLeay::OPENSSL_VERSION_NUMBER(), 12 | Net::SSLeay::SSLeay(), 13 | Net::SSLeay::SSLeay_version(0))); 14 | 15 | diag( sprintf( "Net::SSLeay version=%s", $Net::SSLeay::VERSION)); 16 | diag( sprintf( "parent %s version=%s", $_, $_->VERSION)) 17 | for (@IO::Socket::SSL::ISA); 18 | 19 | IO::Socket::SSL->import(':debug1'); 20 | is( $IO::Socket::SSL::DEBUG,1, "IO::Socket::SSL::DEBUG 1"); 21 | is( $Net::SSLeay::trace,1, "Net::SSLeay::trace 1"); 22 | 23 | -------------------------------------------------------------------------------- /t/acceptSSL-timeout.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Socket; 4 | use IO::Socket::SSL; 5 | do './testlib.pl' || do './t/testlib.pl' || die "no testlib"; 6 | 7 | $|=1; 8 | print "1..15\n"; 9 | 10 | # first use SSL client 11 | { 12 | my ($server,$saddr) = create_listen_socket(); 13 | ok(1, "listening \@$saddr" ); 14 | my $srv = fork_sub( 'server',$server ); 15 | close($server); 16 | fd_grep_ok( 'Waiting', $srv ); 17 | my $cl = fork_sub( 'client_ssl',$saddr ); 18 | fd_grep_ok( 'Connect from',$srv ); 19 | fd_grep_ok( 'Connected', $cl ); 20 | fd_grep_ok( 'SSL Handshake OK', $srv ); 21 | fd_grep_ok( 'Hi!', $cl ); 22 | } 23 | 24 | # then try bad non-SSL client 25 | { 26 | my ($server,$saddr) = create_listen_socket(); 27 | ok(1, "listening \@$saddr" ); 28 | my $srv = fork_sub( 'server',$server ); 29 | close($server); 30 | fd_grep_ok( 'Waiting', $srv ); 31 | my $cl = fork_sub( 'client_no_ssl',$saddr ); 32 | fd_grep_ok( 'Connect from',$srv ); 33 | fd_grep_ok( 'Connected', $cl ); 34 | fd_grep_ok( 'SSL Handshake FAILED', $srv ); 35 | } 36 | 37 | 38 | sub server { 39 | my $server = shift; 40 | print "Waiting\n"; 41 | my $client = $server->accept || die "accept failed: $!"; 42 | print "Connect from ".$client->peerhost.':'.$client->peerport."\n"; 43 | if ( IO::Socket::SSL->start_SSL( $client, 44 | SSL_server => 1, 45 | Timeout => 5, 46 | SSL_cert_file => 't/certs/server-cert.pem', 47 | SSL_key_file => 't/certs/server-key.pem', 48 | )) { 49 | print "SSL Handshake OK\n"; 50 | print $client "Hi!\n"; 51 | } else { 52 | print "SSL Handshake FAILED - $!\n" 53 | } 54 | } 55 | 56 | sub client_no_ssl { 57 | my $saddr = shift; 58 | my $c = IO::Socket::INET->new( $saddr ) || die "connect failed: $!"; 59 | print "Connected\n"; 60 | while ( sysread( $c,my $buf,8000 )) {} 61 | } 62 | 63 | sub client_ssl { 64 | my $saddr = shift; 65 | my $c = IO::Socket::SSL->new( 66 | PeerAddr => $saddr, 67 | Domain => AF_INET, 68 | SSL_verify_mode => 0 69 | ) || die "connect failed: $!|$SSL_ERROR"; 70 | print "Connected\n"; 71 | while ( sysread( $c,my $buf,8000 )) { print $buf } 72 | } 73 | -------------------------------------------------------------------------------- /t/alpn.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | # Before `make install' is performed this script should be runnable with 3 | # `make test'. After `make install' it should work as `perl t/alpn.t' 4 | 5 | use strict; 6 | use warnings; 7 | use Net::SSLeay; 8 | use Socket; 9 | use IO::Socket::SSL; 10 | 11 | do './testlib.pl' || do './t/testlib.pl' || die "no testlib"; 12 | 13 | # check if we have ALPN available 14 | # if it is available 15 | if ( ! IO::Socket::SSL->can_alpn ) { 16 | print "1..0 # Skipped: ALPN not available in Net::SSLeay\n"; 17 | exit; 18 | } 19 | 20 | print "1..5\n"; 21 | 22 | # first create simple ssl-server 23 | my $ID = 'server'; 24 | my $addr = '127.0.0.1'; 25 | my $server = IO::Socket::SSL->new( 26 | LocalAddr => $addr, 27 | Listen => 2, 28 | SSL_cert_file => 't/certs/server-cert.pem', 29 | SSL_key_file => 't/certs/server-key.pem', 30 | SSL_alpn_protocols => [qw(one two)], 31 | ) || do { 32 | ok(0,"server creation failed: $!"); 33 | exit; 34 | }; 35 | ok(1,"Server Initialization at $addr"); 36 | 37 | # add server port to addr 38 | $addr = "$addr:".$server->sockport; 39 | print "# server at $addr\n"; 40 | 41 | my $pid = fork(); 42 | if ( !defined $pid ) { 43 | die $!; # fork failed 44 | 45 | } elsif ( !$pid ) { ###### Client 46 | 47 | $ID = 'client'; 48 | close($server); 49 | my $to_server = IO::Socket::SSL->new( 50 | PeerAddr => $addr, 51 | Domain => AF_INET, 52 | SSL_verify_mode => 0, 53 | SSL_alpn_protocols => [qw(two three)], 54 | ) or do { 55 | ok(0,"connect failed: ".IO::Socket::SSL->errstr()); 56 | exit; 57 | }; 58 | ok(1,"client connected" ); 59 | my $proto = $to_server->alpn_selected; 60 | ok($proto eq "two","negotiated $proto"); 61 | } else { ###### Server 62 | my $to_client = $server->accept or do { 63 | ok(0,"accept failed: ".$server->errstr()); 64 | kill(9,$pid); 65 | exit; 66 | }; 67 | ok(1,"Server accepted" ); 68 | my $proto = $to_client->alpn_selected; 69 | ok($proto eq "two","negotiated $proto"); 70 | wait; 71 | } 72 | 73 | sub ok { 74 | my $ok = shift; 75 | print $ok ? '' : 'not ', "ok # [$ID] @_\n"; 76 | } 77 | -------------------------------------------------------------------------------- /t/auto_verify_hostname.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use warnings; 5 | use Net::SSLeay; 6 | use Socket; 7 | use IO::Socket::SSL; 8 | use Test::More; 9 | 10 | do './testlib.pl' || do './t/testlib.pl' || die "no testlib"; 11 | 12 | plan tests => 1 + 7 + 4 + 7*2 + 4; 13 | my @tests = qw( 14 | example.com www FAIL 15 | server.local ldap OK 16 | server.local www FAIL 17 | bla.server.local www OK 18 | www7.other.local www OK 19 | www7.other.local ldap FAIL 20 | bla.server.local ldap OK 21 | ); 22 | 23 | 24 | 25 | my $server = IO::Socket::SSL->new( 26 | LocalAddr => '127.0.0.1', 27 | LocalPort => 0, 28 | Listen => 2, 29 | ReuseAddr => 1, 30 | SSL_server => 1, 31 | SSL_cert_file => "t/certs/server-wildcard.pem", 32 | SSL_key_file => "t/certs/server-wildcard.pem", 33 | ); 34 | warn "\$!=$!, \$\@=$@, S\$SSL_ERROR=$SSL_ERROR" if ! $server; 35 | ok( $server, "Server Initialization"); 36 | exit if !$server; 37 | my $saddr = $server->sockhost.':'.$server->sockport; 38 | 39 | defined( my $pid = fork() ) || die $!; 40 | if ( $pid == 0 ) { 41 | while (1) { 42 | my $csock = $server->accept || next; 43 | print $csock "hallo\n"; 44 | } 45 | } 46 | 47 | close($server); 48 | IO::Socket::SSL::default_ca('t/certs/test-ca.pem'); 49 | for( my $i=0;$i<@tests;$i+=3 ) { 50 | my ($name,$scheme,$result) = @tests[$i,$i+1,$i+2]; 51 | my $cl = IO::Socket::SSL->new( 52 | PeerAddr => $saddr, 53 | Domain => AF_INET, 54 | SSL_verify_mode => 1, 55 | SSL_verifycn_scheme => $scheme, 56 | SSL_verifycn_name => $name, 57 | ); 58 | if ( $result eq 'FAIL' ) { 59 | ok( !$cl, "connection to $name/$scheme failed" ); 60 | } else { 61 | ok( $cl, "connection to $name/$scheme succeeded" ); 62 | } 63 | $cl || next; 64 | is( <$cl>, "hallo\n", "received hallo" ); 65 | } 66 | 67 | for( my $i=0;$i<@tests;$i+=3 ) { 68 | my ($name,$scheme,$result) = @tests[$i,$i+1,$i+2]; 69 | my $cl = IO::Socket::INET->new($saddr); 70 | ok( $cl, "tcp connect" ); 71 | $cl = IO::Socket::SSL->start_SSL( $cl, 72 | SSL_verify_mode => 1, 73 | SSL_verifycn_scheme => $scheme, 74 | SSL_verifycn_name => $name, 75 | ); 76 | if ( $result eq 'FAIL' ) { 77 | ok( !$cl, "ssl upgrade of connection to $name/$scheme failed" ); 78 | } else { 79 | ok( $cl, "ssl upgrade of connection to $name/$scheme succeeded" ); 80 | } 81 | $cl || next; 82 | is( <$cl>, "hallo\n", "received hallo" ); 83 | } 84 | 85 | kill(9,$pid); 86 | wait; 87 | 88 | -------------------------------------------------------------------------------- /t/cert_formats.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | use IO::Socket::SSL; 5 | use File::Temp 'tempfile'; 6 | do './testlib.pl' || do './t/testlib.pl' || die "no testlib"; 7 | 8 | my $srv = IO::Socket::INET->new( 9 | LocalAddr => '127.0.0.1', 10 | Listen => 10, 11 | ); 12 | plan skip_all => "server creation failed: $!" if ! $srv; 13 | my $saddr = $srv->sockhost.':'.$srv->sockport; 14 | 15 | my ($fh,$pemfile) = tempfile(); 16 | my $master = $$; 17 | END { unlink($pemfile) if $$ == $master }; 18 | for ('t/certs/server-cert.pem','t/certs/server-key.pem') { 19 | open( my $pf,'<',$_ ) or die "open $_: $!"; 20 | print $fh do { local $/; <$pf> }; 21 | } 22 | close($fh); 23 | 24 | my @tests = ( 25 | 'PEM' => { 26 | SSL_cert_file => 't/certs/server-cert.pem', 27 | SSL_key_file => 't/certs/server-key.pem', 28 | }, 29 | 'PEM_one_file' => { 30 | SSL_cert_file => $pemfile, 31 | }, 32 | 'PEM_keyenc' => { 33 | SSL_cert_file => 't/certs/server-cert.pem', 34 | SSL_key_file => 't/certs/server-key.enc', 35 | SSL_passwd_cb => sub { "bluebell" }, 36 | }, 37 | 'DER' => { 38 | SSL_cert_file => 't/certs/server-cert.der', 39 | SSL_key_file => 't/certs/server-key.der', 40 | }, 41 | 'PKCS12' => { 42 | SSL_cert_file => 't/certs/server.p12', 43 | }, 44 | 'PKCS12_enc' => { 45 | SSL_cert_file => 't/certs/server_enc.p12', 46 | SSL_passwd_cb => sub { "bluebell" }, 47 | }, 48 | ); 49 | plan tests => @tests/2; 50 | 51 | while (my ($name,$sslargs) = splice(@tests,0,2)) { 52 | defined(my $pid = fork()) or die "fork failed: $!"; 53 | if ($pid == 0) { 54 | # child = server 55 | my $cl = $srv->accept or die "accept $!"; 56 | if (!IO::Socket::SSL->start_SSL($cl, 57 | SSL_server => 1, 58 | Timeout => 10, 59 | %$sslargs 60 | )) { 61 | diag("start_SSL failed: $SSL_ERROR"); 62 | } 63 | exit(0); 64 | } else { 65 | # parent = client 66 | my $cl = IO::Socket::INET->new($saddr) or die "connect: $!"; 67 | if (!IO::Socket::SSL->start_SSL($cl, 68 | SSL_verify_mode => 0 69 | )) { 70 | fail("[$name] ssl connect failed: $SSL_ERROR"); 71 | } else { 72 | pass("[$name] ssl connect success"); 73 | } 74 | wait; 75 | } 76 | } 77 | -------------------------------------------------------------------------------- /t/cert_no_file.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | # Before `make install' is performed this script should be runnable with 3 | # `make test'. After `make install' it should work as `perl t/nonblock.t' 4 | 5 | # Tests the use if SSL_cert instead of SSL_cert_file 6 | # because Net::SSLeay does not implement the necessary functions 7 | # to create an X509 from file/string (PEM_read_bio_X509) I just 8 | # create a server with SSL_cert_file and get the X509 from it using 9 | # Net::SSLeay::get_certificate. 10 | # Test should also test if SSL_cert is an array of X509* 11 | # and if SSL_key is an EVP_PKEY* but with the current function in 12 | # Net::SSLeay I don't see a way to test it 13 | 14 | use strict; 15 | use warnings; 16 | use Net::SSLeay; 17 | use Socket; 18 | use IO::Socket::SSL; 19 | 20 | do './testlib.pl' || do './t/testlib.pl' || die "no testlib"; 21 | 22 | use Test::More tests => 9; 23 | Test::More->builder->use_numbers(0); 24 | Test::More->builder->no_ending(1); 25 | 26 | my $ID = 'server'; 27 | my %server_args = ( 28 | LocalAddr => '127.0.0.1', 29 | LocalPort => 0, 30 | Listen => 2, 31 | SSL_server => 1, 32 | SSL_verify_mode => 0x00, 33 | SSL_ca_file => "t/certs/test-ca.pem", 34 | SSL_key_file => "t/certs/client-key.pem", 35 | ); 36 | 37 | my ($x509,@server); 38 | foreach my $test ( 1,2,3 ) { 39 | my %args = %server_args; 40 | my $spec; 41 | if ( $test == 1 ) { 42 | # 1st test: create server with SSL_cert_file 43 | $args{SSL_cert_file} = "t/certs/client-cert.pem"; 44 | $spec = 'Using SSL_cert_file'; 45 | } elsif ( $test == 2 ) { 46 | # 2nd test: use x509 from previous server 47 | # with SSL_cert instead of SSL_cert_file 48 | $args{SSL_cert} = $x509; 49 | $spec = 'Using SSL_cert'; 50 | } elsif ( $test == 3 ) { 51 | # 3rd test: empty SSL_cert, so that default 52 | # SSL_cert_file gets not used 53 | # server creation should fail 54 | $spec = 'Empty SSL_cert'; 55 | $args{SSL_cert} = undef; 56 | } 57 | 58 | # create server 59 | my $server = IO::Socket::SSL->new( %args ) || do { 60 | fail( "$spec: $!" ); 61 | next; 62 | }; 63 | 64 | my $saddr = $server->sockhost.':'.$server->sockport; 65 | pass("Server Initialization $spec"); 66 | push @server,$server; 67 | 68 | # then connect to it from a child 69 | defined( my $pid = fork() ) || die $!; 70 | if ( $pid == 0 ) { 71 | close($server); 72 | $ID = 'client'; 73 | 74 | my $to_server = IO::Socket::SSL->new( 75 | PeerAddr => $saddr, 76 | Domain => AF_INET, 77 | SSL_verify_mode => 0x00, 78 | ); 79 | if ( $test == 3 ) { 80 | ok( !$to_server, "$spec: connect succeeded" ); 81 | exit; 82 | } elsif ( ! $to_server ) { 83 | fail("connect failed: $!"); 84 | exit; 85 | } 86 | pass( "client connected $spec" ); 87 | <$to_server>; # wait for close from parent 88 | exit; 89 | } 90 | 91 | my $to_client = $server->accept; 92 | if ( $test == 3 ) { 93 | ok( !$to_client, "$spec: accept succeeded" ); 94 | } elsif ( ! $to_client ) { 95 | kill(9,$pid); 96 | fail("$spec: accept failed: $!"); 97 | exit; 98 | } else { 99 | pass( "Server accepted $spec" ); 100 | # save the X509 certificate from the server 101 | $x509 ||= Net::SSLeay::get_certificate($to_client->_get_ssl_object); 102 | } 103 | 104 | close($to_client) if $to_client; 105 | wait; 106 | } 107 | 108 | -------------------------------------------------------------------------------- /t/certs/c.pem: -------------------------------------------------------------------------------- 1 | -----BEGIN CERTIFICATE----- 2 | MIIDPDCCAiSgAwIBAgIEFlP1rjANBgkqhkiG9w0BAQsFADAiMSAwHgYDVQQDDBdJ 3 | Tzo6U29ja2V0OjpTU0wgRGVtbyBDQTAeFw0xOTAyMjgxMDE3NDdaFw0yOTAyMjUx 4 | MDE3NDdaMCYxJDAiBgNVBAMMG0lPOjpTb2NrZXQ6OlNTTCBEZW1vIFN1YiBDQTCC 5 | ASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBALcwFf4s8NAcJxDFGtG/6Ehr 6 | VcfFKFF+5wSQG4CmmrsW3shAHSHqVZUT3YkJfr521pyVTowtjE2R2E4p/FK18hUO 7 | L5L+cySLi7W2kspgNyVidu6yc0H0NGsASHUvpRgqdBsjsWibOVlsFa1dvJGpPuOs 8 | bUhR/rwWBPlIjAxz89gsB4WcNP6w3Q2kRHm+QgfJv5fb38tlTjNMrCDAsEu/0hcK 9 | +72WPofDATfP/MoKW+aRTrI2pgBxh9i6DIrz5uczCDWM0aw3doP9/AJG5QEfSMkJ 10 | GEVJ+Ekp0RDJVeV4VjAUg0+ZlqdDfqW0Ym0fgqHZHuOtIegzmF8ck3O0zi7FONEC 11 | AwEAAaN2MHQwHQYDVR0OBBYEFKdltgciWwBzBZ0N9PhcfCr+CMdrMB8GA1UdIwQY 12 | MBaAFO+VgQZmwvrXOpIbik0wLEzOeEthMA8GA1UdEwEB/wQFMAMBAf8wDgYDVR0P 13 | AQH/BAQDAgKEMBEGCWCGSAGG+EIBAQQEAwIABzANBgkqhkiG9w0BAQsFAAOCAQEA 14 | C8ls6D6fp9TUs2YOrc22U0BIs09NF7oQTCS7VDjrQWZq18Ca2eSKwTSOu27e3x2o 15 | xUgHcBOTcFqlTPNHqrJVlJTVJkIlzu/tDuPeSeo49sS2hC32IaSvkdy0u27XKhCn 16 | tUNP3m2Sv/UG3PleW4laBArwzC4DVLTxPS737b9K5NFLwl6JVjybGi3IoYCzdGcj 17 | t7GumoR7VFkWy+Q8Cha4kXTP1pRRuDUvT5kuRCA+tGEKQonZEdVD8k0eLo8R0ycA 18 | q0bXIulMr98utfoQDbQHlbQKV7M1LxAK2zC0Aye37tZDahVbsIcyCcI3WtRLui7G 19 | W7vn5+46bF+azUgLzkS96w== 20 | -----END CERTIFICATE----- 21 | -----BEGIN CERTIFICATE----- 22 | MIIDOTCCAiGgAwIBAgIFAMd3sU8wDQYJKoZIhvcNAQELBQAwIjEgMB4GA1UEAwwX 23 | SU86OlNvY2tldDo6U1NMIERlbW8gQ0EwHhcNMTkwMjI4MTAxNzQ3WhcNMjkwMjI1 24 | MTAxNzQ3WjAiMSAwHgYDVQQDDBdJTzo6U29ja2V0OjpTU0wgRGVtbyBDQTCCASIw 25 | DQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBAOGyOtVy/cx7DkJPltVu9pQV+9/l 26 | HsttS1wD+UWjsz2Eb7u5N1HU7IPAUTKB+6TsC059XiHr9RkbjyWbgWCV8EVfNULP 27 | Rx6sRol5T9KoiZH5ktswuCsVjnT7iY6EJpuCzAgn159zXQlRKLDL42lydSqOMVIi 28 | iBcI8KUyUtr3oWbty59kZvv5P2QsQ5ibhRcfQIgrgSTt5cdZNrIZkXfTSn6dTcnP 29 | P6X5WXIaZo66Ot2BkykaG+dpERuEHe1r2ZH/8rLSDSRAeqF0ao9UjtFxsGRiwZqf 30 | KnLvkd34zS+UZbS5jTGf+RhgRCFzKliJTaASstMos9U2evwaR/KWdVe2o48CAwEA 31 | AaN2MHQwHQYDVR0OBBYEFO+VgQZmwvrXOpIbik0wLEzOeEthMB8GA1UdIwQYMBaA 32 | FO+VgQZmwvrXOpIbik0wLEzOeEthMA8GA1UdEwEB/wQFMAMBAf8wDgYDVR0PAQH/ 33 | BAQDAgKEMBEGCWCGSAGG+EIBAQQEAwIABzANBgkqhkiG9w0BAQsFAAOCAQEAsEJz 34 | ZcKxjZpCunAEumuOqExJB+dWuIvrkGtzuFm04TaTVvgYtJk5vF6qnEHBNbpKbuIT 35 | wvDOpJvQHxQpBxCXqj2yeHvk98SdA3Inlhhm3kwqWTB97KBcPvlgdU759Xm8uLYG 36 | xVoMn4VK6n5pEZPkxuKLqQbLXUdyn2eDwBsloclWGSAX4OaxAEBEiv9R0zc8i0fI 37 | 6gpg+VuUxDN+usLfCDrZBU7UmrhMEx4M00QgYPdCvbjv0n2pcZP+6EYzXbi+4duC 38 | flJht3LTqYovvIOAJwUCwAq9fnuxq8gdOzJyDFI00oo9qdpBKWPKxXTvyBR+1d+m 39 | khCxOQWbRUNrMDBCtg== 40 | -----END CERTIFICATE----- 41 | -------------------------------------------------------------------------------- /t/certs/client-cert.pem: -------------------------------------------------------------------------------- 1 | -----BEGIN CERTIFICATE----- 2 | MIIDQjCCAiqgAwIBAgIFANIO7CcwDQYJKoZIhvcNAQELBQAwIjEgMB4GA1UEAwwX 3 | SU86OlNvY2tldDo6U1NMIERlbW8gQ0EwHhcNMjIxMjExMTk1MzQxWhcNMzIxMjA4 4 | MTk1MzQxWjAXMRUwEwYDVQQDDAxjbGllbnQubG9jYWwwggEiMA0GCSqGSIb3DQEB 5 | AQUAA4IBDwAwggEKAoIBAQC0i9404R22VBv1ZHGNN5TNeCHxMmAxKHPzkoof/CMF 6 | UzSrmwzvYP0k1EygbRKbrA40eOX775G4Jp/DU6fRs0aAamPO0eT+Y10fXrUkE+/x 7 | AFwW36vPFkwuprkatzyqqAOr9GHnSrFlzgM4uV0WbJNC2H6SovSYAOk30C8TiMIy 8 | pSdC5VkiZUWC/nekioEB90hmqU+An2b5y1oSHI9uwO0S+TLcilWkFCmUKXPxEUOj 9 | l/Wg7fB2W2L6pHpcuztqpZluSd+cZ6m820PUxbQKB3YD5ZrZT+RNjb+cpVTlqByn 10 | kWq83PxcPU8vTk8NESCNBuk7CiR/k3qrhCU/3NxiD/hBAgMBAAGjgYkwgYYwHQYD 11 | VR0OBBYEFNcCOPQC8C+uv+36vcovBvILRyELMB8GA1UdIwQYMBaAFEnT2LwqEtZv 12 | wVkEbtlv/7SmEt9cMAwGA1UdEwEB/wQCMAAwDgYDVR0PAQH/BAQDAgWgMBEGCWCG 13 | SAGG+EIBAQQEAwIHgDATBgNVHSUEDDAKBggrBgEFBQcDAjANBgkqhkiG9w0BAQsF 14 | AAOCAQEAM7Qb36dynl4/suJACh6dpBlZ89NQOah7RrJZahL1cA/81MBlkN/MRIYW 15 | jlZwmgggoyCzpMCmHdFb+/DHA8qFJs7Q7arHJeFgYOCe5TIFMDZSCoShXqe97Ncc 16 | ISfdpBpITvh0l63nABibKvrUAacTsEdmKxPml81gkaxHiNR86z1uIZIZ4h6yX7Pa 17 | VNX7mLXK2hxifvoXGTCsFjaSrn8Vr3rEdUHGrhO6jMtn84g6l8p+4uTVk+PYeveQ 18 | VLZVyWXshojs6oSBMl7IxxmaddIwNZodEvsRToC9ZVKbCBGmU0DPLBjyCqUJcGt4 19 | pmdA4se0gfWovTvy5YzfsOOCqUkp7w== 20 | -----END CERTIFICATE----- 21 | -------------------------------------------------------------------------------- /t/certs/client-key.enc: -------------------------------------------------------------------------------- 1 | -----BEGIN RSA PRIVATE KEY----- 2 | MIIEpQIBAAKCAQEAtIveNOEdtlQb9WRxjTeUzXgh8TJgMShz85KKH/wjBVM0q5sM 3 | 72D9JNRMoG0Sm6wONHjl+++RuCafw1On0bNGgGpjztHk/mNdH161JBPv8QBcFt+r 4 | zxZMLqa5Grc8qqgDq/Rh50qxZc4DOLldFmyTQth+kqL0mADpN9AvE4jCMqUnQuVZ 5 | ImVFgv53pIqBAfdIZqlPgJ9m+ctaEhyPbsDtEvky3IpVpBQplClz8RFDo5f1oO3w 6 | dlti+qR6XLs7aqWZbknfnGepvNtD1MW0Cgd2A+Wa2U/kTY2/nKVU5agcp5FqvNz8 7 | XD1PL05PDREgjQbpOwokf5N6q4QlP9zcYg/4QQIDAQABAoIBABXes/jalI1toJHf 8 | /AfHxe8COHVVvXRy8qG8fF4NviXC25hWcLGOAXgMvef4cma4R6O4Sd6T2WZRymxA 9 | Fc3nbhi32nV29CrS+TinsaBISHo8aYtNRovwJuQHRtibPd5ruf8iPBpG8Fh1RSth 10 | u8qPtiJkpGdplSCVCqsbvRocCK8W4WSya/NCq/sq7j4Th0OTPJV/2oUDnn7SYTJV 11 | f8fg7X+NIcymeNDkiOz2jwyEtH26sKQpECdLDR6Huk9crVes/2bhbuTocIarCb8r 12 | BGImlZ7l0brfpwor7gXrY5DPPVMSYW+UEz3c63qSp97bVnja5CLiZStCol1Q9/6M 13 | nhY5zJkCgYEA5r+n17K4+zHNP5uuywbqrxa2jxhpOeFYrYqFtr2F+phhUM/G5taV 14 | whcgwrvqc08mmcL8FnG6uDbx3wWkFjHTwFQLbLgn1lytRINMPSMfXmXJ84MB2mtM 15 | 5nu40+BMd3TYapJexnd2QVb6ToldA6/QN28/1/0lYYdCAy4fIbyopJkCgYEAyE3P 16 | 8cGPtAiIncNIp+GU8Z07LLK2+uJZUZ8SNY6BU7rKJThbb6EfQ6AWXmbhibr2qmwk 17 | H45guzlflT0PIiWmVvvx3ETlZu6qsVVX/XDWfAdNDGwm9zK1IEFOnf8zc+G/Miip 18 | oR9OLxBqAz89WeHPLTbOZYdJHlbOtrJtImlEEekCgYEAnGtLUfK7Zrypz/avFL4J 19 | lMsm0fXQTwYtYObIIcpz6h4lyewvfwfz2PBoqtlL4wLCvfTpgiVyV7IXYAGo68q3 20 | KmdOn1Ju3udQJWOD6OXIO+twbPxf4zpdlNhFwIsKCuhQVF4IlS0iIsTdRSPkw70I 21 | vqtRcg8OqgBQhWtcezgycfECgYEAxPzheFxnuyJ5WM3o8lHDbSq4O2k20t0wAjly 22 | awFO5s1YZ+pY4huO567U0NpVDGK2mzvm+rHHJ9lwyxBVhbuJLxpv7bRD90rYy7Wm 23 | 5zTFewyjFYh3ebyArMwNSQzlyR1GL0oWKMLk3RxDZhYXfAG7AjhYGzlFC3VLrhkj 24 | gygLLaECgYEAvMxiWTZ+1knOAt2ajtlEEKuEh5Ez0NVcclhkcZGbE/SFo6Zw0U+B 25 | WV8rZ74SyFcRNznk/zd/Kcvbe7sH7w823Te/UI5QiU3IUmlYFUEGHxChaIxGm/1n 26 | mQlvAjaIK3TPGVpY/BGptJEWTrFlH9HH11tHAiEkFFZhzkYQLjg9cZM= 27 | -----END RSA PRIVATE KEY----- 28 | -------------------------------------------------------------------------------- /t/certs/client-key.pem: -------------------------------------------------------------------------------- 1 | -----BEGIN PRIVATE KEY----- 2 | MIIEvwIBADANBgkqhkiG9w0BAQEFAASCBKkwggSlAgEAAoIBAQC0i9404R22VBv1 3 | ZHGNN5TNeCHxMmAxKHPzkoof/CMFUzSrmwzvYP0k1EygbRKbrA40eOX775G4Jp/D 4 | U6fRs0aAamPO0eT+Y10fXrUkE+/xAFwW36vPFkwuprkatzyqqAOr9GHnSrFlzgM4 5 | uV0WbJNC2H6SovSYAOk30C8TiMIypSdC5VkiZUWC/nekioEB90hmqU+An2b5y1oS 6 | HI9uwO0S+TLcilWkFCmUKXPxEUOjl/Wg7fB2W2L6pHpcuztqpZluSd+cZ6m820PU 7 | xbQKB3YD5ZrZT+RNjb+cpVTlqBynkWq83PxcPU8vTk8NESCNBuk7CiR/k3qrhCU/ 8 | 3NxiD/hBAgMBAAECggEAFd6z+NqUjW2gkd/8B8fF7wI4dVW9dHLyobx8Xg2+JcLb 9 | mFZwsY4BeAy95/hyZrhHo7hJ3pPZZlHKbEAVzeduGLfadXb0KtL5OKexoEhIejxp 10 | i01Gi/Am5AdG2Js93mu5/yI8GkbwWHVFK2G7yo+2ImSkZ2mVIJUKqxu9GhwIrxbh 11 | ZLJr80Kr+yruPhOHQ5M8lX/ahQOeftJhMlV/x+Dtf40hzKZ40OSI7PaPDIS0fbqw 12 | pCkQJ0sNHoe6T1ytV6z/ZuFu5OhwhqsJvysEYiaVnuXRut+nCivuBetjkM89UxJh 13 | b5QTPdzrepKn3ttWeNrkIuJlK0KiXVD3/oyeFjnMmQKBgQDmv6fXsrj7Mc0/m67L 14 | BuqvFraPGGk54VitioW2vYX6mGFQz8bm1pXCFyDCu+pzTyaZwvwWcbq4NvHfBaQW 15 | MdPAVAtsuCfWXK1Eg0w9Ix9eZcnzgwHaa0zme7jT4Ex3dNhqkl7Gd3ZBVvpOiV0D 16 | r9A3bz/X/SVhh0IDLh8hvKikmQKBgQDITc/xwY+0CIidw0in4ZTxnTsssrb64llR 17 | nxI1joFTusolOFtvoR9DoBZeZuGJuvaqbCQfjmC7OV+VPQ8iJaZW+/HcROVm7qqx 18 | VVf9cNZ8B00MbCb3MrUgQU6d/zNz4b8yKKmhH04vEGoDPz1Z4c8tNs5lh0keVs62 19 | sm0iaUQR6QKBgQCca0tR8rtmvKnP9q8UvgmUyybR9dBPBi1g5sghynPqHiXJ7C9/ 20 | B/PY8Giq2UvjAsK99OmCJXJXshdgAajryrcqZ06fUm7e51AlY4Po5cg763Bs/F/j 21 | Ol2U2EXAiwoK6FBUXgiVLSIixN1FI+TDvQi+q1FyDw6qAFCFa1x7ODJx8QKBgQDE 22 | /OF4XGe7InlYzejyUcNtKrg7aTbS3TACOXJrAU7mzVhn6ljiG47nrtTQ2lUMYrab 23 | O+b6sccn2XDLEFWFu4kvGm/ttEP3StjLtabnNMV7DKMViHd5vICszA1JDOXJHUYv 24 | ShYowuTdHENmFhd8AbsCOFgbOUULdUuuGSODKAstoQKBgQC8zGJZNn7WSc4C3ZqO 25 | 2UQQq4SHkTPQ1VxyWGRxkZsT9IWjpnDRT4FZXytnvhLIVxE3OeT/N38py9t7uwfv 26 | DzbdN79QjlCJTchSaVgVQQYfEKFojEab/WeZCW8CNogrdM8ZWlj8Eam0kRZOsWUf 27 | 0cfXW0cCISQUVmHORhAuOD1xkw== 28 | -----END PRIVATE KEY----- 29 | -------------------------------------------------------------------------------- /t/certs/create-certs.pl: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use IO::Socket::SSL::Utils; 4 | use Net::SSLeay; 5 | 6 | my $dir = "./"; 7 | my $now = time(); 8 | my $later = $now + 10*365*86400; 9 | 10 | Net::SSLeay::SSLeay_add_ssl_algorithms(); 11 | my $sha256 = Net::SSLeay::EVP_get_digestbyname('sha256') or die; 12 | my $printfp = sub { 13 | my ($w,$cert) = @_; 14 | print $w.' sha256$'.unpack('H*',Net::SSLeay::X509_digest($cert, $sha256))."\n" 15 | }; 16 | 17 | my %time_valid = (not_before => $now, not_after => $later); 18 | 19 | my @ca = CERT_create( 20 | CA => 1, 21 | subject => { CN => 'IO::Socket::SSL Demo CA' }, 22 | %time_valid, 23 | ); 24 | save('test-ca.pem',PEM_cert2string($ca[0])); 25 | 26 | my @server = CERT_create( 27 | CA => 0, 28 | subject => { CN => 'server.local' }, 29 | subjectAltNames => [ [ DNS => 'server.local' ], [ IP => '127.0.0.1' ] ], 30 | purpose => 'server', 31 | issuer => \@ca, 32 | %time_valid, 33 | ); 34 | save('server-cert.pem',PEM_cert2string($server[0])); 35 | save('server-key.pem',PEM_key2string($server[1])); 36 | $printfp->(server => $server[0]); 37 | 38 | @server = CERT_create( 39 | CA => 0, 40 | subject => { CN => 'server2.local' }, 41 | subjectAltNames => [ [ DNS => 'server2.local' ], [ IP => '127.0.0.1' ] ], 42 | purpose => 'server', 43 | issuer => \@ca, 44 | %time_valid, 45 | ); 46 | save('server2-cert.pem',PEM_cert2string($server[0])); 47 | save('server2-key.pem',PEM_key2string($server[1])); 48 | $printfp->(server2 => $server[0]); 49 | 50 | @server = CERT_create( 51 | CA => 0, 52 | subject => { CN => 'server-ecc.local' }, 53 | subjectAltNames => [ [ DNS => 'server-ecc.local' ], [ IP => '127.0.0.1' ] ], 54 | purpose => 'server', 55 | issuer => \@ca, 56 | key => KEY_create_ec(), 57 | %time_valid, 58 | ); 59 | save('server-ecc-cert.pem',PEM_cert2string($server[0])); 60 | save('server-ecc-key.pem',PEM_key2string($server[1])); 61 | $printfp->('server-ecc' => $server[0]); 62 | 63 | 64 | my @client = CERT_create( 65 | CA => 0, 66 | subject => { CN => 'client.local' }, 67 | purpose => 'client', 68 | issuer => \@ca, 69 | %time_valid, 70 | ); 71 | save('client-cert.pem',PEM_cert2string($client[0])); 72 | save('client-key.pem',PEM_key2string($client[1])); 73 | $printfp->(client => $client[0]); 74 | 75 | my @swc = CERT_create( 76 | CA => 0, 77 | subject => { CN => 'server.local' }, 78 | purpose => 'server', 79 | issuer => \@ca, 80 | subjectAltNames => [ 81 | [ DNS => '*.server.local' ], 82 | [ IP => '127.0.0.1' ], 83 | [ DNS => 'www*.other.local' ], 84 | [ DNS => 'smtp.mydomain.local' ], 85 | [ DNS => 'xn--lwe-sna.idntest.local' ] 86 | ], 87 | %time_valid, 88 | ); 89 | save('server-wildcard.pem',PEM_cert2string($swc[0]),PEM_key2string($swc[1])); 90 | 91 | 92 | my @subca = CERT_create( 93 | CA => 1, 94 | issuer => \@ca, 95 | subject => { CN => 'IO::Socket::SSL Demo Sub CA' }, 96 | %time_valid, 97 | ); 98 | save('test-subca.pem',PEM_cert2string($subca[0])); 99 | @server = CERT_create( 100 | CA => 0, 101 | subject => { CN => 'server.local' }, 102 | subjectAltNames => [ [ DNS => 'server.local' ], [ IP => '127.0.0.1' ] ], 103 | purpose => 'server', 104 | issuer => \@subca, 105 | %time_valid, 106 | ); 107 | save('sub-server.pem',PEM_cert2string($server[0]).PEM_key2string($server[1])); 108 | 109 | 110 | 111 | my @cap = CERT_create( 112 | CA => 1, 113 | subject => { CN => 'IO::Socket::SSL::Intercept' }, 114 | %time_valid, 115 | ); 116 | save('proxyca.pem',PEM_cert2string($cap[0]).PEM_key2string($cap[1])); 117 | 118 | sub save { 119 | my $file = shift; 120 | open(my $fd,'>',$dir.$file) or die $!; 121 | print $fd @_; 122 | } 123 | 124 | system(< 9; 13 | Test::More->builder->use_numbers(0); 14 | Test::More->builder->no_ending(1); 15 | 16 | $SIG{'CHLD'} = "IGNORE"; 17 | 18 | IO::Socket::SSL::context_init(SSL_verify_mode => 0x01); 19 | 20 | my $server = IO::Socket::INET->new( 21 | LocalAddr => '127.0.0.1', 22 | LocalPort => 0, 23 | Listen => 1, 24 | ) or do { 25 | plan skip_all => "Bail out!". 26 | "Setup of test IO::Socket::INET client and server failed. All the rest of". 27 | "the tests in this suite will fail also unless you change the values in". 28 | "ssl_settings.req in the t/ directory."; 29 | }; 30 | pass("server create"); 31 | 32 | { 33 | package MyClass; 34 | use IO::Socket::SSL; 35 | our @ISA = "IO::Socket::SSL"; 36 | } 37 | 38 | my $saddr = $server->sockhost.':'.$server->sockport; 39 | unless (fork) { 40 | close $server; 41 | my $client = IO::Socket::INET->new($saddr); 42 | ok( MyClass->start_SSL($client, SSL_verify_mode => 0), "ssl upgrade"); 43 | is( ref( $client ), "MyClass", "class MyClass"); 44 | ok( $client->issuer_name, "issuer_name"); 45 | ok( $client->subject_name, "subject_name"); 46 | ok( $client->opened, "opened"); 47 | print $client "Ok to close\n"; 48 | close $client; 49 | exit(0); 50 | } 51 | 52 | my $contact = $server->accept; 53 | my $socket_to_ssl = IO::Socket::SSL::socketToSSL($contact, { 54 | SSL_server => 1, 55 | SSL_verify_mode => 0, 56 | SSL_cert_file => 't/certs/server-cert.pem', 57 | SSL_key_file => 't/certs/server-key.pem', 58 | }); 59 | ok( $socket_to_ssl, "socketToSSL"); 60 | <$contact>; 61 | close $contact; 62 | close $server; 63 | 64 | bless $contact, "MyClass"; 65 | ok( !IO::Socket::SSL::socket_to_SSL($contact, SSL_server => 1), "socket_to_SSL"); 66 | is( ref($contact), "MyClass", "upgrade is MyClass"); 67 | -------------------------------------------------------------------------------- /t/connectSSL-timeout.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use IO::Socket::SSL; 4 | do './testlib.pl' || do './t/testlib.pl' || die "no testlib"; 5 | 6 | $|=1; 7 | print "1..16\n"; 8 | 9 | 10 | { 11 | # first use SSL client 12 | my ($server,$saddr) = create_listen_socket(); 13 | ok( 1, "listening \@$saddr" ); 14 | my $srv = fork_sub( 'server','ssl',$server ); 15 | close($server); 16 | fd_grep_ok( 'Waiting', $srv ); 17 | my $cl = fork_sub( 'client',$saddr ); 18 | fd_grep_ok( 'Connect from',$srv ); 19 | fd_grep_ok( 'Connected', $cl ); 20 | fd_grep_ok( 'Server SSL Handshake OK', $srv ); 21 | fd_grep_ok( 'Client SSL Handshake OK', $cl ); 22 | fd_grep_ok( 'Hi!', $cl ); 23 | } 24 | 25 | { 26 | # then try bad non-SSL client 27 | my ($server,$saddr) = create_listen_socket(); 28 | ok( 1, "listening \@$saddr" ); 29 | my $srv = fork_sub( 'server','nossl',$server ); 30 | close($server); 31 | fd_grep_ok( 'Waiting', $srv ); 32 | my $cl = fork_sub( 'client',$saddr ); 33 | fd_grep_ok( 'Connect from',$srv ); 34 | fd_grep_ok( 'Connected', $cl ); 35 | fd_grep_ok( 'Client SSL Handshake FAILED', $cl ); 36 | } 37 | 38 | 39 | sub server { 40 | my ($behavior,$server) = @_; 41 | print "Waiting\n"; 42 | my $client = $server->accept || die "accept failed: $!"; 43 | print "Connect from ".$client->peerhost.':'.$client->peerport."\n"; 44 | if ( $behavior eq 'ssl' ) { 45 | if ( IO::Socket::SSL->start_SSL( $client, 46 | SSL_server => 1, 47 | Timeout => 30, 48 | SSL_cert_file => 't/certs/server-cert.pem', 49 | SSL_key_file => 't/certs/server-key.pem', 50 | )) { 51 | print "Server SSL Handshake OK\n"; 52 | print $client "Hi!\n"; 53 | } 54 | } else { 55 | while ( sysread( $client, my $buf,8000 )) {} 56 | } 57 | } 58 | 59 | sub client { 60 | my $saddr = shift; 61 | my $c = IO::Socket::INET->new( $saddr ) || die "connect failed: $!"; 62 | print "Connected\n"; 63 | if ( IO::Socket::SSL->start_SSL( $c, 64 | Timeout => 5, 65 | SSL_ca_file => 't/certs/test-ca.pem', 66 | )) { 67 | print "Client SSL Handshake OK\n"; 68 | print <$c> 69 | } else { 70 | print "Client SSL Handshake FAILED - $SSL_ERROR\n"; 71 | } 72 | } 73 | -------------------------------------------------------------------------------- /t/dhe.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | # Before `make install' is performed this script should be runnable with 3 | # `make test'. After `make install' it should work as `perl t/dhe.t' 4 | 5 | # This tests the use of Diffie Hellman Key Exchange (DHE) 6 | 7 | use strict; 8 | use warnings; 9 | use Net::SSLeay; 10 | use Socket; 11 | use IO::Socket::SSL; 12 | do './testlib.pl' || do './t/testlib.pl' || die "no testlib"; 13 | 14 | $|=1; 15 | print "1..3\n"; 16 | 17 | # first create simple ssl-server 18 | my $ID = 'server'; 19 | my $addr = '127.0.0.1'; 20 | my $server = IO::Socket::SSL->new( 21 | LocalAddr => $addr, 22 | Listen => 2, 23 | ReuseAddr => 1, 24 | SSL_cert_file => "t/certs/server-cert.pem", 25 | SSL_key_file => "t/certs/server-key.pem", 26 | SSL_cipher_list => 'DH:!aNULL', # allow only DH ciphers 27 | ) || do { 28 | notok($!); 29 | exit 30 | }; 31 | ok("Server Initialization"); 32 | 33 | # add server port to addr 34 | $addr.= ':'.(sockaddr_in( getsockname( $server )))[0]; 35 | 36 | my $pid = fork(); 37 | if ( !defined $pid ) { 38 | die $!; # fork failed 39 | 40 | } elsif ( !$pid ) { ###### Client 41 | 42 | $ID = 'client'; 43 | close($server); 44 | my $to_server = IO::Socket::SSL->new( 45 | PeerAddr => $addr, 46 | Domain => AF_INET, 47 | SSL_verify_mode => 0 ) || do { 48 | notok( "connect failed: $SSL_ERROR" ); 49 | exit 50 | }; 51 | ok( "client connected" ); 52 | 53 | } else { ###### Server 54 | 55 | my $to_client = $server->accept || do { 56 | notok( "accept failed: $SSL_ERROR" ); 57 | kill(9,$pid); 58 | exit; 59 | }; 60 | ok( "Server accepted" ); 61 | wait; 62 | } 63 | 64 | sub ok { print "ok # [$ID] @_\n"; } 65 | sub notok { print "not ok # [$ID] @_\n"; } 66 | -------------------------------------------------------------------------------- /t/ecdhe.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | # Before `make install' is performed this script should be runnable with 3 | # `make test'. After `make install' it should work as `perl t/ecdhe.t' 4 | 5 | use strict; 6 | use warnings; 7 | use Net::SSLeay; 8 | use Socket; 9 | use IO::Socket::SSL; 10 | do './testlib.pl' || do './t/testlib.pl' || die "no testlib"; 11 | 12 | my $can_ecdh = IO::Socket::SSL->can_ecdh; 13 | if (! $can_ecdh) { 14 | print "1..0 # Skipped: no support for ecdh with this openssl/Net::SSLeay\n"; 15 | exit 16 | } 17 | 18 | $|=1; 19 | print "1..4\n"; 20 | 21 | # first create simple ssl-server 22 | my $ID = 'server'; 23 | my $addr = '127.0.0.1'; 24 | my $server = IO::Socket::SSL->new( 25 | LocalAddr => $addr, 26 | Listen => 2, 27 | ReuseAddr => 1, 28 | SSL_cert_file => "t/certs/server-cert.pem", 29 | SSL_key_file => "t/certs/server-key.pem", 30 | (defined &Net::SSLeay::CTX_set1_groups_list || defined &Net::SSLeay::CTX_set1_curves_list) 31 | ? (SSL_ecdh_curve => 'prime256v1' ) : (), 32 | ) || do { 33 | notok($!); 34 | exit 35 | }; 36 | ok("Server Initialization"); 37 | 38 | # add server port to addr 39 | $addr.= ':'.(sockaddr_in( getsockname( $server )))[0]; 40 | 41 | my $pid = fork(); 42 | if ( !defined $pid ) { 43 | die $!; # fork failed 44 | 45 | } elsif ( !$pid ) { ###### Client 46 | 47 | $ID = 'client'; 48 | close($server); 49 | my $to_server = IO::Socket::SSL->new( 50 | PeerAddr => $addr, 51 | Domain => AF_INET, 52 | (defined &Net::SSLeay::CTX_set1_groups_list || defined &Net::SSLeay::CTX_set1_curves_list) 53 | ? (SSL_ecdh_curve => 'prime256v1' ) : (), 54 | SSL_verify_mode => 0 ) || do { 55 | notok( "connect failed: $SSL_ERROR" ); 56 | exit 57 | }; 58 | ok( "client connected" ); 59 | 60 | my $protocol = $to_server->get_sslversion; 61 | if ($protocol eq 'TLSv1_3') { 62 | # 63 | ok("# SKIP TLSv1.3 doesn't advertize key exchange in a chipher name"); 64 | } else { 65 | my $cipher = $to_server->get_cipher(); 66 | if ( $cipher !~m/^ECDHE-/ ) { 67 | notok("bad key exchange: $cipher"); 68 | exit; 69 | } 70 | ok("ecdh key exchange: $cipher"); 71 | } 72 | 73 | } else { ###### Server 74 | 75 | my $to_client = $server->accept || do { 76 | notok( "accept failed: $SSL_ERROR" ); 77 | kill(9,$pid); 78 | exit; 79 | }; 80 | ok( "Server accepted" ); 81 | wait; 82 | } 83 | 84 | sub ok { print "ok # [$ID] @_\n"; } 85 | sub notok { print "not ok # [$ID] @_\n"; } 86 | -------------------------------------------------------------------------------- /t/external/fingerprint.pl: -------------------------------------------------------------------------------- 1 | # to update fingerprints in this file: 2 | # perl -e 'do q[./t/external/fingerprint.pl]; update_fingerprints()' 3 | 4 | use strict; 5 | use warnings; 6 | use IO::Socket::SSL; 7 | 8 | # --- BEGIN-FINGERPRINTS ---- 9 | my $fingerprints= [ 10 | { 11 | _ => 'this should give us OCSP stapling - before LetsEncrypt had disabled OCSP support', 12 | fingerprint => 'sha1$pub$39d64bbaea90c6035e25ff990ba4ce565350bac5', 13 | host => 'www.chksum.de', 14 | _disabled_ocsp => { 15 | staple => 1 16 | }, 17 | port => 443 18 | }, 19 | { 20 | _ => 'no OCSP stapling', 21 | fingerprint => 'sha1$pub$136e4c79586c88759201e705696e72bdaa12c9e2', 22 | host => 'www.bild.de', 23 | ocsp => { 24 | staple => 0 25 | }, 26 | port => 443, 27 | subject_hash_ca => '3513523f' 28 | }, 29 | { 30 | _ => 'this is revoked', 31 | fingerprint => 'sha1$pub$31b4b89651e35cb09606f445172d3e7c5642ed74', 32 | host => 'revoked.grc.com', 33 | ocsp => { 34 | revoked => 1 35 | }, 36 | port => 443 37 | }, 38 | { 39 | fingerprint => 'sha1$pub$1ecb28613975b1477ca49eafdbbcda5472c53f23', 40 | host => 'www.yahoo.com', 41 | port => 443, 42 | subject_hash_ca => '244b5494' 43 | }, 44 | { 45 | fingerprint => 'sha1$pub$88f7d4848c4217aa2805436b7145b8fe305fb240', 46 | host => 'www.comdirect.de', 47 | port => 443, 48 | subject_hash_ca => '062cdee6' 49 | }, 50 | { 51 | fingerprint => 'sha1$pub$19d4c556a1cccbe84270c474346e9ad737d1b1b2', 52 | host => 'meine.deutsche-bank.de', 53 | port => 443, 54 | subject_hash_ca => '607986c7' 55 | }, 56 | { 57 | fingerprint => 'sha1$pub$1c1d85a6a26f103c66a088dfd48e7ee9d19b4c49', 58 | host => 'www.twitter.com', 59 | port => 443, 60 | subject_hash_ca => '4042bcee' 61 | }, 62 | { 63 | fingerprint => 'sha1$pub$c06ebc6e8c75fcd8388c9db8ff49907677471bcb', 64 | host => 'www.facebook.com', 65 | port => 443, 66 | subject_hash_ca => '244b5494' 67 | }, 68 | { 69 | fingerprint => 'sha1$pub$62b73053f65d85a6d1fe281da47fb91bae972bd2', 70 | host => 'www.live.com', 71 | port => 443, 72 | subject_hash_ca => '3513523f' 73 | } 74 | ] 75 | ; 76 | # --- END-FINGERPRINTS ---- 77 | 78 | 79 | sub update_fingerprints { 80 | my $changed; 81 | for my $fp (@$fingerprints) { 82 | my $cl = IO::Socket::INET->new( 83 | PeerHost => $fp->{host}, 84 | PeerPort => $fp->{port} || 443, 85 | Timeout => 10, 86 | ); 87 | my $root; 88 | if (!$cl) { 89 | warn "E $fp->{host}:$fp->{port} - TCP connect failed: $!\n"; 90 | } elsif (!IO::Socket::SSL->start_SSL($cl, 91 | Timeout => 10, 92 | SSL_ocsp_mode => 0, 93 | SSL_hostname => $fp->{host}, 94 | SSL_verify_callback => sub { 95 | my ($cert,$depth) = @_[4,5]; 96 | $root ||= $cert; 97 | return 1; 98 | } 99 | )) { 100 | warn "E $fp->{host}:$fp->{port} - SSL handshake failed: $SSL_ERROR\n"; 101 | } else { 102 | my $sha1 = $cl->get_fingerprint('sha1',undef,1); 103 | if ($sha1 eq $fp->{fingerprint}) { 104 | warn "N $fp->{host}:$fp->{port} - fingerprint as expected\n"; 105 | } else { 106 | warn "W $fp->{host}:$fp->{port} - fingerprint changed from $fp->{fingerprint} to $sha1\n"; 107 | $fp->{fingerprint} = $sha1; 108 | $changed++; 109 | } 110 | if ($root and $fp->{subject_hash_ca}) { 111 | my $hash = sprintf("%08x",Net::SSLeay::X509_subject_name_hash($root)); 112 | if ($fp->{subject_hash_ca} eq $hash) { 113 | warn "N $fp->{host}:$fp->{port} - subject_hash_ca as expected\n"; 114 | } else { 115 | warn "N $fp->{host}:$fp->{port} - subject_hash_ca changed from $fp->{subject_hash_ca} to $hash\n"; 116 | $fp->{subject_hash_ca} = $hash; 117 | $changed++; 118 | } 119 | } 120 | } 121 | } 122 | if ($changed) { 123 | require Data::Dumper; 124 | open(my $fh,'<',__FILE__) or die $!; 125 | my $pl = do { local $/; <$fh> }; 126 | my $new = 'my $fingerprints= '.Data::Dumper->new([$fingerprints])->Terse(1)->Quotekeys(0)->Sortkeys(1)->Dump().";\n"; 127 | $pl =~ s{^(# --- BEGIN-FINGERPRINTS ----\s*\n)(.*)^(# --- END-FINGERPRINTS ----\s*\n)}{$1$new$3}ms 128 | or die "did not find BEGIN and END markers in ".__FILE__; 129 | open($fh,'>',__FILE__) or die $!; 130 | print $fh $pl; 131 | warn __FILE__." updated\n"; 132 | } 133 | } 134 | 135 | $fingerprints; 136 | -------------------------------------------------------------------------------- /t/external/ocsp.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | use Test::More; 6 | use IO::Socket::SSL; 7 | #$Net::SSLeay::trace=3; 8 | 9 | plan skip_all => "no OCSP support" if ! IO::Socket::SSL->can_ocsp; 10 | 11 | my $fingerprints = do './fingerprint.pl' 12 | || do './t/external/fingerprint.pl' 13 | || die "no fingerprints for sites"; 14 | my @tests = grep { $_->{ocsp} } @$fingerprints; 15 | 16 | plan tests => 0+@tests; 17 | 18 | my $timeout = 10; 19 | my $proxy = ( $ENV{http_proxy} || '' ) 20 | =~m{^(?:\w+://)?([\w\-.:\[\]]+:\d+)/?$} && $1; 21 | my $have_httptiny = eval { require HTTP::Tiny }; 22 | my $ipclass = 'IO::Socket::INET'; 23 | for( qw( IO::Socket::IP IO::Socket::INET6 )) { 24 | eval { require $_ } or next; 25 | $ipclass = $_; 26 | last; 27 | } 28 | 29 | 30 | TEST: 31 | for my $test (@tests) { 32 | my $tcp_connect = sub { 33 | if ( ! $proxy ) { 34 | # direct connection 35 | return $ipclass->new( 36 | PeerAddr => $test->{host}, 37 | PeerPort => $test->{port}, 38 | Timeout => $timeout, 39 | ) || die "tcp connect to $test->{host}:$test->{port} failed: $!"; 40 | } 41 | my $cl = $ipclass->new( 42 | PeerAddr => $proxy, 43 | Timeout => $timeout, 44 | ) || die "tcp connect to proxy $proxy failed: $!"; 45 | 46 | # try to establish tunnel via proxy with CONNECT 47 | { 48 | local $SIG{ALRM} = sub { 49 | die "proxy HTTP tunnel creation timed out" }; 50 | alarm($timeout); 51 | print $cl "CONNECT $test->{host}:$test->{port} HTTP/1.0\r\n\r\n"; 52 | my $reply = ''; 53 | while (<$cl>) { 54 | $reply .= $_; 55 | last if m{\A\r?\n\Z}; 56 | } 57 | alarm(0); 58 | $reply =~m{\AHTTP/1\.[01] 200\b} or 59 | die "unexpected response from proxy: $reply"; 60 | } 61 | return $cl; 62 | }; 63 | 64 | SKIP: { 65 | # first check fingerprint in case of SSL interception 66 | my $cl = eval { &$tcp_connect } or skip "TCP connect#1 failed: $@",1; 67 | diag("tcp connect to $test->{host}:$test->{port} ok"); 68 | skip "SSL upgrade w/o validation failed: $SSL_ERROR",1 69 | if ! IO::Socket::SSL->start_SSL($cl, 70 | SSL_hostname => $test->{host}, 71 | SSL_verify_mode => 0 72 | ); 73 | my $pubkey_fp = $test->{fingerprint} =~m{\$pub\$}; 74 | skip "fingerprints do not match",1 75 | if $cl->get_fingerprint('sha1',undef,$pubkey_fp) ne $test->{fingerprint}; 76 | diag("fingerprint matches"); 77 | 78 | # then check if we can use the default CA path for successful 79 | # validation without OCSP yet 80 | $cl = eval { &$tcp_connect } or skip "TCP connect#2 failed: $@",1; 81 | skip "SSL upgrade w/o OCSP failed: $SSL_ERROR",1 82 | if ! IO::Socket::SSL->start_SSL($cl, 83 | SSL_hostname => $test->{host}, 84 | SSL_ocsp_mode => SSL_OCSP_NO_STAPLE 85 | ); 86 | diag("validation with default CA w/o OCSP ok"); 87 | 88 | # check with default settings 89 | $cl = eval { &$tcp_connect } or skip "TCP connect#3 failed: $@",1; 90 | my $ok = IO::Socket::SSL->start_SSL($cl, SSL_hostname => $test->{host}); 91 | my $err = !$ok && $SSL_ERROR; 92 | if (!$ok && !$test->{ocsp}{revoked}) { 93 | fail("SSL upgrade with OCSP stapling failed: $err"); 94 | next TEST; 95 | } 96 | 97 | # we got usable stapling if _SSL_ocsp_verify is defined 98 | if ($test->{ocsp}{staple}) { 99 | if ( ! ${*$cl}{_SSL_ocsp_verify}) { 100 | fail("did not get expected OCSP response with stapling"); 101 | next TEST; 102 | } else { 103 | diag("got stapled response as expected"); 104 | } 105 | } 106 | 107 | if (!$err && !$${*$cl}{_SSL_ocsp_verify} && $have_httptiny) { 108 | # use OCSP resolver to resolve remaining certs, should be at most one 109 | my $ocsp_resolver = $cl->ocsp_resolver; 110 | my %rq = $ocsp_resolver->requests; 111 | if (keys(%rq)>1) { 112 | fail("got more open OCSP requests (".keys(%rq). 113 | ") than expected(1) in default mode"); 114 | next TEST; 115 | } 116 | $err = $ocsp_resolver->resolve_blocking(timeout => $timeout); 117 | } 118 | 119 | if ($test->{ocsp}{revoked}) { 120 | if ($err =~m/revoked/) { 121 | my $where = ${*$cl}{_SSL_ocsp_verify} ? 'stapled':'asked OCSP server'; 122 | pass("revoked as expected ($where)"); 123 | } elsif ($err =~m/OCSP_basic_verify:certificate verify error/) { 124 | # badly signed OCSP record 125 | pass("maybe revoked, but got OCSP verification error: $SSL_ERROR"); 126 | } elsif ($err =~m/response not yet valid or expired/) { 127 | pass("maybe revoked, but got not yet valid/expired response from OCSP server"); 128 | } elsif ($err) { 129 | # some other error 130 | pass("maybe revoked, but got error: $err"); 131 | } elsif (!$have_httptiny && !$test->{ocsp}{staple}) { 132 | # could not check because HTTP::Tiny is missing 133 | pass("maybe revoked, but could not check because HTTP::Tiny is missing"); 134 | } else { 135 | fail("expected revoked but connection ok"); 136 | } 137 | next TEST; 138 | 139 | } elsif ($err) { 140 | if ($err =~m/revoked/) { 141 | fail("expected ok but revoked"); 142 | } else { 143 | pass("probably ok, but got $err"); 144 | } 145 | next TEST; 146 | } 147 | 148 | diag("validation with default CA with OCSP defaults ok"); 149 | 150 | # now check with full chain 151 | $cl = eval { &$tcp_connect } or skip "TCP connect#4 failed: $@",1; 152 | my $cache = IO::Socket::SSL::OCSP_Cache->new; 153 | if (! IO::Socket::SSL->start_SSL($cl, 154 | SSL_hostname => $test->{host}, 155 | SSL_ocsp_mode => SSL_OCSP_FULL_CHAIN, 156 | SSL_ocsp_cache => $cache 157 | )) { 158 | skip "unexpected fail of SSL connect: $SSL_ERROR",1 159 | } 160 | my $chain_size = $cl->peer_certificates; 161 | if ( my $ocsp_resolver = $have_httptiny && $cl->ocsp_resolver ) { 162 | # there should be no hard error after resolving - unless an 163 | # intermediate certificate got revoked which I don't hope 164 | $err = $ocsp_resolver->resolve_blocking(timeout => $timeout); 165 | if ($err) { 166 | fail("fatal error in OCSP resolver: $err"); 167 | next TEST; 168 | } 169 | # we should now either have soft errors or the OCSP cache should 170 | # have chain_size entries 171 | if ( ! $ocsp_resolver->soft_error ) { 172 | my $cache_size = keys(%$cache)-1; 173 | if ($cache_size!=$chain_size) { 174 | fail("cache_size($cache_size) != chain_size($chain_size)"); 175 | next TEST; 176 | } 177 | } 178 | diag("validation with default CA with OCSP full chain ok"); 179 | } 180 | 181 | done: 182 | pass("OCSP tests $test->{host}:$test->{port} ok"); 183 | } 184 | } 185 | -------------------------------------------------------------------------------- /t/external/usable_ca.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | use IO::Socket::SSL; 5 | use IO::Socket::SSL::Utils; 6 | 7 | my $ipclass = 'IO::Socket::INET'; 8 | for( qw( IO::Socket::IP IO::Socket::INET6 )) { 9 | eval { require $_ } or next; 10 | $ipclass = $_; 11 | last; 12 | } 13 | 14 | my $fingerprints = do './fingerprint.pl' 15 | || do './t/external/fingerprint.pl' 16 | || die "no fingerprints for sites"; 17 | my @tests = grep { $_->{subject_hash_ca} } @$fingerprints; 18 | 19 | my %ca = IO::Socket::SSL::default_ca(); 20 | plan skip_all => "no default CA store found" if ! %ca; 21 | 22 | my %have_ca; 23 | # some systems seems to have junk in the CA stores 24 | # so better wrap it into eval 25 | eval { 26 | for my $f ( 27 | ( $ca{SSL_ca_file} ? ($ca{SSL_ca_file}) : ()), 28 | ( $ca{SSL_ca_path} ? glob("$ca{SSL_ca_path}/*") :()), 29 | ) { 30 | open( my $fh,'<',$f ) or next; 31 | my $pem; 32 | while (<$fh>) { 33 | if ( m{^--+END} ) { 34 | my $cert = PEM_string2cert($pem.$_); 35 | $pem = undef; 36 | $cert or next; 37 | my $hash = Net::SSLeay::X509_subject_name_hash($cert); 38 | $have_ca{sprintf("%08x",$hash)} = 1; 39 | } elsif ( m{^--+BEGIN (TRUSTED |X509 |)CERTIFICATE-+} ) { 40 | $pem = $_; 41 | } elsif ( $pem ) { 42 | $pem .= $_; 43 | } 44 | } 45 | } 46 | }; 47 | diag( "found ".(0+keys %have_ca)." CA certs"); 48 | plan skip_all => "no CA certs found" if ! %have_ca; 49 | 50 | my $proxy = ( $ENV{https_proxy} || $ENV{http_proxy} || '' ) 51 | =~m{^(?:\w+://)?([\w\-.:\[\]]+:\d+)/?$} && $1; 52 | 53 | my @cap = ('SSL_verifycn_name'); 54 | push @cap, 'SSL_hostname' if IO::Socket::SSL->can_client_sni(); 55 | plan tests => (1+@cap)*@tests; 56 | 57 | for my $test (@tests) { 58 | my $host = $test->{host}; 59 | my $port = $test->{port} || 443; 60 | my $fp = $test->{fingerprint}; 61 | my $ca_hash = $test->{subject_hash_ca}; 62 | 63 | SKIP: { 64 | 65 | # first check if we have the CA in store 66 | skip "no root CA $ca_hash for $host in store",1+@cap 67 | if ! $have_ca{$ca_hash}; 68 | diag("have root CA for $host in store"); 69 | 70 | # then build inet connections for later SSL upgrades 71 | my @cl; 72 | for my $cap ('fp','nocn',@cap,'noca') { 73 | my $cl; 74 | if ( ! $proxy ) { 75 | # direct connection 76 | $cl = $ipclass->new( 77 | PeerAddr => $host, 78 | PeerPort => $port, 79 | Timeout => 15, 80 | ) 81 | } elsif ( $cl = $ipclass->new( 82 | PeerAddr => $proxy, 83 | Timeout => 15 84 | )) { 85 | # try to establish tunnel via proxy with CONNECT 86 | my $reply = ''; 87 | if ( eval { 88 | local $SIG{ALRM} = sub { die "timed out" }; 89 | alarm(15); 90 | print $cl "CONNECT $host:443 HTTP/1.0\r\n\r\n"; 91 | while (<$cl>) { 92 | $reply .= $_; 93 | last if m{\A\r?\n\Z}; 94 | } 95 | $reply =~m{\AHTTP/1\.[01] 200\b} or 96 | die "unexpected response from proxy: $reply"; 97 | }) { 98 | } else { 99 | $cl = undef 100 | } 101 | } 102 | 103 | skip "cannot connect to $host:443 with $ipclass: $!",1+@cap 104 | if ! $cl; 105 | push @cl,$cl; 106 | } 107 | 108 | diag(int(@cl)." connections to $host ok"); 109 | 110 | # check if we have SSL interception by comparing the fingerprint we get 111 | my $cl = shift(@cl); 112 | skip "ssl upgrade failed even without verification",1+@cap 113 | if ! IO::Socket::SSL->start_SSL($cl, SSL_verify_mode => 0 ); 114 | my $pubkey_fp = $test->{fingerprint} =~m{\$pub\$}; 115 | my $clfp = $cl->get_fingerprint('sha1',undef,$pubkey_fp); 116 | skip "fingerprint mismatch ($clfp) - probably SSL interception or certificate changed",1+@cap 117 | if $clfp ne $fp; 118 | diag("fingerprint $host matches"); 119 | 120 | # check if it can verify against builtin CA store 121 | $cl = shift(@cl); 122 | if ( ! IO::Socket::SSL->start_SSL($cl)) { 123 | skip "ssl upgrade failed with builtin CA store",1+@cap; 124 | } 125 | diag("check $host against builtin CA store ok"); 126 | 127 | for my $cap (@cap) { 128 | my $cl = shift(@cl); 129 | # try to upgrade with SSL using default CA path 130 | if ( IO::Socket::SSL->start_SSL($cl, 131 | SSL_verify_mode => 1, 132 | SSL_verifycn_scheme => 'http', 133 | $cap => $host, 134 | )) { 135 | pass("SSL upgrade $host with default CA and $cap"); 136 | } elsif ( $SSL_ERROR =~m{verify failed} ) { 137 | fail("SSL upgrade $host with default CA and $cap: $SSL_ERROR"); 138 | } else { 139 | pass("SSL upgrade $host with default CA and $cap failed but not because of verify problem: $SSL_ERROR"); 140 | } 141 | } 142 | 143 | # it should fail when we use no default ca, even on OS X 144 | # https://hynek.me/articles/apple-openssl-verification-surprises/ 145 | $cl = shift(@cl); 146 | if ( IO::Socket::SSL->start_SSL($cl, SSL_ca_file => \'' )) { 147 | fail("SSL upgrade $host with no CA succeeded"); 148 | } elsif ( $SSL_ERROR =~m{verify failed} ) { 149 | pass("SSL upgrade $host with no CA failed"); 150 | } else { 151 | pass("SSL upgrade $host with no CA failed but not because of verify problem: $SSL_ERROR"); 152 | } 153 | } 154 | } 155 | -------------------------------------------------------------------------------- /t/io-socket-inet6.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | # make sure IO::Socket::IP will not be used 4 | BEGIN { 5 | if ( eval { require Acme::Override::INET }) { 6 | print "1..0 # Skipped: will not work with Acme::Override::INET installed\n"; 7 | exit 8 | } 9 | $INC{'IO/Socket/IP.pm'} = undef 10 | } 11 | 12 | use strict; 13 | use warnings; 14 | use Net::SSLeay; 15 | use Socket; 16 | use IO::Socket::SSL; 17 | do './testlib.pl' || do './t/testlib.pl' || die "no testlib"; 18 | 19 | # check first if we have loaded IO::Socket::IP, as if so we won't need or use 20 | # IO::Socket::INET6 21 | if( IO::Socket::SSL->CAN_IPV6 eq "IO::Socket::IP" ) { 22 | print "1..0 # Skipped: using IO::Socket::IP instead\n"; 23 | exit; 24 | } 25 | 26 | # check if we have loaded INET6, IO::Socket::SSL should do it by itself 27 | # if it is available 28 | unless( IO::Socket::SSL->CAN_IPV6 eq "IO::Socket::INET6" ) { 29 | # not available or IO::Socket::SSL forgot to load it 30 | if ( ! eval { require IO::Socket::INET6 } ) { 31 | print "1..0 # Skipped: no IO::Socket::INET6 available\n"; 32 | } elsif ( ! eval { IO::Socket::INET6->VERSION(2.62) } ) { 33 | print "1..0 # Skipped: no IO::Socket::INET6 available\n"; 34 | } else { 35 | print "1..1\nnot ok # automatic use of INET6\n"; 36 | } 37 | exit 38 | } 39 | 40 | my $addr = '::1'; 41 | # check if we can use ::1, e.g. if the computer has IPv6 enabled 42 | if ( ! IO::Socket::INET6->new( 43 | Listen => 10, 44 | LocalAddr => $addr, 45 | )) { 46 | print "1..0 # no IPv6 enabled on this computer\n"; 47 | exit 48 | } 49 | 50 | $|=1; 51 | print "1..3\n"; 52 | print "# IO::Socket::INET6 version=$IO::Socket::INET6::VERSION\n"; 53 | 54 | # first create simple ssl-server 55 | my $ID = 'server'; 56 | my $server = IO::Socket::SSL->new( 57 | LocalAddr => $addr, 58 | Listen => 2, 59 | SSL_cert_file => "t/certs/server-cert.pem", 60 | SSL_key_file => "t/certs/server-key.pem", 61 | ) || do { 62 | notok($!); 63 | exit 64 | }; 65 | ok("Server Initialization at $addr"); 66 | 67 | # add server port to addr 68 | $addr = "[$addr]:".$server->sockport; 69 | print "# server at $addr\n"; 70 | 71 | my $pid = fork(); 72 | if ( !defined $pid ) { 73 | die $!; # fork failed 74 | 75 | } elsif ( !$pid ) { ###### Client 76 | 77 | $ID = 'client'; 78 | close($server); 79 | my $to_server = IO::Socket::SSL->new( 80 | PeerAddr => $addr, 81 | SSL_verify_mode => 0, 82 | ) || do { 83 | notok( "connect failed: ".IO::Socket::SSL->errstr() ); 84 | exit 85 | }; 86 | ok( "client connected" ); 87 | 88 | } else { ###### Server 89 | 90 | my $to_client = $server->accept || do { 91 | notok( "accept failed: ".$server->errstr() ); 92 | kill(9,$pid); 93 | exit; 94 | }; 95 | ok( "Server accepted" ); 96 | wait; 97 | } 98 | 99 | sub ok { print "ok # [$ID] @_\n"; } 100 | sub notok { print "not ok # [$ID] @_\n"; } 101 | -------------------------------------------------------------------------------- /t/io-socket-ip.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | # Before `make install' is performed this script should be runnable with 3 | # `make test'. After `make install' it should work as `perl t/dhe.t' 4 | 5 | # make sure IO::Socket::INET6 will not be used 6 | BEGIN { $INC{'IO/Socket/INET6.pm'} = undef } 7 | 8 | use strict; 9 | use warnings; 10 | use Net::SSLeay; 11 | use Socket; 12 | use IO::Socket::SSL; 13 | do './testlib.pl' || do './t/testlib.pl' || die "no testlib"; 14 | 15 | # check if we have loaded IO::Socket::IP, IO::Socket::SSL should do it by 16 | # itself if it is available 17 | unless( IO::Socket::SSL->CAN_IPV6 eq "IO::Socket::IP" ) { 18 | # not available or IO::Socket::SSL forgot to load it 19 | if ( ! eval { 20 | require IO::Socket::IP; 21 | IO::Socket::IP->VERSION(0.31) 22 | }) { 23 | print "1..0 # Skipped: usable IO::Socket::IP is not available\n"; 24 | } elsif (! defined &IO::Socket::SSL::_getnameinfo) { 25 | print "1..0 # Skipped: no IPv6 support despite IO::Socket::IP\n"; 26 | } else { 27 | print "1..1\nnot ok # automatic use of IO::Socket::IP\n"; 28 | } 29 | exit 30 | } 31 | 32 | my $addr = '::1'; 33 | # check if we can use ::1, e.g. if the computer has IPv6 enabled 34 | if ( ! IO::Socket::IP->new( 35 | Listen => 10, 36 | LocalAddr => $addr, 37 | )) { 38 | print "1..0 # no IPv6 enabled on this computer\n"; 39 | exit 40 | } 41 | 42 | $|=1; 43 | print "1..3\n"; 44 | print "# IO::Socket::IP version=$IO::Socket::IP::VERSION\n"; 45 | 46 | # first create simple ssl-server 47 | my $ID = 'server'; 48 | my $server = IO::Socket::SSL->new( 49 | LocalAddr => $addr, 50 | Listen => 2, 51 | SSL_cert_file => "t/certs/server-cert.pem", 52 | SSL_key_file => "t/certs/server-key.pem", 53 | ) || do { 54 | notok($!); 55 | exit 56 | }; 57 | ok("Server Initialization at $addr"); 58 | 59 | # add server port to addr 60 | $addr = "[$addr]:".$server->sockport; 61 | print "# server at $addr\n"; 62 | 63 | my $pid = fork(); 64 | if ( !defined $pid ) { 65 | die $!; # fork failed 66 | 67 | } elsif ( !$pid ) { ###### Client 68 | 69 | $ID = 'client'; 70 | close($server); 71 | my $to_server = IO::Socket::SSL->new( 72 | PeerAddr => $addr, 73 | SSL_verify_mode => 0 74 | ) || do { 75 | notok( "connect failed: ".IO::Socket::SSL->errstr() ); 76 | exit 77 | }; 78 | ok( "client connected" ); 79 | 80 | } else { ###### Server 81 | 82 | my $to_client = $server->accept || do { 83 | notok( "accept failed: ".$server->errstr() ); 84 | kill(9,$pid); 85 | exit; 86 | }; 87 | ok( "Server accepted" ); 88 | wait; 89 | } 90 | 91 | sub ok { print "ok # [$ID] @_\n"; } 92 | sub notok { print "not ok # [$ID] @_\n"; } 93 | -------------------------------------------------------------------------------- /t/memleak_bad_handshake.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | # Before `make install' is performed this script should be runnable with 3 | # `make test'. After `make install' it should work as `perl t/nonblock.t' 4 | 5 | use strict; 6 | use warnings; 7 | use Net::SSLeay; 8 | use Socket; 9 | use IO::Socket::SSL; 10 | use IO::Select; 11 | do './testlib.pl' || do './t/testlib.pl' || die "no testlib"; 12 | 13 | my $getsize; 14 | if ( -f "/proc/$$/statm" ) { 15 | $getsize = sub { 16 | my $pid = shift; 17 | open( my $fh,'<', "/proc/$pid/statm"); 18 | my $line = <$fh>; 19 | return (split(' ',$line))[0] * 4; 20 | }; 21 | } elsif ( ! grep { $^O =~m{$_}i } qw( MacOS VOS vmesa riscos amigaos mswin32) ) { 22 | $getsize = sub { 23 | my $pid = shift; 24 | open( my $ps,'-|',"ps -o vsize -p $pid 2>/dev/null" ) or return; 25 | $ps && <$ps> or return; # header 26 | return int(<$ps>); # size 27 | }; 28 | } else { 29 | print "1..0 # Skipped: ps not implemented on this platform\n"; 30 | exit 31 | } 32 | 33 | if ( $^O =~m{aix}i ) { 34 | print "1..0 # Skipped: might hang, see https://rt.cpan.org/Ticket/Display.html?id=72170\n"; 35 | exit 36 | } 37 | 38 | 39 | $|=1; 40 | if ( ! $getsize->($$) ) { 41 | print "1..0 # Skipped: no usable ps\n"; 42 | exit; 43 | } 44 | 45 | my $server = IO::Socket::SSL->new( 46 | LocalAddr => '127.0.0.1', 47 | LocalPort => 0, 48 | Listen => 200, 49 | SSL_cert_file => 't/certs/server-cert.pem', 50 | SSL_key_file => 't/certs/server-key.pem', 51 | ); 52 | 53 | my $saddr = $server->sockhost.':'.$server->sockport; 54 | defined( my $pid = fork()) or die "fork failed: $!"; 55 | if ( $pid == 0 ) { 56 | # server 57 | while (1) { 58 | # socket accept, client handshake and client close 59 | $server->accept; 60 | } 61 | exit(0); 62 | } 63 | 64 | 65 | close($server); 66 | # plain non-SSL connect and close w/o sending data 67 | for(1..100) { 68 | IO::Socket::INET->new( $saddr ) or next; 69 | } 70 | my $size100 = $getsize->($pid); 71 | if ( ! $size100 ) { 72 | print "1..0 # Skipped: cannot get size of child process\n"; 73 | goto done; 74 | } 75 | 76 | for(100..200) { 77 | IO::Socket::INET->new( $saddr ) or next; 78 | } 79 | my $size200 = $getsize->($pid); 80 | 81 | for(200..300) { 82 | IO::Socket::INET->new( $saddr ) or next; 83 | } 84 | my $size300 = $getsize->($pid); 85 | if ($size100>$size200 or $size200<$size300) {; 86 | print "1..0 # skipped - do we measure the right thing?\n"; 87 | goto done; 88 | } 89 | 90 | print "1..1\n"; 91 | print "not " if $size100 < $size200 and $size200 < $size300; 92 | print "ok # check memleak failed handshake ($size100,$size200,$size300)\n"; 93 | 94 | done: 95 | kill(9,$pid); 96 | wait; 97 | exit; 98 | 99 | 100 | -------------------------------------------------------------------------------- /t/mitm.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use warnings; 5 | use Net::SSLeay; 6 | use Socket; 7 | use IO::Socket::SSL; 8 | use IO::Socket::SSL::Intercept; 9 | do './testlib.pl' || do './t/testlib.pl' || die "no testlib"; 10 | 11 | print "1..8\n"; 12 | 13 | my @pid; 14 | END { kill 9,@pid } 15 | 16 | my $server = IO::Socket::SSL->new( 17 | LocalAddr => '127.0.0.1', 18 | LocalPort => 0, 19 | SSL_cert_file => 't/certs/server-cert.pem', 20 | SSL_key_file => 't/certs/server-key.pem', 21 | Listen => 10, 22 | ); 23 | ok($server,"server ssl socket"); 24 | my $saddr = $server->sockhost.':'.$server->sockport; 25 | defined( my $pid = fork ) or die $!; 26 | exit( server()) if ! $pid; # child -> server() 27 | push @pid,$pid; 28 | close($server); 29 | 30 | my $proxy = IO::Socket::INET->new( 31 | LocalAddr => '127.0.0.1', 32 | LocalPort => 0, 33 | Listen => 10, 34 | Reuse => 1, 35 | ); 36 | sys_ok($proxy,"proxy tcp socket"); 37 | my $paddr = $proxy->sockhost.':'.$proxy->sockport; 38 | defined( $pid = fork ) or die $!; 39 | exit( proxy()) if ! $pid; # child -> proxy() 40 | push @pid,$pid; 41 | close($proxy); 42 | 43 | # connect to server, check certificate 44 | my $cl = IO::Socket::SSL->new( 45 | PeerAddr => $saddr, 46 | Domain => AF_INET, 47 | SSL_verify_mode => 1, 48 | SSL_ca_file => 't/certs/test-ca.pem', 49 | ); 50 | ssl_ok($cl,"ssl connected to server"); 51 | ok( $cl->peer_certificate('subject') =~ m{server\.local}, "subject w/o mitm"); 52 | ok( $cl->peer_certificate('issuer') =~ m{IO::Socket::SSL Demo CA}, 53 | "issuer w/o mitm"); 54 | 55 | # connect to proxy, check certificate 56 | $cl = IO::Socket::SSL->new( 57 | PeerAddr => $paddr, 58 | Domain => AF_INET, 59 | SSL_verify_mode => 1, 60 | SSL_ca_file => 't/certs/proxyca.pem', 61 | ); 62 | ssl_ok($cl,"ssl connected to proxy"); 63 | ok( $cl->peer_certificate('subject') =~ m{server\.local}, "subject w/ mitm"); 64 | ok( $cl->peer_certificate('issuer') =~ m{IO::Socket::SSL::Intercept}, 65 | "issuer w/ mitm"); 66 | 67 | 68 | sub server { 69 | while (1) { 70 | my $cl = $server->accept or next; 71 | sleep(1); 72 | } 73 | } 74 | 75 | sub proxy { 76 | my $mitm = IO::Socket::SSL::Intercept->new( 77 | proxy_cert_file => 't/certs/proxyca.pem', 78 | proxy_key_file => 't/certs/proxyca.pem', 79 | ); 80 | while (1) { 81 | my $toc = $proxy->accept or next; 82 | my $tos = IO::Socket::SSL->new( 83 | PeerAddr => $saddr, 84 | Domain => AF_INET, 85 | SSL_verify_mode => 1, 86 | SSL_ca_file => 't/certs/test-ca.pem', 87 | ) or die "failed connect to server: $!, $SSL_ERROR"; 88 | my ($cert,$key) = $mitm->clone_cert($tos->peer_certificate); 89 | $toc = IO::Socket::SSL->start_SSL( $toc, 90 | SSL_server => 1, 91 | SSL_cert => $cert, 92 | SSL_key => $key, 93 | ) or die "ssl upgrade client failed: $SSL_ERROR"; 94 | sleep(1); 95 | } 96 | } 97 | 98 | sub ok { 99 | my ($what,$msg) = @_; 100 | print "not " if ! $what; 101 | print "ok # $msg\n"; 102 | } 103 | sub sys_ok { 104 | my ($what,$msg) = @_; 105 | if ( $what ) { 106 | print "ok # $msg\n"; 107 | } else { 108 | print "not ok # $msg - $!\n"; 109 | exit 110 | } 111 | } 112 | 113 | sub ssl_ok { 114 | my ($what,$msg) = @_; 115 | if ( $what ) { 116 | print "ok # $msg\n"; 117 | } else { 118 | print "not ok # $msg - $SSL_ERROR\n"; 119 | exit 120 | } 121 | } 122 | -------------------------------------------------------------------------------- /t/multiple-cert-rsa-ecc.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use warnings; 5 | use Net::SSLeay; 6 | use Socket; 7 | use IO::Socket::SSL; 8 | use IO::Socket::SSL::Utils; 9 | do './testlib.pl' || do './t/testlib.pl' || die "no testlib"; 10 | 11 | if ( ! IO::Socket::SSL->can_server_sni() 12 | or ! IO::Socket::SSL->can_client_sni()) { 13 | print "1..0 # skipped because no full SNI support - openssl/Net::SSleay too old\n"; 14 | exit; 15 | } 16 | 17 | if ( ! IO::Socket::SSL->can_multi_cert() ) { 18 | print "1..0 # no support for multiple certificate types\n"; 19 | exit; 20 | } 21 | 22 | print "1..12\n"; 23 | 24 | my %certs = ( 25 | SSL_cert_file => { 26 | '' => 't/certs/server-cert.pem', 27 | '%ecc' => "t/certs/server-ecc-cert.pem", 28 | 'server2.local' => 't/certs/server2-cert.pem', 29 | }, 30 | SSL_key_file => { 31 | '' => 't/certs/server-key.pem', 32 | '%ecc' => 't/certs/server-ecc-key.pem', 33 | 'server2.local' => 't/certs/server2-key.pem', 34 | } 35 | ); 36 | 37 | my (%k2fp,%fp2k); 38 | Net::SSLeay::SSLeay_add_ssl_algorithms(); 39 | my $sha256 = Net::SSLeay::EVP_get_digestbyname('sha256') or die; 40 | for (keys %{ $certs{SSL_cert_file} }) { 41 | my $cert = PEM_file2cert($certs{SSL_cert_file}{$_}); 42 | my $fp = 'sha256$'.unpack('H*',Net::SSLeay::X509_digest($cert, $sha256)); 43 | $k2fp{$_} = $fp; 44 | $fp2k{$fp} = $_; 45 | } 46 | 47 | my $server = IO::Socket::SSL->new( 48 | LocalAddr => '127.0.0.1', 49 | Listen => 2, 50 | ReuseAddr => 1, 51 | SSL_server => 1, 52 | SSL_ca_file => "t/certs/test-ca.pem", 53 | SSL_honor_cipher_order => 0, 54 | SSL_cipher_list => 'ECDHE-ECDSA-AES128-SHA:ECDHE-RSA-AES128-SHA', 55 | %certs, 56 | ); 57 | 58 | warn "\$!=$!, \$\@=$@, S\$SSL_ERROR=$SSL_ERROR" if ! $server; 59 | print "not ok\n", exit if !$server; 60 | print "ok # Server Initialization\n"; 61 | my $saddr = $server->sockhost.':'.$server->sockport; 62 | 63 | my @tests = ( 64 | [ 'foo.bar', 'ECDHE-ECDSA-AES128-SHA', '%ecc' ], 65 | [ 'foo.bar', 'ECDHE-RSA-AES128-SHA', '' ], 66 | [ 'foo.bar', 'ECDHE-RSA-AES128-SHA:ECDHE-ECDSA-AES128-SHA', '' ], 67 | [ 'foo.bar', 'ECDHE-ECDSA-AES128-SHA:ECDHE-RSA-AES128-SHA', '%ecc' ], 68 | [ 'server2.local', 'ECDHE-ECDSA-AES128-SHA:ECDHE-RSA-AES128-SHA', 'server2.local' ], 69 | [ 'server2.local', 'ECDHE-RSA-AES128-SHA:ECDHE-ECDSA-AES128-SHA', 'server2.local' ], 70 | [ 'server2.local', 'ECDHE-ECDSA-AES128-SHA', 'FAIL' ], 71 | [ undef, 'ECDHE-ECDSA-AES128-SHA', '%ecc' ], 72 | [ undef, 'ECDHE-RSA-AES128-SHA', '' ], 73 | [ undef, 'ECDHE-RSA-AES128-SHA:ECDHE-ECDSA-AES128-SHA', '' ], 74 | [ undef, 'ECDHE-ECDSA-AES128-SHA:ECDHE-RSA-AES128-SHA', '%ecc' ], 75 | ); 76 | 77 | defined( my $pid = fork() ) || die $!; 78 | if ( $pid == 0 ) { 79 | close($server); 80 | 81 | for my $test (@tests) { 82 | my ($host,$ciphers,$expect) = @$test; 83 | my $what = ($host || ''). " $ciphers | expect='$expect'"; 84 | my $client = IO::Socket::SSL->new( 85 | PeerAddr => $saddr, 86 | Domain => AF_INET, 87 | SSL_verify_mode => 0, 88 | SSL_hostname => $host, 89 | SSL_ca_file => 't/certs/test-ca.pem', 90 | SSL_cipher_list => $ciphers, 91 | # don't use TLS 1.3 since the ciphers there don't specifify the 92 | # authentication mechanism 93 | SSL_version => 'SSLv23:!TLSv1_3', 94 | ); 95 | 96 | my $fp = $client ? $fp2k{$client->get_fingerprint('sha256')} : 'FAIL'; 97 | $fp = '???' if ! defined $fp; 98 | my $cipher = $client ? $client->get_cipher() : ''; 99 | print "not " if $fp ne $expect; 100 | print "ok # fingerprint match - $what - got='$fp' -- $cipher\n"; 101 | } 102 | exit; 103 | } 104 | 105 | for my $host (@tests) { 106 | $server->accept or next; 107 | } 108 | wait; 109 | -------------------------------------------------------------------------------- /t/npn.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | # Before `make install' is performed this script should be runnable with 3 | # `make test'. After `make install' it should work as `perl t/dhe.t' 4 | 5 | use strict; 6 | use warnings; 7 | use Net::SSLeay; 8 | use Socket; 9 | use IO::Socket::SSL; 10 | do './testlib.pl' || do './t/testlib.pl' || die "no testlib"; 11 | 12 | # check if we have NPN available 13 | # if it is available 14 | if ( ! IO::Socket::SSL->can_npn ) { 15 | print "1..0 # Skipped: NPN not available in Net::SSLeay\n"; 16 | exit 17 | } 18 | 19 | $|=1; 20 | print "1..5\n"; 21 | 22 | # first create simple ssl-server 23 | my $ID = 'server'; 24 | my $addr = '127.0.0.1'; 25 | my $server = IO::Socket::SSL->new( 26 | LocalAddr => $addr, 27 | Listen => 2, 28 | SSL_version => 'SSLv23:!TLSv1_3', # NPN does not exist in TLSv1.3 29 | # https://github.com/openssl/openssl/issues/3665 30 | SSL_cert_file => 't/certs/server-cert.pem', 31 | SSL_key_file => 't/certs/server-key.pem', 32 | SSL_npn_protocols => [qw(one two)], 33 | ) || do { 34 | ok(0,$!); 35 | exit 36 | }; 37 | ok(1,"Server Initialization at $addr"); 38 | 39 | # add server port to addr 40 | $addr = "$addr:".$server->sockport; 41 | print "# server at $addr\n"; 42 | 43 | my $pid = fork(); 44 | if ( !defined $pid ) { 45 | die $!; # fork failed 46 | 47 | } elsif ( !$pid ) { ###### Client 48 | 49 | $ID = 'client'; 50 | close($server); 51 | my $to_server = IO::Socket::SSL->new( 52 | PeerAddr => $addr, 53 | Domain => AF_INET, 54 | SSL_verify_mode => 0, 55 | SSL_npn_protocols => [qw(two three)], 56 | ) or do { 57 | ok(0, "connect failed: ".IO::Socket::SSL->errstr() ); 58 | exit 59 | }; 60 | ok(1,"client connected" ); 61 | my $proto = $to_server->next_proto_negotiated; 62 | ok($proto eq 'two',"negotiated $proto"); 63 | 64 | 65 | } else { ###### Server 66 | 67 | my $to_client = $server->accept or do { 68 | ok(0,"accept failed: ".$server->errstr() ); 69 | kill(9,$pid); 70 | exit; 71 | }; 72 | ok(1,"Server accepted" ); 73 | my $proto = $to_client->next_proto_negotiated; 74 | ok($proto eq 'two',"negotiated $proto"); 75 | wait; 76 | } 77 | 78 | sub ok { 79 | my $ok = shift; 80 | print $ok ? '' : 'not ', "ok # [$ID] @_\n"; 81 | } 82 | -------------------------------------------------------------------------------- /t/plain_upgrade_downgrade.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Socket; 4 | use IO::Socket::SSL; 5 | use IO::Socket::SSL::Utils; 6 | use Test::More; 7 | do './testlib.pl' || do './t/testlib.pl' || die "no testlib"; 8 | 9 | # create listener 10 | IO::Socket::SSL::default_ca('t/certs/test-ca.pem'); 11 | my $server = IO::Socket::SSL->new( 12 | LocalAddr => '127.0.0.1', 13 | LocalPort => 0, 14 | Listen => 2, 15 | SSL_cert_file => 't/certs/server-cert.pem', 16 | SSL_key_file => 't/certs/server-key.pem', 17 | # start as plain and upgrade later 18 | SSL_startHandshake => 0, 19 | ) || die "not ok #tcp listen failed: $!\n"; 20 | my $saddr = $server->sockhost.':'.$server->sockport; 21 | #diag("listen at $saddr"); 22 | 23 | # fork child for server 24 | defined( my $pid = fork() ) || die $!; 25 | if ( ! $pid ) { 26 | $SIG{ALRM} = sub { die "server timed out" }; 27 | while (1) { 28 | alarm(30); 29 | my $cl = $server->accept; 30 | diag("server accepted new client"); 31 | #${*$cl}{_SSL_ctx} or die "accepted socket has no SSL context"; 32 | ${*$cl}{_SSL_object} and die "accepted socket is already SSL"; 33 | 34 | # try to find out if we start with TLS immediately (peek gets data from 35 | # client hello) or have some plain data initially (peek gets these 36 | # plain data) 37 | diag("wait for initial data from client"); 38 | my $buf = ''; 39 | while (length($buf)<3) { 40 | vec(my $rin='',fileno($cl),1) = 1; 41 | my $rv = select($rin,undef,undef,10); 42 | die "timeout waiting for data from client" if ! $rv; 43 | die "something wrong: $!" if $rv<0; 44 | $cl->peek($buf,3); 45 | $buf eq '' and die "eof from client"; 46 | diag("got 0x".unpack("H*",$buf)." from client"); 47 | } 48 | 49 | if ($buf eq "end") { 50 | # done 51 | diag("client requested end of tests"); 52 | exit(0); 53 | } 54 | 55 | if ($buf eq 'foo') { 56 | # initial plain dialog 57 | diag("server: got plain data at start of connection"); 58 | read($cl,$buf,3) or die "failed to read"; 59 | $buf eq 'foo' or die "read($buf) different from peek"; 60 | print $cl "bar"; # reply 61 | } 62 | 63 | # now we upgrade to TLS 64 | diag("server: TLS upgrade"); 65 | $cl->accept_SSL or die "failed to SSL upgrade server side: $SSL_ERROR"; 66 | ${*$cl}{_SSL_object} or die "no SSL object after accept_SSL"; 67 | read($cl,$buf,6) or die "failed to ssl read"; 68 | $buf eq 'sslfoo' or die "wrong data received from client '$buf'"; 69 | print $cl "sslbar"; 70 | 71 | # now we downgrade from TLS to plain and try to exchange some data 72 | diag("server: TLS downgrade"); 73 | $cl->stop_SSL or die "failed to stop SSL"; 74 | ${*$cl}{_SSL_object} and die "still SSL object after stop_SSL"; 75 | read($cl,$buf,3); 76 | $buf eq 'foo' or die "wrong data received from client '$buf'"; 77 | print $cl "bar"; 78 | 79 | # now we upgrade again to TLS 80 | diag("server: TLS upgrade#2"); 81 | $cl->accept_SSL or die "failed to SSL upgrade server side"; 82 | ${*$cl}{_SSL_object} or die "no SSL object after accept_SSL"; 83 | read($cl,$buf,6) or die "failed to ssl read"; 84 | $buf eq 'sslfoo' or die "wrong data received from client '$buf'"; 85 | print $cl "sslbar"; 86 | } 87 | } 88 | 89 | # client 90 | close($server); # close server in client 91 | $SIG{ALRM} = sub { die "client timed out" }; 92 | 93 | plan tests => 15; 94 | 95 | for my $test ( 96 | [qw(newINET start_SSL stop_SSL start_SSL)], 97 | [qw(newSSL stop_SSL connect_SSL)], 98 | [qw(newSSL:0 connect_SSL stop_SSL connect_SSL)], 99 | [qw(newSSL:0 start_SSL stop_SSL connect_SSL)], 100 | ) { 101 | my $cl; 102 | diag("-- test: @$test"); 103 | for my $act (@$test) { 104 | if (eval { 105 | if ($act =~m{newSSL(?::(.*))?$} ) { 106 | $cl = IO::Socket::SSL->new( 107 | PeerAddr => $saddr, 108 | Domain => AF_INET, 109 | defined($1) ? (SSL_startHandshake => $1):(), 110 | ) or die "failed to connect: $!|$SSL_ERROR"; 111 | if ( ! defined($1) || $1 ) { 112 | ${*$cl}{_SSL_object} or die "no SSL object"; 113 | } else { 114 | ${*$cl}{_SSL_object} and die "have SSL object"; 115 | } 116 | } elsif ($act eq 'newINET') { 117 | $cl = IO::Socket::INET->new($saddr) 118 | or die "failed to connect: $!"; 119 | } elsif ($act eq 'stop_SSL') { 120 | $cl->stop_SSL or die "stop_SSL failed: $SSL_ERROR"; 121 | ${*$cl}{_SSL_object} and 122 | die "still having SSL object after stop_SSL"; 123 | } elsif ($act eq 'connect_SSL') { 124 | $cl->connect_SSL or die "connect_SSL failed: $SSL_ERROR"; 125 | ${*$cl}{_SSL_object} or die "no SSL object after connect_SSL"; 126 | } elsif ($act eq 'start_SSL') { 127 | IO::Socket::SSL->start_SSL($cl) or 128 | die "start_SSL failed: $SSL_ERROR"; 129 | ${*$cl}{_SSL_object} or die "no SSL object after start_SSL"; 130 | } else { 131 | die "unknown action $act" 132 | } 133 | if (${*$cl}{_SSL_object}) { 134 | print $cl "sslfoo"; 135 | read($cl, my $buf,6); 136 | $buf eq 'sslbar' or die "wrong response with ssl: $buf"; 137 | } else { 138 | print $cl "foo"; 139 | read($cl, my $buf,3); 140 | $buf eq 'bar' or die "wrong response without ssl: $buf"; 141 | } 142 | }) { 143 | pass($act); 144 | } else { 145 | fail("$act: $@"); 146 | last; # slip rest 147 | } 148 | } 149 | } 150 | 151 | # make server exit 152 | alarm(10); 153 | my $cl = IO::Socket::INET->new($saddr); 154 | print $cl "end" if $cl; 155 | wait; 156 | -------------------------------------------------------------------------------- /t/protocol_version.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use warnings; 5 | use Test::More; 6 | use Socket; 7 | use IO::Socket::SSL; 8 | do './testlib.pl' || do './t/testlib.pl' || die "no testlib"; 9 | 10 | plan skip_all => "Test::More has no done_testing" 11 | if !defined &done_testing; 12 | 13 | $|=1; 14 | 15 | my $XDEBUG = 0; 16 | my @versions = qw(SSLv3 TLSv1 TLSv1_1 TLSv1_2 TLSv1_3); 17 | 18 | my %server_args = ( 19 | LocalAddr => '127.0.0.1', 20 | LocalPort => 0, 21 | Listen => 2, 22 | SSL_server => 1, 23 | SSL_startHandshake => 0, 24 | SSL_version => 'SSLv23', # allow SSLv3 too 25 | SSL_cert_file => 't/certs/server-cert.pem', 26 | SSL_key_file => 't/certs/server-key.pem', 27 | ); 28 | my %cipher_args = ( 29 | SSL_cipher_list => 'DEFAULT:@SECLEVEL=0', 30 | ); 31 | my $server = IO::Socket::SSL->new( 32 | %server_args, 33 | %cipher_args, 34 | ); 35 | if (!$server && $SSL_ERROR) { 36 | # likely SECLEVEL not supported 37 | diag("$SSL_ERROR - assuming SECLEVEL not supported"); 38 | %cipher_args = (SSL_cipher_list => 'DEFAULT'); 39 | $server = IO::Socket::SSL->new( 40 | %server_args, 41 | %cipher_args, 42 | ); 43 | } 44 | $server or BAIL_OUT("cannot listen on localhost: $!"); 45 | print "not ok\n", exit if !$server; 46 | my $saddr = $server->sockhost().':'.$server->sockport(); 47 | $XDEBUG && diag("server at $saddr"); 48 | 49 | defined( my $pid = fork() ) or BAIL_OUT("fork failed: $!"); 50 | if ($pid == 0) { 51 | close($server); 52 | my $check = sub { 53 | my ($ver,$expect) = @_; 54 | $XDEBUG && diag("try $ver, expect $expect"); 55 | # Hoping that this isn't necessary, but just in case we get a TCP 56 | # failure rather than SSL failure, wiping the previous value here 57 | # seems like it might be a useful precaution: 58 | $SSL_ERROR = ''; 59 | 60 | my $cl = IO::Socket::SSL->new( 61 | PeerAddr => $saddr, 62 | Domain => AF_INET, 63 | SSL_startHandshake => 0, 64 | SSL_verify_mode => 0, 65 | SSL_version => $ver, 66 | %cipher_args, 67 | ) or do { 68 | # Might bail out before the starttls if we provide a known-unsupported 69 | # version, for example SSLv3 on openssl 1.0.2+ 70 | if($SSL_ERROR =~ /$ver not supported|null ssl method passed/) { 71 | $XDEBUG && diag("SSL connect failed with $ver: $SSL_ERROR"); 72 | return; 73 | } 74 | die "connection with $ver failed: $! (SSL error: $SSL_ERROR)"; 75 | }; 76 | $XDEBUG && diag("TCP connected"); 77 | print $cl "starttls $ver $expect\n"; 78 | <$cl>; 79 | if (!$cl->connect_SSL) { 80 | $XDEBUG && diag("SSL upgrade failed with $ver: $SSL_ERROR"); 81 | return; 82 | } 83 | $XDEBUG && diag("SSL connect done"); 84 | return $cl->get_sslversion(); 85 | }; 86 | my $stop = sub { 87 | my $cl = IO::Socket::INET->new($saddr) or return; 88 | print $cl "quit\n"; 89 | }; 90 | 91 | # find out the best protocol version the server can 92 | my %supported; 93 | my $ver = $check->('SSLv23','') or die "connect to server failed: $!"; 94 | $XDEBUG && diag("best protocol version: $ver"); 95 | 96 | for (@versions, 'foo') { 97 | $supported{$_} = 1; 98 | $ver eq $_ and last; 99 | } 100 | die "best protocol version server supports is $ver" if $supported{foo}; 101 | 102 | # Check if the OpenSSL was compiled without support for specific protocols 103 | for(qw(SSLv3 TLSv1 TLSv1_1 TLSv1_2 TLSv1_3)) { 104 | if ( ! $check->($_,'')) { 105 | diag("looks like OpenSSL was compiled without $_ support"); 106 | delete $supported{$_}; 107 | } 108 | } 109 | 110 | for my $ver (@versions) { 111 | next if ! $supported{$ver}; 112 | # requesting only this version should be done with this version 113 | $check->($ver,$ver); 114 | # requesting SSLv23 and disallowing anything better should give $ver too 115 | my $sslver = "SSLv23"; 116 | for(reverse grep { $supported{$_} } @versions) { 117 | last if $_ eq $ver; 118 | $sslver .= ":!$_"; 119 | } 120 | $check->($sslver,$ver); 121 | } 122 | 123 | $stop->(); 124 | exit(0); 125 | } 126 | 127 | vec( my $vs = '',fileno($server),1) = 1; 128 | while (select( my $rvs = $vs,undef,undef,15 )) { 129 | $XDEBUG && diag("got read event"); 130 | my $cl = $server->accept or do { 131 | $XDEBUG && diag("accept failed: $!"); 132 | next; 133 | }; 134 | $XDEBUG && diag("TCP accept done"); 135 | my $cmd = <$cl>; 136 | $XDEBUG && diag("got command $cmd"); 137 | my ($ver,$expect) = $cmd =~m{^starttls (\S+) (\S*)} or do { 138 | $XDEBUG && diag("finish"); 139 | done_testing() if $cmd =~m/^quit/; 140 | last; 141 | }; 142 | print $cl "ok\n"; 143 | $cl->accept_SSL() or do { 144 | $XDEBUG && diag("accept_SSL failed: $SSL_ERROR"); 145 | if ($expect) { 146 | fail("accept $ver"); 147 | } else { 148 | diag("failed to accept $ver"); 149 | } 150 | next; 151 | }; 152 | $XDEBUG && diag("SSL accept done"); 153 | if ($expect) { 154 | is($cl->get_sslversion,$expect,"accept $ver with $expect"); 155 | } else { 156 | pass("accept $ver with any, got ".$cl->get_sslversion); 157 | } 158 | close($cl); 159 | } 160 | 161 | wait; 162 | -------------------------------------------------------------------------------- /t/psk.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use warnings; 5 | use Socket; 6 | use IO::Socket::SSL; 7 | use Test::More; 8 | 9 | my $can_psk = IO::Socket::SSL->can_psk; 10 | plan skip_all => 'insufficient support for PSK in Net::SSLeay' 11 | if !$can_psk || !$can_psk->{server} || !$can_psk->{client}; 12 | 13 | my $server = IO::Socket::SSL->new( 14 | LocalAddr => '127.0.0.1', 15 | Listen => 2, 16 | ReuseAddr => 1, 17 | SSL_server => 1, 18 | SSL_cipher_list => 'PSK', 19 | SSL_psk => { 20 | 'foo' => 'foobar', 21 | 'io_socket_ssl' => 'barfoot', 22 | '' => pack("H*",'deadbeef'), 23 | } 24 | ) or die "\$!=$!, \$\@=$@, S\$SSL_ERROR=$SSL_ERROR"; 25 | my $saddr = $server->sockhost.':'.$server->sockport; 26 | 27 | defined(my $server_pid = fork()) || die $!; 28 | if ($server_pid == 0) { 29 | while (1) { 30 | my $cl = $server->accept or do { 31 | diag("accept failed: $!, $SSL_ERROR"); 32 | next; 33 | }; 34 | diag("client accepted: ver=".$cl->get_sslversion." cipher=".$cl->get_cipher); 35 | my $l = <$cl>; 36 | $l eq "ping\n" or die "wrong message from client: '$l'"; 37 | print $cl "pong\n"; 38 | } 39 | exit; 40 | } 41 | close($server); 42 | 43 | for my $v ('TLSv1_3','TLSv1_2') { 44 | my $ctx = IO::Socket::SSL::SSL_Context->new(SSL_version => $v) or do { 45 | diag("no support for $v"); 46 | next; 47 | }; 48 | 49 | for my $t ( 50 | [ 1, [ foo => 'foobar' ] ], 51 | [ 0, [ foo => 'barfoot' ] ], 52 | [ 1, [ io_socket_ssl => 'barfoot' ] ], 53 | [ 1, 'barfoot' ], 54 | [ 0, [ yikes => 'barfoot' ] ], 55 | [ 1, [ yikes => pack("H*",'deadbeef') ] ], 56 | [ 0, [ foo => pack("H*",'deadbeef') ] ], 57 | ) { 58 | my ($expect_ok,$psk) = @$t; 59 | my $cl = IO::Socket::SSL->new( 60 | PeerAddr => $saddr, 61 | SSL_version => $v, 62 | SSL_cipher_list => 'PSK', 63 | SSL_psk => $psk 64 | ); 65 | my $tid = ref($psk) ? "$v/['$psk->[0]','$psk->[1]']":"$v/'$psk'"; 66 | ok($expect_ok ? $cl : !$cl, "$tid - connect"); 67 | next if !$cl or !$expect_ok; 68 | print $cl "ping\n"; 69 | my $l = <$cl>; 70 | is($l, "pong\n", "$tid - data exchange"); 71 | } 72 | } 73 | 74 | kill 9,$server_pid; 75 | done_testing(); 76 | -------------------------------------------------------------------------------- /t/public_suffix_lib_encode_idn.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use FindBin; 4 | 5 | require "$FindBin::Bin/public_suffix_lib.pl"; 6 | run_with_lib( 'Net::IDN::Encode' ); 7 | -------------------------------------------------------------------------------- /t/public_suffix_lib_libidn.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use FindBin; 4 | 5 | require "$FindBin::Bin/public_suffix_lib.pl"; 6 | run_with_lib( 'Net::LibIDN' ); 7 | -------------------------------------------------------------------------------- /t/public_suffix_lib_uri.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use FindBin; 4 | 5 | require "$FindBin::Bin/public_suffix_lib.pl"; 6 | run_with_lib( 'URI::_idna' ); 7 | -------------------------------------------------------------------------------- /t/public_suffix_ssl.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use IO::Socket::SSL; 4 | use IO::Socket::SSL::Utils; 5 | use Test::More; 6 | do './testlib.pl' || do './t/testlib.pl' || die "no testlib"; 7 | 8 | my @tests = qw( 9 | fail:com|* 10 | ok:com|com 11 | fail:googleapis.com|*.com 12 | ok:googleapis.com|googleapis.com 13 | ok:ajax.googleapis.com|*.googleapis.com 14 | ok:s3.amazonaws.com|s3.amazonaws.com 15 | ok:foo.s3.amazonaws.com|*.s3.amazonaws.com 16 | fail:google.com|*.com 17 | ok:google.com|google.com 18 | ok:www.google.com|*.google.com 19 | ok:www.bar.com|*.bar.com 20 | ok:www.foo.bar.com|*.foo.bar.com 21 | ok:www.foo.co.uk|*.foo.co.uk 22 | fail:www.co.uk|*.co.uk 23 | fail:co.uk|*.uk 24 | ok:bl.uk|bl.uk 25 | ok:www.bl.uk|*.bl.uk 26 | fail:bar.kobe.jp|*.kobe.jp 27 | fail:foo.bar.kobe.jp|*.bar.kobe.jp 28 | ok:www.foo.bar.kobe.jp|*.foo.bar.kobe.jp 29 | fail:city.kobe.jp|*.kobe.jp 30 | ok:city.kobe.jp|city.kobe.jp 31 | ok:www.city.kobe.jp|*.city.kobe.jp 32 | fail:nodomain|* 33 | fail:foo.nodomain|*.nodomain 34 | ok:www.foo.nodomain|*.foo.nodomain 35 | ); 36 | 37 | $|=1; 38 | plan tests => 0+@tests; 39 | 40 | # create listener 41 | my $server = IO::Socket::INET->new( 42 | LocalAddr => '127.0.0.1', 43 | LocalPort => 0, 44 | Listen => 2, 45 | ) || die "not ok #tcp listen failed: $!\n"; 46 | my $saddr = $server->sockhost.':'.$server->sockport; 47 | #diag("listen at $saddr"); 48 | 49 | # create CA - certificates will be created on demand 50 | my ($cacert,$cakey) = CERT_create( CA => 1 ); 51 | 52 | defined( my $pid = fork() ) || die $!; 53 | if ( ! $pid ) { 54 | while (@tests) { 55 | my $cl = $server->accept or next; 56 | shift(@tests); # only for counting 57 | # client initially sends line with expected CN 58 | defined( my $cn = <$cl> ) or do { 59 | warn "failed to get expected name from client, remaining ".(0+@tests); 60 | next; 61 | }; 62 | chop($cn); 63 | print $cl "ok\n"; 64 | my ($cert,$key) = CERT_create( 65 | subject => { CN => $cn }, 66 | issuer => [ $cacert,$cakey ], 67 | key => $cakey, # reuse to speed up 68 | ); 69 | #diag("created cert for $cn"); 70 | <$cl> if IO::Socket::SSL->start_SSL($cl, 71 | SSL_server => 1, 72 | SSL_cert => $cert, 73 | SSL_key => $key, 74 | ); 75 | } 76 | exit(0); 77 | } 78 | 79 | # if anything blocks - this will at least finish the test 80 | alarm(60); 81 | $SIG{ALRM} = sub { die "test takes too long" }; 82 | 83 | close($server); 84 | for my $test (@tests) { 85 | my ($expect,$host,$cn) = $test=~m{^(ok|fail):(\S+)\|(\S+)} or die $test; 86 | my $cl = IO::Socket::INET->new($saddr) or die "failed to connect: $!"; 87 | print $cl "$cn\n"; 88 | <$cl>; 89 | my $sslok = IO::Socket::SSL->start_SSL($cl, 90 | SSL_verifycn_name => $host, 91 | SSL_verifycn_scheme => 'http', 92 | SSL_ca => [$cacert], 93 | ); 94 | if ( ! $sslok ) { 95 | is( $sslok?1:0, $expect eq 'ok' ? 1:0, "ssl $host against $cn -> $expect ($SSL_ERROR)"); 96 | } else { 97 | is( $sslok?1:0, $expect eq 'ok' ? 1:0, "ssl $host against $cn -> $expect"); 98 | } 99 | } 100 | 101 | 102 | -------------------------------------------------------------------------------- /t/readline.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | # Before `make install' is performed this script should be runnable with 3 | # `make test'. After `make install' it should work as `perl t/readline.t' 4 | 5 | # This tests the behavior of readline with the variety of 6 | # cases with $/: 7 | # $/ undef - read all 8 | # $/ '' - read up to next nonempty line: .*?\n\n+ 9 | # $/ s - read up to string s 10 | # $/ \$num - read $num bytes 11 | # scalar context - get first match 12 | # array context - get all matches 13 | 14 | use strict; 15 | use warnings; 16 | use Net::SSLeay; 17 | use Socket; 18 | use IO::Socket::SSL; 19 | do './testlib.pl' || do './t/testlib.pl' || die "no testlib"; 20 | 21 | my @tests; 22 | push @tests, [ 23 | "multi\nple\n\n1234567890line\n\n\n\nbla\n\nblubb\n\nblip", 24 | sub { 25 | my $c = shift; 26 | local $/ = "\n\n"; 27 | my $b; 28 | ($b=<$c>) eq "multi\nple\n\n" || die "LFLF failed ($b)"; 29 | $/ = \"10"; 30 | ($b=<$c>) eq "1234567890" || die "\\size failed ($b)"; 31 | $/ = ''; 32 | ($b=<$c>) eq "line\n\n\n\n" || die "'' failed ($b)"; 33 | my @c = <$c>; 34 | die "'' @ failed: @c" unless $c[0] eq "bla\n\n" && 35 | $c[1] eq "blubb\n\n" && 36 | $c[2] eq "blip" && @c == 3; 37 | }, 38 | ]; 39 | 40 | push @tests, [ 41 | "some\nstring\nwith\nsome\nlines\nwhatever", 42 | sub { 43 | my $c = shift; 44 | local $/ = "\n"; 45 | my $b; 46 | ($b=<$c>) eq "some\n" || die "LF failed ($b)"; 47 | $/ = undef; 48 | ($b=<$c>) eq "string\nwith\nsome\nlines\nwhatever" || die "undef failed ($b)"; 49 | }, 50 | ]; 51 | 52 | push @tests, [ 53 | "some\nstring\nwith\nsome\nlines\nwhatever", 54 | sub { 55 | my $c = shift; 56 | local $/ = "\n"; 57 | my @c = <$c>; 58 | die "LF @ failed: @c" unless $c[0] eq "some\n" && 59 | $c[1] eq "string\n" && $c[2] eq "with\n" && $c[3] eq "some\n" && 60 | $c[4] eq "lines\n" && $c[5] eq "whatever" && @c == 6; 61 | 62 | }, 63 | ]; 64 | 65 | push @tests, [ 66 | "some\nstring\nwith\nsome\nlines\nwhatever", 67 | sub { 68 | my $c = shift; 69 | local $/; 70 | my @c = <$c>; 71 | die "undef @ failed: @c" unless 72 | $c[0] eq "some\nstring\nwith\nsome\nlines\nwhatever" 73 | && @c == 1; 74 | 75 | }, 76 | ]; 77 | 78 | push @tests, [ 79 | "1234567890", 80 | sub { 81 | my $c = shift; 82 | local $/ = \2; 83 | my @c = <$c>; 84 | die "\\2 @ failed: @c" unless 85 | $c[0] eq '12' && $c[1] eq '34' && $c[2] eq '56' && 86 | $c[3] eq '78' && $c[4] eq '90' && @c == 5; 87 | 88 | }, 89 | ]; 90 | 91 | push @tests, [ 92 | [ "bla\n","0","blubb\n","no newline" ], 93 | sub { 94 | my $c = shift; 95 | my $l = <$c>; 96 | $l eq "bla\n" or die "'bla\\n' failed"; 97 | $l = <$c>; 98 | $l eq "0blubb\n" or die "'0blubb\\n' failed"; 99 | $l = <$c>; 100 | $l eq "no newline" or die "'no newline' failed"; 101 | }, 102 | ]; 103 | 104 | $|=1; 105 | print "1..".(1+3*@tests)."\n"; 106 | 107 | 108 | # first create simple ssl-server 109 | my $ID = 'server'; 110 | my $addr = '127.0.0.1'; 111 | my $server = IO::Socket::SSL->new( 112 | LocalAddr => $addr, 113 | Listen => 2, 114 | ReuseAddr => 1, 115 | SSL_cert_file => "t/certs/server-cert.pem", 116 | SSL_key_file => "t/certs/server-key.pem", 117 | ) || do { 118 | notok($!); 119 | exit 120 | }; 121 | ok("Server Initialization"); 122 | 123 | # add server port to addr 124 | $addr.= ':'.(sockaddr_in( getsockname( $server )))[0]; 125 | 126 | my $pid = fork(); 127 | if ( !defined $pid ) { 128 | die $!; # fork failed 129 | 130 | } elsif ( $pid ) { ###### Server 131 | 132 | foreach my $test (@tests) { 133 | my $to_client = $server->accept || do { 134 | notok( "accept failed: ".$server->errstr() ); 135 | kill(9,$pid); 136 | exit; 137 | }; 138 | ok( "Server accepted" ); 139 | $to_client->autoflush; 140 | my $t = $test->[0]; 141 | $t = [$t] if ! ref($t); 142 | for(@$t) { 143 | $to_client->print($_); 144 | select(undef,undef,undef,0.1); 145 | } 146 | } 147 | wait; 148 | exit; 149 | } 150 | 151 | $ID = 'client'; 152 | close($server); 153 | my $testid = "Test00"; 154 | foreach my $test (@tests) { 155 | my $to_server = IO::Socket::SSL->new( 156 | PeerAddr => $addr, 157 | Domain => AF_INET, 158 | SSL_verify_mode => 0 ) || do { 159 | notok( "connect failed: ".IO::Socket::SSL->errstr() ); 160 | exit 161 | }; 162 | ok( "client connected" ); 163 | eval { $test->[1]( $to_server ) }; 164 | $@ ? notok( "$testid $@" ) : ok( $testid ); 165 | $testid++ 166 | } 167 | 168 | 169 | 170 | sub ok { print "ok # [$ID] @_\n"; } 171 | sub notok { print "not ok # [$ID] @_\n"; } 172 | -------------------------------------------------------------------------------- /t/session_cache.t: -------------------------------------------------------------------------------- 1 | my $DEBUG = 0; 2 | 3 | use strict; 4 | use warnings; 5 | use Net::SSLeay; 6 | use Socket; 7 | use IO::Socket::SSL; 8 | do './testlib.pl' || do './t/testlib.pl' || die "no testlib"; 9 | 10 | $|=1; 11 | my $numtests = 11; 12 | print "1..$numtests\n"; 13 | 14 | my $ctx = IO::Socket::SSL::SSL_Context->new( 15 | SSL_ca_file => "t/certs/test-ca.pem", 16 | SSL_session_cache_size => 3, 17 | ); 18 | 19 | my $cache = $ctx->{session_cache} or do { 20 | print "not ok \# Context init\n"; 21 | exit; 22 | }; 23 | ok("Context init"); 24 | 25 | my $dump_cache = $DEBUG ? sub { diag($cache->_dump) } : sub {}; 26 | 27 | print "not " if $cache->{room} != 3; 28 | ok("0 entries in cache, room for 3 more"); 29 | &$dump_cache; 30 | 31 | $cache->add_session("bogus", 0); 32 | print "not " if $cache->{ghead}[1] ne 'bogus'; 33 | ok("cache head at 'bogus'"); 34 | &$dump_cache; 35 | 36 | $cache->add_session("bogus1", 0); 37 | print "not " if $cache->{room} != 1; 38 | ok("two entries in cache, room for 1 more"); 39 | print "not " if $cache->{ghead}[1] ne 'bogus1'; 40 | ok("cache head at 'bogus1'"); 41 | &$dump_cache; 42 | 43 | $cache->get_session("bogus"); 44 | print "not " if $cache->{ghead}[1] ne 'bogus'; 45 | ok("get_session moves cache head to 'bogus'"); 46 | &$dump_cache; 47 | 48 | $cache->add_session("bogus", 0); 49 | print "not " if $cache->{room} != 0; 50 | ok("3 entries in cache, room for no more"); 51 | &$dump_cache; 52 | 53 | # add another bogus and bogus1 should be removed to make room 54 | print "not " if ! $cache->{shead}{bogus1}; 55 | ok("bogus1 still in cache"); 56 | &$dump_cache; 57 | 58 | $cache->add_session("bogus", 0); 59 | print "not " if $cache->{room} != 0; 60 | ok("still 3 entries in cache, room for no more"); 61 | &$dump_cache; 62 | 63 | print "not " if $cache->{shead}{bogus1}; 64 | ok("bogus1 removed from cache to make room"); 65 | 66 | # when removing 'bogus' the cache should be empty again 67 | $cache->del_session('bogus'); 68 | print "not " if $cache->{room} != 3; 69 | ok("0 entries in cache, room for 3"); 70 | &$dump_cache; 71 | 72 | 73 | sub ok { 74 | my $line = (caller)[2]; 75 | print "ok # $_[0]\n"; 76 | } 77 | sub diag { 78 | my $msg = shift; 79 | $msg =~s{^}{ # }mg; 80 | print STDERR $msg; 81 | } 82 | -------------------------------------------------------------------------------- /t/session_ticket.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use IO::Socket::SSL; 4 | use IO::Socket::SSL::Utils; 5 | use Test::More; 6 | do './testlib.pl' || do './t/testlib.pl' || die "no testlib"; 7 | 8 | 9 | $|=1; 10 | plan skip_all => 'no support for session ticket key callback' 11 | if ! IO::Socket::SSL->can_ticket_keycb; 12 | 13 | plan tests => 6; 14 | 15 | # create two servers with the same session ticket callback 16 | my (@server,@saddr); 17 | for (1,2) { 18 | my $server = IO::Socket::INET->new( 19 | LocalAddr => '127.0.0.1', 20 | LocalPort => 0, 21 | Listen => 2, 22 | ) or die "failed to create listener: $!"; 23 | push @server,{ fd => $server }; 24 | push @saddr, $server->sockhost.':'.$server->sockport; 25 | diag("listen at $saddr[-1]"); 26 | } 27 | 28 | # create some self signed certificate 29 | my ($cert,$key) = CERT_create(CA => 1, 30 | subject => { CN => 'ca' }, 31 | ); 32 | my ($client_cert,$client_key) = CERT_create( 33 | issuer => [ $cert,$key], 34 | subject => { CN => 'client' }, 35 | purpose => { client => 1 } 36 | ); 37 | my ($server_cert,$server_key) = CERT_create( 38 | issuer => [ $cert,$key], 39 | subject => { CN => 'server' }, 40 | subjectAltNames => [ 41 | [ DNS => 'server' ], 42 | [ IP => $saddr[0]=~m{^(.*):} && $1 ], 43 | [ IP => $saddr[1]=~m{^(.*):} && $1 ], 44 | ], 45 | purpose => { server => 1 } 46 | ); 47 | 48 | 49 | defined( my $pid = fork() ) || die $!; 50 | exit(_server()) if ! $pid; 51 | @server = (); 52 | 53 | 54 | 55 | # if anything blocks - this will at least finish the test 56 | alarm(60); 57 | $SIG{ALRM} = sub { die "test takes too long" }; 58 | END{ kill 9,$pid if $pid }; 59 | 60 | my $clctx = IO::Socket::SSL::SSL_Context->new( 61 | SSL_session_cache_size => 10, 62 | SSL_cert => $client_cert, 63 | SSL_key => $client_key, 64 | SSL_ca => [ $cert ], 65 | 66 | # LibreSSL has currently no support for TLS 1.3 session handling 67 | # therefore enforce TLS 1.2 68 | Net::SSLeay::constant("LIBRESSL_VERSION_NUMBER") ? 69 | (SSL_version => 'TLSv1_2') : 70 | # versions of Net::SSLeay with support for SESSION_up_ref have also the 71 | # other functionality needed for proper TLS 1.3 session handling 72 | defined(&Net::SSLeay::SESSION_up_ref) ? () 73 | : (SSL_version => 'SSLv23:!TLSv1_3:!SSLv3:!SSLv2'), 74 | ); 75 | 76 | my $client = sub { 77 | my ($i,$expect_reuse,$desc) = @_; 78 | my $cl = IO::Socket::SSL->new( 79 | PeerAddr => $saddr[$i], 80 | SSL_reuse_ctx => $clctx, 81 | SSL_session_key => 'server', # single key for both @saddr 82 | ); 83 | <$cl>; # read something, incl. TLS 1.3 ticket 84 | my $reuse = $cl && Net::SSLeay::session_reused($cl->_get_ssl_object); 85 | diag("connect to $i: ". ($cl 86 | ? "success reuse=$reuse version=".$cl->get_sslversion() 87 | : "error: $!,$SSL_ERROR" 88 | )); 89 | is($reuse,$expect_reuse,$desc); 90 | close($cl); 91 | }; 92 | 93 | 94 | $client->(0,0,"no initial session -> no reuse"); 95 | $client->(0,1,"reuse with the next session and secret[0]"); 96 | $client->(1,1,"reuse even though server changed, since they share ticket secret"); 97 | $client->(1,0,"reports non-reuse since server1 changed secret to secret[1]"); 98 | $client->(0,0,"reports non-reuse on server0 since got ticket with secret[1] in last step"); 99 | $client->(0,1,"reuse again since got ticket with secret[0] in last step"); 100 | 101 | 102 | sub _server { 103 | 104 | # create the secrets for handling session tickets 105 | my @secrets; 106 | for(qw(key1 key2)) { 107 | my $name = pack("a16",$_); 108 | Net::SSLeay::RAND_bytes(my $key,32); 109 | push @secrets, [ $key,$name ]; 110 | } 111 | 112 | my $get_ticket_key = sub { 113 | my (undef,$name) = @_; 114 | if (!defined $name) { 115 | print "creating new ticket $secrets[0][1]\n"; 116 | return @{$secrets[0]}; 117 | } 118 | for(my $i=0;$i<@secrets;$i++) { 119 | next if $secrets[$i][1] ne $name; 120 | if ($i == 0) { 121 | print "using current ticket secret\n"; 122 | return @{$secrets[0]}; 123 | } else { 124 | print "using non-current ticket secret\n"; 125 | return ($secrets[0][0],$secrets[$i][1]); 126 | } 127 | } 128 | print "unknown ticket key name\n"; 129 | return; 130 | }; 131 | 132 | # create the SSL context 133 | for(@server) { 134 | $_->{sslctx} = IO::Socket::SSL::SSL_Context->new( 135 | SSL_server => 1, 136 | SSL_cert => $server_cert, 137 | SSL_key => $server_key, 138 | SSL_ca => [ $cert ], 139 | SSL_verify_mode => SSL_VERIFY_PEER|SSL_VERIFY_FAIL_IF_NO_PEER_CERT, 140 | SSL_ticket_keycb => $get_ticket_key, 141 | SSL_session_id_context => 'foobar', 142 | ) or die "failed to create SSL context: $SSL_ERROR"; 143 | } 144 | 145 | my $rin = ''; 146 | vec($rin,fileno($_->{fd}),1) = 1 for @server; 147 | while (1) { 148 | select(my $rout = $rin,undef,undef,10) 149 | or die "select failed or timed out: $!"; 150 | for(my $i=0;$i<@server;$i++) { 151 | next if ! vec($rout,fileno($server[$i]{fd}),1); 152 | 153 | alarm(10); 154 | local $SIG{ALRM} = sub { die "server[$i] timed out" }; 155 | print "access to server[$i]\n"; 156 | 157 | my $cl = $server[$i]{fd}->accept or do { 158 | print "failed to TCP accept: $!\n"; 159 | last; 160 | }; 161 | IO::Socket::SSL->start_SSL($cl, 162 | SSL_server => 1, 163 | SSL_reuse_ctx => $server[$i]{sslctx} 164 | ) or do { 165 | print "failed to SSL accept: $SSL_ERROR\n"; 166 | last; 167 | }; 168 | 169 | print $cl "hi\n"; 170 | my $reuse = Net::SSLeay::session_reused($cl->_get_ssl_object); 171 | print "server[$i] reused=$reuse\n"; 172 | 173 | # after access to server[1] rotate the secrets 174 | if ($i == 1) { 175 | print "rotate secrets\n"; 176 | push @secrets, shift(@secrets); 177 | } 178 | close($cl); 179 | alarm(0); 180 | last; 181 | } 182 | } 183 | exit(0); 184 | } 185 | -------------------------------------------------------------------------------- /t/sessions.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | # Before `make install' is performed this script should be runnable with 3 | # `make test'. After `make install' it should work as `perl t/core.t' 4 | 5 | my $DEBUG = 0; 6 | 7 | use strict; 8 | use warnings; 9 | use Net::SSLeay; 10 | use Socket; 11 | use IO::Socket::SSL; 12 | do './testlib.pl' || do './t/testlib.pl' || die "no testlib"; 13 | 14 | $|=1; 15 | my $numtests = 17; 16 | print "1..$numtests\n"; 17 | 18 | my $what = 'server'; 19 | my @servers = map { 20 | IO::Socket::INET->new( 21 | LocalAddr => '127.0.0.1', 22 | LocalPort => 0, 23 | Listen => 2, 24 | ) 25 | } (1..3); 26 | 27 | if ( grep { !$_ } @servers > 0 ) { 28 | print "not ok # Server init\n"; 29 | exit; 30 | } 31 | ok("Server initialization"); 32 | 33 | my @saddr = map { $_->sockhost.':'.$_->sockport } @servers; 34 | defined(my $pid = fork()) or die "fork failed: $!"; 35 | if ($pid == 0) { 36 | server(); 37 | exit(0); 38 | } 39 | client(); 40 | wait; 41 | 42 | sub client { 43 | $what = 'client'; 44 | @servers = (); 45 | my $ctx = IO::Socket::SSL::SSL_Context->new( 46 | SSL_ca_file => "t/certs/test-ca.pem", 47 | # make cache large enough since we get multiple tickets with TLS 1.3 48 | SSL_session_cache_size => 100, 49 | # LibreSSL has currently no support for TLS 1.3 session handling 50 | # therefore enforce TLS 1.2 51 | Net::SSLeay::constant("LIBRESSL_VERSION_NUMBER") ? 52 | (SSL_version => 'TLSv1_2') : 53 | # versions of Net::SSLeay with support for SESSION_up_ref have also the 54 | # other functionality needed for proper TLS 1.3 session handling 55 | defined(&Net::SSLeay::SESSION_up_ref) ? () : 56 | (SSL_version => 'SSLv23:!TLSv1_3:!SSLv3:!SSLv2'), 57 | ); 58 | 59 | my $cache = $ctx->{session_cache} or do { 60 | print "not ok \# Context init\n"; 61 | exit; 62 | }; 63 | ok("Context init"); 64 | my $dump_cache = $DEBUG ? sub { diag($cache->_dump) } : sub {}; 65 | 66 | IO::Socket::SSL::set_default_context($ctx); 67 | my @clients; 68 | push @clients, IO::Socket::SSL->new(PeerAddr => $saddr[0], Domain => AF_INET); 69 | push @clients, IO::Socket::SSL->new(PeerAddr => $saddr[1], Domain => AF_INET); 70 | my $sock3 = IO::Socket::INET->new($saddr[2]); 71 | push @clients, IO::Socket::SSL->start_SSL($sock3); 72 | 73 | if ( grep { !$_ } @clients >0 ) { 74 | print "not ok \# Client init $SSL_ERROR\n"; 75 | exit; 76 | } 77 | ok("Client init, version=".$clients[0]->get_sslversion); 78 | 79 | for(@clients) { 80 | <$_>; # read ping 81 | print $_ "pong!\n"; 82 | } 83 | &$dump_cache; 84 | 85 | print "not " if $cache->{room} >97; 86 | ok(">=3 entries in cache: ". (100- $cache->{room})); 87 | for(@saddr) { 88 | $cache->{shead}{$_} or print "not "; 89 | ok("$_ in cache"); 90 | } 91 | $cache->{ghead}[1] eq $saddr[2] or print "not "; 92 | ok("latest ($saddr[2]) on top of cache"); 93 | 94 | for (0..2) { 95 | # check if current session is cached 96 | $cache->get_session($saddr[$_], 97 | Net::SSLeay::get_session($clients[$_]->_get_ssl_object)) 98 | or print "not "; 99 | ok("session in client $_"); 100 | close $clients[$_]; 101 | } 102 | 103 | # check if sessions get reused 104 | @clients = map { IO::Socket::SSL->new(PeerAddr => $_, Domain => AF_INET) } 105 | @saddr; 106 | for(@clients) { 107 | print "not " if ! $_->get_session_reused; 108 | ok("client $_ reused"); 109 | <$_>; # read ping 110 | print $_ "pong!\n"; 111 | } 112 | &$dump_cache; 113 | } 114 | 115 | sub server { 116 | my @ctx = map { 117 | IO::Socket::SSL::SSL_Context->new( 118 | SSL_server => 1, 119 | SSL_cert_file => "t/certs/server-cert.pem", 120 | SSL_key_file => "t/certs/server-key.pem", 121 | SSL_ca_file => "t/certs/test-ca.pem", 122 | ); 123 | } @servers; 124 | my @clients; 125 | my $accept_all = sub { 126 | @clients = map { undef } @servers; 127 | for(my $i=0; $i<@servers; $i++) { 128 | my $cl = $servers[$i]->accept or next; 129 | IO::Socket::SSL->start_SSL($cl, 130 | SSL_server => 1, 131 | SSL_reuse_ctx => $ctx[$i] 132 | ) or next; 133 | $clients[$i] = $cl; 134 | } 135 | }; 136 | &$accept_all; 137 | if ( grep { !$_ } @clients > 0 ) { 138 | print "not ok \# Client init\n"; 139 | exit; 140 | } 141 | 142 | ok("Client init"); 143 | for(@clients) { 144 | print $_ "ping!\n"; 145 | <$_>; # read pong 146 | } 147 | ok("Server send pong, received ping"); 148 | close($_) for @clients; 149 | 150 | &$accept_all; 151 | for(@clients) { 152 | print $_ "ping!\n"; 153 | <$_>; # read pong 154 | } 155 | ok("Client again init + write + read"); 156 | } 157 | 158 | 159 | 160 | sub ok { 161 | my $line = (caller)[2]; 162 | print "ok # [$what]:$line $_[0]\n"; 163 | } 164 | sub diag { 165 | my $msg = shift; 166 | $msg =~s{^}{ # [$what] }mg; 167 | print STDERR $msg; 168 | } 169 | -------------------------------------------------------------------------------- /t/set_curves.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use warnings; 5 | use Net::SSLeay; 6 | use Socket; 7 | use IO::Socket::SSL; 8 | 9 | do './testlib.pl' || do './t/testlib.pl' || die "no testlib"; 10 | 11 | my $set_groups_list = 12 | defined &Net::SSLeay::CTX_set1_groups_list ? \&Net::SSLeay::CTX_set1_groups_list : 13 | defined &Net::SSLeay::CTX_set1_curves_list ? \&Net::SSLeay::CTX_set1_curves_list : 14 | do { 15 | print "1..0 # no support for CTX_set1_curves_list or CTX_set1_groups_list\n"; 16 | exit; 17 | }; 18 | 19 | print "1..6\n"; 20 | my $server = IO::Socket::SSL->new( 21 | LocalAddr => '127.0.0.1', 22 | Listen => 2, 23 | ReuseAddr => 1, 24 | SSL_server => 1, 25 | SSL_ca_file => "t/certs/test-ca.pem", 26 | SSL_cert_file => 't/certs/server-cert.pem', 27 | SSL_key_file => 't/certs/server-key.pem', 28 | SSL_cipher_list => 'ECDHE', 29 | SSL_ecdh_curve => 'P-521:P-384', 30 | ); 31 | 32 | warn "\$!=$!, \$\@=$@, S\$SSL_ERROR=$SSL_ERROR" if ! $server; 33 | print "not ok\n", exit if !$server; 34 | print "ok # Server Initialization\n"; 35 | my $saddr = $server->sockhost.':'.$server->sockport; 36 | 37 | my @tests = ( 38 | [ 1,'P-521' ], 39 | [ 1,'P-384' ], 40 | [ 0,'P-256' ], 41 | [ 1,'P-384:P-521' ], 42 | [ 1,'P-256:P-384:P-521' ], 43 | ); 44 | 45 | defined( my $pid = fork() ) || die $!; 46 | if (!$pid) { 47 | close($server); 48 | for my $t (@tests) { 49 | my (undef,$curves) = @$t; 50 | my $cl = IO::Socket::SSL->new( 51 | PeerAddr => $saddr, 52 | SSL_verify_mode => 1, 53 | SSL_ca_file => 't/certs/test-ca.pem', 54 | SSL_ecdh_curve => $curves, 55 | ) or next; 56 | <$cl>; 57 | } 58 | exit; 59 | } 60 | 61 | for my $t (@tests) { 62 | my ($expect_ok,$curves) = @$t; 63 | my $csock = $server->accept; 64 | if ($csock && $expect_ok) { 65 | print "ok # expect success $curves\n"; 66 | } elsif (!$csock && !$expect_ok) { 67 | print "ok # expect fail $curves: $SSL_ERROR\n"; 68 | } elsif ($csock) { 69 | print "not ok # expect fail $curves\n"; 70 | } else { 71 | print "not ok # expect success $curves: $SSL_ERROR\n"; 72 | } 73 | close($csock) if $csock; 74 | } 75 | wait; 76 | -------------------------------------------------------------------------------- /t/signal-readline.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use warnings; 5 | use Net::SSLeay; 6 | use Socket; 7 | use IO::Socket::SSL; 8 | do './testlib.pl' || do './t/testlib.pl' || die "no testlib"; 9 | 10 | if ( $^O =~m{mswin32}i ) { 11 | print "1..0 # Skipped: signals not relevant on this platform\n"; 12 | exit 13 | } 14 | 15 | print "1..9\n"; 16 | 17 | my $server = IO::Socket::SSL->new( 18 | LocalAddr => '127.0.0.1', 19 | LocalPort => 0, 20 | Listen => 2, 21 | SSL_server => 1, 22 | SSL_ca_file => "t/certs/test-ca.pem", 23 | SSL_cert_file => "t/certs/server-wildcard.pem", 24 | SSL_key_file => "t/certs/server-wildcard.pem", 25 | ); 26 | warn "\$!=$!, \$\@=$@, S\$SSL_ERROR=$SSL_ERROR" if ! $server; 27 | print "not ok\n", exit if !$server; 28 | ok("Server Initialization"); 29 | my $saddr = $server->sockhost.':'.$server->sockport; 30 | 31 | defined( my $pid = fork() ) || die $!; 32 | if ( $pid == 0 ) { 33 | 34 | $SIG{HUP} = sub { ok("got hup") }; 35 | 36 | close($server); 37 | my $client = IO::Socket::SSL->new( 38 | PeerAddr => $saddr, 39 | Domain => AF_INET, 40 | SSL_verify_mode => 0 41 | ) || print "not "; 42 | ok( "client ssl connect" ); 43 | 44 | my $line = <$client>; 45 | print "not " if $line ne "foobar\n"; 46 | ok("got line"); 47 | 48 | exit; 49 | } 50 | 51 | my $csock = $server->accept; 52 | ok("accept"); 53 | 54 | syswrite($csock,"foo") or print "not "; 55 | ok("wrote foo"); 56 | sleep(1); 57 | 58 | kill HUP => $pid or print "not "; 59 | ok("send hup"); 60 | sleep(1); 61 | 62 | syswrite($csock,"bar\n") or print "not "; 63 | ok("wrote bar\\n"); 64 | 65 | wait; 66 | ok("wait: $?"); 67 | 68 | 69 | 70 | sub ok { print "ok #$_[0]\n"; } 71 | -------------------------------------------------------------------------------- /t/sni.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use warnings; 5 | use Net::SSLeay; 6 | use Socket; 7 | use IO::Socket::SSL; 8 | do './testlib.pl' || do './t/testlib.pl' || die "no testlib"; 9 | 10 | if ( ! IO::Socket::SSL->can_server_sni() ) { 11 | print "1..0 # skipped because no server side SNI support - openssl/Net::SSleay too old\n"; 12 | exit; 13 | } 14 | 15 | if ( ! IO::Socket::SSL->can_client_sni() ) { 16 | print "1..0 # skipped because no client side SNI support - openssl/Net::SSleay too old\n"; 17 | exit; 18 | } 19 | 20 | print "1..17\n"; 21 | my $server = IO::Socket::SSL->new( 22 | LocalAddr => '127.0.0.1', 23 | Listen => 2, 24 | ReuseAddr => 1, 25 | SSL_server => 1, 26 | SSL_ca_file => "t/certs/test-ca.pem", 27 | SSL_cert_file => { 28 | 'server.local' => 't/certs/server-cert.pem', 29 | 'server2.local' => 't/certs/server2-cert.pem', 30 | 'smtp.mydomain.local' => "t/certs/server-wildcard.pem", 31 | '' => "t/certs/server-wildcard.pem", 32 | }, 33 | SSL_key_file => { 34 | 'server.local' => 't/certs/server-key.pem', 35 | 'server2.local' => 't/certs/server2-key.pem', 36 | 'smtp.mydomain.local' => "t/certs/server-wildcard.pem", 37 | '' => "t/certs/server-wildcard.pem", 38 | }, 39 | ); 40 | 41 | warn "\$!=$!, \$\@=$@, S\$SSL_ERROR=$SSL_ERROR" if ! $server; 42 | print "not ok\n", exit if !$server; 43 | print "ok # Server Initialization\n"; 44 | my $saddr = $server->sockhost.':'.$server->sockport; 45 | 46 | # www13.other.local should match default '' 47 | # all other should match the specific entries 48 | my @tests = qw( 49 | server.local 50 | server2.local 51 | smtp.mydomain.local 52 | www13.other.local 53 | ); 54 | 55 | defined( my $pid = fork() ) || die $!; 56 | if ( $pid == 0 ) { 57 | close($server); 58 | 59 | for my $host (@tests) { 60 | my $client = IO::Socket::SSL->new( 61 | PeerAddr => $saddr, 62 | Domain => AF_INET, 63 | SSL_verify_mode => 1, 64 | SSL_hostname => $host, 65 | SSL_ca_file => 't/certs/test-ca.pem', 66 | ); 67 | if ($client) { 68 | print "ok # client ssl connect $host\n"; 69 | $client->verify_hostname($host,'http') or print "not "; 70 | print "ok # client verify hostname in cert $host\n"; 71 | # wait for server to send something to make sure finished accept 72 | <$client>; 73 | } else { 74 | print "not ok # client ssl connect $host - $SSL_ERROR\n"; 75 | print "ok # skip connect failed\n"; 76 | } 77 | } 78 | exit; 79 | } 80 | 81 | for my $host (@tests) { 82 | my $csock = $server->accept; 83 | if ($csock) { 84 | print "ok # server accept\n"; 85 | my $name = $csock->get_servername; 86 | print "not " if ! $name or $name ne $host; 87 | print "ok # server got SNI name $host\n"; 88 | print $csock "hi\n"; 89 | } else { 90 | print "not ok # server accept - $SSL_ERROR\n"; 91 | print "ok # skip accept failed\n"; 92 | } 93 | } 94 | wait; 95 | -------------------------------------------------------------------------------- /t/sni_verify.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use warnings; 5 | use Net::SSLeay; 6 | use Socket; 7 | use IO::Socket::SSL; 8 | do './testlib.pl' || do './t/testlib.pl' || die "no testlib"; 9 | 10 | if ( ! IO::Socket::SSL->can_server_sni() ) { 11 | print "1..0 # skipped because no server side SNI support - openssl/Net::SSleay too old\n"; 12 | exit; 13 | } 14 | 15 | if ( ! IO::Socket::SSL->can_client_sni() ) { 16 | print "1..0 # skipped because no client side SNI support - openssl/Net::SSleay too old\n"; 17 | exit; 18 | } 19 | 20 | print "1..17\n"; 21 | my $server = IO::Socket::SSL->new( 22 | LocalAddr => '127.0.0.1', 23 | Listen => 2, 24 | ReuseAddr => 1, 25 | SSL_server => 1, 26 | SSL_ca_file => "t/certs/test-ca.pem", 27 | SSL_cert_file => { 28 | 'server.local' => 't/certs/server-cert.pem', 29 | 'server2.local' => 't/certs/server2-cert.pem', 30 | 'smtp.mydomain.local' => "t/certs/server-wildcard.pem", 31 | '' => "t/certs/server-wildcard.pem", 32 | }, 33 | SSL_key_file => { 34 | 'server.local' => 't/certs/server-key.pem', 35 | 'server2.local' => 't/certs/server2-key.pem', 36 | 'smtp.mydomain.local' => "t/certs/server-wildcard.pem", 37 | '' => "t/certs/server-wildcard.pem", 38 | }, 39 | SSL_verify_mode => 1 40 | ); 41 | 42 | warn "\$!=$!, \$\@=$@, S\$SSL_ERROR=$SSL_ERROR" if ! $server; 43 | print "not ok\n", exit if !$server; 44 | print "ok # Server Initialization\n"; 45 | my $saddr = $server->sockhost.':'.$server->sockport; 46 | 47 | # www13.other.local should match default '' 48 | # all other should match the specific entries 49 | my @tests = qw( 50 | server.local 51 | server2.local 52 | smtp.mydomain.local 53 | www13.other.local 54 | ); 55 | 56 | defined( my $pid = fork() ) || die $!; 57 | if ( $pid == 0 ) { 58 | close($server); 59 | 60 | for my $host (@tests) { 61 | my $client = IO::Socket::SSL->new( 62 | PeerAddr => $saddr, 63 | Domain => AF_INET, 64 | SSL_verify_mode => 1, 65 | SSL_hostname => $host, 66 | SSL_ca_file => 't/certs/test-ca.pem', 67 | SSL_cert_file => 't/certs/client-cert.pem', 68 | SSL_key_file => 't/certs/client-key.pem', 69 | ); 70 | if ($client) { 71 | print "ok # client ssl connect $host\n"; 72 | $client->verify_hostname($host,'http') or print "not "; 73 | print "ok # client verify hostname in cert $host\n"; 74 | # wait for server to send something to make sure finished accept 75 | <$client>; 76 | } else { 77 | print "not ok # client ssl connect $host - $SSL_ERROR\n"; 78 | print "ok # skip connect failed\n"; 79 | } 80 | } 81 | exit; 82 | } 83 | 84 | for my $host (@tests) { 85 | my $csock = $server->accept; 86 | if ($csock) { 87 | print "ok # server accept\n"; 88 | my $name = $csock->get_servername; 89 | print "not " if ! $name or $name ne $host; 90 | print "ok # server got SNI name $host\n"; 91 | print $csock "hi\n"; 92 | } else { 93 | print "not ok # server accept - $SSL_ERROR\n"; 94 | print "ok # skip accept failed\n"; 95 | } 96 | } 97 | wait; 98 | -------------------------------------------------------------------------------- /t/sni_verify_old.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use warnings; 5 | use Net::SSLeay; 6 | use Socket; 7 | use IO::Socket::SSL; 8 | do './testlib.pl' || do './t/testlib.pl' || die "no testlib"; 9 | 10 | if ( ! IO::Socket::SSL->can_server_sni() ) { 11 | print "1..0 # skipped because no server side SNI support - openssl/Net::SSleay too old\n"; 12 | exit; 13 | } 14 | 15 | if ( ! IO::Socket::SSL->can_client_sni() ) { 16 | print "1..0 # skipped because no client side SNI support - openssl/Net::SSleay too old\n"; 17 | exit; 18 | } 19 | 20 | print "1..17\n"; 21 | my $server = IO::Socket::SSL->new( 22 | LocalAddr => '127.0.0.1', 23 | Listen => 2, 24 | ReuseAddr => 1, 25 | SSL_server => 1, 26 | SSL_ca_file => "t/certs/test-ca.pem", 27 | SSL_cert_file => { 28 | 'server.local' => 't/certs/server-cert.pem', 29 | 'server2.local' => 't/certs/server2-cert.pem', 30 | 'smtp.mydomain.local' => "t/certs/server-wildcard.pem", 31 | '' => "t/certs/server-wildcard.pem", 32 | }, 33 | SSL_key_file => { 34 | 'server.local' => 't/certs/server-key.pem', 35 | 'server2.local' => 't/certs/server2-key.pem', 36 | 'smtp.mydomain.local' => "t/certs/server-wildcard.pem", 37 | '' => "t/certs/server-wildcard.pem", 38 | }, 39 | SSL_verify_mode => 1 40 | ); 41 | 42 | warn "\$!=$!, \$\@=$@, S\$SSL_ERROR=$SSL_ERROR" if ! $server; 43 | print "not ok\n", exit if !$server; 44 | print "ok # Server Initialization\n"; 45 | my $saddr = $server->sockhost.':'.$server->sockport; 46 | 47 | # www13.other.local should match default '' 48 | # all other should match the specific entries 49 | my @tests = qw( 50 | server.local 51 | server2.local 52 | smtp.mydomain.local 53 | www13.other.local 54 | ); 55 | 56 | defined( my $pid = fork() ) || die $!; 57 | if ( $pid == 0 ) { 58 | close($server); 59 | 60 | for my $host (@tests) { 61 | my $client = IO::Socket::SSL->new( 62 | PeerAddr => $saddr, 63 | Domain => AF_INET, 64 | SSL_verify_mode => 1, 65 | SSL_hostname => $host, 66 | SSL_ca_file => 't/certs/test-ca.pem', 67 | SSL_cert_file => 't/certs/client-cert.pem', 68 | SSL_key_file => 't/certs/client-key.pem', 69 | ) || print "not "; 70 | print "ok # client ssl connect $host\n"; 71 | 72 | $client->verify_hostname($host,'http') or print "not "; 73 | print "ok # client verify hostname in cert $host\n"; 74 | } 75 | exit; 76 | } 77 | 78 | for my $host (@tests) { 79 | my $csock = $server->accept or print "not "; 80 | print "ok # server accept\n"; 81 | my $name = $csock->get_servername; 82 | print "not " if ! $name or $name ne $host; 83 | print "ok # server got SNI name $host\n"; 84 | } 85 | wait; 86 | -------------------------------------------------------------------------------- /t/start-stopssl.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use warnings; 5 | use IO::Socket::INET; 6 | use IO::Socket::SSL; 7 | do './testlib.pl' || do './t/testlib.pl' || die "no testlib"; 8 | 9 | $|=1; 10 | my @tests = qw( start stop start close ); 11 | print "1..16\n"; 12 | 13 | my $server = IO::Socket::INET->new( 14 | LocalAddr => '127.0.0.1', 15 | LocalPort => 0, 16 | Listen => 2, 17 | ) || die "not ok #tcp listen failed: $!\n"; 18 | print "ok #listen\n"; 19 | my $saddr = $server->sockhost.':'.$server->sockport; 20 | 21 | defined( my $pid = fork() ) || die $!; 22 | $pid ? server():client(); 23 | wait; 24 | exit(0); 25 | 26 | 27 | sub client { 28 | close($server); 29 | my $client = IO::Socket::INET->new($saddr) or 30 | die "not ok #client connect: $!\n"; 31 | $client->autoflush; 32 | print "ok #client connect\n"; 33 | 34 | for my $test (@tests) { 35 | alarm(15); 36 | #print STDERR "begin test $test\n"; 37 | if ( $test eq 'start' ) { 38 | print $client "start\n"; 39 | sleep(1); # avoid race condition, if client calls start but server is not yet available 40 | 41 | #print STDERR ">>$$(client) start\n"; 42 | IO::Socket::SSL->start_SSL($client, SSL_verify_mode => 0 ) 43 | || die "not ok #client::start_SSL: $SSL_ERROR\n"; 44 | #print STDERR "<<$$(client) start\n"; 45 | print "ok # client::start_SSL\n"; 46 | 47 | ref($client) eq "IO::Socket::SSL" or print "not "; 48 | print "ok # client::class=".ref($client)."\n"; 49 | 50 | } elsif ( $test eq 'stop' ) { 51 | print $client "stop\n"; 52 | $client->stop_SSL || die "not ok #client::stop_SSL\n"; 53 | print "ok # client::stop_SSL\n"; 54 | 55 | ref($client) eq "IO::Socket::INET" or print "not "; 56 | print "ok # client::class=".ref($client)."\n"; 57 | 58 | } elsif ( $test eq 'close' ) { 59 | print $client "close\n"; 60 | my $class = ref($client); 61 | $client->close || die "not ok # client::close\n"; 62 | print "ok # client::close\n"; 63 | 64 | ref($client) eq $class or print "not "; 65 | print "ok # client::class=".ref($client)."\n"; 66 | last; 67 | } 68 | #print STDERR "cont test $test\n"; 69 | 70 | defined( my $line = <$client> ) or return; 71 | die "'$line'" if $line ne "OK\n"; 72 | } 73 | } 74 | 75 | 76 | sub server { 77 | my $client = $server->accept || die $!; 78 | $client->autoflush; 79 | while (1) { 80 | alarm(15); 81 | defined( my $line = <$client> ) or last; 82 | chomp($line); 83 | if ( $line eq 'start' ) { 84 | #print STDERR ">>$$ start\n"; 85 | IO::Socket::SSL->start_SSL( $client, 86 | SSL_server => 1, 87 | SSL_cert_file => "t/certs/client-cert.pem", 88 | SSL_key_file => "t/certs/client-key.pem" 89 | ) || die "not ok #server::start_SSL: $SSL_ERROR\n"; 90 | #print STDERR "<<$$ start\n"; 91 | 92 | ref($client) eq "IO::Socket::SSL" or print "not "; 93 | print "ok # server::class=".ref($client)."\n"; 94 | print $client "OK\n"; 95 | 96 | } elsif ( $line eq 'stop' ) { 97 | $client->stop_SSL || die "not ok #server::stop_SSL\n"; 98 | print "ok #server::stop_SSL\n"; 99 | 100 | ref($client) eq "IO::Socket::INET" or print "not "; 101 | print "ok # class=".ref($client)."\n"; 102 | print $client "OK\n"; 103 | 104 | } elsif ( $line eq 'close' ) { 105 | my $class = ref($client); 106 | $client->close || die "not ok #server::close\n"; 107 | print "ok #server::close\n"; 108 | 109 | ref($client) eq $class or print "not "; 110 | print "ok # class=".ref($client)."\n"; 111 | last; 112 | } 113 | } 114 | } 115 | -------------------------------------------------------------------------------- /t/startssl-failed.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use warnings; 5 | use Net::SSLeay; 6 | use Socket; 7 | use IO::Socket::SSL; 8 | use IO::Select; 9 | do './testlib.pl' || do './t/testlib.pl' || die "no testlib"; 10 | 11 | $|=1; 12 | print "1..9\n"; 13 | 14 | my $server = IO::Socket::INET->new( 15 | LocalAddr => '127.0.0.1', 16 | LocalPort => 0, 17 | Listen => 2, 18 | ); 19 | print("not ok\n"),exit if !$server; 20 | ok("Server Initialization"); 21 | my $saddr = $server->sockhost.':'.$server->sockport; 22 | 23 | 24 | defined( my $pid = fork() ) || die $!; 25 | if ( $pid == 0 ) { 26 | client(); 27 | } else { 28 | server(); 29 | #kill(9,$pid); 30 | wait; 31 | } 32 | 33 | 34 | sub client { 35 | close($server); 36 | my $client = IO::Socket::INET->new($saddr) 37 | or return fail("client tcp connect"); 38 | ok("client tcp connect"); 39 | 40 | IO::Socket::SSL->start_SSL($client, SSL_verify_mode => 0) and 41 | return fail('start ssl should fail'); 42 | ok("startssl client failed: $SSL_ERROR"); 43 | 44 | UNIVERSAL::isa($client,'IO::Socket::INET') or 45 | return fail('downgrade socket after error'); 46 | ok('downgrade socket after error'); 47 | 48 | print $client "foo\n" or return fail("send to server: $!"); 49 | ok("send to server"); 50 | my $l; 51 | while (defined($l = <$client>)) { 52 | if ( $l =~m{bar\n} ) { 53 | return ok('client receive non-ssl data'); 54 | } 55 | } 56 | fail("receive non-ssl data"); 57 | } 58 | 59 | sub server { 60 | my $csock = $server->accept or return fail('tcp accept'); 61 | ok('tcp accept'); 62 | print $csock "This is no SSL handshake\n"; 63 | ok('send non-ssl data'); 64 | 65 | alarm(10); 66 | my $l; 67 | while (defined( $l = <$csock>)) { 68 | if ($l =~m{foo\n} ) { 69 | print $csock "bar\n"; 70 | return ok("received non-ssl data"); 71 | } 72 | #warn "XXXXXXXXX $l"; 73 | } 74 | fail('no data from client'.$!); 75 | } 76 | 77 | 78 | sub ok { print "ok #$_[0]\n"; return 1 } 79 | sub fail { print "not ok #$_[0]\n"; return } 80 | -------------------------------------------------------------------------------- /t/startssl.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use warnings; 5 | use Net::SSLeay; 6 | use Socket; 7 | use IO::Socket::SSL; 8 | use IO::Socket::SSL::Utils; 9 | use IO::Select; 10 | do './testlib.pl' || do './t/testlib.pl' || die "no testlib"; 11 | 12 | $|=1; 13 | print "1..21\n"; 14 | 15 | my $getfp = do { 16 | my (%file2fp); 17 | Net::SSLeay::SSLeay_add_ssl_algorithms(); 18 | my $sha256 = Net::SSLeay::EVP_get_digestbyname('sha256') or die; 19 | sub { 20 | my $file = shift; 21 | return $file2fp{$file} ||= do { 22 | my $cert = PEM_file2cert($file); 23 | 'sha256$'.unpack('H*',Net::SSLeay::X509_digest($cert, $sha256)); 24 | }; 25 | } 26 | }; 27 | 28 | 29 | my $server = IO::Socket::INET->new( 30 | LocalAddr => '127.0.0.1', 31 | LocalPort => 0, 32 | Listen => 2, 33 | ); 34 | print "not ok\n", exit if !$server; 35 | ok("Server Initialization"); 36 | 37 | print "not " if (!defined fileno($server)); 38 | ok("Server Fileno Check"); 39 | 40 | my $saddr = $server->sockhost.':'.$server->sockport; 41 | defined( my $pid = fork() ) || die $!; 42 | if ( $pid == 0 ) { 43 | 44 | close($server); 45 | my $client = IO::Socket::INET->new($saddr) || print "not "; 46 | ok( "client tcp connect" ); 47 | 48 | unless ( IO::Socket::SSL->start_SSL( $client, 49 | SSL_verify_mode => 0, 50 | SSL_cert_file => "t/certs/client-cert.pem", 51 | SSL_key_file => "t/certs/client-key.enc", 52 | SSL_passwd_cb => sub { return "opossum" } 53 | )) { 54 | #DEBUG( $SSL_ERROR ); 55 | print "not "; 56 | } 57 | ok( "sslify client" ); 58 | 59 | UNIVERSAL::isa( $client,'IO::Socket::SSL' ) || print "not "; 60 | ok( 'client reblessed as IO::Socket::SSL' ); 61 | 62 | $client->sock_certificate('subject') =~ /client\.local/ or print "not "; 63 | ok("client local certificate subject"); 64 | $client->sock_certificate('issuer') =~ /IO::Socket::SSL Demo CA/ or print "not "; 65 | ok("client local certificate issuer"); 66 | $client->get_fingerprint('sha256',$client->sock_certificate) 67 | eq $getfp->('t/certs/client-cert.pem') 68 | or print "not "; 69 | ok("client local certificate fingerprint"); 70 | 71 | $client->peer_certificate('subject') =~ /server\.local/ or print "not "; 72 | ok("client peer certificate subject"); 73 | $client->peer_certificate('issuer') =~ /IO::Socket::SSL Demo CA/ or print "not "; 74 | ok("client peer certificate issuer"); 75 | $client->get_fingerprint() 76 | eq $getfp->('t/certs/server-cert.pem') 77 | or print "not "; 78 | ok("client peer certificate fingerprint"); 79 | 80 | print $client "hannibal\n"; 81 | 82 | exit; 83 | } 84 | 85 | my $csock = $server->accept || print "not "; 86 | ok( "tcp accept" ); 87 | 88 | 89 | IO::Socket::SSL->start_SSL( $csock, 90 | SSL_server => 1, 91 | SSL_verify_mode => SSL_VERIFY_PEER|SSL_VERIFY_FAIL_IF_NO_PEER_CERT, 92 | SSL_ca_file => "t/certs/test-ca.pem", 93 | SSL_cert_file => "t/certs/server-cert.pem", 94 | SSL_key_file => "t/certs/server-key.enc", 95 | SSL_passwd_cb => sub { return "bluebell" }, 96 | ) || print "not "; 97 | #DEBUG( $IO::Socket::SSL::ERROR ); 98 | ok( 'sslify server' ); 99 | 100 | UNIVERSAL::isa( $csock,'IO::Socket::SSL' ) || print "not "; 101 | ok( 'server reblessed as IO::Socket::SSL' ); 102 | 103 | $csock->sock_certificate('subject') =~ /server\.local/ or print "not "; 104 | ok("server local certificate subject"); 105 | $csock->sock_certificate('issuer') =~ /IO::Socket::SSL Demo CA/ or print "not "; 106 | ok("server local certificate issuer"); 107 | $csock->get_fingerprint('sha256',$csock->sock_certificate) 108 | eq $getfp->('t/certs/server-cert.pem') 109 | or print "not "; 110 | ok("server local certificate fingerprint"); 111 | 112 | $csock->peer_certificate('subject') =~ /client\.local/ or print "not "; 113 | ok("server peer certificate subject"); 114 | $csock->peer_certificate('issuer') =~ /IO::Socket::SSL Demo CA/ or print "not "; 115 | ok("server peer certificate issuer"); 116 | $csock->get_fingerprint() 117 | eq $getfp->('t/certs/client-cert.pem') 118 | or print "not "; 119 | ok("server peer certificate fingerprint"); 120 | 121 | 122 | my $l = <$csock>; 123 | #DEBUG($l); 124 | print "not " if $l ne "hannibal\n"; 125 | ok( "received client message" ); 126 | 127 | wait; 128 | 129 | 130 | 131 | sub ok { print "ok #$_[0]\n"; } 132 | -------------------------------------------------------------------------------- /t/sysread_write.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | # Before `make install' is performed this script should be runnable with 3 | # `make test'. After `make install' it should work as `perl t/sysread_write.t' 4 | 5 | # This tests that sysread/syswrite behave different to read/write, e.g. 6 | # that the latter ones are blocking until they read/write everything while 7 | # the sys* function also can read/write partial data. 8 | 9 | use strict; 10 | use warnings; 11 | use Net::SSLeay; 12 | use Socket; 13 | use IO::Socket::SSL; 14 | do './testlib.pl' || do './t/testlib.pl' || die "no testlib"; 15 | 16 | $|=1; 17 | print "1..9\n"; 18 | 19 | ################################################################# 20 | # create Server socket before forking client, so that it is 21 | # guaranteed to be listening 22 | ################################################################# 23 | 24 | # first create simple ssl-server 25 | my $ID = 'server'; 26 | my $server = IO::Socket::SSL->new( 27 | LocalAddr => '127.0.0.1', 28 | LocalPort => 0, 29 | Listen => 2, 30 | SSL_cert_file => "t/certs/server-cert.pem", 31 | SSL_key_file => "t/certs/server-key.pem", 32 | ); 33 | print "not ok: $!\n", exit if !$server; 34 | ok("Server Initialization"); 35 | 36 | my $saddr = $server->sockhost.':'.$server->sockport; 37 | 38 | defined( my $pid = fork() ) || die $!; 39 | if ( $pid == 0 ) { 40 | 41 | ############################################################ 42 | # CLIENT == child process 43 | ############################################################ 44 | 45 | close($server); 46 | $ID = 'client'; 47 | 48 | my $to_server = IO::Socket::SSL->new( 49 | PeerAddr => $saddr, 50 | Domain => AF_INET, 51 | SSL_ca_file => "t/certs/test-ca.pem", 52 | ) || do { 53 | print "not ok: connect failed: $!\n"; 54 | exit 55 | }; 56 | 57 | ok( "client connected" ); 58 | 59 | # write 512 byte, server reads it in 66 byte chunks which 60 | # should cause at least the last read to be less then 66 bytes 61 | # (and not block). 62 | alarm(10); 63 | $SIG{ALRM} = sub { 64 | print "not ok: timed out\n"; 65 | exit; 66 | }; 67 | #DEBUG( "send 2x512 byte" ); 68 | unless ( syswrite( $to_server, 'x' x 512 ) == 512 69 | and syswrite( $to_server, 'x' x 512 ) == 512 ) { 70 | print "not ok: write to small: $!\n"; 71 | exit; 72 | } 73 | 74 | sysread( $to_server,my $ack,1 ) || print "not "; 75 | ok( "received ack" ); 76 | 77 | alarm(0); 78 | ok( "send in time" ); 79 | 80 | # make a syswrite with a buffer length greater than the 81 | # ssl message block size (16k for sslv3). It should send 82 | # only a partial packet of 16k 83 | my $n = syswrite( $to_server, 'x' x 18000 ); 84 | #DEBUG( "send $n bytes" ); 85 | print "not " if $n != 16384; 86 | ok( "partial write in syswrite" ); 87 | 88 | # but write should send everything because it does ssl_write_all 89 | $n = $to_server->write( 'x' x 18000 ); 90 | #DEBUG( "send $n bytes" ); 91 | print "not " if $n != 18000; 92 | ok( "full write in write ($n)" ); 93 | 94 | exit; 95 | 96 | } else { 97 | 98 | ############################################################ 99 | # SERVER == parent process 100 | ############################################################ 101 | 102 | my $to_client = $server->accept || do { 103 | print "not ok: accept failed: $!\n"; 104 | kill(9,$pid); 105 | exit; 106 | }; 107 | ok( "Server accepted" ); 108 | 109 | my $total = 1024; 110 | my $partial; 111 | while ( $total > 0 ) { 112 | #DEBUG( "reading 66 of $total bytes pending=".$to_client->pending() ); 113 | my $n = sysread( $to_client, my $buf,66 ); 114 | #DEBUG( "read $n bytes" ); 115 | if ( !$n ) { 116 | print "not ok: read failed: $!\n"; 117 | kill(9,$pid); 118 | exit; 119 | } elsif ( $n != 66 ) { 120 | $partial++; 121 | } 122 | $total -= $n; 123 | } 124 | print "not " if !$partial; 125 | ok( "partial read in sysread" ); 126 | 127 | # send ack back 128 | print "not " if !syswrite( $to_client, 'x' ); 129 | ok( "send ack back" ); 130 | 131 | # just read so that the writes will not block 132 | $to_client->read( my $buf,18000 ); 133 | $to_client->read( $buf,18000 ); 134 | 135 | 136 | # wait until client exits 137 | wait; 138 | } 139 | 140 | exit; 141 | 142 | 143 | sub ok { print "ok # [$ID] @_\n"; } 144 | -------------------------------------------------------------------------------- /t/testlib.pl: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use IO::Socket; 4 | use IO::Socket::SSL; 5 | use Config; 6 | 7 | ############################################################################ 8 | # 9 | # small test lib for common tasks: 10 | # adapted from t/testlib.pl in Net::SIP package 11 | # 12 | ############################################################################ 13 | 14 | unless ( $Config::Config{d_fork} || $Config::Config{d_pseudofork} || 15 | (($^O eq 'MSWin32' || $^O eq 'NetWare') and 16 | $Config::Config{useithreads} and 17 | $Config::Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/) ) { 18 | print "1..0 # Skipped: fork not implemented on this platform\n"; 19 | exit 20 | } 21 | 22 | # let IO errors result in EPIPE instead of crashing the test 23 | $SIG{PIPE} = 'IGNORE'; 24 | 25 | # small implementations if not used from Test::More (09_fdleak.t) 26 | if ( ! defined &ok ) { 27 | no strict 'refs'; 28 | *{'ok'} = sub { 29 | my ($bool,$desc) = @_; 30 | print $bool ? "ok ":"not ok ", '# ',$desc || '',"\n"; 31 | }; 32 | *{'diag'} = sub { print "# @_\n"; }; 33 | *{'like'} = sub { 34 | my ( $data,$rx,$desc ) = @_; 35 | ok( $data =~ $rx ? 1:0, $desc ); 36 | }; 37 | } 38 | 39 | $SIG{ __DIE__ } = sub { 40 | return if $^S; # Ignore from within evals 41 | ok( 0,"@_" ); 42 | killall(); 43 | exit(1); 44 | }; 45 | 46 | ############################################################################ 47 | # kill all process collected by fork_sub 48 | # Args: ?$signal 49 | # $signal: signal to use, default 9 50 | # Returns: NONE 51 | ############################################################################ 52 | my @pids; 53 | sub killall { 54 | my $sig = shift || 9; 55 | kill $sig, @pids; 56 | #diag( "killed @pids with $sig" ); 57 | while ( wait() >= 0 ) {} # collect all 58 | @pids = (); 59 | } 60 | 61 | 62 | ############################################################################ 63 | # fork named sub with args and provide fd into subs STDOUT 64 | # Args: ($name,@args) 65 | # $name: name or ref to sub, if name it will be used for debugging 66 | # @args: arguments for sub 67 | # Returns: $fh 68 | # $fh: file handle to read STDOUT of sub 69 | ############################################################################ 70 | my %fd2name; # associated sub-name for file descriptor to subs STDOUT 71 | sub fork_sub { 72 | my ($name,@arg) = @_; 73 | my $sub = ref($name) ? $name : UNIVERSAL::can( 'main',$name ) || die; 74 | pipe( my $rh, my $wh ) || die $!; 75 | defined( my $pid = fork() ) || die $!; 76 | if ( ! $pid ) { 77 | # CHILD, exec sub 78 | $SIG{ __DIE__ } = undef; 79 | close($rh); 80 | local *STDOUT = local *STDERR = $wh; 81 | $wh->autoflush; 82 | print "OK\n"; 83 | $sub->(@arg); 84 | exit(0); 85 | } 86 | 87 | push @pids,$pid; 88 | close( $wh ); 89 | $fd2name{$rh} = $name; 90 | fd_grep_ok( 'OK',10,$rh ) || die 'startup failed'; 91 | return $rh; 92 | } 93 | 94 | ############################################################################ 95 | # grep within fd's for specified regex or substring 96 | # Args: ($pattern,[ $timeout ],@fd) 97 | # $pattern: regex or substring 98 | # $timeout: how many seconds to wait for pattern, default 10 99 | # @fd: which fds to search, usually fds from fork_sub(..) 100 | # Returns: $rv| ($rv,$name) 101 | # $rv: matched text if pattern is found, else undef 102 | # $name: name for file handle 103 | ############################################################################ 104 | my %fd2buf; # already read data from fd 105 | sub fd_grep { 106 | my $pattern = shift; 107 | my $timeout = 10; 108 | $timeout = shift if !ref($_[0]); 109 | my @fd = @_; 110 | $pattern = qr{\Q$pattern} if ! UNIVERSAL::isa( $pattern,'Regexp' ); 111 | my $name = join( "|", map { $fd2name{$_} || "$_" } @fd ); 112 | #diag( "look for $pattern in $name" ); 113 | my @bad = wantarray ? ( undef,$name ):(undef); 114 | @fd || return @bad; 115 | my $rin = ''; 116 | map { $_->blocking(0); vec( $rin,fileno($_),1 ) = 1 } @fd; 117 | my $end = defined( $timeout ) ? time() + $timeout : undef; 118 | 119 | while (@fd) { 120 | 121 | # check existing buf from previous reads 122 | foreach my $fd (@fd) { 123 | my $buf = \$fd2buf{$fd}; 124 | $$buf || next; 125 | if ( $$buf =~s{\A(?:.*?)($pattern)}{}s ) { 126 | #diag( "found" ); 127 | return wantarray ? ( $1,$name ) : $1; 128 | } 129 | } 130 | 131 | # if not found try to read new data 132 | $timeout = $end - time() if $end; 133 | return @bad if $timeout < 0; 134 | select( my $rout = $rin,undef,undef,$timeout ); 135 | $rout || return @bad; # not found 136 | foreach my $fd (@fd) { 137 | my $name = $fd2name{$fd} || "$fd"; 138 | my $buf = \$fd2buf{$fd}; 139 | my $fn = fileno($fd); 140 | my $n; 141 | if ( defined ($fn)) { 142 | vec( $rout,$fn,1 ) || next; 143 | my $l = $$buf && length($$buf) || 0; 144 | $n = sysread( $fd,$$buf,8192,$l ); 145 | } 146 | if ( ! $n ) { 147 | #diag( "$name >CLOSED<" ); 148 | delete $fd2buf{$fd}; 149 | @fd = grep { $_ != $fd } @fd; 150 | close($fd); 151 | next; 152 | } 153 | diag( "$name >> ".substr( $$buf,-$n ). "<<" ); 154 | } 155 | } 156 | return @bad; 157 | } 158 | 159 | ############################################################################ 160 | # like Test::Simple::ok, but based on fd_grep, same as 161 | # ok( fd_grep( pattern,... ), "[$subname] $pattern" ) 162 | # Args: ($pattern,[ $timeout ],@fd) - see fd_grep 163 | # Returns: $rv - like in fd_grep 164 | # Comment: if !$rv and wantarray says void it will die() 165 | ############################################################################ 166 | sub fd_grep_ok { 167 | my $pattern = shift; 168 | my ($rv,$name) = fd_grep( $pattern, @_ ); 169 | local $Test::Builder::Level = $Test::Builder::Level || 0 +1; 170 | ok( $rv,"[$name] $pattern" ); 171 | die "fatal error" if !$rv && ! defined wantarray; 172 | return $rv; 173 | } 174 | 175 | 176 | ############################################################################ 177 | # create socket on IP 178 | # return socket and ip:port 179 | ############################################################################ 180 | sub create_listen_socket { 181 | my ($addr,$port,$proto) = @_; 182 | $addr ||= '127.0.0.1'; 183 | my $sock = IO::Socket::INET->new( 184 | LocalAddr => $addr, 185 | $port ? ( LocalPort => $port, Reuse => 1 ) : (), 186 | Listen => 10, 187 | ) || die $!; 188 | ($port,$addr) = unpack_sockaddr_in( getsockname($sock) ); 189 | return wantarray ? ( $sock, inet_ntoa($addr).':'.$port ) : $sock; 190 | } 191 | 1; 192 | -------------------------------------------------------------------------------- /t/verify_fingerprint.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | use IO::Socket::SSL; 5 | use IO::Socket::SSL::Utils; 6 | use File::Temp 'tempfile'; 7 | do './testlib.pl' || do './t/testlib.pl' || die "no testlib"; 8 | 9 | plan tests => 15; 10 | 11 | my ($ca1,$cakey1) = CERT_create( CA => 1, subject => { CN => 'ca1' }); 12 | my ($cert1,$key1) = CERT_create( 13 | subject => { CN => 'cert1' }, 14 | subjectAltNames => [ [ DNS => 'cert1' ], [ IP => '127.0.0.1' ] ], 15 | issuer => [ $ca1,$cakey1 ] 16 | ); 17 | my ($ca2,$cakey2) = CERT_create( CA => 1, subject => { CN => 'ca2' }); 18 | my ($ica2,$icakey2) = CERT_create( 19 | CA => 1, 20 | subject => { CN => 'ica2' }, 21 | issuer => [ $ca2,$cakey2 ] 22 | ); 23 | my ($cert2,$key2) = CERT_create( 24 | subject => { CN => 'cert2' }, 25 | subjectAltNames => [ [ DNS => 'cert2' ], [ IP => '127.0.0.1' ] ], 26 | issuer => [ $ica2,$icakey2 ] 27 | ); 28 | 29 | my ($saddr1,$fp1) = _server([$cert1],$key1); 30 | my ($saddr2,$fp2,$ifp2) = _server([$cert2,$ica2],$key2); 31 | my $fp1pub = $fp1->[1]; 32 | $_ = $_->[0] for($fp1,$fp2,$ifp2); 33 | 34 | for my $test ( 35 | [ $saddr1, undef, $fp1, "accept fp1 for saddr1", 1 ], 36 | [ $saddr1, undef, $fp1pub, "accept fp1 pubkey for saddr1", 1 ], 37 | [ $saddr2, undef, $fp2, "accept fp2 for saddr2", 1 ], 38 | [ $saddr2, undef, $ifp2, "reject ifp2 for saddr2", 0 ], 39 | [ $saddr1, undef, $fp2, "reject fp2 for saddr1", 0 ], 40 | [ $saddr2, undef, $fp1, "reject fp1 for saddr2", 0 ], 41 | [ $saddr1, undef, [$fp1,$fp2], "accept fp1|fp2 for saddr1", 1 ], 42 | [ $saddr2, undef, [$fp1,$fp2], "accept fp1|fp2 for saddr2", 1 ], 43 | [ $saddr2, [$ca1], $fp2, "accept fp2 for saddr2 even if ca1 given", 1 ], 44 | [ $saddr2, [$ca2], undef, "accept ca2 for saddr2", 1 ], 45 | [ $saddr1, [$ca2], undef, "reject ca2 for saddr1", 0 ], 46 | [ $saddr1, [$ca1,$ca2], undef, "accept ca[12] for saddr1", 1 ], 47 | [ $saddr1, [$ca1,$ca2], $fp2, "reject with wrong forced fp but correct cert", 0, { SSL_force_fingerprint => 1 } ], 48 | [ $saddr1, [$ca1,$ca2], $fp1, "accept with correct forced fp and correct cert", 1, { SSL_force_fingerprint => 1 } ], 49 | (defined &Net::SSLeay::X509_V_FLAG_PARTIAL_CHAIN ? 50 | [ $saddr1, [$cert1], undef, "accept leaf cert1 as trust anchor for saddr1", 1 ] : 51 | [ $saddr1, [$cert1], undef, "reject leaf cert1 as trust anchor for saddr1", 0 ] 52 | ) 53 | ) { 54 | my ($saddr,$certs,$fp,$what,$expect,$sslopt) = @$test; 55 | my $cafile; 56 | my $cl = IO::Socket::INET->new( $saddr ) or die $!; 57 | syswrite($cl,"X",1); 58 | my $ok = IO::Socket::SSL->start_SSL($cl, 59 | SSL_verify_mode => 1, 60 | SSL_fingerprint => $fp, 61 | SSL_ca => $certs, 62 | SSL_ca_file => undef, 63 | SSL_ca_path => undef, 64 | $sslopt ? %$sslopt : (), 65 | ); 66 | ok( ($ok?1:0) == ($expect?1:0),$what); 67 | } 68 | 69 | # Notify server children to exit by connecting and disconnecting immediately, 70 | # kill only if they will not exit. 71 | alarm(10); 72 | my @child; 73 | END { kill 9,@child } 74 | IO::Socket::INET->new($saddr1); 75 | IO::Socket::INET->new($saddr2); 76 | while ( @child && ( my $pid = waitpid(-1,0))>0 ) { 77 | @child = grep { $_ != $pid } @child 78 | } 79 | 80 | 81 | sub _server { 82 | my ($certs,$key) = @_; 83 | my $sock = IO::Socket::INET->new( LocalAddr => '0.0.0.0', Listen => 10 ) 84 | or die $!; 85 | defined( my $pid = fork()) or die $!; 86 | if ( $pid ) { 87 | push @child,$pid; 88 | my $saddr = '127.0.0.1:'.$sock->sockport; 89 | close($sock); 90 | return ( 91 | $saddr, 92 | map { [ 93 | 'sha1$'.Net::SSLeay::X509_get_fingerprint($_,'sha1'), 94 | 'sha1$pub$'.unpack("H*",Net::SSLeay::X509_pubkey_digest($_, 95 | Net::SSLeay::EVP_get_digestbyname('sha1'))) 96 | ]} @$certs 97 | ); 98 | } 99 | 100 | # The chain certificates will be added without increasing reference counter 101 | # and will be destroyed at close of context, so we better have a common 102 | # context between all start_SSL. 103 | my $ctx = IO::Socket::SSL::SSL_Context->new( 104 | SSL_server => 1, 105 | SSL_cert => $certs, 106 | SSL_key => $key 107 | ); 108 | while (1) { 109 | #local $IO::Socket::SSL::DEBUG=10; 110 | my $cl = $sock->accept or next; 111 | sysread($cl,my $buf,1) || last; 112 | IO::Socket::SSL->start_SSL($cl, 113 | SSL_server => 1, 114 | SSL_reuse_ctx => $ctx, 115 | ); 116 | } 117 | exit(0); 118 | } 119 | -------------------------------------------------------------------------------- /t/verify_hostname.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use warnings; 5 | use Net::SSLeay; 6 | use Socket; 7 | use IO::Socket::SSL; 8 | do './testlib.pl' || do './t/testlib.pl' || die "no testlib"; 9 | 10 | # if we have an IDN library max the IDN tests too 11 | my $can_idn = eval { require Encode } && ( 12 | eval { require Net::LibIDN } 13 | || eval { require Net::IDN::Encode } 14 | || eval { require URI; URI->VERSION(1.50) } 15 | ); 16 | 17 | $|=1; 18 | my $max = 42; 19 | $max+=3 if $can_idn; 20 | print "1..$max\n"; 21 | 22 | my $server = IO::Socket::INET->new( 23 | LocalAddr => '127.0.0.1', 24 | LocalPort => 0, 25 | Listen => 2, 26 | ReuseAddr => 1, 27 | ); 28 | warn "\$!=$!, \$\@=$@, S\$SSL_ERROR=$SSL_ERROR" if ! $server; 29 | print "not ok\n", exit if !$server; 30 | ok("Server Initialization"); 31 | my $saddr = $server->sockhost.':'.$server->sockport; 32 | 33 | defined( my $pid = fork() ) || die $!; 34 | if ( $pid == 0 ) { 35 | close($server); 36 | my $client = IO::Socket::SSL->new( 37 | PeerAddr => $saddr, 38 | Domain => AF_INET, 39 | SSL_verify_mode => 0 40 | ) || print "not "; 41 | ok( "client ssl connect" ); 42 | 43 | my $issuer = $client->peer_certificate( 'issuer' ); 44 | print "not " if $issuer !~m{IO::Socket::SSL Demo CA}; 45 | ok("issuer"); 46 | 47 | my $cn = $client->peer_certificate( 'cn' ); 48 | print "not " unless $cn eq "server.local"; 49 | ok("cn"); 50 | 51 | my @alt = $client->peer_certificate( 'subjectAltNames' ); 52 | my @want = ( 53 | GEN_DNS() => '*.server.local', 54 | GEN_IPADD() => '127.0.0.1', 55 | GEN_DNS() => 'www*.other.local', 56 | GEN_DNS() => 'smtp.mydomain.local', 57 | GEN_DNS() => 'xn--lwe-sna.idntest.local', 58 | ); 59 | while (@want) { 60 | my ($typ,$text) = splice(@want,0,2); 61 | my $data = ($typ == GEN_IPADD() ) ? inet_aton($text):$text; 62 | my ($th,$dh) = splice(@alt,0,2); 63 | $th == $typ and $dh eq $data or print "not "; 64 | ok( $text ); 65 | } 66 | @alt and print "not "; 67 | ok( 'no more altSubjectNames' ); 68 | 69 | my @tests = ( 70 | '127.0.0.1' => [qw( smtp ldap www)], 71 | 'server.local' => [qw(smtp ldap)], 72 | 'blafasel.server.local' => [qw(smtp ldap www)], 73 | 'lala.blafasel.server.local' => [], 74 | 'www.other.local' => [qw()], 75 | 'www-13.other.local' => [qw(www)], 76 | 'www-13.lala.other.local' => [], 77 | 'smtp.mydomain.local' => [qw(smtp ldap www)], 78 | 'xn--lwe-sna.idntest.local' => [qw(smtp ldap www)], 79 | 'smtp.mydomain.localizing.useless.local' => [], 80 | ); 81 | if ( $can_idn ) { 82 | # check IDN handling 83 | my $loewe = "l\366we.idntest.local"; 84 | push @tests, ( $loewe => [qw(smtp ldap www)] ); 85 | } 86 | 87 | while (@tests) { 88 | my ($host,$expect) = splice(@tests,0,2); 89 | my %expect = map { $_=>1 } @$expect; 90 | for my $typ (qw( smtp ldap www)) { 91 | my $is = $client->verify_hostname( $host, $typ ) ? 'pass':'fail'; 92 | my $want = $expect{$typ} ? 'pass':'fail'; 93 | print "not " if $is ne $want; 94 | ok( "$want $host $typ" ); 95 | } 96 | } 97 | exit; 98 | } 99 | 100 | my $accept = sub { 101 | my $csock = $server->accept; 102 | IO::Socket::SSL->start_SSL($csock, 103 | SSL_server => 1, 104 | SSL_ca_file => "t/certs/test-ca.pem", 105 | SSL_cert_file => "t/certs/server-wildcard.pem", 106 | SSL_key_file => "t/certs/server-wildcard.pem", 107 | ); 108 | }; 109 | 110 | my $csock = &$accept; 111 | wait; 112 | 113 | # try with implicit checking 114 | # Should succeed 115 | defined( $pid = fork() ) || die $!; 116 | if ( $pid == 0 ) { 117 | close($server); 118 | IO::Socket::SSL->new( 119 | PeerAddr => $saddr, 120 | Domain => AF_INET, 121 | SSL_ca_file => "t/certs/test-ca.pem", 122 | SSL_verify_mode => 1, 123 | SSL_verifycn_scheme => 'www', 124 | SSL_verifycn_name => 'www.server.local' 125 | ) || print "not "; 126 | ok("implicit hostname check www.server.local"); 127 | exit; 128 | } 129 | $csock = &$accept; 130 | wait; 131 | 132 | # Should fail 133 | defined( $pid = fork() ) || die $!; 134 | if ( $pid == 0 ) { 135 | close($server); 136 | if (IO::Socket::SSL->new( 137 | PeerAddr => $saddr, 138 | Domain => AF_INET, 139 | SSL_ca_file => "t/certs/test-ca.pem", 140 | SSL_verify_mode => 1, 141 | SSL_verifycn_scheme => 'www', 142 | SSL_verifycn_name => 'does.not.match.server.local' 143 | )) { 144 | print "not "; 145 | } elsif ($SSL_ERROR !~ /hostname verification failed/) { 146 | print "# wrong error(should be hostname verification failed): $SSL_ERROR\n"; 147 | print "not "; 148 | } 149 | ok("implicit hostname check does.not.match.server.local"); 150 | exit; 151 | } 152 | $csock = &$accept; 153 | wait; 154 | 155 | 156 | 157 | sub ok { print "ok #$_[0]\n"; } 158 | -------------------------------------------------------------------------------- /t/verify_hostname_standalone.t: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/noxxi/p5-io-socket-ssl/0e7da458fbad2998897cd38ad6ad0500b7897439/t/verify_hostname_standalone.t -------------------------------------------------------------------------------- /t/verify_partial_chain.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use warnings; 5 | use Net::SSLeay; 6 | use Socket; 7 | use IO::Socket::SSL; 8 | 9 | if (!IO::Socket::SSL->can_partial_chain) { 10 | print "1..0 # no support for X509_V_FLAG_PARTIAL_CHAIN\n"; 11 | exit(0); 12 | } 13 | 14 | do './testlib.pl' || do './t/testlib.pl' || die "no testlib"; 15 | 16 | $|=1; 17 | print "1..3\n"; 18 | 19 | my $server = IO::Socket::SSL->new( 20 | LocalAddr => '127.0.0.1', 21 | LocalPort => 0, 22 | Listen => 2, 23 | ReuseAddr => 1, 24 | SSL_cert_file => "t/certs/sub-server.pem", 25 | SSL_key_file => "t/certs/sub-server.pem", 26 | ); 27 | warn "\$!=$!, \$\@=$@, S\$SSL_ERROR=$SSL_ERROR" if ! $server; 28 | print "not ok\n", exit if !$server; 29 | ok("Server Initialization"); 30 | my $saddr = $server->sockhost.':'.$server->sockport; 31 | 32 | defined( my $pid = fork() ) || die $!; 33 | if ( $pid == 0 ) { 34 | close($server); 35 | my $client = IO::Socket::SSL->new( 36 | PeerAddr => $saddr, 37 | Domain => AF_INET, 38 | SSL_ca_file => "t/certs/test-subca.pem", 39 | ) or print "not "; 40 | ok( "client ssl connect" ); 41 | if ($client) { 42 | my $issuer = $client->peer_certificate( 'issuer' ); 43 | print "not " if $issuer !~m{IO::Socket::SSL Demo Sub CA}; 44 | ok("issuer"); 45 | } else { 46 | ok("skip issuer check since no client"); 47 | } 48 | exit; 49 | } 50 | 51 | my $csock = $server->accept; 52 | wait; 53 | 54 | sub ok { print "ok #$_[0]\n"; } 55 | -------------------------------------------------------------------------------- /tls_fingerprint/JAX.pm: -------------------------------------------------------------------------------- 1 | # Copyright Steffen Ullrich 2023 2 | # License: public domain (no restrictions) 3 | 4 | package JAX; 5 | use strict; 6 | use warnings; 7 | use Digest::MD5 'md5_hex'; 8 | use Digest::SHA 'sha256_hex'; 9 | 10 | use Exporter 'import'; 11 | our @EXPORT = qw(ja3 ja4 ja3s); 12 | 13 | my %grease = map { $_ =>1 } ( 14 | 0x0a0a, 0x1a1a, 0x2a2a, 0x3a3a, 0x4a4a, 0x5a5a, 0x6a6a, 0x7a7a, 15 | 0x8a8a, 0x9a9a, 0xaaaa, 0xbaba, 0xcaca, 0xdada, 0xeaea, 0xfafa, 16 | ); 17 | 18 | sub ja3s { 19 | my ($buf,$raw,$ordered) = @_; 20 | 21 | # 2 byte: protocol version 22 | # 32 byte: random 23 | # 1/... : session id 24 | # 2 byte: cipher suite 25 | # 1 byte: compression method 26 | # 2/... : extensions 27 | my ($ver, $cipher, $ext) = unpack("n x32 c/x n x n/a", $buf); 28 | 29 | my @ext; 30 | while (length($ext)>2) { 31 | # 2 byte: extension type 32 | # 2|... : extension data 33 | (my $ext_type, $ext) = unpack("n n/x a*", $ext); 34 | push @ext, $ext_type if ! $grease{$ext_type}; 35 | } 36 | my $fp = join(",", 37 | $ver, 38 | $cipher, 39 | join("-", $ordered ? sort(@ext) : @ext) 40 | ); 41 | return $raw ? $fp : md5_hex($fp); 42 | } 43 | 44 | sub ja3 { 45 | my ($buf,$raw,$ordered) = @_; 46 | 47 | # 2 byte: protocol version 48 | # 32 byte: random 49 | # 1/.. : session id 50 | # 2/... : cipher suites 51 | # 1/... : compression methods 52 | # 2/... : extensions 53 | my ($ver, $ciphers, $ext) = unpack("n x32 c/x n/a c/x n/a", $buf); 54 | 55 | my @ciphers = grep { !$grease{$_} } unpack("n*", $ciphers); 56 | 57 | my (@ext, @elliptic_curve, @elliptic_curve_point_format); 58 | while (length($ext)>2) { 59 | # 2 byte: extension value 60 | # 2|... : extension data 61 | (my $ext_val, my $ext_data, $ext) = unpack("n n/a a*", $ext); 62 | next if $grease{$ext_val}; 63 | push @ext, $ext_val; 64 | if ($ext_val == 0x0a) { 65 | # Elliptic curve points 66 | @elliptic_curve = unpack("x2 n*", $ext_data); 67 | } elsif ($ext_val == 0x0b) { 68 | # Elliptic curve point formats 69 | @elliptic_curve_point_format = unpack("x c*", $ext_data); 70 | } 71 | } 72 | 73 | my $fp = join(",", 74 | $ver, 75 | join("-", @ciphers), 76 | join("-", $ordered ? sort(@ext) : @ext), 77 | join("-", @elliptic_curve), 78 | join("-", @elliptic_curve_point_format), 79 | ); 80 | return $raw ? $fp : md5_hex($fp); 81 | } 82 | 83 | sub ja4 { 84 | my ($buf,$raw,$ordered) = @_; 85 | $ordered //= 1; # default ordered 86 | 87 | # 2 byte: protocol version 88 | # 32 byte: random 89 | # 1/.. : session id 90 | # 2/... : cipher suites 91 | # 1/... : compression methods 92 | # 2/... : extensions 93 | my ($ver, $ciphers, $ext) = unpack("n x32 c/x n/a c/x n/a", $buf); 94 | 95 | my @ciphers = grep { !$grease{$_} } unpack("n*", $ciphers); 96 | my $sni = 'i'; 97 | my $alpn = '00'; 98 | 99 | my (@ext,@sigalg); 100 | my $lenext = 0; 101 | while (length($ext)>2) { 102 | # 2 byte: extension value 103 | # 2|... : extension data 104 | (my $ext_val, my $ext_data, $ext) = unpack("n n/a a*", $ext); 105 | next if $grease{$ext_val}; 106 | $lenext++; 107 | push @ext, $ext_val; 108 | if ($ext_val == 43) { 109 | # supported_versions 110 | my @v = grep { !$grease{$_} } unpack("x n*", $ext_data); 111 | $ver = $v[0] if @v; 112 | } elsif ($ext_val == 13) { 113 | # signature_algorithm 114 | @sigalg = grep { !$grease{$_} } unpack("x2 n*", $ext_data); 115 | } elsif ($ext_val == 0) { 116 | # server_name 117 | pop @ext; # don't include in extension list 118 | $sni = 'd'; 119 | } elsif ($ext_val == 16) { 120 | # alpn 121 | pop @ext; # don't include in extension list 122 | eval { $alpn = unpack("x2 c/a", $ext_data); }; 123 | $alpn = substr($alpn,0,1).substr($alpn,-1,1); 124 | } 125 | } 126 | $ver = $ver>0x0300 ? $ver - 0x0300 + 9 : # 0x303 -> TLS 1.2 127 | $ver == 0x0300 ? 's3' : 128 | $ver == 512 ? 's2' : 129 | $ver == 256 ? 's1' : 130 | '00'; 131 | 132 | for (\@ciphers, \@ext, \@sigalg) { 133 | $_ = sprintf("%04x", $_ ) for @$_; 134 | 135 | } 136 | my $hash = $raw ? sub { shift } : sub { substr(sha256_hex(shift),0,12) }; 137 | return sprintf("%s%02d%s%02d%02d%s_%s_%s", 138 | 't', 139 | $ver, 140 | $sni, 141 | ~~@ciphers, 142 | $lenext, 143 | $alpn, 144 | $hash->(join(",", $ordered? sort(@ciphers) : @ciphers)), 145 | $hash->( join(",", $ordered ? sort(@ext) : @ext) . 146 | (@sigalg ? "_".join(",", @sigalg) : "")), 147 | ); 148 | } 149 | 150 | 1; 151 | -------------------------------------------------------------------------------- /tls_fingerprint/README: -------------------------------------------------------------------------------- 1 | Example code for TLS fingerprinting using JA3, JA3S and JA4 2 | 3 | License is public domain - no restrictions 4 | -------------------------------------------------------------------------------- /tls_fingerprint/client.pl: -------------------------------------------------------------------------------- 1 | # Copyright Steffen Ullrich 2023 2 | # License: public domain (no restrictions) 3 | 4 | use strict; 5 | use warnings; 6 | use IO::Socket::SSL; 7 | use lib '.'; 8 | use JAX qw(ja3 ja4 ja3s); 9 | 10 | for my $dst (@ARGV) { 11 | my $cl = IO::Socket::SSL->new( 12 | PeerAddr => $dst, 13 | PeerPort => 443, 14 | SSL_startHandshake => 0, 15 | #SSL_version => 'TLSv1_2', 16 | ) or die $!; 17 | 18 | my ($chello, $shello); 19 | $cl->set_msg_callback(\&msgcb, \$chello, \$shello); 20 | $cl->connect_SSL() or die $SSL_ERROR; 21 | 22 | print "JA3 ".ja3($chello)."\n"; 23 | print "JA3 raw ".ja3($chello,1)."\n"; 24 | print "JA3N ".ja3($chello,0,1)."\n"; 25 | print "JA3N raw ".ja3($chello,1,1)."\n"; 26 | print "JA4 ".ja4($chello)."\n"; 27 | print "JA4 raw ".ja4($chello,1)."\n"; 28 | print "JA4_o ".ja4($chello,0,0)."\n"; 29 | print "JA4_o raw ".ja4($chello,1,0)."\n"; 30 | print "JA3S ".ja3s($shello)."\n"; 31 | print "JA3S raw ".ja3s($shello,1)."\n"; 32 | print "JA3SN ".ja3s($shello,0,1)."\n"; 33 | print "JA3SN raw ".ja3s($shello,1,1)."\n"; 34 | } 35 | 36 | 37 | sub msgcb { 38 | my ($self, $direction, $ssl_ver, $content_type, $buf, $len, $ssl, $chello_r, $shello_r) = @_; 39 | $content_type == 22 or return; # TLS handshake 40 | # 1 byte: msg type 41 | # 3 byte: length 42 | (my $msg_type, $buf) = unpack('c x3 a*', $buf); 43 | if ($msg_type == 1) { # Client Hello 44 | $$chello_r = $buf; 45 | } elsif ($msg_type == 2) { # Server Hello 46 | $self->set_msg_callback(undef); # no need to look further 47 | $$shello_r = $buf; 48 | } 49 | } 50 | -------------------------------------------------------------------------------- /tls_fingerprint/fp_from_pcap.pl: -------------------------------------------------------------------------------- 1 | # Copyright Steffen Ullrich 2023 2 | # License: public domain (no restrictions) 3 | 4 | use strict; 5 | use warnings; 6 | use Net::Inspect; 7 | use Net::Inspect::L2::Pcap; 8 | use Net::Inspect::L3::IP; 9 | use Net::Inspect::L4::TCP; 10 | use Net::Pcap; 11 | use lib '.'; 12 | use JAX qw(ja3 ja4 ja3s); 13 | 14 | for my $file (@ARGV) { 15 | my $err; 16 | my $pcap = pcap_open_offline($file,\$err); 17 | $pcap or die $err; 18 | 19 | my $tcp = Net::Inspect::L4::TCP->new(Analyzer->new( 20 | 1 => \&fp_client, 21 | 2 => \&fp_server, 22 | )); 23 | my $raw = Net::Inspect::L3::IP->new([$tcp]); 24 | my $pc = Net::Inspect::L2::Pcap->new($pcap,$raw); 25 | 26 | my $time; 27 | pcap_loop($pcap,-1,sub { 28 | my (undef,$hdr,$data) = @_; 29 | if ( ! $time || $hdr->{tv_sec}-$time>10 ) { 30 | #$tcp->expire($time = $hdr->{tv_sec}); 31 | } 32 | return $pc->pktin($data,$hdr); 33 | },undef); 34 | } 35 | 36 | sub fp_client { 37 | my ($chello,$analyzer) = @_; 38 | _dump($analyzer); 39 | print "JA3 ".ja3($chello)."\n"; 40 | print "JA3 raw ".ja3($chello,1)."\n"; 41 | print "JA3N ".ja3($chello,0,1)."\n"; 42 | print "JA3N raw ".ja3($chello,1,1)."\n"; 43 | print "JA4 ".ja4($chello)."\n"; 44 | print "JA4 raw ".ja4($chello,1)."\n"; 45 | print "JA4_o ".ja4($chello,0,0)."\n"; 46 | print "JA4_o raw ".ja4($chello,1,0)."\n"; 47 | print "------\n"; 48 | } 49 | 50 | sub fp_server { 51 | my ($shello,$analyzer) = @_; 52 | _dump($analyzer); 53 | print "JA3S ".ja3s($shello)."\n"; 54 | print "JA3S raw ".ja3s($shello,1)."\n"; 55 | print "JA3SN ".ja3s($shello,0,1)."\n"; 56 | print "JA3SN raw ".ja3s($shello,1,1)."\n"; 57 | print "------\n"; 58 | } 59 | 60 | sub _dump { 61 | my $m = shift->{meta}; 62 | print "$m->{saddr}:$m->{sport} - $m->{daddr}:$m->{dport}\n"; 63 | } 64 | 65 | 1; 66 | 67 | package Analyzer; 68 | use base 'Net::Inspect::Connection'; 69 | use fields qw(buf meta recmap); 70 | 71 | sub new { 72 | my ($class,%recmap) = @_; 73 | if (ref($class)) { 74 | my $self = fields::new(ref($class)); 75 | $self->{recmap} = $class->{recmap}; 76 | $self->{buf} = [ '','' ]; 77 | return $self; 78 | } 79 | my $self = fields::new($class); 80 | $self->{recmap} = \%recmap; 81 | return $self; 82 | } 83 | 84 | sub syn { 1 } 85 | sub fatal { warn "@_\n" } 86 | 87 | sub new_connection { 88 | my ($self,$meta) = @_; 89 | $self = $self->new; 90 | $self->{meta} = $meta; 91 | return $self; 92 | } 93 | 94 | sub in { 95 | my ($self,$dir,$data,$eof) = @_; 96 | return if $eof or $data eq ''; 97 | my $buf = \$self->{buf}[$dir]; 98 | 99 | $$buf .= $data; 100 | while (1) { 101 | if ($$buf =~m{\x16\x03[\x00-\x03](..)}sg) { 102 | # remove everything in front 103 | substr($$buf,0,pos($$buf)-5,'') if pos($$buf)>5; 104 | my $len = unpack("n",$1); 105 | if ($len+5 > length($$buf)) { 106 | # need more 107 | last 108 | } 109 | # extract inner handshake protocol 110 | (my $rec, $$buf) = unpack("x3 n/a a*", $$buf); 111 | (my $type, $rec) = unpack("c x3 a*", $rec); 112 | my $fpsub = $self->{recmap}{$type} or next; 113 | $fpsub->($rec,$self); 114 | } else { 115 | # does not look like TLS, remove unneeded part 116 | substr($$buf,0, length($$buf)-3, '') if length($$buf)>3; 117 | last; 118 | } 119 | } 120 | return length($data); 121 | } 122 | -------------------------------------------------------------------------------- /tls_fingerprint/server.pl: -------------------------------------------------------------------------------- 1 | # Copyright Steffen Ullrich 2023 2 | # License: public domain (no restrictions) 3 | 4 | use strict; 5 | use warnings; 6 | use IO::Socket::SSL; 7 | use IO::Socket::SSL::Utils; 8 | use IO::Socket::IP; 9 | use lib '.'; 10 | use JAX qw(ja3 ja4 ja3s); 11 | 12 | my $addr = $ARGV[0] || "127.0.0.1:4433"; 13 | my $srv = IO::Socket::IP->new( 14 | LocalAddr => $addr, 15 | Listen => 10, 16 | Reuse => 1, 17 | ) or die "failed to listen on $addr: $!"; 18 | 19 | my $cert_and_key = do { local $/; }; 20 | my $ctx = IO::Socket::SSL::SSL_Context->new( 21 | SSL_cert => PEM_string2cert($cert_and_key), 22 | SSL_key => PEM_string2key($cert_and_key), 23 | SSL_server => 1, 24 | SSL_cipher_list => 'DEFAULT:@SECLEVEL=0', 25 | SSL_version => 'SSLv23', 26 | ) or die "failed to create SSL context: $SSL_ERROR"; 27 | 28 | print STDERR "Listening on $addr\n"; 29 | 30 | 31 | while (1) { 32 | my $cl = $srv->accept or next; 33 | $cl = IO::Socket::SSL->start_SSL($cl, 34 | SSL_server => 1, 35 | SSL_reuse_ctx => $ctx, 36 | SSL_startHandshake => 0, 37 | ) or die $!; 38 | 39 | my ($chello, $shello); 40 | $cl->set_msg_callback(\&msgcb, \$chello, \$shello); 41 | $cl->accept_SSL() or die "SSL handshake failed: $SSL_ERROR"; 42 | 43 | print "--- accept from ".$cl->peerhost.":".$cl->peerport."\n"; 44 | print "JA3 ".ja3($chello)."\n"; 45 | print "JA3 raw ".ja3($chello,1)."\n"; 46 | print "JA3N ".ja3($chello,0,1)."\n"; 47 | print "JA3N raw ".ja3($chello,1,1)."\n"; 48 | print "JA4 ".ja4($chello)."\n"; 49 | print "JA4 raw ".ja4($chello,1)."\n"; 50 | print "JA4_o ".ja4($chello,0,0)."\n"; 51 | print "JA4_o raw ".ja4($chello,1,0)."\n"; 52 | print "JA3S ".ja3s($shello)."\n"; 53 | print "JA3S raw ".ja3s($shello,1)."\n"; 54 | print "JA3SN ".ja3s($shello,0,1)."\n"; 55 | print "JA3SN raw ".ja3s($shello,1,1)."\n"; 56 | } 57 | 58 | 59 | sub msgcb { 60 | my ($self, $direction, $ssl_ver, $content_type, $buf, $len, $ssl, $chello_r, $shello_r) = @_; 61 | $content_type == 22 or return; # TLS handshake 62 | # 1 byte: msg type 63 | # 3 byte: length 64 | (my $msg_type, $buf) = unpack('c x3 a*', $buf); 65 | if ($msg_type == 1) { # Client Hello 66 | $$chello_r = $buf; 67 | } elsif ($msg_type == 2) { # Server Hello 68 | $self->set_msg_callback(undef); # no need to look further 69 | $$shello_r = $buf; 70 | } 71 | } 72 | 73 | __DATA__ 74 | -----BEGIN CERTIFICATE----- 75 | MIIDYTCCAkmgAwIBAgIFANkVla8wDQYJKoZIhvcNAQELBQAwIjEgMB4GA1UEAwwX 76 | SU86OlNvY2tldDo6U1NMIERlbW8gQ0EwHhcNMjIxMjExMTk1MzQxWhcNMzIxMjA4 77 | MTk1MzQxWjAXMRUwEwYDVQQDDAxzZXJ2ZXIubG9jYWwwggEiMA0GCSqGSIb3DQEB 78 | AQUAA4IBDwAwggEKAoIBAQCnMcTzSybDMjCCFTfPPzOltpavJ1cvOQ4X99q7jQph 79 | 2dTGx1feefwcuKJl3eEuwiV/y6MWWkjJVC1vICSu2BuBhL76jCgl0mKIQbN3jVpS 80 | KtqnytRGVvGvB3AP71RMzRXaI0xiwRsjvXnBhliTaYBtbpVqry1Cx7eouxeveRxx 81 | 3+5dfBNU0i9U18EZPl99Yl2z2Z6OvzT0ULJl9cWP90UKrX16G5eH8vHrMwm02rpn 82 | i+7u0o7O9a7/xQV28cSoEgp2Cnbg0ZUXbmQS4aYDqIkpS2GlOL8eV26KvM2hYX7h 83 | qy0CsrjJ4riJd+YhmGRsPH3DBGjB/kRX8NhAP2+tblc/AgMBAAGjgagwgaUwHQYD 84 | VR0OBBYEFHW7Ml+/HDstKVpiCxHde7b+VttWMB8GA1UdIwQYMBaAFEnT2LwqEtZv 85 | wVkEbtlv/7SmEt9cMB0GA1UdEQQWMBSCDHNlcnZlci5sb2NhbIcEfwAAATAMBgNV 86 | HRMBAf8EAjAAMA4GA1UdDwEB/wQEAwIFoDARBglghkgBhvhCAQEEBAMCBkAwEwYD 87 | VR0lBAwwCgYIKwYBBQUHAwEwDQYJKoZIhvcNAQELBQADggEBAKA5/2fl2oRtBnUj 88 | Zr+a2Z1uc+oTP03VPT/w46uolz27MqgQyBiSX+a2WWFWZJZFDK6jv3Yd1C7j+KOm 89 | V7sbHOhoIGDwQC55vwdlc5r72RYZOuZSFtujvaABEZ+vF8AHnI3PbiShedL/bK2N 90 | yZYWtBj4Lbl1Hb9I+AjOY5TJ5zcenyS5hIEYXZgV0NH5Thf4zMIKrRZ6//3XcN5n 91 | zT7nMyPTqh0nYIAblmOKvYu6RJQ29BL8FyNmNXjItr3HjaKIxZry7apvwrHBt+a7 92 | bLQzc5e8/cb06gTHZJYdsWDBT6Mv81jNFA/d2OEbpWCNH4ySLPHCBItMmWTxZR87 93 | D7hgP1A= 94 | -----END CERTIFICATE----- 95 | -----BEGIN PRIVATE KEY----- 96 | MIIEvAIBADANBgkqhkiG9w0BAQEFAASCBKYwggSiAgEAAoIBAQCnMcTzSybDMjCC 97 | FTfPPzOltpavJ1cvOQ4X99q7jQph2dTGx1feefwcuKJl3eEuwiV/y6MWWkjJVC1v 98 | ICSu2BuBhL76jCgl0mKIQbN3jVpSKtqnytRGVvGvB3AP71RMzRXaI0xiwRsjvXnB 99 | hliTaYBtbpVqry1Cx7eouxeveRxx3+5dfBNU0i9U18EZPl99Yl2z2Z6OvzT0ULJl 100 | 9cWP90UKrX16G5eH8vHrMwm02rpni+7u0o7O9a7/xQV28cSoEgp2Cnbg0ZUXbmQS 101 | 4aYDqIkpS2GlOL8eV26KvM2hYX7hqy0CsrjJ4riJd+YhmGRsPH3DBGjB/kRX8NhA 102 | P2+tblc/AgMBAAECggEABJVkCtodPpivpRaj0wtZL8p+UwrxuZpc0oy5nblTdt9G 103 | lV8oVNxklvz7fBjFxZxjnsnxt05+VFakcDl3XVEQtU+dqgy8RQfW1QQdbBefSZq3 104 | J9vIT1gELteLW5nPZn5GLRbD+f5v7147FPJz7Ial6K9xaof8O6px/y7cirOinf80 105 | Ll73KxTyb7amgAxJS34/STSHvBGUu0RYUQWX7cXllqONn+zZ+fgiertwervHYH+7 106 | rkcbAsG3AGZtXJ20K20qOmc5QvtIdu0OGvRdW861ZYCNgEcUaeO7Lvt9CrOZyhUe 107 | lqGw22cxJevIPUEoJY4gyNY3SV/WmqG+QKOIK4IuMQKBgQDoqpVvkp3Q47GsG6Dr 108 | skTgIv9Aof7/4fv9dHNYWYaUzQMGW2uxr7Dy6yuvhkplwjVTYxmZrwcKeT0L4wuu 109 | ofhSPRKH7h4o3CVZI9QSz6hrk15u9oKvqmN9W5FOj5ZaXxcdT1NHVENGMYl08E2J 110 | dzLgTJPFPnCEWiZKEE0QSLW4LQKBgQC39kalXeDAMDXR7Db0ui1Wgfc0hL0NuDim 111 | HrzmgtZrZCoYZLjvm1pYQ0sxZ/8S97oh3HKTZh83plbmDQzTRjgSJTGLp0utRTuY 112 | 2TuyJURurX2SJggg+6yL0o2eS1yA4t1Mb2onr49o4DSeEggRML9hAY3Ihg2cTYiy 113 | ImTQ8vekmwKBgC+4nUHvLpNjwFNur0jonZvjUbtt/qF5Nng75FSguCvZCN/K7IHb 114 | aU3J0oID50qL1OgvkVamQalySIUhoonFCuvDPwPGYUU8MiTgZmUdVowKA/p6cT+a 115 | kSFrIJiedtY+Xr1SQeCFde71xh3IE/84BaVfz4dLUUS0QNo8EbJfV3ZZAoGACbwS 116 | iPWqywDCGFWzosenVoiSGEld57fz53aA8IHD7vLh92B9GNDTuw/0jqy+JrbNNrV/ 117 | qqUgycUXnBzcrOFuXidxs74qlwSu3qvAKPEn6eNsXat9iqFGxC9kJxg90OQwabcL 118 | mwYDRL14i1TQ8Hfv6KY4ZoARgE/qB+MiCpyQ1jkCgYAD3jMZAYaxp11Zl0qxffCT 119 | AQZkah+tTA8tC0TYSNxUUq18nnU8gvLuIF8YUt/HJkFajA9GQkA0rg+KUZ3ig3n2 120 | VfwHCMf0HGH90jc9wRQRd0FlkaAn68e5t3/eCAoQFnN65iit+ODR8isqTqRISMJt 121 | nL6o91SHe9luE7bU49fnVQ== 122 | -----END PRIVATE KEY----- 123 | --------------------------------------------------------------------------------