├── .gitignore ├── .includepath ├── .project ├── .travis.yml ├── Build.PL ├── Changes ├── LICENSE ├── MANIFEST ├── MANIFEST.SKIP ├── README.md ├── TODO.txt ├── bin ├── check_ciphers_single_domains.pl ├── csv-result-to-summary.pl ├── ext │ └── check-ssl-heartbleed.pl ├── helper │ ├── check-timeout-jitter--ihk-server.sh │ ├── check-timeout-jitter.sh │ ├── dump-ciphers.pl │ ├── extract-dummy-domains.sh │ ├── extract-scores.pl │ ├── osaft-cipherlist-to-complete-perl.pl │ ├── sslaudit.ini │ └── tmp_OLD_osaft-cipherlist-converter.pl ├── tls-check ├── tls-check-parallel.pl └── tls-check.pl ├── conf ├── tls-check-logging.properties └── tls-check.conf ├── files ├── CipherSuites │ └── tls-parameters-4.csv └── DomainFilter │ └── tlds-alpha-by-domain.txt ├── lib ├── Log │ └── Log4perl │ │ └── EasyCatch.pm ├── MooseX │ └── ListAttributes.pm ├── Net │ └── SSL │ │ ├── CipherSuites.pm │ │ ├── GetServerProperties.pm │ │ ├── Handshake.pm │ │ └── Handshake │ │ ├── Extensions.pm │ │ ├── Extensions │ │ ├── ECPointFormats.pm │ │ ├── EllipticCurves.pm │ │ └── ServerName.pm │ │ └── StartTLS │ │ └── SMTP.pm └── Security │ ├── TLSCheck.pm │ └── TLSCheck │ ├── App.pm │ ├── App │ ├── DomainFilter.pm │ └── Parallel.pm │ ├── Checks.pm │ ├── Checks │ ├── AgeDE.pm │ ├── CipherStrength.pm │ ├── CipherStrengthOnlyValidCerts.pm │ ├── DNS.pm │ ├── Dummy.pm │ ├── FinalScore.pm │ ├── Heartbleed.pm │ ├── Helper │ │ ├── MX.pm │ │ └── Timing.pm │ ├── Mail.pm │ ├── MailCipherStrength.pm │ ├── TODO.txt │ └── Web.pm │ ├── Result.pm │ └── Result │ └── CSV.pm └── t ├── 000-load.t ├── 110-ciphersuites.t ├── 120-ssl-handshake.t ├── 122-ssl-handshake-smtp-starttls.t ├── 201-main.t ├── 221-domain_filter.t ├── 401-checks-base.t ├── 501-dns.t ├── 510-web.t ├── 900-perlcritic.t ├── 910-boilerplate.t ├── 920-manifest.t ├── 930-pod-coverage.t ├── 931-pod.t ├── log-test.properties ├── manual └── check_lwp_preload.pl ├── one-testdomain.txt ├── perlcriticrc ├── perltidyrc ├── ssl ├── server.pem └── test.html ├── testdomains.txt └── umlautdomain.txt /.gitignore: -------------------------------------------------------------------------------- 1 | /blib/ 2 | /.build/ 3 | _build/ 4 | cover_db/ 5 | inc/ 6 | Build 7 | !Build/ 8 | Build.bat 9 | .last_cover_stats 10 | /Makefile 11 | /Makefile.old 12 | /MANIFEST.bak 13 | /META.yml 14 | /META.json 15 | /MYMETA.* 16 | nytprof.out 17 | /pm_to_blib 18 | *.o 19 | *.bs 20 | /_eumm/ 21 | .lwpcookies 22 | Security-TLS-Check-* 23 | Security-TLS-Check-*.tar.gz 24 | /tmp/ 25 | /work/ 26 | /logs/ 27 | /ext-doc/ 28 | /result/ 29 | /results/ 30 | out.html 31 | run-localdummy.sh 32 | testresult.csv 33 | get-results.sh 34 | /more-testdomains/ 35 | /.svn/ 36 | /MANIFEST.SKIP.bak 37 | /t/logs/ 38 | /svn-commit.tmp 39 | /Makefile.PL 40 | 41 | META-INF/MANIFEST.MF 42 | 43 | build.properties 44 | -------------------------------------------------------------------------------- /.includepath: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | -------------------------------------------------------------------------------- /.project: -------------------------------------------------------------------------------- 1 | 2 | 3 | TLS-Check 4 | 5 | 6 | 7 | 8 | 9 | org.epic.perleditor.perlbuilder 10 | 11 | 12 | 13 | 14 | org.eclipse.pde.ManifestBuilder 15 | 16 | 17 | 18 | 19 | org.eclipse.pde.SchemaBuilder 20 | 21 | 22 | 23 | 24 | 25 | org.epic.perleditor.perlnature 26 | org.eclipse.pde.PluginNature 27 | 28 | 29 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # 2 | # Enable Testing with Travis CI 3 | # See https://travis-ci.org/ 4 | # 5 | 6 | language: perl 7 | perl: 8 | - "5.24" 9 | - "5.22" 10 | - "5.20" 11 | - "5.18" 12 | - "5.16" 13 | # Skip, because dependency installation problems: - "5.14" 14 | 15 | # libidn11 for full IDN support in Net::DNS 16 | before_install: 17 | - sudo apt-get -qq update 18 | - sudo apt-get install -y libidn11-dev 19 | 20 | -------------------------------------------------------------------------------- /Build.PL: -------------------------------------------------------------------------------- 1 | use 5.016; 2 | use strict; 3 | use warnings FATAL => 'all'; 4 | use Module::Build; 5 | 6 | my $builder = Module::Build->new( 7 | module_name => 'Security::TLSCheck', 8 | license => 'artistic_2', 9 | dist_author => q{Alvar C.H. Freude }, 10 | dist_version_from => 'lib/Security/TLSCheck.pm', 11 | release_status => 'testing', 12 | configure_requires => { 13 | 'Module::Build' => 0, 14 | }, 15 | test_requires => { 16 | 'Test::More' => 0, 17 | 'Test::Exception' => 0.25, 18 | 'Test::MockObject' => 1.20140408, 19 | 'Test::LWP::UserAgent' => 0.025, 20 | 'Test::File' => 1.41, 21 | 'Test::Differences' => 0.62, 22 | 'Test::Deep' => 0.113, 23 | 'Test::Perl::Critic' => 1.03, 24 | 'Test::Pod::Coverage' => 1.08, 25 | 'Test::Pod' => 1.22, 26 | 'IPC::Run' => 0.90, 27 | }, 28 | 29 | share_dir => { 30 | module => { 31 | 'Net::SSL::CipherSuites' => [ 'files/CipherSuites', ], 32 | 'Security::TLSCheck::App::DomainFilter' => [ 'files/DomainFilter', ], 33 | 'Security::TLSCheck' => [ 'conf', 'bin/ext', ], 34 | }, 35 | 36 | }, 37 | 38 | # TODO: 39 | # Check minimal required versions! 40 | # this versions are set to my installed versions at writing time ... 41 | # usually it should work with older versions of this modules, but this 42 | # is not tested. 43 | requires => { 44 | 'Moose' => 2.1213, 45 | 'MooseX::Getopt' => 0.65, 46 | 'MooseX::SimpleConfig' => 0.10, 47 | 'Net::DNS' => 0.80, 48 | 'Log::Log4perl' => 1.44, 49 | 'Net::LibIDN' => 0.12, # Needed by Net::DNS 50 | 'Net::DNS::RR::DS' => 0.20, 51 | 'LWP::Protocol::https' => 6.06, 52 | 'Text::CSV_XS' => 1.11, 53 | 'IO::All' => 0.79, 54 | 'Config::General' => 2.56, 55 | 'Readonly' => 2, 56 | 'Mozilla::CA' => 20141217, 57 | 'Net::SMTP' => 3.04, 58 | 'IO::Socket::Timeout' => 0.29, 59 | 'File::ShareDir' => 1.102, 60 | 'IO::Socket::SSL' => 2.016, 61 | 'LWP::UserAgent' => 6.06, 62 | 'PerlIO::via::Timeout' => 0.30, 63 | 'Parallel::ForkManager' => 1.11, # make this OPTIONAL! 64 | 'File::HomeDir' => 1.0, 65 | 'Net::IDN::Encode' => 2.202, # maybe replace by Net::LibIDN 66 | 'autodie' => 2.23, # at least version from Perl 5.20, because of sleep bugs 67 | 'LWP::Protocol::https' => 6.0, 68 | 'IO::Socket::Timeout' => 0.32, 69 | 'Net::IDN::Encode' => 2.400, 70 | 'Config::General' => 2.47, 71 | 'Net::DNS' => 1.12, 72 | }, 73 | add_to_cleanup => ['Security-TLSCheck-*'], 74 | create_makefile_pl => 'traditional', 75 | ); 76 | 77 | $builder->create_build_script(); 78 | 79 | 80 | -------------------------------------------------------------------------------- /Changes: -------------------------------------------------------------------------------- 1 | Revision history for TLS-Check 2 | 3 | 0.20 2016-03-31 4 | First public release 5 | 6 | 1.0.0 2016-04-01 7 | Version bump to 1.0 8 | fixed some tests 9 | fixed config file paths and config loading 10 | 11 | 1.0.1 2016-04-01 12 | fixed bug, that config files could not be found 13 | fixed bug, that heartbleed executable was not correctly installed 14 | 15 | 1.0.2 2016-04-01 16 | again fixed missing config files 17 | -------------------------------------------------------------------------------- /MANIFEST: -------------------------------------------------------------------------------- 1 | .includepath 2 | .project 3 | .travis.yml 4 | bin/check_ciphers_single_domains.pl 5 | bin/csv-result-to-summary.pl 6 | bin/ext/check-ssl-heartbleed.pl 7 | bin/helper/check-timeout-jitter--ihk-server.sh 8 | bin/helper/check-timeout-jitter.sh 9 | bin/helper/dump-ciphers.pl 10 | bin/helper/extract-dummy-domains.sh 11 | bin/helper/extract-scores.pl 12 | bin/helper/osaft-cipherlist-to-complete-perl.pl 13 | bin/helper/sslaudit.ini 14 | bin/helper/tmp_OLD_osaft-cipherlist-converter.pl 15 | bin/tls-check 16 | bin/tls-check-parallel.pl 17 | bin/tls-check.pl 18 | Build.PL 19 | Changes 20 | conf/tls-check-logging.properties 21 | conf/tls-check.conf 22 | files/CipherSuites/tls-parameters-4.csv 23 | files/DomainFilter/tlds-alpha-by-domain.txt 24 | lib/Log/Log4perl/EasyCatch.pm 25 | lib/MooseX/ListAttributes.pm 26 | lib/Net/SSL/CipherSuites.pm 27 | lib/Net/SSL/GetServerProperties.pm 28 | lib/Net/SSL/Handshake.pm 29 | lib/Net/SSL/Handshake/Extensions.pm 30 | lib/Net/SSL/Handshake/Extensions/ECPointFormats.pm 31 | lib/Net/SSL/Handshake/Extensions/EllipticCurves.pm 32 | lib/Net/SSL/Handshake/Extensions/ServerName.pm 33 | lib/Net/SSL/Handshake/StartTLS/SMTP.pm 34 | lib/Security/TLSCheck.pm 35 | lib/Security/TLSCheck/App.pm 36 | lib/Security/TLSCheck/App/DomainFilter.pm 37 | lib/Security/TLSCheck/App/Parallel.pm 38 | lib/Security/TLSCheck/Checks.pm 39 | lib/Security/TLSCheck/Checks/AgeDE.pm 40 | lib/Security/TLSCheck/Checks/CipherStrength.pm 41 | lib/Security/TLSCheck/Checks/CipherStrengthOnlyValidCerts.pm 42 | lib/Security/TLSCheck/Checks/DNS.pm 43 | lib/Security/TLSCheck/Checks/Dummy.pm 44 | lib/Security/TLSCheck/Checks/FinalScore.pm 45 | lib/Security/TLSCheck/Checks/Heartbleed.pm 46 | lib/Security/TLSCheck/Checks/Helper/MX.pm 47 | lib/Security/TLSCheck/Checks/Helper/Timing.pm 48 | lib/Security/TLSCheck/Checks/Mail.pm 49 | lib/Security/TLSCheck/Checks/MailCipherStrength.pm 50 | lib/Security/TLSCheck/Checks/TODO.txt 51 | lib/Security/TLSCheck/Checks/Web.pm 52 | lib/Security/TLSCheck/Result.pm 53 | lib/Security/TLSCheck/Result/CSV.pm 54 | LICENSE 55 | MANIFEST This list of files 56 | README.md 57 | t/000-load.t 58 | t/110-ciphersuites.t 59 | t/120-ssl-handshake.t 60 | t/122-ssl-handshake-smtp-starttls.t 61 | t/201-main.t 62 | t/221-domain_filter.t 63 | t/401-checks-base.t 64 | t/501-dns.t 65 | t/510-web.t 66 | t/900-perlcritic.t 67 | t/910-boilerplate.t 68 | t/920-manifest.t 69 | t/930-pod-coverage.t 70 | t/931-pod.t 71 | t/log-test.properties 72 | t/manual/check_lwp_preload.pl 73 | t/one-testdomain.txt 74 | t/perlcriticrc 75 | t/perltidyrc 76 | t/ssl/server.pem 77 | t/ssl/test.html 78 | t/testdomains.txt 79 | t/umlautdomain.txt 80 | TODO.txt 81 | -------------------------------------------------------------------------------- /MANIFEST.SKIP: -------------------------------------------------------------------------------- 1 | # Avoid version control files. 2 | \bRCS\b 3 | \bCVS\b 4 | \bSCCS\b 5 | ,v$ 6 | \B\.svn\b 7 | \B\.git\b 8 | \B\.gitignore\b 9 | \b_darcs\b 10 | \B\.cvsignore$ 11 | 12 | # Avoid VMS specific MakeMaker generated files 13 | \bDescrip.MMS$ 14 | \bDESCRIP.MMS$ 15 | \bdescrip.mms$ 16 | 17 | # Avoid Makemaker generated and utility files. 18 | \bMANIFEST\.bak 19 | \bMakefile$ 20 | \bblib/ 21 | \bMakeMaker-\d 22 | \bpm_to_blib\.ts$ 23 | \bpm_to_blib$ 24 | \bblibdirs\.ts$ # 6.18 through 6.25 generated this 25 | 26 | # Avoid Module::Build generated and utility files. 27 | \bBuild$ 28 | \b_build/ 29 | \bBuild.bat$ 30 | \bBuild.COM$ 31 | \bBUILD.COM$ 32 | \bbuild.com$ 33 | 34 | # Avoid temp and backup files. 35 | ~$ 36 | \.old$ 37 | \#$ 38 | \b\.# 39 | \.bak$ 40 | \.tmp$ 41 | \.# 42 | \.rej$ 43 | 44 | # Avoid OS-specific files/dirs 45 | # Mac OSX metadata 46 | \B\.DS_Store 47 | # Mac OSX SMB mount metadata files 48 | \B\._ 49 | 50 | # Avoid Devel::Cover and Devel::CoverX::Covered files. 51 | \bcover_db\b 52 | \bcovered\b 53 | 54 | # Avoid MYMETA files 55 | ^MYMETA\. 56 | 57 | # Avoid configuration metadata file 58 | ^MYMETA\. 59 | 60 | # Avoid Module::Build generated and utility files. 61 | \bBuild$ 62 | \bBuild.bat$ 63 | \b_build 64 | \bBuild.COM$ 65 | \bBUILD.COM$ 66 | \bbuild.com$ 67 | ^MANIFEST\.SKIP 68 | ^MANIFEST\.bak 69 | 70 | # Avoid archives of this distribution 71 | \bSecurity-TLSCheck-[\d\.\_]+ 72 | 73 | # 74 | ^META.json 75 | ^META.yml 76 | 77 | 78 | # my own, local 79 | ext-doc 80 | ^results?\b 81 | out\.html 82 | run-localdummy.sh$ 83 | testresult.csv 84 | ^get-results.sh$ 85 | \bmore-testdomains\b 86 | \btmp\b 87 | \bwork\b 88 | \blogs\b 89 | ^Makefile.PL 90 | 91 | 92 | # Eclipse -- NO, include it! 93 | # \.includepath$ 94 | 95 | # Eclipse disabled files 96 | ^build.properties 97 | ^META-INF 98 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | [![Build Status](https://travis-ci.org/tls-check/TLS-Check.svg?branch=master)](https://travis-ci.org/tls-check/TLS-Check) 2 | 3 | # TLS-Check – Collect information about domains and their servers 4 | 5 | TLS-Check is 6 | 7 | 1. a modular framework for collecting and summarizing arbitrary key figures for a lot of domains and their running servers (usually Web- and Mailserver) 8 | 2. a software for analyzing and summarizing the security and encryption of given domains, e.g. supported SSL/TLS-Versions and cipher suites. 9 | 10 | Its primary goal is to get key figures about SSL/TLS connections. It can count how many servers support encryption or not, good or weak SSL/TLS-Versions, good or weak cipher suites, how many websites or mailservers are vulnerable to security problems like Heartbleed, how many support IPv6, how many support all recommendations of the BSI or Bettercrypto project and much much more. 11 | 12 | TLS-Check comes with a lot of checks. But it is very easy to add more tests. It is highly modular and each part of the code can be replaced (e.g. input or output). 13 | 14 | Development contracted by Chamber of Commerce and Industry of the Stuttgart (Germany) Region and its committee of information technology, information services and telecommunication. 15 | 16 | 17 | ## Why writing another SSL/TLS testing tool? What are the primary goals? 18 | 19 | There are a lot of tools, which check servers for their SSL/TLS capabilities (e.g. SSLyze, OWASP O-Saft, ssl-cipher-suite-enum, testssl.sh and much more). But none meets all our requirements at starting with TLS-Check in 2014: 20 | 21 | * We need a flexible and extensible tool to check every possible key figure for a given domain – e.g. from counting how many servers support IPv6 or the different top level domains to counting how many supports the really old SSLv2 protocol. 22 | * The most important subtests in TLS-Check are SSL/TLS checks. TLS-Check uses it's own SSL/TLS handshake implementation, because we found no acceptable other solution. Some of the tools for checking SSL/TLS cipher suites are really ugly hacks, violating all best practice rules, have no or very few automated tests, have ugly spaghetti code, are unmaintainable or buggy. TLS-Check is not free of errors, but tries to have testable, extendable, maintainable code. 23 | * It should allow to check every known or unknown cipher suite, not limited to e.g. the cipher suites supported by OpenSSL. Because TLS-Check uses it's own code for SSL/TLS Handshake, it supports every possible ciphersuite. It knows about 362 different cipher suites, 455 with duplicates. 24 | * It should be easy to add new checks: *It makes easy things easy and hard things possible – reliable, testable.* 25 | * Tests must run in parallel to reduce the runtime. 26 | * We have some limitations because of privacy reasons. 27 | * The output should be parseable. The output of TLS-Check is CSV by default, for import in Excel, Numbers, LibreOffice or similar. But it is easy to write a module which outputs the result as JSON, XML or whatever. 28 | 29 | 30 | ## Checks 31 | 32 | TLS-Check comes with the following check modules; they are enabled by default. If a check is dependant on another, then the order is important. The default order is fine. 33 | 34 | For more Documentation see the doc in Security::TLSCheck::Checks::xxx 35 | 36 | * **DNS** – Does some DNS Checks, tests for IPv4 and IPv6 IPs, counts MX (Mail eXchanger). 37 | * **Web** – Basic web tests: check if there is a website and if HTTPS is supported; redirect checks and some more. 38 | * **Mail** - Checks if the MX are reachable an support STARTTLS; DNS must run before, some results are used here. 39 | * **Dummy** – A small and simple example module; counts the top level domains. 40 | * **CipherStrength** – Checks for supported SSL/TLS versions and cipher suites of websites, checks if BSI and Bettercrypto recommendations are met and much more. Web must run first, its output is used. 41 | * **MailCipherStrength** – the same, but for mailserver. Mail must run before. 42 | * **CipherStrengthOnlyValidCerts** – exactly the same as CipherStrength, but counts only web cipher strengths when the certificate is valid. CipherStrength must run first, its result is used. 43 | * **AgeDE** – checks, if a server supports the german age declaration for youth protection and which default/minimum age are given. Web must run first. 44 | * **Heartbleed** – Heartbleed check, web and mail; Web and DNS must run before. 45 | * **FinalScore** – calculates a final score for websites (only websites). Web and CipherStrength must run before. 46 | 47 | As example here a summary of the most important tests of a real life check, generated with TLS-Check and converted with the summary script: 48 | * [TLS-Check summary IHK Region Stuttgart, Q1 2016](https://www.stuttgart.ihk24.de/blob/sihk24/Fuer-Unternehmen/innovation/downloads/3300084/5a1ce6ed286e7385afb6e878a95dcc65/TLS-Check---Zusammenfassung-data.pdf) (in german) 49 | 50 | Full output has much more details. 51 | 52 | 53 | ## Installation 54 | 55 | TLS-Check was developed on FreeBSD and OS X, but also works with Linux. It's not tested on Windows. TLS-Check is written in Perl with Moose and uses a lot of CPAN modules. 56 | 57 | ### Install as packages 58 | 59 | The most easy way to install TLS-Check is using [FreeBSD](https://www.freebsd.org/) and install it as port or package. [FreeBSD](https://www.freebsd.org/) is an [UNIX-like operating system](https://en.wikipedia.org/wiki/FreeBSD) similar to Linux, you may read [FreeBSD Quickstart Guide for Linux Users](https://www.freebsd.org/doc/en/articles/linux-users/article.html) as Linux user. You can download [installer and virtual machine images](https://www.freebsd.org/where.html). 60 | 61 | Installing TLS-Check on FreeBSD is easy and always up to date to the latest release. Login as root and type: 62 | 63 | ```` 64 | # Fast binary install from packages 65 | pkg install security/tls-check 66 | 67 | # or: flexible individual install from ports 68 | cd /usr/ports/security/tls-check && make install clean 69 | ```` 70 | 71 | ### Manual installation on Linux, Solaris, AIX, OS X, …: 72 | 73 | On Linux, OS X and other operating systems you have to install all dependencies and TLS-Check manually. 74 | 75 | #### Install the following dependencies: 76 | 77 | ##### • LibIDN 78 | 79 | If you want to use IDN domain names (with characters other then US-ASCII, e.g. äöü.tld), LibIDN is needed. You should install it with the package manager of your OS, e.g. `apt-get install libidn11-dev` should do this on Debian and Ubuntu. 80 | 81 | ##### • Perl 82 | 83 | TLS-Check is written in Perl and should work with an old Perl 5.10 and is tested with 5.16 and up. 84 | 85 | * Perl is usually installed by your OS. Some Linux distributions deliver broken Perl packages and maybe you should install the perl default modules `perl-modules`. (untested, please report issues here) 86 | * If you don't want to (or can't) install all dependencies with the package manager of your OS, it may be better to install your own Perl to avoid conflicts with system packages. The best way is to use [perlbrew](http://perlbrew.pl) for this. A latest Perl without ithreads and full optimizations (-O3) is recommended. 87 | 88 | ```` 89 | # install perlbrew and the latest stable perl 90 | sudo cpan App::perlbrew # or, if you trust them: wget -O - https://install.perlbrew.pl | bash 91 | perlbrew init 92 | perlbrew install stable --Doptimize='-O3 -march=native -mtune=native' --switch 93 | ```` 94 | 95 | ##### • `Module::Build`, Perl Build manager 96 | 97 | On some Perl versions this is already installed, you can check this with: 98 | 99 | ``` 100 | perl -MModule::Build -E 'say "Module-Build-version installed: $Module::Build::VERSION"' 101 | ``` 102 | 103 | When there is an error message, you should install `Module::Build`, either with your package manager or via CPAN: 104 | 105 | ``` 106 | cpan Module::Build 107 | ``` 108 | 109 | `Module::Build`is only needed at build time, not for running TLS-Check. 110 | 111 | #### Install TLS-Check 112 | 113 | At the moment TLS-Check is not yet available on CPAN. So, you have to install it manually: Download and unpack TLS-Check. **Do not unpack it on Windows:** Windows has no Symlinks and some files will be broken. 114 | 115 | Then run in the main source directory: 116 | 117 | perl Build.PL 118 | 119 | It may complain about missing dependencies. Install them manually with your favorite package manager, install them manually via CPAN or use the buildin CPAN installer: 120 | 121 | ./Build installdeps 122 | 123 | Because CPAN runs a lot of tests, this may take a long time. You can install all dependencies without testing by calling: 124 | 125 | cpanm --installdeps --notest . 126 | 127 | If you want to do DNS checks on IDN-Domains, the installation of the `Net::LibIDN` module is necessary. But this needs the LibIDN library, so you should install this before, see above. 128 | 129 | Then you may install TLS-Check: 130 | 131 | ./Build install 132 | 133 | As alternative you can start everything without installing directly from `bin`, e.g. as `bin/tls-check-parallel.pl`. 134 | 135 | 136 | ## Example Usage 137 | 138 | ### Short summary 139 | 140 | tls-check-parallel.pl --files=path/to/domain-file.txt --outfile=results/my-result.csv 141 | csv-result-to-summary.pl results/my-result.csv > result/summary.csv 142 | 143 | You may also run it without parameter, then it gets input from STDIN and writes the result to STDOUT. 144 | 145 | csv-result-to-summary.pl is a hack to extract the most important results and create an easy to read CSV, which can be used with LibreOffice, Excel, Numbers, … But at the moment the descriptions of the summary are in german. 146 | 147 | You can also use the full result (which is also CSV), but it's harder to read. 148 | 149 | ### More detailed usage 150 | 151 | After installation there are some new executables: 152 | 153 | tls-check.pl 154 | tls-check-parallel.pl 155 | tls-check (symlink to tls-check-parallel.pl) 156 | 157 | They are the same, but, tls-check-parallel can query domains in parallel. 158 | 159 | Usage: 160 | 161 | > tls-check-parallel.pl --help 162 | usage: tls-check-parallel.pl [-?h] [long options...] 163 | --configfile STR Configuration file 164 | --jobs INT Number of max. parallel worker jobs 165 | --log_config STR Alternative logging config 166 | --checks STR... List of checks to run 167 | --user_agent_name STR UserAgent string for web checks 168 | --my_hostname STR Hostname for SMTP EHLO etc. 169 | --timeout INT Timeout for networking 170 | --separator STR CSV Separator char(s) 171 | --files STR... List of files with domain names to check 172 | --verbose Verbose Output/Logging 173 | --temp_out_interval INT Produce temporary output every # Domains 174 | -h -? --usage --help Prints this usage information. 175 | --undef_string STR String for undef with show_options 176 | --show_options List all Options 177 | --results KEY=STR... 178 | --outfile STR Output file name; - for STDOUT (default) 179 | 180 | Each config parameter can be set in the configuration file. This is searched in the following places: 181 | 182 | ~/.tls-check.conf 183 | /usr/local/etc/tls-check.conf 184 | /etc/tls-check.conf 185 | /tls-check.conf 186 | 187 | You can view the default and used values by adding `--show_options`: 188 | 189 | tls-check-parallel.pl --show_options 190 | tls-check-parallel.pl --configfile=~/my-config.conf --show_options 191 | 192 | The domain file is a CSV and has one or more colums: first column is a domain name, the second a category; so it looks usually like: 193 | 194 | domain.tld;Category 195 | other-domain.tld;Other Category 196 | 197 | It's OK to have no category, so the file simply contains one domain per line. 198 | 199 | If you have enough memory it's OK to set --jobs to a high value (e.g. 50 when running all checks on a 4 core machine with 16 GB RAM or more when not running all checks). But at the moment the parallel mode is not optimal, because it spawns a new process for every domain. 200 | 201 | The result file is a CSV with a lot of detailed results. You can read it with Excel, LibreOffice, Numbers or any other spreadsheet program. 202 | 203 | You can use `csv-result-to-summary.pl` to get a summary of the result: 204 | 205 | csv-result-to-summary.pl results/my-result.csv > result/summary.csv 206 | 207 | This script uses standard unix input/output via one or more file or STDIN (for input) and prints the result to STDOUT, so you can redirect this everywhere. 208 | 209 | If you want your own summary, you may change `csv-result-to-summary.pl`. It's a little bit hacky, but works. 210 | 211 | 212 | ### Logfiles 213 | 214 | You find log files (trace, info and error) usually in ~/.perl/dist/TLS-Check by default, or in your data-directory if your OS supports this. When running without installation, the logfiles will be stored in the logs folder in die main diretory. 215 | 216 | 217 | ## Bugs 218 | 219 | It's sure, that there are bugs. Please report them, patches and fixes are welcome. 220 | 221 | ### Known other issues 222 | 223 | * Some documentation (POD) for code and internal API should be (re)written 224 | * Parallel fork mode does not scale well, should be rewritten with a fork pool and queue handling 225 | * Some tests are written for execution in my local development environment, should be rewritten 226 | * write more and better tests, e.g. with different SSL implementations 227 | * Single standalone program for getting SSL/TLS properties should be rewritten (Net::SSL::GetServerProperties module should provide list of all checks) 228 | * Split some modules into extra Distributions (e.g. Net::SSL::xxx Modules) 229 | * publish everything on CPAN (after splitting in distributions) 230 | * There are some other TODOs … ;-) 231 | * MX handling works as expected, but should be rewritten, e.g. to better handle categories 232 | * Heartbleed check uses external executable; should be implemented as module. 233 | 234 | 235 | ## Mailing list and support 236 | 237 | There is a mailing list. Until there is much traffic, we have only one for developers and users together. 238 | 239 | * [Info Page](https://lists.odem.org/sympa/info/tls-check) 240 | * [Subscribe via web interface](https://lists.odem.org/sympa/subscribe/tls-check) 241 | * To subscribe via mail, send a mail to [sympa@lists.odem.org with Subject "subscribe tls-check"](mailto:sympa@lists.odem.org?subject=subscribe%20tls-check) 242 | 243 | 244 | ## Author 245 | 246 | TLS-Check is written by [Alvar C.H. Freude](http://alvar.a-blast.org/), 2014–2016. 247 | 248 | Development contracted by Chamber of Commerce and Industry of the Stuttgart (Germany) Region and its committee of information technology, information services and telecommunication. 249 | 250 | https://www.stuttgart.ihk24.de 251 | 252 | ## Links 253 | 254 | * [TLS-Check page, IHK Region Stuttgart](https://www.stuttgart.ihk24.de/Fuer-Unternehmen/innovation/E-Businessberatung/IT-Sicherheits-Check/664320) (in german) 255 | * [TLS-Check summary IHK Region Stuttgart, Q1 2016](https://www.stuttgart.ihk24.de/blob/sihk24/Fuer-Unternehmen/innovation/downloads/3300084/5a1ce6ed286e7385afb6e878a95dcc65/TLS-Check---Zusammenfassung-data.pdf); output from the TLS-Check summary script (in german) 256 | * [Description TLS Check and results](https://www.stuttgart.ihk24.de/blob/sihk24/Fuer-Unternehmen/innovation/downloads/3300070/801b0ef29405c1710223f9a76bc24c06/TLS-Check-Ergebnisse-data.pdf) (in german) 257 | * [Bettercrypto project](https://bettercrypto.org), [Bettercrypto guide](https://bettercrypto.org/static/applied-crypto-hardening.pdf) with copy&paste configuration examples for hardening your servers (in english) 258 | * [BSI Guideline TR-01102-2](https://www.bsi.bund.de/SharedDocs/Downloads/DE/BSI/Publikationen/TechnischeRichtlinien/TR02102/BSI-TR-02102-2.html) (in german) 259 | * [Press Release IHK Region Stuttgart](https://www.stuttgart.ihk24.de/presse/Pressemitteilungen/IHK-Pressemitteilungen_2016/Januar-bis-Maerz_2016/PM-Nr--17-Sicherheitscheck/3302518) to the first public launch (in german) 260 | 261 | ## License 262 | 263 | TLS-Check is licensed under the [Artistic License 2.0](https://opensource.org/licenses/Artistic-2.0) or the [European Public Licence 1.1 (EUPL)](https://joinup.ec.europa.eu/community/eupl/og_page/european-union-public-licence-eupl-v11). 264 | 265 | 266 | -------------------------------------------------------------------------------- /TODO.txt: -------------------------------------------------------------------------------- 1 | 2 | * Add mode to take domain names on CLI 3 | * Add output mode: result for each domain in human readable form. 4 | => Activate automatically when taking domain names on CLI. 5 | 6 | * i18n csv-result-to-summary.pl for other languages then german ... ;-) 7 | 8 | 9 | * store if web check was successful with www. or without; => use this in CipherStrengts 10 | 11 | * New Subtests: 12 | * See TODO.txt in the Checks folder 13 | 14 | * Score: OpenSource vs non OSS Webserver? 15 | 16 | 17 | * ? Change int types to num? 18 | 19 | * support multiple categories per domain 20 | => Split category: A1, A2, A3; B1; B2; B3? 21 | 22 | 23 | * MX: Debug hostname mismatch (...) 24 | * MX: new check, type group: starttls_error 25 | 26 | * Check remaining ERROR/WARN log messages 27 | * mostly done 28 | 29 | 30 | * Rewrite parallel mode with fork pool and queue to speed up everything 31 | * maybe use MCE for this, see: 32 | https://github.com/marioroy/mce-perl 33 | http://search.cpan.org/dist/MCE/lib/MCE.pod 34 | 35 | * Build ready-to-use images for VMware, VirtualBox, iocage etc. 36 | 37 | * Check result when connecting Exim with unreadable cert 38 | 39 | * Loop through IP ranges an check IP-Adresses 40 | 41 | => Some thoughts to this in german: 42 | 43 | In Security::TLSCheck::App etwa bei Zeile 220 müsste das eingebaut werden; evtl. könnte auch filter_domain eine Liste statt einer einzelnen Domain zurückgeben. 44 | Und um den Rest danach halt eine Formach-Schleife. 45 | 46 | Das Problem ist nur, dass eben die Methoden ->www und ->domain entsprechend www.meine-domain.tld oder meine-domain.tld zurückgeben; da müsste an mehreren Stellen der Code angepasst werden. z.B. könnte ->www und ->domain einfach die IP zurückgeben, aber dann müsste verhindert werden, dass anschließend u.U. noch ->domain getestet wird – zum Beispiel via Bool-Attribut „is_ipaddr“, was bei IP-Adressen gesetzt wird. Es gibt aber keine MX, da würde dann die IP an sich hergenommen werden. 47 | 48 | Aber besser wäre wahrscheinlich, insgesamt einen sauberen Mechanismus einzuführen, der www-Domain, Domain und IP unterscheidet und nach dem/den ersten Test(s) das richtige fix setzt. 49 | 50 | 51 | Das Herausfinden der IP-Adressen könnte via http://search.cpan.org/~manu/Net-IP/IP.pm gehen 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | -------------------------------------------------------------------------------- /bin/check_ciphers_single_domains.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | ## no critic 3 | 4 | # TODO: This is a hack and will be changed 5 | 6 | use strict; 7 | use warnings; 8 | 9 | use FindBin qw($Bin); 10 | use lib "$Bin/../lib"; 11 | use English qw( -no_match_vars ); 12 | 13 | 14 | use Net::SSL::GetServerProperties; 15 | 16 | use 5.010; 17 | 18 | say "-- "; 19 | say "-- TLS-Check / Net::SSL::GetServerProperties -- Version $Net::SSL::GetServerProperties::VERSION"; 20 | say "-- Small helper for getting a quick (and incomplete) overview of one or more hosts"; 21 | say "-- It's more an example for the API of Net::SSL::GetServerProperties then an analysis program!"; 22 | say "-- "; 23 | say "-- TLS-Check is at the moment made for mass analysis, not individual analysis of single domains."; 24 | say "-- Nevertheless you can use it for single domain analysis, but it is neither complete nor perfect ..."; 25 | say "-- "; 26 | say "-- usage: $PROGRAM_NAME [ ... ]"; 27 | say "-- "; 28 | 29 | foreach my $host (@ARGV) 30 | { 31 | 32 | my $prop = Net::SSL::GetServerProperties->new( host => $host, ); 33 | $prop->get_properties; 34 | 35 | say ""; 36 | say "Summary for $host"; 37 | say "Supported Cipher Suites at Host $host: "; 38 | say " * 0x$_->{code} $_->{name}" foreach @{ $prop->accepted_ciphers->order_by_code->ciphers }; 39 | say "Supports SSLv2" if $prop->supports_sslv2; 40 | say "Supports SSLv3" if $prop->supports_sslv3; 41 | say "Supports TLSv1" if $prop->supports_tlsv1; 42 | say "Supports TLSv1.1" if $prop->supports_tlsv11; 43 | say "Supports TLSv1.2" if $prop->supports_tlsv12; 44 | 45 | say "Supports at least one Bettercrypto A Cipher Suite" if $prop->supports_any_bc_a; 46 | say "Supports at least one Bettercrypto B Cipher Suite" if $prop->supports_any_bc_b; 47 | say "Supports at least one BSI TR-02102-2 Cipher Suite with PFS" if $prop->supports_any_bsi_pfs; 48 | say "Supports at least one BSI TR-02102-2 Cipher Suite with or without PFS" if $prop->supports_any_bsi_nopfs; 49 | 50 | say "Supports only Bettercrypto A Cipher Suites" if $prop->supports_only_bc_a; 51 | say "Supports only Bettercrypto B Cipher Suites" if $prop->supports_only_bc_b; 52 | say "Supports only BSI TR-02102-2 Cipher Suites with PFS" if $prop->supports_only_bsi_pfs; 53 | say "Supports only BSI TR-02102-2 Cipher Suites with or without PFS" if $prop->supports_only_bsi_nopfs; 54 | 55 | say "Supports weak Cipher Suites: " . $prop->weak_ciphers->names if $prop->supports_weak; 56 | say "Supports medium Cipher Suites: " . $prop->medium_ciphers->names if $prop->supports_medium; 57 | say "Supports no weak or medium Cipher Suites, only high or unknown" if $prop->supports_no_weakmedium; 58 | say "Supports ancient SSL Versions 2.0 or 3.0" if $prop->supports_ancient_ssl_versions; 59 | 60 | say "Supports EC keys" if $prop->supports_ec_keys; 61 | say "Supports only EC keys" if $prop->supports_only_ec_keys; 62 | say "Supports PFS cipher suites" if $prop->supports_pfs; 63 | say "Supports only PFS cipher suites" if $prop->supports_only_pfs; 64 | 65 | 66 | say "Cipher Suite used by Firefox: " . $prop->firefox_cipher; 67 | say "Cipher Suite used by Safari: " . $prop->safari_cipher; 68 | say "Cipher Suite used by Chrome: " . $prop->chrome_cipher; 69 | say "Cipher Suite used by Win 7 (IE 8): " . $prop->ie8win7_cipher; 70 | say "Cipher Suite used by Win 10 (IE 11): " . $prop->ie11win10_cipher; 71 | 72 | say "Supports only SSL/TLS versions recommended by BSI TR-02102-2" if $prop->supports_only_bsi_versions; 73 | say "Supports only SSL/TLS versions and cipher suites with PFS recommended by BSI TR-02102-2" 74 | if $prop->supports_only_bsi_versions_ciphers; 75 | say "Supports only TLS 1.2 (or newer)" if $prop->supports_only_tlsv12; 76 | 77 | say "Overall Score for this Host: " . $prop->score; 78 | 79 | say ""; 80 | 81 | } ## end foreach my $host (@ARGV) 82 | 83 | 84 | -------------------------------------------------------------------------------- /bin/csv-result-to-summary.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | # 4 | # A little hack to create a (good readable) summary of most important TLS-Check-Results. 5 | # 6 | 7 | 8 | use strict; 9 | use warnings; 10 | use autodie; 11 | 12 | use utf8; 13 | 14 | use Carp qw(croak carp); 15 | use English qw( -no_match_vars ); 16 | 17 | use Text::CSV_XS; 18 | 19 | use Readonly; 20 | 21 | use 5.010; 22 | 23 | Readonly my $COL_CATEGORY => 0; 24 | Readonly my $COL_MODULE => 1; 25 | Readonly my $COL_CLASS => 2; 26 | Readonly my $COL_CLASS_DESCRIPTION => 3; 27 | Readonly my $COL_RUNTIME => 4; 28 | Readonly my $COL_CHECK_NAME => 5; 29 | Readonly my $COL_CHECK_DESCRIPTION => 6; 30 | Readonly my $COL_CHECK_TYPE => 7; 31 | Readonly my $COL_RESULT_ALL => 8; 32 | Readonly my $COL_RESULT_SUM => 9; 33 | Readonly my $COL_RESULT_MEAN => 10; 34 | Readonly my $COL_RESULT_PERCENT => 11; 35 | Readonly my $COL_RESULT_MEDIAN => 12; 36 | Readonly my $COL_RESULT_GROUP => 13; 37 | 38 | # TODO: read from CLI parameter! 39 | Readonly my $HACKY_CONF__NO_CATEGORIES => 0; 40 | 41 | 42 | 43 | binmode STDIN, ":encoding(UTF-8)"; 44 | binmode STDOUT, ":encoding(UTF-8)"; 45 | 46 | my %result; 47 | 48 | my @categories; 49 | 50 | init(); 51 | 52 | # TODO: sep_char via CLI parameter! 53 | my $out_csv = Text::CSV_XS->new( { binary => 1, sep_char => qq{;}, } ); 54 | 55 | if ($HACKY_CONF__NO_CATEGORIES) 56 | { 57 | $out_csv->combine( "Name des Tests", "Wert", "Prozent" ) or croak "CSV error at headline"; 58 | } 59 | else 60 | { 61 | $out_csv->combine( "Name des Tests", @categories ) or croak "CSV error at headline"; 62 | } 63 | say $out_csv->string; 64 | 65 | #<<< 66 | 67 | # Summarize: Beschreibung, Check-Modul, Check-Name, Spalte, Prozent-Angabe 68 | # Spalte 9 ist default (Wert) 69 | 70 | head(""); 71 | head("Webserver"); 72 | summarize( "Alle gültigen Domains", Web => "HTTP active", col => $COL_RESULT_ALL, ); 73 | summarize( "Alle erreichbaren Webseiten", Web => "HTTP active", ); 74 | summarize( "Webseiten die prinzipiell Verschlüsselung können", Web => "HTTPS active", ); 75 | summarize( "Webseiten ohne Browser-Warnung (Host und Zertifikat verifiziert)", Web => "HTTPS all verified", ); 76 | 77 | 78 | head(""); 79 | 80 | summarize("Von den Webseiten, die prinzipiell Verschlüsselung können", Web => "HTTPS active", percentcol => $COL_RESULT_SUM, ); # percent => "Web/HTTPS active"?????? 81 | summarize( "Beachten alle BSI-Empfehlungen zu Protokoll-Version/kryptografische Verfahren", CipherStrength => "Full BSI support Vers+Ciph", ); 82 | summarize( "Webseiten ohne Browser-Warnung (Domain und Zertifikat verifiziert)", Web => "HTTPS all verified", percent => "Web/HTTPS active"); 83 | summarize( "… haben ein zum Domainname passendes Zertifikat", Web => "HTTPS host verified", percent => "Web/HTTPS active"); 84 | summarize( "… mit validem Zertifikat einer von den Browsern akzeptierten Zertifizierungsstelle", Web => "HTTPS cert verified", percent => "Web/HTTPS active"); 85 | summarize( "… mit validem Zertifikat, aber falschem Host", Web => "HTTPS wrong host, cert OK", percent => "Web/HTTPS active"); 86 | 87 | summarize_cipher("CipherStrength"); 88 | 89 | summarize( "… Leiten von verschlüsselter auf unverschlüsselte Verbindung um (schlecht)", Web => "Redirect to HTTP", percentcol => $COL_RESULT_SUM, percent => "Web/HTTPS active"); 90 | summarize( "… Leiten von unverschlüsselter auf verschlüsselte Verbindung um (gut)", Web => "Redirect to HTTPS", percentcol => $COL_RESULT_SUM, percent => "Web/HTTPS active"); 91 | summarize( "… nutzen die Sicherheitsfunktion Strict Transport Security", Web => "Supports HSTS", percentcol => $COL_RESULT_SUM, percent => "Web/HTTPS active"); 92 | summarize( "… nutzen die Sicherheitsfunktion Public Key Pinning", Web => "Supports HPKP", percentcol => $COL_RESULT_SUM, percent => "Web/HTTPS active"); 93 | 94 | 95 | summarize("Von den Webseiten, die ein gültiges Zertifikat haben …", Web => "HTTPS all verified", percentcol => $COL_RESULT_SUM); 96 | summarize_cipher("CipherStrengthOnlyValidCerts"); 97 | 98 | head(""); 99 | summarize("Webserver, die für die Heartbleed-Attacke anfällig sind", Heartbleed => "HTTPS Heartbleed vulnerable", percent => undef, ); 100 | head(""); 101 | 102 | summarize( "Durchschnittlicher Score der Verschlüsselung unterstützenden Seiten", CipherStrength => "Score", col => $COL_RESULT_MEAN, percent => undef, ); 103 | summarize( "Durchschnittlicher Score der Webseiten mit verifiziertem Zertifikat/Domain", CipherStrengthOnlyValidCerts => "Score", col => $COL_RESULT_MEAN, percent => undef, ); 104 | summarize( "Gesamt-Score nach Einbeziehung aller Ergebnisse", FinalScore => "Final Web Score", col => $COL_RESULT_MEAN, percent => undef, ); 105 | 106 | # TODO: Selbstsigniert 107 | 108 | head(""); 109 | head("Sonstiges usw"); 110 | 111 | 112 | summarize( "Webserver via IPv6", DNS => "Domain IPv6"); 113 | summarize( "Hat ein age-de.xml", AgeDE => "Looks like age-de.xml"); 114 | 115 | 116 | head(""); 117 | head("Mailserver (MX)"); 118 | summarize( "Alle getesteten Mailserver", Mail => "#MX unique", percentcol => $COL_RESULT_SUM, ); 119 | summarize( "Alle erreichbaren Mailserver", Mail => "#MX active", percentcol => $COL_RESULT_SUM, percent => "Mail/#MX unique", ); 120 | summarize( "Mailserver, die prinzipiell Verschlüsselung können", Mail => "#MX Supports STARTTLS", percentcol => $COL_RESULT_SUM, percent => "Mail/#MX unique", ); 121 | 122 | summarize("Von den Mailservern, die prinzipiell Verschlüsselung können", Mail => "#MX Supports STARTTLS", percentcol => $COL_RESULT_SUM, percent => "Mail/#MX Supports STARTTLS"); 123 | summarize( "… haben ein gültiges und zum Domainname passendes Zertifikat", Mail => "#MX STARTTLS OK", percentcol => $COL_RESULT_SUM, percent => "Mail/#MX Supports STARTTLS"); 124 | 125 | summarize_cipher("MailCipherStrength"); 126 | summarize( "… könnten verschlüsselt mit „nur Bettercrypto B“-Server kommunizieren", MailCipherStrength => "Supports Any BC B", ); 127 | 128 | head(""); 129 | summarize("Mailserver, die für die Heartbleed-Attacke anfällig sind", Heartbleed => "# MX Heartbleed vulnerable", percent => undef, ); 130 | head(""); 131 | 132 | summarize( "Durchschnittlicher Score der Verschlüsselung unterstützenden Mailserver", MailCipherStrength => "Score", col => $COL_RESULT_MEAN, percent => undef,); 133 | 134 | #>>> 135 | 136 | 137 | # Marktanteil OpenSource Webserver! 138 | 139 | 140 | 141 | # 142 | # Summarize Cipher extra, weil das mehrfach verwendet! 143 | # 144 | 145 | sub summarize_cipher 146 | { 147 | my $class = shift; 148 | my @rest = @ARG; 149 | 150 | #<<< 151 | summarize( "… mit Unterstützung für extrem unsicheres Protokoll SSL 2.0", $class => "Supports SSLv2", @rest ); 152 | summarize( "… mit Unterstützung für sehr unsicheres Protokoll SSL 3.0", $class => "Supports SSLv3", @rest ); 153 | summarize( "… mit Unterstützung für sehr unsichere Protokolle SSL 2.0 oder SSL 3.0", $class => "Supports old SSL v2/v3", @rest ); 154 | summarize( "… mit Unterstützung für veraltetes Protokoll TLS 1.0", $class => "Supports TLSv1", @rest ); 155 | summarize( "… mit Unterstützung für TLS 1.1", $class => "Supports TLSv11", @rest ); 156 | summarize( "… mit Unterstützung für TLS 1.2", $class => "Supports TLSv12", @rest ); 157 | summarize( "… unterstützen nur das aktuelle Protokoll TLS 1.2 von 2008", $class => "Supports Only TLSv12", @rest ); 158 | summarize( "… halten die BSI-Vorgaben fürs Protokoll ein (TLS 1.2, evtl. TLS 1.1)", $class => "Supports Only BSI Versions", @rest ); 159 | summarize( "… unterstützen nur TLS 1.0 oder älter", $class => "Supports TLSv1 or older", @rest ); 160 | summarize( "… bieten sehr schwache kryptografische Verfahren an (z.B. Export, NULL,)", $class => "Supports very weak ciphers", @rest ); 161 | summarize( "… bieten schwache kryptografische Verfahren an (z.B. RC4, 56 Bit, ...)", $class => "Supports weak ciphers", @rest ); 162 | summarize( "… bieten mittelschwache kryptografische Verfahren an", $class => "Supports medium ciphers", @rest ); 163 | summarize( "… bieten keine schwachen/mittelschwachen kryptografischen Verfahren an", $class => "Supports no weak/medium cipher", @rest ); 164 | summarize( "… Experimental: Schwache Cipher-Suiten ohne Beast/CBC anfällige", $class => "Supports weak ciphers, no Beast/CBC", @rest); 165 | summarize( "… Experimental: Unterstützt Beast/CBC afällige Cipher", $class => "Supports Beast/CBC ciphers", @rest); 166 | summarize( "… Experimental: Mittelschwache, aber inklusive Beast/BCB", $class => "Supports medium ciphers, including Beast/CBC", @rest); 167 | summarize( "… Experimental: Schwache Cipher-Suiten, außer wenn Bettercrypto B Empfehlung", $class => "Supports weak ciphers, excluding Bettercrypto B", @rest); 168 | summarize( "… bieten nur empfohlene kompatible kryptografische Verfahren an (Bettercrypto B)", $class => "Supports Only BC b", @rest ); 169 | summarize( "… halten die BSI-Vorgaben für kryptografische Verfahren ein", $class => "Supports Only BSI PFS", @rest ); 170 | summarize( "… bieten mindestens eines der vom BSI vorgegebenen kryptographischen Verfahren an", $class => "Supports Any BSI PFS", @rest ); 171 | summarize( "… bieten nur empfohlene sehr sichere kryptografische Verfahren an (Bettercrypto A)", $class => "Supports Only BC A", @rest ); 172 | summarize( "… nutzen (auch) ECDSA Keys", $class => "Supports ECDSA keys", @rest ); 173 | summarize( "… bieten auch Cipher-Suiten mit PFS an", $class => "Supports PFS cipher(s)", @rest ); 174 | summarize( "… bieten nur Cipher-Suiten mit PFS an", $class => "Supports only PFS ciphers", @rest ); 175 | 176 | #>>> 177 | 178 | return; 179 | } ## end sub summarize_cipher 180 | 181 | 182 | 183 | sub init 184 | { 185 | 186 | my $in_csv = Text::CSV_XS->new( { binary => 1, sep_char => q{;} } ); 187 | 188 | my $cat = ""; 189 | my $module = ""; 190 | 191 | <>; 192 | <>; # head 193 | 194 | my $catpos = 0; 195 | while (<>) 196 | { 197 | $in_csv->parse($_); 198 | my @fields = $in_csv->fields(); 199 | 200 | if ( $fields[$COL_CATEGORY] ) 201 | { 202 | $cat = $fields[$COL_CATEGORY]; 203 | $catpos++; # New Category! 204 | $catpos = 0 if $cat eq "Category All Categories (Summary)"; 205 | $categories[$catpos] = $cat; 206 | next; 207 | } 208 | 209 | $fields[$COL_CATEGORY] = $cat; 210 | 211 | $module = $fields[$COL_MODULE] if $fields[$COL_MODULE]; 212 | next unless $fields[$COL_CHECK_NAME]; 213 | $fields[$COL_MODULE] = $module; 214 | 215 | $fields[$COL_CHECK_NAME] =~ s{Suppports}{Supports}; 216 | $result{ lc("$module/$fields[$COL_CHECK_NAME]") }[$catpos] = \@fields; 217 | 218 | } ## end while (<>) 219 | 220 | return; 221 | } ## end sub init 222 | 223 | 224 | sub head 225 | { 226 | $out_csv->combine(@ARG) or croak "CSV error on Head Combine!"; 227 | say $out_csv->string; 228 | return; 229 | } 230 | 231 | 232 | sub summarize 233 | { 234 | my $title = shift; 235 | my $module = shift; 236 | my $check_name = shift; 237 | my %extra = ( col => $COL_RESULT_SUM, percentcol => $COL_RESULT_ALL, percent => "$module/$check_name", @ARG ); 238 | 239 | # loop cat 240 | 241 | 242 | my @fields = ($title); 243 | 244 | my $last_col = $HACKY_CONF__NO_CATEGORIES ? 0 : $#categories; 245 | 246 | # Pronzent weglassen wenn percent == undef 247 | for my $pos ( 0 .. $last_col ) 248 | { 249 | my $value = $result{ lc("$module/$check_name") }[$pos][ $extra{col} ] // ""; 250 | 251 | $value = sprintf( "%.3f", $value ) if $value =~ m{[.]}; 252 | 253 | # Wenn Prozent da sein sollen 254 | if ( not $HACKY_CONF__NO_CATEGORIES and defined $extra{percent} ) 255 | { 256 | my $percent_base = $result{ lc( $extra{percent} ) }[$pos][ $extra{percentcol} ] // ""; 257 | if ($percent_base) 258 | { 259 | $value = sprintf( "$value (%.3f%%)", ( $value / $percent_base ) * 100 ); 260 | $value =~ s{100[.]000%}{100%}x; 261 | } 262 | else 263 | { 264 | $value = "$value (---%)"; 265 | } 266 | } 267 | 268 | $value =~ s{[.]}{,}g; # 269 | push @fields, $value; 270 | 271 | if ( $HACKY_CONF__NO_CATEGORIES and defined $extra{percent} ) 272 | { 273 | my $percent_base = $result{ lc( $extra{percent} ) }[$pos][ $extra{percentcol} ] // ""; 274 | my $percent_value; 275 | if ($percent_base) 276 | { 277 | $percent_value = sprintf( "%.3f%%", ( $value / $percent_base ) * 100 ); 278 | $percent_value =~ s{100[.]000%}{100%}x; 279 | $percent_value =~ s{[.]}{,}g; 280 | } 281 | else 282 | { 283 | $value = "$value (---%)"; 284 | } 285 | push @fields, $percent_value; 286 | } 287 | 288 | } ## end for my $pos ( 0 .. $last_col...) 289 | 290 | 291 | $out_csv->combine(@fields) or croak "CSV error: can't combine summary"; 292 | 293 | say $out_csv->string; 294 | 295 | return; 296 | } ## end sub summarize 297 | 298 | 299 | sub get_field 300 | { 301 | my $in_fields = shift; 302 | my %params = @ARG; 303 | 304 | my $field = $in_fields->[ $params{col} ]; 305 | 306 | return $field if exists $params{percent} and not defined $params{percent}; 307 | return; 308 | } 309 | -------------------------------------------------------------------------------- /bin/helper/check-timeout-jitter--ihk-server.sh: -------------------------------------------------------------------------------- 1 | 2 | time bin/tls-check-parallel.pl --files=t/more-testdomains/dummy-de-domains-1000-a.csv --temp_out_interval=200 --my_hostname=wurzelgnom2.a-blast.org --outfile=result/test-wurzelgnom-de1000a-fixed-1.csv --jobs=100 --checks=Web --checks=CipherStrength 3 | date 4 | mv logs/ result/logs-test-wurzelgnom-de1000a-fixed-1/ ; mkdir logs 5 | 6 | echo 7 | echo ============================================== 8 | echo 9 | 10 | time bin/tls-check-parallel.pl --files=t/more-testdomains/dummy-de-domains-1000-a.csv --temp_out_interval=200 --my_hostname=wurzelgnom2.a-blast.org --outfile=result/test-wurzelgnom-de1000a-fixed-2.csv --jobs=100 --checks=Web --checks=CipherStrength 11 | date 12 | mv logs/ result/logs-test-wurzelgnom-de1000a-fixed-2/ ; mkdir logs 13 | 14 | echo 15 | echo ============================================== 16 | echo 17 | 18 | time bin/tls-check-parallel.pl --files=t/more-testdomains/dummy-de-domains-1000-a.csv --temp_out_interval=200 --my_hostname=wurzelgnom2.a-blast.org --outfile=result/test-wurzelgnom-de1000a-fixed-3.csv --jobs=100 --checks=Web --checks=CipherStrength 19 | date 20 | mv logs/ result/logs-test-wurzelgnom-de1000a-fixed-3/ ; mkdir logs 21 | 22 | 23 | echo 24 | echo ============================================== 25 | echo 26 | 27 | echo 28 | echo ============================================== 29 | echo 30 | 31 | 32 | 33 | 34 | # Alle sind: 35 | # DNS Web Mail Dummy CipherStrength MailCipherStrength AgeDE Heartbleed CipherStrengthOnlyValidCerts 36 | 37 | date 38 | time bin/tls-check-parallel.pl --files=tmp/Alle\ mit\ Internetadresse\ Final_2015.11.csv --outfile=tmp/result-v45.csv --temp_out_interval=250 --jobs=50 --checks="DNS Web Mail Dummy CipherStrength MailCipherStrength AgeDE CipherStrengthOnlyValidCerts" 39 | date 40 | 41 | 42 | # 43 | # 44 | # 45 | # 46 | # time bin/tls-check-parallel.pl --files=t/more-testdomains/dummy-de-domains-1000-b.csv --temp_out_interval=100 --my_hostname=wurzelgnom2.a-blast.org --outfile=result/test-wurzelgnom-de1000b-1.txt --jobs=20 --checks=Web --checks=CipherStrength 47 | # date 48 | # mv logs/ result/logs-test-wurzelgnom-de1000b-1/ ; mkdir logs 49 | # 50 | # echo 51 | # echo ============================================== 52 | # echo 53 | # 54 | # time bin/tls-check-parallel.pl --files=t/more-testdomains/dummy-de-domains-1000-b.csv --temp_out_interval=100 --my_hostname=wurzelgnom2.a-blast.org --outfile=result/test-wurzelgnom-de1000b-2.txt --jobs=20 --checks=Web --checks=CipherStrength 55 | # date 56 | # mv logs/ result/logs-test-wurzelgnom-de1000b-2/ ; mkdir logs 57 | # 58 | # echo 59 | # echo ============================================== 60 | # echo 61 | # 62 | # time bin/tls-check-parallel.pl --files=t/more-testdomains/dummy-de-domains-1000-b.csv --temp_out_interval=100 --my_hostname=wurzelgnom2.a-blast.org --outfile=result/test-wurzelgnom-de1000b-3.txt --jobs=20 --checks=Web --checks=CipherStrength 63 | # date 64 | # mv logs/ result/logs-test-wurzelgnom-de1000b-3/ ; mkdir logs 65 | # 66 | # 67 | # 68 | # 69 | # 70 | # 71 | # echo 72 | # echo ============================================== 73 | # echo 74 | # 75 | # echo 76 | # echo ============================================== 77 | # echo 78 | # 79 | # 80 | # 81 | # 82 | # 83 | # 84 | # time bin/tls-check-parallel.pl --files=t/more-testdomains/dummy-de-domains-1000-c.csv --temp_out_interval=100 --my_hostname=wurzelgnom2.a-blast.org --outfile=result/test-wurzelgnom-de1000c-full-1.txt --jobs=30 85 | # date 86 | # mv logs/ result/logs-test-wurzelgnom-de1000c-1/ ; mkdir logs 87 | # 88 | # echo 89 | # echo ============================================== 90 | # echo 91 | # 92 | # time bin/tls-check-parallel.pl --files=t/more-testdomains/dummy-de-domains-1000-c.csv --temp_out_interval=100 --my_hostname=wurzelgnom2.a-blast.org --outfile=result/test-wurzelgnom-de1000c-full-2.txt --jobs=30 93 | # date 94 | # mv logs/ result/logs-test-wurzelgnom-de1000c-2/ ; mkdir logs 95 | # 96 | # echo 97 | # echo ============================================== 98 | # echo 99 | # 100 | # time bin/tls-check-parallel.pl --files=t/more-testdomains/dummy-de-domains-1000-c.csv --temp_out_interval=100 --my_hostname=wurzelgnom2.a-blast.org --outfile=result/test-wurzelgnom-de1000c-full-3.txt --jobs=30 101 | # date 102 | # mv logs/ result/logs-test-wurzelgnom-de1000c-3/ ; mkdir logs 103 | # 104 | # 105 | # 106 | # 107 | 108 | 109 | 110 | 111 | -------------------------------------------------------------------------------- /bin/helper/check-timeout-jitter.sh: -------------------------------------------------------------------------------- 1 | 2 | time bin/tls-check-parallel.pl --files=t/more-testdomains/dummy-de-domains-1000-a.csv --temp_out_interval=200 --my_hostname=wurzelgnom2.a-blast.org --outfile=result/test-wurzelgnom-de1000a-fixed-1.csv --jobs=100 --checks=Web --checks=CipherStrength 3 | date 4 | mv logs/ result/logs-test-wurzelgnom-de1000a-fixed-1/ ; mkdir logs 5 | 6 | echo 7 | echo ============================================== 8 | echo 9 | 10 | time bin/tls-check-parallel.pl --files=t/more-testdomains/dummy-de-domains-1000-a.csv --temp_out_interval=200 --my_hostname=wurzelgnom2.a-blast.org --outfile=result/test-wurzelgnom-de1000a-fixed-2.csv --jobs=100 --checks=Web --checks=CipherStrength 11 | date 12 | mv logs/ result/logs-test-wurzelgnom-de1000a-fixed-2/ ; mkdir logs 13 | 14 | echo 15 | echo ============================================== 16 | echo 17 | 18 | time bin/tls-check-parallel.pl --files=t/more-testdomains/dummy-de-domains-1000-a.csv --temp_out_interval=200 --my_hostname=wurzelgnom2.a-blast.org --outfile=result/test-wurzelgnom-de1000a-fixed-3.csv --jobs=100 --checks=Web --checks=CipherStrength 19 | date 20 | mv logs/ result/logs-test-wurzelgnom-de1000a-fixed-3/ ; mkdir logs 21 | 22 | 23 | echo 24 | echo ============================================== 25 | echo 26 | 27 | echo 28 | echo ============================================== 29 | echo 30 | 31 | 32 | 33 | # 34 | # 35 | # 36 | # time bin/tls-check-parallel.pl --files=t/more-testdomains/dummy-de-domains-1000-b.csv --temp_out_interval=100 --my_hostname=wurzelgnom2.a-blast.org --outfile=result/test-wurzelgnom-de1000b-1.txt --jobs=20 --checks=Web --checks=CipherStrength 37 | # date 38 | # mv logs/ result/logs-test-wurzelgnom-de1000b-1/ ; mkdir logs 39 | # 40 | # echo 41 | # echo ============================================== 42 | # echo 43 | # 44 | # time bin/tls-check-parallel.pl --files=t/more-testdomains/dummy-de-domains-1000-b.csv --temp_out_interval=100 --my_hostname=wurzelgnom2.a-blast.org --outfile=result/test-wurzelgnom-de1000b-2.txt --jobs=20 --checks=Web --checks=CipherStrength 45 | # date 46 | # mv logs/ result/logs-test-wurzelgnom-de1000b-2/ ; mkdir logs 47 | # 48 | # echo 49 | # echo ============================================== 50 | # echo 51 | # 52 | # time bin/tls-check-parallel.pl --files=t/more-testdomains/dummy-de-domains-1000-b.csv --temp_out_interval=100 --my_hostname=wurzelgnom2.a-blast.org --outfile=result/test-wurzelgnom-de1000b-3.txt --jobs=20 --checks=Web --checks=CipherStrength 53 | # date 54 | # mv logs/ result/logs-test-wurzelgnom-de1000b-3/ ; mkdir logs 55 | # 56 | # 57 | # 58 | # 59 | # 60 | # 61 | # echo 62 | # echo ============================================== 63 | # echo 64 | # 65 | # echo 66 | # echo ============================================== 67 | # echo 68 | # 69 | # 70 | # 71 | # 72 | # 73 | # 74 | # time bin/tls-check-parallel.pl --files=t/more-testdomains/dummy-de-domains-1000-c.csv --temp_out_interval=100 --my_hostname=wurzelgnom2.a-blast.org --outfile=result/test-wurzelgnom-de1000c-full-1.txt --jobs=30 75 | # date 76 | # mv logs/ result/logs-test-wurzelgnom-de1000c-1/ ; mkdir logs 77 | # 78 | # echo 79 | # echo ============================================== 80 | # echo 81 | # 82 | # time bin/tls-check-parallel.pl --files=t/more-testdomains/dummy-de-domains-1000-c.csv --temp_out_interval=100 --my_hostname=wurzelgnom2.a-blast.org --outfile=result/test-wurzelgnom-de1000c-full-2.txt --jobs=30 83 | # date 84 | # mv logs/ result/logs-test-wurzelgnom-de1000c-2/ ; mkdir logs 85 | # 86 | # echo 87 | # echo ============================================== 88 | # echo 89 | # 90 | # time bin/tls-check-parallel.pl --files=t/more-testdomains/dummy-de-domains-1000-c.csv --temp_out_interval=100 --my_hostname=wurzelgnom2.a-blast.org --outfile=result/test-wurzelgnom-de1000c-full-3.txt --jobs=30 91 | # date 92 | # mv logs/ result/logs-test-wurzelgnom-de1000c-3/ ; mkdir logs 93 | # 94 | # 95 | # 96 | # 97 | # 98 | # 99 | # 100 | # 101 | -------------------------------------------------------------------------------- /bin/helper/dump-ciphers.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | use strict; 4 | use warnings; 5 | use 5.010; 6 | 7 | use FindBin qw($Bin); 8 | use lib "$Bin/../lib"; 9 | 10 | use Net::SSL::CipherSuites; 11 | 12 | use Data::Dumper; 13 | 14 | 15 | foreach my $name (@ARGV) 16 | { 17 | my $ciphers = Net::SSL::CipherSuites->new_by_name($name); 18 | unless ( $ciphers->count ) 19 | { 20 | say "===> NO CipherSuite found for $name!"; 21 | next; 22 | } 23 | 24 | say "+++> Found CipherSuites: " . $ciphers->names; 25 | say Dumper($ciphers); 26 | say ""; 27 | } 28 | 29 | 30 | -------------------------------------------------------------------------------- /bin/helper/extract-dummy-domains.sh: -------------------------------------------------------------------------------- 1 | # perl -nE 'chomp; ($num, $domain) = split /,/; say "$domain;1"' ~/Downloads/top-1m-2015-06-14.csv | perl -MList::Util=shuffle -E 'print shuffle <>' | tail -n 1000 >dummy-domains-1000-a.csv 2 | 3 | # perl -nE 'chomp; ($num, $domain) = split /,/; say "$domain;1" if $domain =~ m{de$};' ~/Downloads/top-1m-2015-06-14.csv | perl -MList::Util=shuffle -E 'print shuffle <>' | tail -n 1000 >dummy-de-domains-1000-b.csv 4 | 5 | 6 | 7 | 8 | -------------------------------------------------------------------------------- /bin/helper/extract-scores.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | 4 | use strict; 5 | use warnings; 6 | 7 | use 5.010; 8 | 9 | my $category; 10 | my $base; 11 | 12 | say "Category,Base,cipher_score,version_score,count"; 13 | 14 | while (<>) 15 | { 16 | chomp; 17 | $category = $1 if m{Category (\S+)}; 18 | $base = $1 if m{(CipherStrength\w*)}; 19 | 20 | while ( m{cipher(\d+)-version(\d+) => (\d+)}g ) 21 | { 22 | say "$category,$base,$1,$2,$3"; 23 | } 24 | 25 | } 26 | 27 | -------------------------------------------------------------------------------- /bin/tls-check: -------------------------------------------------------------------------------- 1 | tls-check-parallel.pl -------------------------------------------------------------------------------- /bin/tls-check-parallel.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | use strict; 4 | use warnings; 5 | use FindBin qw($Bin); 6 | use lib "$Bin/../lib"; 7 | 8 | # 9 | # For usage see 10 | # tls-check.pl --help! 11 | # 12 | # For a project overview, see the README.md of the Distribution. 13 | # 14 | 15 | use Security::TLSCheck::App::Parallel extends => "Security::TLSCheck::Result::CSV"; 16 | 17 | 18 | # TODO: Hack: preload all SSL libraries / init internal states! 19 | # Preload later required libraries (for parallel fork mode) 20 | use HTTP::Response; 21 | use HTTP::Request; 22 | use LWP::Protocol::https; 23 | use LWP::Protocol::http; 24 | use Mozilla::CA; 25 | use IO::Socket::SSL; 26 | use LWP::Simple; 27 | use Net::SMTP; 28 | 29 | use Net::SSL::CipherSuites; 30 | use Net::SSL::Handshake; 31 | use Net::SSL::GetServerProperties; 32 | 33 | # Hack: do an SSL request: LWP should preload all modules. 34 | # TODO: Remove and use everything manually. 35 | getstore( "https://wurzelgnom.a-blast.org/", "/dev/null" ); 36 | 37 | 38 | my $app = Security::TLSCheck::App::Parallel->new_with_options(); 39 | $app->run; 40 | -------------------------------------------------------------------------------- /bin/tls-check.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | use strict; 4 | use warnings; 5 | use FindBin qw($Bin); 6 | use lib "$Bin/../lib"; 7 | 8 | # 9 | # For usage see 10 | # tls-check.pl --help! 11 | # 12 | # For a project overview, see the README.md of the Distribution. 13 | # 14 | 15 | 16 | #use Security::TLSCheck::App; 17 | use Security::TLSCheck::App extends => "Security::TLSCheck::Result::CSV"; 18 | 19 | my $app = Security::TLSCheck::App->new_with_options(); 20 | $app->run; 21 | 22 | -------------------------------------------------------------------------------- /conf/tls-check-logging.properties: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tls-check/TLS-Check/7ec514bfab17528d54107920a9b452873355d0d4/conf/tls-check-logging.properties -------------------------------------------------------------------------------- /conf/tls-check.conf: -------------------------------------------------------------------------------- 1 | # 2 | # Default TLS-Check config file 3 | # 4 | # This file is empty. 5 | # Call "tls-check --help" for configuration options 6 | # 7 | 8 | -------------------------------------------------------------------------------- /lib/Log/Log4perl/EasyCatch.pm: -------------------------------------------------------------------------------- 1 | package Log::Log4perl::EasyCatch; 2 | 3 | =head1 NAME 4 | 5 | Log::Log4perl::EasyCatch - Easy Logging with Log4perl, catching errors and warnings, using configfile 6 | 7 | =cut 8 | 9 | 10 | use strict; 11 | use warnings; 12 | 13 | use FindBin qw($Bin); 14 | use English qw( -no_match_vars ); 15 | use Readonly; 16 | 17 | use File::HomeDir; 18 | 19 | use Log::Log4perl qw(:easy); 20 | 21 | use base qw(Exporter); 22 | 23 | Readonly our $LOG_TRESHOLD_VERBOSE => -3; 24 | Readonly our $LOG_TRESHOLD_SILENT => 3; 25 | 26 | use 5.010; 27 | 28 | ## it's here OK to export them all. 29 | ## no critic (Modules::ProhibitAutomaticExportation) 30 | our @EXPORT = qw( 31 | TRACE DEBUG INFO WARN ERROR FATAL ALWAYS 32 | LOGCROAK LOGCLUCK LOGCARP LOGCONFESS 33 | LOGDIE LOGWARN 34 | LOGEXIT 35 | $DEFAULT_LOG_CONFIG 36 | $LOG_TRESHOLD_VERBOSE 37 | $LOG_TRESHOLD_SILENT 38 | ); 39 | 40 | 41 | 42 | #<<< 43 | my $BASE_VERSION = "0.1"; use version; our $VERSION = qv( sprintf "$BASE_VERSION.%d", q$Revision: 658 $ =~ /(\d+)/xg ); 44 | #>>> 45 | 46 | =head1 VERSION 47 | 48 | Version 0.1.x 49 | 50 | =head1 SYNOPSIS 51 | 52 | use Log::Log4perl::EasyCatch; 53 | 54 | INFO "Startup!"; 55 | 56 | ERROR "There is an error: $error" if $error; 57 | 58 | DEBUG "Internal state: $status"; 59 | 60 | ... 61 | 62 | =head1 DESCRIPTION 63 | 64 | Everything from Log::Log4perl in easy mode, plus: Logging of warnings and Exceptions; default config file. 65 | 66 | 67 | =head1 TODO: 68 | 69 | Automatic logging of data structures via Data::Dumper! 70 | Configure default log_dir via import. 71 | 72 | Include a default log config and optionally write it? 73 | 74 | =cut 75 | 76 | my $initialised; 77 | 78 | if ( not $initialised and not $COMPILING ) 79 | { 80 | 81 | no warnings qw(once); ## no critic (TestingAndDebugging::ProhibitNoWarnings) 82 | Readonly our $DEFAULT_LOG_CONFIG => $Security::TLSCheck::LOG_CONFIG_FILE // $ENV{LOG_CONFIG} 83 | // "$Bin/../conf/tls-check-logging.properties"; 84 | 85 | 86 | # log dir should be created by appender! 87 | # -d "$Bin/../logs" or mkdir "$Bin/../logs" or die "Kann fehlendes logs-Verzeichnis nicht anlegen: $OS_ERROR\n"; 88 | 89 | Log::Log4perl->init_once($DEFAULT_LOG_CONFIG); # allows logging before reading config 90 | Log::Log4perl->appender_thresholds_adjust( $LOG_TRESHOLD_SILENT, ['SCREEN'] ) 91 | if $ENV{HARNESS_ACTIVE}; 92 | 93 | # catch and log all exceptions 94 | $SIG{__DIE__} = sub { ## no critic (Variables::RequireLocalizedPunctuationVars) 95 | my @messages = @_; 96 | chomp $messages[-1]; 97 | 98 | if ($EXCEPTIONS_BEING_CAUGHT) 99 | { 100 | TRACE "Exception caught (executing eval): ", @messages; 101 | } 102 | elsif ( not defined $EXCEPTIONS_BEING_CAUGHT ) 103 | { 104 | TRACE "Exception in Parsing module, eval, or main program: ", @messages; 105 | } 106 | else # when $EXCEPTIONS_BEING_CAUGHT == 0 107 | { 108 | local $Log::Log4perl::caller_depth = $Log::Log4perl::caller_depth + 1; 109 | LOGDIE "Uncaught exception! ", @messages; 110 | } 111 | 112 | return; 113 | }; 114 | 115 | # Log all warnings as errors in the log! 116 | $SIG{__WARN__} = sub { ## no critic (Variables::RequireLocalizedPunctuationVars) 117 | my @messages = @_; 118 | local $Log::Log4perl::caller_depth = $Log::Log4perl::caller_depth + 1; 119 | chomp $messages[-1]; 120 | ERROR "Perl warning: ", @messages; 121 | return; 122 | }; 123 | 124 | $initialised = 1; 125 | 126 | } ## end if ( not $initialised ...) 127 | 128 | 129 | =head2 get_log_dir($application) 130 | 131 | Returns a log dir; can be called from logging-properties file! 132 | 133 | =cut 134 | 135 | sub get_log_dir 136 | { 137 | my $application = shift // "logs"; 138 | state $logdir = -d "$Bin/../logs" ? "$Bin/../logs" : File::HomeDir->my_dist_data( $application, { create => 1 } ) // "/tmp"; 139 | return $logdir; 140 | } 141 | 142 | 143 | 1; 144 | 145 | -------------------------------------------------------------------------------- /lib/MooseX/ListAttributes.pm: -------------------------------------------------------------------------------- 1 | package MooseX::ListAttributes; 2 | 3 | use Moose::Role; 4 | 5 | use 5.010; 6 | use English qw( -no_match_vars ); 7 | use Data::Dumper; 8 | 9 | # use Readonly; 10 | 11 | has show_options => ( is => "ro", isa => "Bool", default => 0, documentation => "List all Options" ); 12 | has undef_string => ( is => "ro", isa => "Str", default => "", documentation => "String for undef with show_options" ); 13 | 14 | =head1 SYNOPSIS 15 | 16 | with 'MooseX::ListAttributes'; 17 | 18 | # later, inside a method 19 | $self->usage if $self->show_options; 20 | 21 | =head1 DESCRIPTION 22 | 23 | Adds an after modifier to an existing usage method 24 | 25 | =head1 METHODS 26 | 27 | =head2 list_attributes 28 | 29 | Lists all attributes of this class. 30 | 31 | =cut 32 | 33 | # Readonly my $UNDEF => ""; 34 | 35 | sub list_attributes 36 | { 37 | my $self = shift; 38 | 39 | print "\n $PROGRAM_NAME wurde mit den folgenden Werten gestartet:\n\n"; 40 | print " Attribut/Option | Aktueller Wert | Default \n"; 41 | print "----------------------+--------------------------------+--------------------------\n"; 42 | 43 | # alle Attribute durchsuchen ... 44 | foreach my $attr ( sort { $a->name cmp $b->name } $self->meta->get_all_attributes ) 45 | { 46 | next unless $attr->documentation; 47 | my $attr_name = $attr->name; 48 | 49 | next if $attr_name =~ m{^_}x; 50 | 51 | my $value = $self->$attr_name // $self->undef_string; 52 | $value = "[" . join( ", ", @$value ) . "]" if ref $value eq "ARRAY"; 53 | 54 | my $default = $attr->default // $self->undef_string; 55 | $default = &$default() if ref $default eq "CODE"; # for hash/array-Ref-Defaults 56 | $default = "[" . join( ", ", @$default ) . "]" if ref $default eq "ARRAY"; 57 | 58 | $value = "" if $value eq $default; 59 | 60 | printf " %-20s | %-30s | %-30s\n", "--$attr_name", $value, $default; 61 | } 62 | 63 | print "\n"; 64 | print "Uebergebene CLI-Parameter beim Aufruf: ", join( " ", @{ $self->ARGV } ) . "\n\n"; 65 | 66 | return; 67 | }; ## end after usage 68 | 69 | 70 | 71 | 1; 72 | -------------------------------------------------------------------------------- /lib/Net/SSL/Handshake/Extensions.pm: -------------------------------------------------------------------------------- 1 | package Net::SSL::Handshake::Extensions; 2 | 3 | =encoding utf8 4 | 5 | =head1 NAME 6 | 7 | Net::SSL::Handshake::Extensions - Base class for TLS handshake extensions 8 | 9 | =head1 VERSION 10 | 11 | Version 1.0.x, $Revision: 658 $ 12 | 13 | 14 | =cut 15 | 16 | 17 | =head1 SYNOPSIS 18 | 19 | extends "Net::SSL::Handshake::Extensions"; 20 | sub BUILD 21 | { 22 | my $self = shift; 23 | $self->add($pack_pattern, @data); 24 | } 25 | 26 | =head1 DESCRIPTION 27 | 28 | The base class for TLS extensions. Used by each extension Class. 29 | 30 | For example see Net::SSL::Handshake::Extensions::EllipticCurves or 31 | Net::SSL::Handshake::Extensions::ECPointFormats. 32 | 33 | 34 | 35 | =cut 36 | 37 | 38 | use Moose; 39 | use Carp qw(croak); 40 | use English qw( -no_match_vars ); 41 | 42 | has extension_template => ( 43 | is => "ro", 44 | isa => "Str", 45 | traits => ['String'], 46 | default => "", 47 | handles => { add_extension_template => "append", clear_extension_template => "clear", }, 48 | ); 49 | has _extension_data => ( 50 | is => "ro", 51 | isa => "ArrayRef", 52 | traits => ['Array'], 53 | default => sub { [] }, 54 | handles => { add_extension_data => "push", clear_extension_data => "clear", extension_data => "elements", }, 55 | ); 56 | 57 | has type => ( is => "ro", isa => "Int", default => sub { croak "Subclass must set default value!" }, ); 58 | 59 | 60 | =head2 ->data 61 | 62 | Returns the binary string for this extension. 63 | 64 | =cut 65 | 66 | sub data 67 | { 68 | my $self = shift; 69 | my $extension_data = pack( $self->extension_template, $self->extension_data ); 70 | return pack( "n n a*", $self->type, length($extension_data), $extension_data ); 71 | } 72 | 73 | =head2 ->add($pattern, @data) 74 | 75 | Adds the data for this extension. 76 | 77 | =cut 78 | 79 | sub add 80 | { 81 | my $self = shift; 82 | my $template = shift; 83 | 84 | $self->add_extension_data(@ARG); 85 | $self->add_extension_template($template); 86 | 87 | return $self; 88 | } 89 | 90 | 91 | 1; 92 | -------------------------------------------------------------------------------- /lib/Net/SSL/Handshake/Extensions/ECPointFormats.pm: -------------------------------------------------------------------------------- 1 | package Net::SSL::Handshake::Extensions::ECPointFormats; 2 | 3 | use Moose; 4 | extends "Net::SSL::Handshake::Extensions"; 5 | 6 | 7 | 8 | =encoding utf8 9 | 10 | =head1 NAME 11 | 12 | Net::SSL::Handshake::Extensions::ECPointFormats - client extension for TLS Handshake to show supported elliptic courves 13 | 14 | =head1 VERSION 15 | 16 | Version 0.1.x, $Revision: 658 $ 17 | 18 | =cut 19 | 20 | use version; our $VERSION = qv( "v0.1." . ( sprintf "%d", q$Revision: 658 $ =~ /(\d+)/xg ) ); 21 | 22 | has "+type" => ( default => 0x000b ); 23 | 24 | 25 | 26 | =head1 SYNOPSIS 27 | 28 | =encoding utf8 29 | 30 | use Net::SSL::Handshake::Extensions::ECPointFormats; 31 | 32 | my $ecp = Net::SSL::Handshake::Extensions::ECPointFormats->new( ); 33 | my $data = $ecp->data; 34 | #... 35 | 36 | =head1 DESCRIPTION 37 | 38 | =cut 39 | 40 | # List of "supported" EC point formats 41 | # at the moment hardcoded! 42 | # TODO: make this as option (via atrribute)! 43 | 44 | my @ec_point_formats = ( 0, 1, 2 ); 45 | 46 | sub BUILD 47 | 48 | { 49 | my $self = shift; 50 | 51 | $self->add( "C C*", scalar @ec_point_formats, @ec_point_formats ); 52 | 53 | return; 54 | } 55 | 56 | 57 | 58 | 1; 59 | -------------------------------------------------------------------------------- /lib/Net/SSL/Handshake/Extensions/EllipticCurves.pm: -------------------------------------------------------------------------------- 1 | package Net::SSL::Handshake::Extensions::EllipticCurves; 2 | 3 | use Moose; 4 | extends "Net::SSL::Handshake::Extensions"; 5 | 6 | 7 | 8 | =encoding utf8 9 | 10 | =head1 NAME 11 | 12 | Net::SSL::Handshake::Extensions::EllipticCurves - client extension for TLS Handshake to show supported elliptic courves 13 | 14 | =head1 VERSION 15 | 16 | Version 0.1.x, $Revision: 640 $ 17 | 18 | =cut 19 | 20 | use version; our $VERSION = qv( "v0.1." . ( sprintf "%d", q$Revision: 640 $ =~ /(\d+)/xg ) ); 21 | 22 | has "+type" => ( default => 0x000a ); 23 | 24 | 25 | 26 | =head1 SYNOPSIS 27 | 28 | =encoding utf8 29 | 30 | use Net::SSL::Handshake::Extensions::EllipticCurves; 31 | 32 | my $ec = Net::SSL::Handshake::Extensions::EllipticCurves->new( ); 33 | my $data = $ec->data; 34 | #... 35 | 36 | =head1 DESCRIPTION 37 | 38 | =cut 39 | 40 | # List of "supported" elliptic courves 41 | # at the moment hardcoded! 42 | # TODO: make this as option (via attribute)! 43 | 44 | my @curves = qw(0017 0019 001c 001b 0018 001a 0016 000e 000d 000b 000c 0009 000a); 45 | 46 | sub BUILD 47 | { 48 | my $self = shift; 49 | 50 | # $self->add( "n C n a*", $length+3, 0, $length, $idn_host); 51 | 52 | my $curves_bin = pack( "(H4)*", @curves ); 53 | $self->add( "n a*", length($curves_bin), $curves_bin ); 54 | 55 | return; 56 | } 57 | 58 | 59 | 60 | 1; 61 | -------------------------------------------------------------------------------- /lib/Net/SSL/Handshake/Extensions/ServerName.pm: -------------------------------------------------------------------------------- 1 | package Net::SSL::Handshake::Extensions::ServerName; 2 | 3 | use Moose; 4 | extends "Net::SSL::Handshake::Extensions"; 5 | 6 | use Net::IDN::Encode qw(domain_to_ascii); 7 | 8 | 9 | =encoding utf8 10 | 11 | =head1 NAME 12 | 13 | Net::SSL::Handshake::Extensions::ServerName - SNI extension for TLS Handshake 14 | 15 | =head1 VERSION 16 | 17 | Version 0.1.x, $Revision: 658 $ 18 | 19 | =cut 20 | 21 | use version; our $VERSION = qv( "v0.1." . ( sprintf "%d", q$Revision: 658 $ =~ /(\d+)/xg ) ); 22 | 23 | has "+type" => ( default => 0 ); 24 | 25 | has hostname => ( is => "ro", isa => "Str", required => 1, ); 26 | 27 | 28 | 29 | =head1 SYNOPSIS 30 | 31 | =encoding utf8 32 | 33 | use Net::SSL::Handshake::Extensions::ServerName; 34 | 35 | my $sni = Net::SSL::Handshake::Extensions::ServerName->new( hostname => $hostname ); 36 | my $data = $sni->data; 37 | #... 38 | 39 | =head1 DESCRIPTION 40 | 41 | =cut 42 | 43 | sub BUILD 44 | { 45 | my $self = shift; 46 | 47 | my $idn_host = domain_to_ascii( $self->hostname ); 48 | 49 | my $length = length($idn_host); 50 | $self->add( "n C n a*", $length + 1 + 2, 0, $length, $idn_host ); 51 | 52 | return; 53 | } 54 | 55 | 56 | 57 | 1; 58 | -------------------------------------------------------------------------------- /lib/Net/SSL/Handshake/StartTLS/SMTP.pm: -------------------------------------------------------------------------------- 1 | package Net::SSL::Handshake::StartTLS::SMTP; 2 | 3 | use Moose; 4 | 5 | extends 'Net::SSL::Handshake'; 6 | 7 | use IO::Socket::Timeout; 8 | use Net::Cmd; # need constants 9 | use Net::SMTP; 10 | 11 | use English qw( -no_match_vars ); 12 | use Time::HiRes qw(sleep); 13 | use Fatal qw(sleep); 14 | use Readonly; 15 | 16 | use 5.010; 17 | 18 | =encoding utf8 19 | 20 | =head1 NAME 21 | 22 | Net::SSL::Handshake::StartTLS::SMTP - SSL Handshake via SMTP+StartTLS 23 | 24 | =head1 VERSION 25 | 26 | Version 0.1.x, $Revision: 658 $ 27 | 28 | 29 | =cut 30 | 31 | 32 | =head1 SYNOPSIS 33 | 34 | use Net::SSL::Handshake::StartTLS::SMTP; 35 | 36 | # the same API as Net::SSL::Handshake 37 | my $handshake = $self->Net::SSL::Handshake::StartTLS::SMTP->new 38 | ( 39 | host => $self->host, 40 | ssl_version => $ssl_version, 41 | ciphers => $self->ciphers_to_check 42 | ); 43 | $handshake->hello; 44 | 45 | 46 | =head1 DESCRIPTION 47 | 48 | This module simulates an SSL/TLS-Handshake like Net::SSL::Handshake, but encapsulated in a 49 | SMTP dialog with STARTSSL. 50 | 51 | This module derives everything from Net::SSL::Handshake, but adds SMTP and STARTTLS. For this, 52 | it overrides _build_socket to start an SMTP session and STARTTLS. After SSL/TLS connections ends, 53 | an SMTP quit command is sent. 54 | 55 | When no host (but a socket) is given, this code does not work and is nearly obsolete and 56 | the socket is used unaltered by Net::SSL::Handshake. 57 | 58 | 59 | New Parameters: 60 | 61 | =over 4 62 | 63 | =item * 64 | 65 | max_retries: when a temporary error (421/450) occured, the connection may be retried. 66 | Set max_retries to 0 to disable retry; or any other value to enable. Default: 2 retries. 67 | 68 | =item * 69 | 70 | throttle_time: time (in seconds) to wait when retrying. This time is multiplicated with the 71 | retry number. Default: 65 seconds (which means, that the 2nd retry waits 130 seconds, ...) 72 | 73 | =back 74 | 75 | 76 | 77 | =cut 78 | 79 | 80 | has '+port' => ( default => 25, ); 81 | has max_retries => ( is => "ro", isa => "Int", default => 2, ); 82 | has throttle_time => ( is => "ro", isa => "Int", default => 65, ); 83 | has my_hostname => ( is => "ro", isa => "Str", default => "tls-check.localhost", ); 84 | 85 | 86 | # when SSL/TLS closed: send SMTP QUIT! 87 | after close_notify => sub { 88 | my $self = shift; 89 | $self->socket->quit; 90 | return; 91 | }; 92 | 93 | Readonly my $SMTP_ERROR_MAX_CONNECTIONS => 421; 94 | Readonly my $SMTP_ERROR_UNAVAILABLE => 450; 95 | 96 | 97 | sub _build_socket 98 | { 99 | my $self = shift; 100 | 101 | die __PACKAGE__ . ": need parameter socket or host!\n" unless $self->host; 102 | 103 | my $mx = $self->host; 104 | 105 | my $smtp; 106 | for my $retry ( 0 .. $self->max_retries ) 107 | { 108 | my $state = ""; 109 | $self->_wait( $retry, $state ) if $retry; 110 | 111 | # Step 1: connect, die on error; but if 421 or 450: wait and retry 112 | $smtp = Net::SMTP->new( Hello => $self->my_hostname, Host => $mx, Timeout => $self->timeout, ); 113 | unless ($smtp) 114 | { 115 | 116 | if ( $EVAL_ERROR =~ m{: \s* 4(?:21|50) }x ) 117 | { 118 | # no, can't quit on not defined obj ... $smtp->quit; 119 | $state = "SMTP Connection"; 120 | next; 121 | } 122 | else 123 | { 124 | # TODO: timeouts with some servers! 125 | die "Can't connect to SMTP Server $mx: $EVAL_ERROR\n"; 126 | } 127 | } 128 | 129 | IO::Socket::Timeout->enable_timeouts_on($smtp); 130 | $smtp->read_timeout( $self->timeout ); 131 | $smtp->write_timeout( $self->timeout ); 132 | 133 | 134 | # Step 2: die, when no STARTTLS supported 135 | die "SMTP-Server $mx does not support STARTTLS\n" unless defined $smtp->supports("STARTTLS"); 136 | 137 | # Step 3: do STARTTLS; when error code 421/450: wait and retry 138 | unless ( $smtp->command("STARTTLS")->response() == CMD_OK ) 139 | { 140 | 141 | if ( $smtp->code == $SMTP_ERROR_MAX_CONNECTIONS or $smtp->code == $SMTP_ERROR_UNAVAILABLE ) 142 | { 143 | $smtp->quit; 144 | $state = "SMTP STARTTLS"; 145 | next; 146 | } 147 | else 148 | { 149 | die "SMTP STARTTLS failed: " . $smtp->code . " " . $smtp->message . "\n"; 150 | } 151 | } 152 | 153 | # All fine? exit retry loop 154 | last; 155 | 156 | } ## end for my $retry ( 0 .. $self...) 157 | 158 | 159 | # die "NIX DA im smtp" unless defined $smtp; 160 | 161 | binmode($smtp) or warn "binmode on SMTP failed: $OS_ERROR\n"; 162 | 163 | return $smtp; 164 | } ## end sub _build_socket 165 | 166 | sub _wait 167 | { 168 | my $self = shift; 169 | my $retry = shift // 1; 170 | my $message = shift // __PACKAGE__; 171 | 172 | # DEBUG "$message: Wait for retry, $retry: " . $self->throttle_time . " Seconds"; 173 | 174 | sleep $retry * $self->throttle_time; 175 | return $self; 176 | } 177 | 178 | =head2 send, recv 179 | 180 | We have to override send and recv, because we use Net::SMTP instead ob IO::Socket object. 181 | 182 | =cut 183 | 184 | sub send ## no critic (Subroutines::ProhibitBuiltinHomonyms) 185 | { 186 | my $self = shift; 187 | my $data = shift; 188 | 189 | return $self->socket->rawdatasend($data); 190 | } 191 | 192 | sub recv ## no critic (Subroutines::ProhibitBuiltinHomonyms) 193 | 194 | { 195 | my $self = shift; 196 | 197 | my $ret = $self->socket->recv( $ARG[0], $ARG[1], $ARG[2] ); 198 | 199 | return $ret; 200 | } 201 | 202 | 203 | 1; 204 | -------------------------------------------------------------------------------- /lib/Security/TLSCheck.pm: -------------------------------------------------------------------------------- 1 | package Security::TLSCheck; 2 | 3 | use Moose; 4 | use 5.010; 5 | 6 | 7 | =head1 NAME 8 | 9 | Security::TLSCheck - Application for checking server's TLS capability 10 | 11 | =head1 VERSION 12 | 13 | Version 1.0.2, $Revision: 658 $ 14 | 15 | =cut 16 | 17 | #<<< 18 | my $BASE_VERSION = "1.0.3"; use version; our $VERSION = qv( sprintf "$BASE_VERSION.%d", q$Revision: 658 $ =~ /(\d+)/xg ); 19 | #>>> 20 | 21 | 22 | =head1 SYNOPSIS 23 | 24 | =encoding utf8 25 | 26 | TODO! 27 | 28 | 29 | use TLS::Check; 30 | 31 | my $foo = Security::TLSCheck->new(); 32 | ... 33 | 34 | =head1 DESCRIPTION 35 | 36 | TODO: Write Description! 37 | 38 | For a project overview, see the README.md of the Distribution. 39 | 40 | If you want to write you own checks, look at the checks in C, 41 | e.g. Dummy for a simple intro. 42 | 43 | =cut 44 | 45 | use English qw( -no_match_vars ); 46 | use FindBin qw($Bin); 47 | use File::HomeDir; 48 | use File::ShareDir; 49 | 50 | 51 | # 52 | # Configfile search: 53 | # 1. relative to bin: $Bin../conf (for development) 54 | # 2. /usr/local/etc (maybe /etc on linux?) 55 | # 3. ~/ 56 | # 57 | 58 | 59 | #$DATADIR = eval { return File::ShareDir::module_dir(__PACKAGE__) }; 60 | #$DATADIR = "$FindBin::Bin/../files/CipherSuites" if not defined $DATADIR; # or not -d $DATADIR; 61 | 62 | 63 | 64 | # TODO: Configfile via File::ShareDir 65 | # Default: ~/.tls-check.conf; /usr/local/etc/tls-check.conf; /etc/tls-check.conf; File::ShareDir-Location 66 | 67 | # Run this at begin, before logging gets initialized 68 | # TODO: maybe write a module for this, which may eliminate the BEGIN hazzle 69 | 70 | our $CONFIG_FILE; 71 | our $LOG_CONFIG_FILE; 72 | 73 | # our $LOG_DIR; 74 | my $should_die_later; 75 | 76 | BEGIN 77 | { 78 | # $LOG_DIR = File::HomeDir->my_dist_data( 'TLS-Check', { create => 1 } ) // "$Bin/../logs"; 79 | $CONFIG_FILE = _get_configfile("tls-check.conf"); 80 | $LOG_CONFIG_FILE = _get_configfile("tls-check-logging.properties"); 81 | $ENV{LOG_CONFIG} = $LOG_CONFIG_FILE; ## no critic (Variables::RequireLocalizedPunctuationVars) 82 | 83 | sub _get_configfile 84 | { 85 | my $name = shift; 86 | 87 | # 1. Look on development place 88 | my $file = "$Bin/../conf/$name"; 89 | return $file if -f $file; 90 | 91 | # 2. look in users home dir 92 | $file = File::HomeDir->my_home() . "/.$name"; 93 | return $file if -f $file; 94 | 95 | # 3. /usr/local/etc 96 | $file = "/usr/local/etc/$name"; 97 | return $file if -f $file; 98 | 99 | # 4. /etc 100 | $file = "/etc/$name"; 101 | return $file if -f $file; 102 | 103 | # and othervise look in applications share dir 104 | my $CONFDIR = eval { return File::ShareDir::module_dir(__PACKAGE__) } // "conf"; 105 | 106 | # warn "Share-Dir-Eval-Error: $EVAL_ERROR" if $EVAL_ERROR; 107 | $file = "$CONFDIR/$name"; 108 | return $file if -f $file; 109 | 110 | $should_die_later = "UUUPS, FATAL: configfile $name not found. Last try was <$file>."; 111 | return; 112 | 113 | } ## end sub _get_configfile 114 | 115 | } ## end BEGIN 116 | 117 | die "$should_die_later\n" if not $COMPILING and $should_die_later; 118 | 119 | 120 | 121 | use Log::Log4perl::EasyCatch; 122 | 123 | 124 | 125 | has app => ( 126 | is => "ro", 127 | isa => "Object", 128 | default => sub { require Security::TLSCheck::App; return Security::TLSCheck::App->new; }, 129 | handles => [qw(checks timeout user_agent_name my_hostname)], 130 | ); 131 | 132 | has domain => ( is => "ro", isa => "Str", required => 1, ); 133 | has category => ( is => "ro", isa => "Str", default => "", ); 134 | 135 | 136 | has results => ( 137 | is => "rw", 138 | isa => "HashRef[Any]", 139 | default => sub { {} }, 140 | traits => ['Hash'], 141 | handles => { 142 | other_check => "get", 143 | set_check_result => "set", 144 | }, 145 | clearer => "clear_cached_results", 146 | 147 | ); 148 | 149 | 150 | # has cached_mx => ( is => "rw", isa => "ArrayRef[Str]", auto_deref => 1, ); 151 | 152 | 153 | =head1 METHODS 154 | 155 | =head2 ->run_all_checks() 156 | 157 | =cut 158 | 159 | sub run_all_checks 160 | { 161 | my $self = shift; 162 | 163 | my @checks; 164 | 165 | DEBUG "run all checks for " . $self->domain; 166 | foreach my $check_name ( $self->checks ) 167 | { 168 | $check_name =~ s{ [^\w\d:] }{}gx; # strip of all not allowed chars 169 | 170 | # TRACE "Load Module Security::TLSCheck::Checks::$check_name"; 171 | # eval "require Security::TLSCheck::Checks::$check_name;" ## no critic (BuiltinFunctions::ProhibitStringyEval) 172 | # or die "Can't use check $check_name: $EVAL_ERROR\n"; 173 | 174 | eval { 175 | my $check = "Security::TLSCheck::Checks::$check_name"->new( instance => $self ); 176 | 177 | DEBUG "run check " . $check->name . " on " . $self->domain; 178 | my @results = $check->run_check; 179 | $check->clear_instance; 180 | DEBUG sprintf( "Check %s on %s done in %.3f seconds", $check->name, $self->domain, $check->runtime ); 181 | 182 | foreach my $result (@results) 183 | { 184 | push @checks, 185 | { 186 | name => $check->name, 187 | result => $result, 188 | check => { map { $ARG => $check->$ARG } qw(class description runtime) }, 189 | }; 190 | } 191 | 192 | # caching for other checks 193 | # TODO: Refactor the logic! 194 | $self->set_check_result( $check->class => $check ); 195 | $self->set_check_result( $check->class . "-result" => $results[-1] ); # (temp?) last if more then 1 196 | 197 | return 1; 198 | } or ERROR "Check $check_name failed for " . $self->domain . " ($EVAL_ERROR)"; 199 | 200 | } ## end foreach my $check_name ( $self...) 201 | 202 | $self->clear_cached_results; 203 | 204 | return wantarray ? @checks : \@checks; 205 | } ## end sub run_all_checks 206 | 207 | 208 | 209 | =head1 AUTHOR 210 | 211 | Alvar C.H. Freude, C<< <"alvar at a-blast.org"> >> 212 | 213 | http://alvar.a-blast.org/ 214 | 215 | 216 | =head1 ACKNOWLEDGEMENTS 217 | 218 | 219 | =head1 LICENSE AND COPYRIGHT 220 | 221 | Copyright 2014–2016 Alvar C.H. Freude, http://alvar.a-blast.org/ 222 | 223 | Development contracted by Chamber of Commerce and Industry of the 224 | Stuttgart (Germany) Region and its committee of information technology, 225 | information services and telecommunication. 226 | 227 | https://www.stuttgart.ihk24.de/ 228 | 229 | 230 | This program is free software; you can redistribute it and/or modify it 231 | under the terms of the the Artistic License (2.0). You may obtain a 232 | copy of the full license at: 233 | 234 | L 235 | 236 | #Any use, modification, and distribution of the Standard or Modified 237 | #Versions is governed by this Artistic License. By using, modifying or 238 | #distributing the Package, you accept this license. Do not use, modify, 239 | #or distribute the Package, if you do not accept this license. 240 | # 241 | #If your Modified Version has been derived from a Modified Version made 242 | #by someone other than you, you are nevertheless required to ensure that 243 | #your Modified Version complies with the requirements of this license. 244 | # 245 | #This license does not grant you the right to use any trademark, service 246 | #mark, tradename, or logo of the Copyright Holder. 247 | # 248 | #This license includes the non-exclusive, worldwide, free-of-charge 249 | #patent license to make, have made, use, offer to sell, sell, import and 250 | #otherwise transfer the Package with respect to any patent claims 251 | #licensable by the Copyright Holder that are necessarily infringed by the 252 | #Package. If you institute patent litigation (including a cross-claim or 253 | #counterclaim) against any party alleging that the Package constitutes 254 | #direct or contributory patent infringement, then this Artistic License 255 | #to you shall terminate on the date that such litigation is filed. 256 | # 257 | #Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER 258 | #AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. 259 | #THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR 260 | #PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY 261 | #YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR 262 | #CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR 263 | #CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, 264 | #EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 265 | 266 | 267 | =cut 268 | 269 | __PACKAGE__->meta->make_immutable; 270 | 271 | 1; 272 | -------------------------------------------------------------------------------- /lib/Security/TLSCheck/App.pm: -------------------------------------------------------------------------------- 1 | package Security::TLSCheck::App; 2 | 3 | use Moose; 4 | use 5.010; 5 | 6 | 7 | =head1 NAME 8 | 9 | Security::TLSCheck::App -- CLI part of TLS check application 10 | 11 | =head1 VERSION 12 | 13 | Version 0.2.x 14 | 15 | =cut 16 | 17 | #<<< 18 | my $BASE_VERSION = "1.0"; use version; our $VERSION = qv( sprintf "$BASE_VERSION.%d", q$Revision: 658 $ =~ /(\d+)/xg ); 19 | #>>> 20 | 21 | 22 | =head1 SYNOPSIS 23 | 24 | =encoding utf8 25 | 26 | use Security::TLSCheck::App (extends => 'Security::TLSCheck::Result'); 27 | 28 | my $app = Security::TLSCheck::App->new_with_options(); 29 | $app->run; 30 | 31 | 32 | 33 | =head1 DESCRIPTION 34 | 35 | For a project overview, see the README.md of the Distribution. 36 | 37 | 38 | =cut 39 | 40 | use English qw( -no_match_vars ); 41 | use FindBin qw($Bin); 42 | use Data::Dumper; 43 | use Module::Loaded; 44 | use File::HomeDir; 45 | use Text::CSV_XS; 46 | use File::ShareDir; 47 | 48 | # use IO::All -utf8; 49 | use IO::All; # -utf8; 50 | 51 | 52 | 53 | use Security::TLSCheck; 54 | use Log::Log4perl::EasyCatch; 55 | 56 | 57 | 58 | =head2 import 59 | 60 | Has a simple import method for importing "extends => 'My::BAse::Class'" 61 | 62 | =cut 63 | 64 | sub import 65 | { 66 | my $class = shift; 67 | my %params = @ARG; 68 | 69 | if ( $params{extends} ) { with $params{extends}; } 70 | else { with "Security::TLSCheck::Result"; } 71 | 72 | # TODO: call make_immutable but where? 73 | # here looks ok 74 | # But there is an error with t/00-load.t, so don't immutable if Test::More loaded 75 | __PACKAGE__->meta->make_immutable unless is_loaded("Test::More"); 76 | 77 | return; 78 | } 79 | 80 | =begin temp 81 | 82 | was kann denn konfigurierbar sein? 83 | 84 | Logging-Config 85 | checks 86 | eingabe-file 87 | ausgabe-file 88 | flags 89 | 90 | =end temp 91 | 92 | =cut 93 | 94 | my @default_checks 95 | = qw(DNS Web Mail Dummy CipherStrength MailCipherStrength AgeDE Heartbleed CipherStrengthOnlyValidCerts FinalScore); 96 | 97 | 98 | 99 | # Attributes and default values. 100 | #<<< 101 | has configfile => (is => "ro", isa => "Str", default => $Security::TLSCheck::CONFIG_FILE, documentation => "Configuration file"); 102 | has log_config => (is => "ro", isa => "Str", default => $DEFAULT_LOG_CONFIG, documentation => "Alternative logging config" ); 103 | has checks => (is => "rw", isa => "ArrayRef[Str]", default => sub { \@default_checks }, auto_deref => 1, documentation => "List of checks to run" ); 104 | has user_agent_name => (is => "ro", isa => "Str", default => "TLS-Check/$VERSION", documentation => "UserAgent string for web checks" ) ; 105 | has my_hostname => (is => "ro", isa => "Str", lazy_build => 1, documentation => "Hostname for SMTP EHLO etc." ); 106 | has timeout => (is => "ro", isa => "Int", default => 60, documentation => "Timeout for networking" ); 107 | has separator => (is => "ro", isa => "Str", default => qq{;}, documentation => "CSV Separator char(s)" ); 108 | has files => (is => "ro", isa => "ArrayRef[Str]", lazy_build => 1, auto_deref => 1, documentation => "List of files with domain names to check" ); 109 | has verbose => (is => "ro", isa => "Bool", default => 0, documentation => "Verbose Output/Logging" ); 110 | has temp_out_interval => (is => "ro", isa => "Int", default => 250, documentation => "Produce temporary output every # Domains"); 111 | 112 | #>>> 113 | 114 | with 'MooseX::SimpleConfig'; 115 | with 'MooseX::Getopt'; 116 | with 'MooseX::ListAttributes'; 117 | 118 | sub _build_files 119 | { 120 | my $self = shift; 121 | 122 | my @files = @{ $self->extra_argv }; 123 | 124 | @files = qw(-) unless @files; 125 | 126 | return \@files; 127 | } 128 | 129 | sub _build_my_hostname 130 | { 131 | my $self = shift; 132 | return "tls-check.stuttgart.ihk.de" 133 | if $ENV{HOST} // "" eq "tls-check"; # TODO: Change this hack to other defaults ... 134 | return "tls-check.test"; 135 | } 136 | 137 | 138 | =head1 METHODS 139 | 140 | 141 | =head2 BUILD 142 | 143 | Initializing stuff 144 | 145 | =cut 146 | 147 | sub BUILD 148 | { 149 | my $self = shift; 150 | 151 | # Re-Init loggig, if there is an alternative log config 152 | if ( $self->log_config ne $DEFAULT_LOG_CONFIG ) 153 | { 154 | Log::Log4perl->init( $self->log_config ); 155 | DEBUG "Logging initialised with non-default config " . $self->log_config; 156 | } 157 | else 158 | { 159 | DEBUG "Logging initialised with default config: $DEFAULT_LOG_CONFIG."; 160 | } 161 | 162 | # split check names 163 | my @checks = map { split( m{ [:\s] }x, $ARG ); } $self->checks; 164 | $self->checks( \@checks ); 165 | 166 | # 167 | # Pre-Load all Check Modules 168 | # 169 | 170 | foreach my $check_name ( $self->checks ) 171 | { 172 | $check_name =~ s{ [^\w\d:] }{}gx; # remove all not allowed chars for eval! 173 | TRACE "Load Module Security::TLSCheck::Checks::$check_name"; 174 | eval "require Security::TLSCheck::Checks::$check_name;" ## no critic (BuiltinFunctions::ProhibitStringyEval) 175 | or die "Can't use check $check_name: $EVAL_ERROR\n"; 176 | } 177 | 178 | return $self; 179 | } ## end sub BUILD 180 | 181 | =head2 run 182 | 183 | Runs the application ... 184 | 185 | =cut 186 | 187 | my %domains_analysed; 188 | 189 | sub run 190 | { 191 | my $self = shift; 192 | 193 | my $starttime = time; 194 | 195 | return $self->list_attributes if $self->show_options; 196 | 197 | Log::Log4perl->appender_thresholds_adjust( $LOG_TRESHOLD_VERBOSE, ['SCREEN'] ) 198 | if $self->verbose; 199 | 200 | my $csv = Text::CSV_XS->new( { binary => 1, sep_char => $self->separator, } ); 201 | my $counter = 0; 202 | 203 | $self->init_domain_loop; 204 | 205 | foreach my $file ( $self->files ) 206 | { 207 | INFO "Read domain names from STDIN" if $file eq q{-}; 208 | my $io = io $file; 209 | while ( my $row = $csv->getline($io) ) 210 | { 211 | my ( $read_domain, $category ) = @$row; 212 | next unless $read_domain; 213 | next if $read_domain =~ m{^[#]}x; 214 | next if $read_domain eq "INTERNET_NR"; # skip header line 215 | 216 | $category //= ""; 217 | 218 | DEBUG "Next Domain: $read_domain in category $category"; 219 | 220 | my $domain = $self->filter_domain($read_domain); 221 | 222 | unless ($domain) 223 | { 224 | INFO "Skipping $read_domain (#$counter), because filtered."; 225 | next; 226 | } 227 | 228 | if ( $domains_analysed{$domain} ) 229 | { 230 | INFO "Skipping $domain (via $read_domain) (category $category), because already analysed."; 231 | next; 232 | } 233 | 234 | $domains_analysed{$domain} = 1; 235 | $counter++; 236 | 237 | eval { 238 | $self->analyse( $domain, $category, $read_domain, $counter ); 239 | return 1; 240 | } or WARN "Error with domain $domain: $EVAL_ERROR"; 241 | 242 | if ( $self->temp_out_interval and ( $counter % $self->temp_out_interval ) == 0 ) 243 | { 244 | INFO "New Temp output!"; 245 | $self->output; 246 | } 247 | 248 | } ## end while ( my $row = $csv->getline...) 249 | } ## end foreach my $file ( $self->files...) 250 | 251 | DEBUG "All domains finished."; 252 | 253 | $self->finish_domain_loop; 254 | 255 | $self->output; 256 | 257 | INFO "Final message: Everything finished. THE END."; 258 | 259 | my $endtime = time; 260 | my $duration = $endtime - $starttime; 261 | my $minutes = int( $duration / 60 ); ## no critic (ValuesAndExpressions::ProhibitMagicNumbers) 262 | my $rest_sec = sprintf( "%02d", $duration % 60 ); ## no critic (ValuesAndExpressions::ProhibitMagicNumbers) 263 | my $hours = int( $minutes / 60 ); ## no critic (ValuesAndExpressions::ProhibitMagicNumbers) 264 | my $rest_min = sprintf( "%02d", $minutes % 60 ); ## no critic (ValuesAndExpressions::ProhibitMagicNumbers) 265 | 266 | INFO localtime . " Total Runtime: $duration seconds -- $hours:$rest_min:$rest_sec hours"; 267 | 268 | return; 269 | } ## end sub run 270 | 271 | 272 | =head2 filter_domain 273 | 274 | Filters the domain name; here in the base class: only lower case. 275 | 276 | 277 | =cut 278 | 279 | #sub filter_domain 280 | # { 281 | # my $self = shift; 282 | # my $domain = shift; 283 | # 284 | # return lc($domain); 285 | # } 286 | 287 | # Filter/modify bogus domains 288 | # Maybe this can be configured via parameter ... 289 | with 'Security::TLSCheck::App::DomainFilter'; 290 | 291 | 292 | =head2 analyse($domain, $category) 293 | 294 | Runs all checks for one domain. 295 | 296 | Here single-treaded, override this for parallel processing. 297 | 298 | =cut 299 | 300 | sub analyse 301 | { 302 | my $self = shift; 303 | my $domain = shift; 304 | my $category = shift; 305 | my $read_domain = shift; 306 | my $counter = shift; 307 | 308 | INFO "Start analyse $domain (via $read_domain, category $category) (domain # $counter)"; 309 | my $tc = Security::TLSCheck->new( 310 | domain => $domain, 311 | category => $category, 312 | app => $self 313 | ); 314 | $self->add_result_for_category( $category => scalar $tc->run_all_checks ); 315 | INFO "DONE analyse $domain (category $category) (domain # $counter)"; 316 | 317 | return; 318 | } 319 | 320 | =head2 init_domain_loop, finish_domain_loop 321 | 322 | empty init and finish subs for the domain loop; for overridung ... 323 | 324 | =cut 325 | 326 | sub init_domain_loop { return; } 327 | sub finish_domain_loop { return; } 328 | 329 | 330 | 1; # End of TLS::Check 331 | -------------------------------------------------------------------------------- /lib/Security/TLSCheck/App/DomainFilter.pm: -------------------------------------------------------------------------------- 1 | package Security::TLSCheck::App::DomainFilter; 2 | 3 | use Moose::Role; 4 | 5 | use Log::Log4perl::EasyCatch; 6 | 7 | use English qw( -no_match_vars ); 8 | use FindBin qw($Bin); 9 | 10 | use IO::All; 11 | 12 | =head1 NAME 13 | 14 | Security::TLSCheck::App::DomainFilter -- change wrong domain names into correct ones, if possible 15 | 16 | =head1 VERSION 17 | 18 | Version 0.2.x 19 | 20 | =cut 21 | 22 | #<<< 23 | my $BASE_VERSION = "1.0"; use version; our $VERSION = qv( sprintf "$BASE_VERSION.%d", q$Revision: 676 $ =~ /(\d+)/xg ); 24 | #>>> 25 | 26 | 27 | =head1 SYNOPSIS 28 | 29 | =encoding utf8 30 | 31 | with "Security::TLSCheck::App::DomainFilter"; 32 | 33 | ... 34 | 35 | my $filtered_domain = $self->filter_domain($domain) or next; 36 | 37 | 38 | 39 | =head1 DESCRIPTION 40 | 41 | Helps to change wrong domain names into correct ones, if possible 42 | 43 | There are a lot of really strange inputs; see also tests (221-domain_filter.t) ... 44 | 45 | 46 | =head2 filter_domain 47 | 48 | 49 | =cut 50 | 51 | # TODO: put this in a config file 52 | my %map = ( 53 | "replace-all" => "everything-replaced.tld", 54 | "www.omaschmidts.masche.de" => "omaschmidtsmasche.de", 55 | "EGT Eppinger Gears" => "eppinger-gears.com", 56 | "www.Autohaus.Ford/Nuding" => "ford-nuding-remshalden.de", 57 | "http://www.medic-con.cde" => "medic-con.de", 58 | "localhost" => "localhost", # localhost keeps localhost ... 59 | ); 60 | 61 | my $DATADIR = eval { return File::ShareDir::module_dir(__PACKAGE__); } or DEBUG "Share-Dir-Eval-Error: $EVAL_ERROR"; 62 | $DATADIR = "$FindBin::Bin/../files/DomainFilter" if not defined $DATADIR; # or not -d $DATADIR; 63 | 64 | # Source: https://data.iana.org/TLD/tlds-alpha-by-domain.txt 65 | my %valid_tlds = map { lc($ARG) => 1 } grep { not m{ ^ \s* [#] }x } io("$DATADIR/tlds-alpha-by-domain.txt")->chomp->slurp; 66 | my $tlds_regex_or = join( q(|), keys %valid_tlds ); 67 | my $FORBIDDEN_DOMAINS = qr{ (t[-\s]?online|arcor|web|gmx|hotmail|yahoo|facebook|twitter|youtube|googlemail|outlook|xing|google|instagram|blogspot) }x; 68 | 69 | 70 | sub filter_domain 71 | { 72 | my $self = shift; 73 | my $in = shift; 74 | 75 | if ( $map{$in} ) 76 | { 77 | TRACE "Direct mapping $in to $map{$in}"; 78 | return $map{$in}; 79 | } 80 | 81 | my $domain = lc($in); 82 | 83 | $domain =~ s{,}{.}gx; 84 | 85 | return if $domain =~ m{ ( ^ | [.@] ) $FORBIDDEN_DOMAINS [.] (de|com|net) }ox; 86 | 87 | $domain =~ s{^www\s}{}x; # "www test.de" 88 | $domain =~ s{[-\s:]($tlds_regex_or)$}{.$1}ox; # "test de" "test:de", "test-de", com, (all TLDs) 89 | if ( $domain =~ m{\s}x and $domain !~ m{[.]}x ) 90 | { 91 | WARN "Domain with space and no dot: $in"; 92 | return; 93 | } 94 | 95 | $domain =~ s{\\}{/}gx; # Some Windows users use Backslashes ... ;) 96 | $domain =~ s{.*\@}{}gx; # remove everything before a @ 97 | $domain =~ s{^/+}{}gx; # remove leading / 98 | 99 | $domain =~ s{[.]+}{.}gx; # remove too much . 100 | $domain =~ s{^http:/?/?www./}{}x; # Remove http ... 101 | $domain =~ s{ ^( hk?t{1,3}[opt]p?s?[.:]? //? :? )+ }{}x 102 | ; # remove http:// and http:/ and http//: and more then one of them, and one, two or three t ... 103 | $domain =~ s{^htt?pp?s?:}{}x; # http: without // 104 | $domain =~ s{^https?:/?/?}{}x; # still some http 105 | $domain =~ s{^www?[.]}{}x if $domain =~ m{[.].*?[.]}x; # Remove beginning www when there are at least 2 dots 106 | $domain =~ s{\s}{}gx; # remove spaces 107 | $domain =~ s{[/;].*}{}gx; # remove everything after a / or ; 108 | $domain =~ s{:\d+}{}gx; # Remove port numbers 109 | $domain =~ s{[.]$}{}x; # Remove trailing . 110 | 111 | $domain =~ s{(ourworld[.]compuserve[.]com)[.]homepages}{$1}gx; 112 | 113 | $domain =~ s{ [.] ([de]|dee|deu) $}{.de}x; # .de typos 114 | 115 | # at some domains, the last dot before de or com got lost; but not for all TLDs! ... 116 | if ( $domain !~ m{[.]}x ) 117 | { 118 | 119 | unless ( $domain =~ s{(de|com)$}{.$1}x ) # replace "blablacom" => "blabla.com" etc. 120 | { 121 | WARN "No . in domain"; 122 | return; 123 | } 124 | } 125 | 126 | my ($tld) = $domain =~ m{ ([^.]+) $ }x; 127 | 128 | unless ( $valid_tlds{$tld} ) 129 | { 130 | unless ( $domain =~ s{(de|com)$}{.$1}x ) # replace "blablacom" => "blabla.com" etc. 131 | { 132 | if ( $domain =~ s{^www[.]}{}x ) #if www.somedomain without TLD, add .de 133 | { 134 | $domain .= ".de"; 135 | TRACE "Added a fix .de for domain without TLD"; 136 | } 137 | else 138 | { 139 | WARN "Invalid TLD $tld for domain $domain (in: $in)"; 140 | return; 141 | } 142 | } 143 | $domain =~ s{^www[.]}{}x; 144 | } 145 | 146 | 147 | TRACE "IN: $in; OUT: $domain"; 148 | 149 | return $domain; 150 | 151 | } ## end sub filter_domain 152 | 153 | 154 | 1; 155 | -------------------------------------------------------------------------------- /lib/Security/TLSCheck/App/Parallel.pm: -------------------------------------------------------------------------------- 1 | package Security::TLSCheck::App::Parallel; 2 | 3 | use Moose; 4 | use 5.010; 5 | 6 | =head1 NAME 7 | 8 | Security::TLSCheck::App::Parallel -- run everything in parallel 9 | 10 | =head1 VERSION 11 | 12 | Version 0.2.x 13 | 14 | =cut 15 | 16 | #<<< 17 | my $BASE_VERSION = "1.0"; use version; our $VERSION = qv( sprintf "$BASE_VERSION.%d", q$Revision: 658 $ =~ /(\d+)/xg ); 18 | #>>> 19 | 20 | 21 | =head1 SYNOPSIS 22 | 23 | =encoding utf8 24 | 25 | use Security::TLSCheck::App (extends => 'Security::TLSCheck::Result'); 26 | 27 | my $app = Security::TLSCheck::App->new_with_options(); 28 | $app->run; 29 | 30 | 31 | 32 | =head1 DESCRIPTION 33 | 34 | 35 | =cut 36 | 37 | BEGIN { extends "Security::TLSCheck::App"; } 38 | 39 | use English qw( -no_match_vars ); 40 | use FindBin qw($Bin); 41 | 42 | use Log::Log4perl::EasyCatch; 43 | use Security::TLSCheck; 44 | 45 | use Parallel::ForkManager; 46 | use Storable; # => used internally by PFM; => use Sereal instead? 47 | 48 | use Time::HiRes qw(time); 49 | use Readonly; 50 | 51 | Readonly my $HARD_TIMEOUT => 1200; # stop after 20 minutes ... 52 | 53 | 54 | # Attributes and default values. 55 | has jobs => ( is => "ro", isa => "Int", default => 20, documentation => "Number of max. parallel worker jobs" ); 56 | 57 | 58 | =head2 init_domain_loop 59 | 60 | initialises ForkManager... 61 | 62 | =cut 63 | 64 | my $pm; 65 | 66 | sub init_domain_loop 67 | { 68 | my $self = shift; 69 | 70 | die "ForkManager can only be initialised ONCE!\n" if $pm; 71 | 72 | $pm = Parallel::ForkManager->new( $self->jobs ); 73 | 74 | $pm->run_on_finish( 75 | sub { 76 | my ( $pid, $exit_code, $domain, $exit_signal, $core_dump, $return ) = @ARG; 77 | 78 | if ($core_dump) 79 | { 80 | ERROR "Child for $domain (pid: $pid) core dumped. Exit-Code: $exit_code; Exit-Signal: $exit_signal"; 81 | return; 82 | } 83 | 84 | if ($exit_code) 85 | { 86 | ERROR "Child for $domain (pid: $pid) exited with Exit-Code: $exit_code; Exit-Signal: $exit_signal"; 87 | return; 88 | } 89 | 90 | unless ($return) 91 | { 92 | ERROR "Child for $domain (pid: $pid) returned no data; Exit-Code: $exit_code; Exit-Signal: $exit_signal"; 93 | return; 94 | } 95 | 96 | my ( $return_domain, $category, $result ) = @$return; 97 | 98 | if ( $return_domain ne $domain ) 99 | { 100 | ERROR "Really strange error: Domain in return value ($return_domain) differs from ident ($domain)"; 101 | return; 102 | } 103 | 104 | DEBUG "Master process got result for $domain"; 105 | 106 | # Replace copy of info-element with a reference to the original 107 | # saves a lot of memory when running with thousands of domains 108 | foreach my $check (@$result) 109 | { 110 | my $class = $check->{check}{class}; 111 | foreach my $single_result ( @{ $check->{result} } ) 112 | { 113 | my $pos = $single_result->{info}{pos}; 114 | $single_result->{info} = $class->new( instance => $self )->key_figures->[$pos]; 115 | } 116 | } 117 | 118 | $self->add_result_for_category( $category => $result ); 119 | 120 | } 121 | ); 122 | 123 | 124 | return; 125 | } ## end sub init_domain_loop 126 | 127 | 128 | 129 | =head2 analyse($domain, $category) 130 | 131 | Runs all checks for one domain in background! 132 | 133 | =cut 134 | 135 | sub analyse 136 | { 137 | my $self = shift; 138 | my $domain = shift; 139 | my $category = shift; 140 | my $read_domain = shift; 141 | my $counter = shift; 142 | 143 | DEBUG "Schedule $domain in fork pool"; 144 | 145 | no warnings qw(once); ## no critic (TestingAndDebugging::ProhibitNoWarnings) 146 | local $Storable::Eval = 1; ## no critic (Variables::ProhibitPackageVars) 147 | local $Storable::Deparse = 1; ## no critic (Variables::ProhibitPackageVars) 148 | 149 | # returns if in parent process, otherwise the code below continues in new process 150 | $pm->start($domain) and return; 151 | 152 | # here IN FORK! 153 | local $SIG{ALRM} = sub { 154 | ERROR "Fatal Error, should never happen: HARD TIMEOUT for $domain reached!"; 155 | die "FATAL: HARD TIMEOUT for $domain reached!\n"; 156 | }; # NB: \n required 157 | alarm $HARD_TIMEOUT; # Hard timeout ... 158 | 159 | my $starttime = time; 160 | INFO "Start analyse $domain (via $read_domain, category $category) (domain # $counter)"; 161 | my $tc = Security::TLSCheck->new( domain => $domain, category => $category, app => $self ); 162 | my $result = $tc->run_all_checks; 163 | 164 | my $runtime = sprintf( "%.3f", time - $starttime ); 165 | INFO "DONE analyse $domain (category $category) (domain # $counter) in $runtime Seconds"; 166 | 167 | $pm->finish( 0, [ $domain, $category, $result ] ); 168 | 169 | alarm 0; 170 | 171 | return; 172 | } ## end sub analyse 173 | 174 | 175 | 176 | =head2 finish_domain_loop 177 | 178 | Finish ForkManager: wait for all children 179 | 180 | =cut 181 | 182 | sub finish_domain_loop 183 | { 184 | my $self = shift; 185 | 186 | DEBUG "Now waiting for the last jobs."; 187 | $pm->wait_all_children; 188 | undef $pm; 189 | DEBUG "All jobs finished."; 190 | 191 | return; 192 | } 193 | 194 | 1; # End of TLS::Check 195 | -------------------------------------------------------------------------------- /lib/Security/TLSCheck/Checks.pm: -------------------------------------------------------------------------------- 1 | package Security::TLSCheck::Checks; 2 | 3 | use 5.010; 4 | use strict; 5 | use warnings; 6 | 7 | use Carp; 8 | use Scalar::Util qw(blessed); 9 | use English qw( -no_match_vars ); 10 | 11 | use Moose; 12 | 13 | use Log::Log4perl::EasyCatch; 14 | 15 | 16 | =head1 NAME 17 | 18 | Security::TLSCheck::Checks - Base class for all checks 19 | 20 | =encoding utf8 21 | 22 | =cut 23 | 24 | #<<< 25 | my $BASE_VERSION = "1.0"; use version; our $VERSION = qv( sprintf "$BASE_VERSION.%d", q$Revision: 658 $ =~ /(\d+)/xg ); 26 | #>>> 27 | 28 | 29 | =head1 SYNOPSIS 30 | 31 | As check subclass: 32 | 33 | package Security::TLSCheck::Checks::MyCheck 34 | 35 | use Moose; 36 | extends 'Security::TLSCheck::Checks' 37 | 38 | has '+description' => ( default => "Checking my checks"); 39 | 40 | 41 | As caller: 42 | 43 | use Security::TLSCheck::Checks::MyCheck; 44 | 45 | my $check = Security::TLSCheck::Checks::MyCheck->new(); 46 | say "Check Name: " . $check->name; 47 | say "Check Description: " . $check->description; 48 | 49 | my @results = $check->run_check; 50 | 51 | say "Check runtime: " . $check->runtime; 52 | 53 | 54 | =head1 DESCRIPTION 55 | 56 | Base class for all checks. Defines all common attributes, and helper methods. 57 | 58 | For a project overview, see the README.md of the Distribution. 59 | 60 | 61 | 62 | =cut 63 | 64 | 65 | #<<< 66 | 67 | has name => ( is => 'ro', isa => 'Str', lazy_build => 1, ); 68 | has class => ( is => 'ro', isa => 'Str', lazy_build => 1, ); 69 | has www => ( is => "ro", isa => "Str", lazy_build => 1, ); 70 | has description => ( is => 'ro', isa => 'Str', default => "no description" ); 71 | has error => ( is => 'rw', isa => 'Str', ); 72 | 73 | has key_figures => ( is => "ro", isa => "ArrayRef[HashRef[Str]]", auto_deref => 1, default => sub { [] } ); 74 | 75 | has instance => ( is => 'rw', isa => 'Object', required => 1, handles => [qw(domain category timeout user_agent_name my_hostname other_check)], predicate => "has_instance", clearer => "clear_instance",); 76 | 77 | has start_time => ( is => 'rw', isa => 'Num' ); 78 | has end_time => ( is => 'rw', isa => 'Num' ); 79 | 80 | #>>> 81 | 82 | 83 | =head1 METHODS 84 | 85 | =head2 BUILD 86 | 87 | 88 | 89 | =cut 90 | 91 | sub BUILD 92 | { 93 | my $self = shift; 94 | 95 | # Mark position in key_figures with their own number 96 | # with this info the key figure data in the result can be 97 | # replaces by a ref to the all-time same key_figure 98 | # in fork mode, this may save much memory 99 | my $key_figures = $self->key_figures; 100 | 101 | for my $pos ( 0 .. $#{$key_figures} ) 102 | { 103 | $key_figures->[$pos]{pos} = $pos; 104 | } 105 | 106 | return $self; 107 | } 108 | 109 | 110 | =head2 _build_name 111 | 112 | Default name is name of the package, without the basename. 113 | 114 | =cut 115 | 116 | sub _build_name 117 | { 118 | my $self = shift; 119 | 120 | ( my $name = $self->class ) =~ s{Security::TLSCheck::Checks::}{}x; 121 | 122 | return $name; 123 | 124 | } 125 | 126 | =head2 _build_class 127 | 128 | Default name is name of the package, without the basename. 129 | 130 | =cut 131 | 132 | sub _build_class 133 | { 134 | return blessed(shift); 135 | } 136 | 137 | =head2 _build_www 138 | 139 | generaters "www.domain" from domain. 140 | 141 | Very simple at the moment: only prepends www. 142 | 143 | =cut 144 | 145 | sub _build_www 146 | { 147 | my $self = shift; 148 | 149 | return "www." . $self->domain; 150 | } 151 | 152 | 153 | =head2 ->runtime 154 | 155 | Returns the runtime in seconds of this check. 156 | 157 | =cut 158 | 159 | 160 | sub runtime 161 | { 162 | my $self = shift; 163 | 164 | defined $self->start_time or croak "No start time set!"; 165 | defined $self->end_time or croak "No end time set!"; 166 | 167 | return $self->end_time - $self->start_time; 168 | } 169 | 170 | 171 | =head2 ->run_check 172 | 173 | Default for runing all tests: the tests are started via the method calls 174 | of key_figures in the result method. 175 | 176 | So, this method only calls the result method and returns its return value. 177 | 178 | For more complex runs override run_check. 179 | 180 | =cut 181 | 182 | 183 | sub run_check 184 | { 185 | my $self = shift; 186 | 187 | return $self->result; 188 | } 189 | 190 | 191 | 192 | =head2 result 193 | 194 | calculates the result, according to the C attribute. 195 | 196 | Returns a array(ref) of hashrefs: 197 | 198 | [ 199 | { 200 | info => { name => "My Name", type => "flag", ... }, 201 | value => 3, 202 | }, 203 | 204 | ] 205 | 206 | =cut 207 | 208 | sub result 209 | { 210 | my $self = shift; 211 | 212 | DEBUG "build result for " . $self->name . ", domain " . $self->domain; 213 | my @result = map { $self->_get_value($ARG) } $self->key_figures; 214 | DEBUG "OK, result built for " . $self->name . ", domain " . $self->domain; 215 | 216 | return \@result; # wantarray ? @result : \@result; 217 | } 218 | 219 | 220 | sub _get_value 221 | { 222 | my $self = shift; 223 | my $key_figure = shift; 224 | 225 | my $source_method = $key_figure->{source}; 226 | my $value = $self->$source_method; 227 | 228 | # temp, until we handle more types 229 | # when it is only a flag, then switch to 1 or 0 230 | $value = $value ? 1 : 0 if $key_figure->{type} eq "flag"; 231 | 232 | return { 233 | # name => $key_figure->{name}, 234 | # type => $key_figure->{type}, 235 | value => $value, 236 | info => $key_figure, 237 | }; 238 | 239 | } 240 | 241 | 242 | #=head2 key_figure_info_by_name 243 | # 244 | #Gets an key_figure info hash(ref) by the name of the check 245 | # 246 | #=cut 247 | # 248 | #sub key_figure_info_by_name 249 | # { 250 | # my $self = shift; 251 | # 252 | # 253 | # 254 | # } 255 | 256 | 257 | __PACKAGE__->meta->make_immutable; 258 | 259 | 1; 260 | -------------------------------------------------------------------------------- /lib/Security/TLSCheck/Checks/AgeDE.pm: -------------------------------------------------------------------------------- 1 | package Security::TLSCheck::Checks::AgeDE; 2 | 3 | use Moose; 4 | extends 'Security::TLSCheck::Checks'; 5 | with 'Security::TLSCheck::Checks::Helper::Timing'; 6 | 7 | use Log::Log4perl::EasyCatch; 8 | 9 | use LWP::UserAgent; 10 | 11 | 12 | =head1 NAME 13 | 14 | Security::TLSCheck::Checks::AgeDE - Checks, if a host has an age-de.xml file 15 | 16 | =encoding utf8 17 | 18 | =cut 19 | 20 | use version; our $VERSION = sprintf "%d", q$Revision: 662 $ =~ /(\d+)/xg; 21 | 22 | 23 | =head1 SYNOPSIS 24 | 25 | ... 26 | 27 | 28 | =head1 DESCRIPTION 29 | 30 | This test looks for a file named age-de.xml in the root directory and parses it if exists. 31 | 32 | age-de.xml is a german standard for age labeling for child protection filter programs. 33 | It's very rarely used but will be a standard by german law. 34 | 35 | The ages are: 0, 6, 12, 16, 18 36 | 37 | XML parsing not really started, it's only simple regexes 38 | 39 | TODO: Parse XML 40 | 41 | =cut 42 | 43 | #<<< 44 | 45 | { 46 | my $key_figures = 47 | [ 48 | { name => "Has age-de.xml", type => "flag", source => "has_age_de_xml", description => "A file /age-de.xml file exists, but maybe redirected", lazy_build => 1, }, 49 | { name => "Looks like age-de.xml", type => "flag", source => "has_age_declaration", description => "Content looks like a real age-de.xml", }, 50 | { name => "Default age", type => "group", source => "default_age", description => "The default age from age-de.xml", }, 51 | { name => "Min age", type => "group", source => "min_age", description => "The minimum age, from age-de.xml" }, 52 | ]; 53 | 54 | has '+key_figures' => ( default => sub {return $key_figures} ); 55 | } 56 | 57 | has '+description' => ( default => "Checks if a site supports german age rating labels 'age-de.xml'" ); 58 | 59 | has age_de_xml => (is => "rw", isa => "Str", ); 60 | 61 | #>>> 62 | 63 | 64 | =head1 METHODS 65 | 66 | =head2 run_check 67 | 68 | runs the main check 69 | 70 | Here: tries to get the age-de.xml file and stores it's content in attribute 71 | C. 72 | 73 | 74 | =cut 75 | 76 | sub run_check 77 | { 78 | my $self = shift; 79 | 80 | my $www = $self->www; 81 | 82 | unless ( $self->other_check("Security::TLSCheck::Checks::Web")->http_active ) 83 | { 84 | DEBUG "Skipped AgeDE tests for $www because no HTTP active"; 85 | return; 86 | } 87 | 88 | # build user agent (instead of LWP::Simple or IO::All), 89 | # because we need to set agent and timeout etc ... 90 | my $ua = LWP::UserAgent->new( timeout => $self->timeout, agent => $self->user_agent_name, ); 91 | my $response = $ua->get("http://$www/age-de.xml"); 92 | 93 | $self->age_de_xml( $response->decoded_content ) if $response->is_success; 94 | 95 | 96 | return $self->result; 97 | 98 | } ## end sub run_check 99 | 100 | =head2 has_age_de_xml 101 | 102 | Returns true if there is a age_de_xml. 103 | 104 | Since redirects are accepted, this might be the start page 105 | or an error page (when no error code is set) etc. So, this does not mean, 106 | that there is really an age-de.xml! 107 | 108 | =cut 109 | 110 | sub has_age_de_xml 111 | { 112 | my $self = shift; 113 | return 1 if $self->age_de_xml; 114 | return; 115 | } 116 | 117 | 118 | =head2 has_age_declaration 119 | 120 | A simple check, if there is really an age-de.xml. 121 | 122 | =cut 123 | 124 | sub has_age_declaration 125 | { 126 | my $self = shift; 127 | if ( ( $self->age_de_xml // "" ) =~ m{www; # Debug 130 | return 1; 131 | } 132 | return; 133 | } 134 | 135 | =head2 default_age 136 | 137 | Gets the default age from an existing age-de.xml or undef; 138 | 139 | =cut 140 | 141 | sub default_age 142 | { 143 | my $self = shift; 144 | my ($default_age) = ( $self->age_de_xml // "" ) =~ m{ \s* (\d+) }sx; 145 | TRACE "FOUND default-age '$default_age' for " . $self->www if defined $default_age; 146 | return $default_age; 147 | } 148 | 149 | 150 | =head2 min_age 151 | 152 | Gets the minage from an existing age-de.xml or undef; 153 | 154 | =cut 155 | 156 | sub min_age 157 | { 158 | my $self = shift; 159 | my ($min_age) = ( $self->age_de_xml // "" ) =~ m{ \s* (\d+) }sx; 160 | TRACE "FOUND min-age '$min_age' for " . $self->www if defined $min_age; 161 | return $min_age; 162 | } 163 | 164 | 165 | 166 | __PACKAGE__->meta->make_immutable; 167 | 168 | 1; 169 | -------------------------------------------------------------------------------- /lib/Security/TLSCheck/Checks/CipherStrength.pm: -------------------------------------------------------------------------------- 1 | package Security::TLSCheck::Checks::CipherStrength; 2 | 3 | 4 | use Moose; 5 | extends 'Security::TLSCheck::Checks'; 6 | with 'Security::TLSCheck::Checks::Helper::Timing'; 7 | 8 | use Log::Log4perl::EasyCatch; 9 | 10 | use Net::SSL::GetServerProperties; 11 | 12 | 13 | =head1 NAME 14 | 15 | Security::TLSCheck::Checks::CipherStrength - Check Strength of CipherSuites and SSL/TLS Version 16 | 17 | =encoding utf8 18 | 19 | =cut 20 | 21 | use version; our $VERSION = sprintf "%d", q$Revision: 676 $ =~ /(\d+)/xg; 22 | 23 | 24 | =head1 SYNOPSIS 25 | 26 | ... 27 | 28 | 29 | =head1 DESCRIPTION 30 | 31 | ... 32 | 33 | 34 | 35 | =cut 36 | 37 | #<<< 38 | 39 | my $key_figures = 40 | [ 41 | 42 | { name => "Supports SSLv2", type => "flag", source => "supports_sslv2", description => "Server supports SSLv2" }, 43 | { name => "Supports SSLv3", type => "flag", source => "supports_sslv3", description => "Server supports SSLv3" }, 44 | { name => "Supports TLSv1", type => "flag", source => "supports_tlsv1", description => "Server supports TLSv1" }, 45 | { name => "Supports TLSv11", type => "flag", source => "supports_tlsv11", description => "Server supports TLSv11" }, 46 | { name => "Supports TLSv12", type => "flag", source => "supports_tlsv12", description => "Server supports TLSv12" }, 47 | { name => "Supports SSLv3 or better", type => "flag", source => "supports_sslv3_or_newer", description => "Server supports SSLv3 or above" }, 48 | { name => "Supports TLSv1 or better", type => "flag", source => "supports_tlsv1_or_newer", description => "Server supports TLSv1 or above" }, 49 | { name => "Supports TLSv11 or better", type => "flag", source => "supports_tlsv11_or_newer", description => "Server supports TLSv11 or above" }, 50 | { name => "Supports TLSv12 or better", type => "flag", source => "supports_tlsv12_or_newer", description => "Server supports TLSv12 or above" }, 51 | { name => "Supports only SSLv2", type => "flag", source => "supports_only_sslv2", description => "Server supports only SSLv2" }, 52 | { name => "Supports SSLv3 or older", type => "flag", source => "supports_sslv3_or_older", description => "Server supports only SSLv3 or older" }, 53 | { name => "Supports TLSv1 or older", type => "flag", source => "supports_tlsv1_or_older", description => "Server supports TLSv1 or older" }, 54 | { name => "Supports TLSv11 or older", type => "flag", source => "supports_tlsv11_or_older", description => "Server supports TLSv11 or older" }, 55 | 56 | { name => "Supports Any BC A", type => "flag", source => "supports_any_bc_a", description => "Server supports any Bettercrypto A CipherSuite" }, 57 | { name => "Supports Any BC b", type => "flag", source => "supports_any_bc_b", description => "Server supports any Bettercrypto B CipherSuite" }, 58 | { name => "Supports Any BSI PFS", type => "flag", source => "supports_any_bsi_pfs", description => "Server supports any BSI Recommendation with PFS" }, 59 | { name => "Supports Any BSI (no) PFS", type => "flag", source => "supports_any_bsi_nopfs", description => "Server supports any BSI Recommendation with (no) PFS" }, 60 | { name => "Supports Only BC A", type => "flag", source => "supports_only_bc_a", description => "Server supports only Bettercrypto A CipherSuite" }, 61 | { name => "Supports Only BC b", type => "flag", source => "supports_only_bc_b", description => "Server supports only Bettercrypto B CipherSuite" }, 62 | { name => "Supports Only BSI PFS", type => "flag", source => "supports_only_bsi_pfs", description => "Server supports only BSI Recommendation with PFS" }, 63 | { name => "Supports Only BSI (no) PFS", type => "flag", source => "supports_only_bsi_nopfs", description => "Server supports only BSI Recommendation with (no) PFS" }, 64 | 65 | { name => "Supports very weak ciphers", type => "flag", source => "supports_very_weak", description => "Server supports very weak ciphers (e.g. EXPORT, NULL, ...)" }, 66 | { name => "Supports weak ciphers", type => "flag", source => "supports_weak", description => "Server supports weak ciphers (e.g. 56 bit, RC4, ...)" }, 67 | { name => "Supports medium ciphers", type => "flag", source => "supports_medium", description => "Server supports medium ciphers ()" }, 68 | { name => "Supports no weak/medium cipher", type => "flag",source=>"supports_no_weakmedium", description => "Server supports no weak/medium, only high or unknown ciphers" }, 69 | 70 | # TODO: experimental Temp ciphers, CBC ... 71 | { name => "Supports weak ciphers, no Beast/CBC", type => "flag", source => "supports_weak_ciphers_no_cbc", description => "Experimental: Server supports weak ciphers, excluding Beast-CBC", }, 72 | { name => "Supports Beast/CBC ciphers", type => "flag", source => "supports_beast_cbc_ciphers", description => "Experimental: Server supports Beast-CBC ciphers", }, 73 | { name => "Supports medium ciphers, including Beast/CBC", type => "flag", source => "supports_medium_ciphers_withcbc", description => "Experimental: Server supports medium ciphers, including Beast-CBC" }, 74 | { name => "Supports weak ciphers, excluding Bettercrypto B", type => "flag", source => "supports_weak_ciphers_no_bettercrypto_b", description => "Experimental: Server supports weak ciphers, excluding Bettercrypto B" }, 75 | 76 | 77 | { name => "Supports ECDSA keys", type => "flag", source => "supports_ec_keys", description => "Server supports elliptic courve keys" }, 78 | { name => "Supports only ECDSA keys", type => "flag", source => "supports_ec_keys", description => "Server supports only elliptic courve keys" }, 79 | { name => "Supports PFS cipher(s)", type => "flag", source => "supports_pfs", description => "Server supports at least one cipher with perforct forward secrecy" }, 80 | { name => "Supports only PFS ciphers", type => "flag", source => "supports_only_pfs", description => "Server supports only ciphers with perfect forward secrecy" }, 81 | 82 | 83 | { name => "Cipher-Suite with Firefox", type => "group", source => "firefox_cipher", description => "Selected Cipher-Suite with Firefox 42" }, 84 | { name => "Cipher-Suite with Safari", type => "group", source => "safari_cipher", description => "Selected Cipher-Suite with Safari 9.0.1" }, 85 | { name => "Cipher-Suite with Chrome", type => "group", source => "chrome_cipher", description => "Selected Cipher-Suite with Chrome 46.0" }, 86 | { name => "Cipher-Suite with IE8 Win7", type => "group", source => "ie8win7_cipher", description => "Selected Cipher-Suite with IE 8 on Win 7" }, 87 | { name => "Cipher-Suite with IE11 Win11",type => "group", source => "ie11win10_cipher", description => "Selected Cipher-Suite with IE 11 on Win 11" }, 88 | 89 | { name => "# of accepted Cipher Suites", type => "int", source => "count_accepted_ciphers", description => "Counts the number of the accepted cipher suites", }, 90 | { name => "Group # of accepted Ciphers", type => "group", source => "count_accepted_ciphers", description => "Groups the number of the accepted cipher suites", }, 91 | 92 | { name => "Suppports Only BSI Versions", type => "flag", source => "supports_only_bsi_versions", description => "Server supports only BSI recommended Versions: TLSv1.2 and up and maybe TLSv1.1" }, 93 | { name => "Full BSI support Vers+Ciph", type => "flag", source => "supports_only_bsi_versions_ciphers", description => "Full BSI support for version and ciphers" }, 94 | { name => "Supports Only TLSv12", type => "flag", source => "supports_only_tlsv12", description => "Server supports only TLSv1.2" }, 95 | { name => "Supports old SSL v2/v3", type => "flag", source => "supports_ancient_ssl_versions", description => "Server supports ancient SSL versions 2.0 or 3.0" }, 96 | 97 | { name => "Score", type => "int", source => "score", description => "Overall Encryption Strength", }, 98 | { name => "Score grouped", type => "group", source => "score", description => "Histogram of Overall Encryption Strength", }, 99 | { name => "Score from TLS/SSL Version", type => "int", source => "score_tlsversion", description => "TLS/SSL-Version Strength", }, 100 | { name => "Score from CipherSuites", type => "int", source => "score_ciphersuites", description => "CipherSuite Strength", }, 101 | { name => "Score as Name", type => "group", source => "named_score", description => "Score string with CipherSuite and TLS-Version", }, 102 | 103 | { name => "Supported CipherSuites", type => "set", source => "join_cipher_names", description => "All supported CipherSuites by this server", }, 104 | 105 | ]; 106 | 107 | has '+key_figures' => ( default => sub {return $key_figures} ); 108 | 109 | has '+description' => ( default => "Strength of CipherSuites and SSL/TLS Version" ); 110 | 111 | has properties => ( is => "rw", isa => "Net::SSL::GetServerProperties", 112 | handles => [ 113 | qw( 114 | supports_sslv2 115 | supports_sslv3 116 | supports_tlsv1 117 | supports_tlsv11 118 | supports_tlsv12 119 | supports_any_bc_a 120 | supports_any_bc_b 121 | supports_any_bsi_pfs 122 | supports_any_bsi_nopfs 123 | supports_only_bc_a 124 | supports_only_bc_b 125 | supports_only_bsi_pfs 126 | supports_only_bsi_nopfs 127 | supports_very_weak 128 | supports_weak 129 | supports_medium 130 | supports_no_weakmedium 131 | 132 | supports_weak_ciphers_no_cbc 133 | supports_beast_cbc_ciphers 134 | supports_medium_ciphers_withcbc 135 | supports_weak_ciphers_no_bettercrypto_b 136 | 137 | firefox_cipher 138 | safari_cipher 139 | chrome_cipher 140 | ie8win7_cipher 141 | ie11win10_cipher 142 | 143 | count_accepted_ciphers 144 | 145 | supports_only_bsi_versions 146 | supports_only_bsi_versions_ciphers 147 | supports_only_tlsv12 148 | supports_ancient_ssl_versions 149 | 150 | score 151 | named_score 152 | score_ciphersuites 153 | score_tlsversion 154 | 155 | 156 | supports_sslv3_or_newer 157 | supports_tlsv1_or_newer 158 | supports_tlsv11_or_newer 159 | supports_tlsv12_or_newer 160 | supports_tlsv11_or_older 161 | supports_tlsv1_or_older 162 | supports_sslv3_or_older 163 | supports_only_sslv2 164 | 165 | supports_ec_keys 166 | supports_only_ec_keys 167 | supports_pfs 168 | supports_only_pfs 169 | 170 | ), ], ); 171 | 172 | #>>> 173 | 174 | 175 | =head1 METHODS 176 | 177 | =head2 run_check 178 | 179 | ... 180 | 181 | =cut 182 | 183 | sub run_check 184 | { 185 | my $self = shift; 186 | 187 | my $www = $self->www; 188 | 189 | # check web only if there is some HTTPS 190 | unless ( $self->other_check("Security::TLSCheck::Checks::Web")->https_active ) 191 | { 192 | DEBUG "Skipped CipherStrength tests for $www because no https active"; 193 | return; 194 | } 195 | 196 | my $prop = Net::SSL::GetServerProperties->new( host => $www, timeout => $self->timeout, ); 197 | $prop->get_properties; 198 | 199 | $self->properties($prop); 200 | 201 | return $self->result; 202 | } 203 | 204 | =head2 ->join_cipher_names 205 | 206 | Joins all (supported) cipher names with a : to one string, suitable for the Check type "set". 207 | 208 | =cut 209 | 210 | sub join_cipher_names 211 | { 212 | my $self = shift; 213 | 214 | my $ciphers = join( q{:}, $self->properties->supported_cipher_names ); 215 | TRACE "Score ${ \$self->score }, Supported Ciphers for ${ \$self->domain }: $ciphers"; 216 | return $ciphers; 217 | } 218 | 219 | 220 | __PACKAGE__->meta->make_immutable; 221 | 222 | 1; 223 | -------------------------------------------------------------------------------- /lib/Security/TLSCheck/Checks/CipherStrengthOnlyValidCerts.pm: -------------------------------------------------------------------------------- 1 | package Security::TLSCheck::Checks::CipherStrengthOnlyValidCerts; 2 | 3 | 4 | use Moose; 5 | extends 'Security::TLSCheck::Checks::CipherStrength'; 6 | with 'Security::TLSCheck::Checks::Helper::Timing'; 7 | 8 | use Log::Log4perl::EasyCatch; 9 | 10 | =head1 NAME 11 | 12 | Security::TLSCheck::Checks::CipherStrengthOnlyValidCerts - Check Strength of CipherSuites and SSL/TLS Version, but only for domains with valid certficates 13 | 14 | =encoding utf8 15 | 16 | =cut 17 | 18 | use version; our $VERSION = sprintf "%d", q$Revision: 640 $ =~ /(\d+)/xg; 19 | 20 | 21 | has '+description' => ( default => "Strength of CipherSuites and SSL/TLS Version, but only for valid and verified certificates" ); 22 | 23 | 24 | =head1 SYNOPSIS 25 | 26 | The same as Security::TLSCheck::Checks::CipherStrength 27 | 28 | 29 | =head1 DESCRIPTION 30 | 31 | Returns the values of Security::TLSCheck::Checks::CipherStrength, but only if HTTPS Certificate is OK and matches the domain. 32 | 33 | 34 | =cut 35 | 36 | 37 | =head1 METHODS 38 | 39 | =head2 run_check 40 | 41 | Retuns the result from Security::TLSCheck::Checks::CipherStrength, when Certificate is verified etc. 42 | 43 | 44 | 45 | =cut 46 | 47 | sub run_check 48 | { 49 | my $self = shift; 50 | 51 | return $self->other_check("Security::TLSCheck::Checks::CipherStrength-result") 52 | if $self->other_check("Security::TLSCheck::Checks::Web")->https_all_verified; 53 | 54 | my $www = $self->www; 55 | DEBUG "Skipped CipherStrengthOnlyValidCerts tests for $www because no valid certificate"; 56 | return; 57 | 58 | 59 | } 60 | 61 | __PACKAGE__->meta->make_immutable; 62 | 63 | 1; 64 | -------------------------------------------------------------------------------- /lib/Security/TLSCheck/Checks/DNS.pm: -------------------------------------------------------------------------------- 1 | package Security::TLSCheck::Checks::DNS; 2 | 3 | use 5.010; 4 | use strict; 5 | use warnings; 6 | 7 | use Carp; 8 | use English qw( -no_match_vars ); 9 | 10 | use Moose; 11 | extends 'Security::TLSCheck::Checks'; 12 | with 'Security::TLSCheck::Checks::Helper::Timing'; 13 | with 'Security::TLSCheck::Checks::Helper::MX'; 14 | 15 | use Net::DNS (); 16 | 17 | use Log::Log4perl::EasyCatch; 18 | 19 | =head1 NAME 20 | 21 | Security::TLSCheck::Checks::DNS - Basic DNS Checks 22 | 23 | =encoding utf8 24 | 25 | =cut 26 | 27 | use version; our $VERSION = sprintf "%d", q$Revision: 658 $ =~ /(\d+)/xg; 28 | 29 | 30 | =head1 SYNOPSIS 31 | 32 | ... 33 | 34 | 35 | =head1 DESCRIPTION 36 | 37 | Anzahl DNS-Server, Verifizierung DNS-Server (SOA etc), Anzahl MX, IPv6; … 38 | 39 | Gets the following values: 40 | 41 | ... 42 | 43 | Gets the following key figures: 44 | 45 | * Number of ns 46 | * Number of mx 47 | * Count of all ns/mx via IPv4/IPv6 48 | * Count of all addresses for domain or www via IPv4/IPv6 49 | 50 | 51 | =cut 52 | 53 | #<<< 54 | 55 | { 56 | my $key_figures = 57 | [ 58 | { name => "# Nameserver", type => "count", source => "count_ns", description => "Number of nameservers for this domain" }, 59 | { name => "# Mail Exchanger", type => "count", source => "count_mx", description => "Number of MX for this domain" }, 60 | { name => "Domain IPv4", type => "flag", source => "supports_ipv4", description => "Domain (or www) has IPv4 records" }, 61 | { name => "Domain IPv6", type => "flag", source => "supports_ipv6", description => "Domain (or www) has IPv6 records" }, 62 | { name => "NS IPv4", type => "flag", source => "count_ipv4_ns", description => "Nameserver has IPv4 records" }, 63 | { name => "NS IPv6", type => "flag", source => "count_ipv6_ns", description => "Nameserver has IPv6 records" }, 64 | { name => "MX IPv4", type => "flag", source => "count_ipv4_mx", description => "MX has IPv4 records" }, 65 | { name => "MX IPv6", type => "flag", source => "count_ipv6_mx", description => "MX has IPv6 records" }, 66 | { name => "Domain only IPv4", type => "flag", source => "only_ipv4", description => "Domain (or www) has only IPv4 records" }, 67 | { name => "Domain only IPv6", type => "flag", source => "only_ipv6", description => "Domain (or www) has only IPv6 records" }, 68 | { name => "NS only IPv4", type => "flag", source => "only_ipv4_ns", description => "All nameservers have only IPv4 records" }, 69 | { name => "NS only IPv6", type => "flag", source => "only_ipv6_ns", description => "All nameservers have only IPv6 records" }, 70 | { name => "MX only IPv4", type => "flag", source => "only_ipv4_mx", description => "All MX have only IPv4 records" }, 71 | { name => "MX only IPv6", type => "flag", source => "only_ipv6_mx", description => "All MX have only IPv6 records" }, 72 | 73 | { name => "Multi-IP domain IPv4", type => "group", source => "count_ipv4", description => "Number of IPv4-IPs for the domain, grouped (count roundrobin)" }, 74 | { name => "Multi-IP domain IPv6", type => "group", source => "count_ipv6", description => "Number of IPv6-IPs for the domain, grouped (count roundrobin)" }, 75 | { name => "Multi-IP www IPv4", type => "group", source => "count_ipv4_www", description => "Number of IPv4-IPs for the www.domain, grouped (count roundrobin)" }, 76 | { name => "Multi-IP www IPv6", type => "group", source => "count_ipv6_www", description => "Number of IPv6-IPs for the www.domain, grouped (count roundrobin)" }, 77 | 78 | ]; 79 | 80 | has '+key_figures' => ( default => sub {return $key_figures} ); 81 | } 82 | 83 | has '+description' => ( default => "Basic DNS Checks" ); 84 | 85 | has ns => ( is => 'rw', isa => 'ArrayRef[Str]', traits => ['Array'], handles => { count_ns => 'count', add_ns => 'push', all_ns => 'elements', }, default => sub {[]}, ); 86 | has mx => ( is => 'rw', isa => 'ArrayRef[Str]', traits => ['Array'], handles => { count_mx => 'count', add_mx => 'push', all_mx => 'elements', }, default => sub {[]}, ); 87 | has ipv4 => ( is => 'rw', isa => 'ArrayRef[Str]', traits => ['Array'], handles => { count_ipv4 => 'count', add_ipv4 => 'push', all_ipv4 => 'elements', }, default => sub {[]}, ); 88 | has ipv6 => ( is => 'rw', isa => 'ArrayRef[Str]', traits => ['Array'], handles => { count_ipv6 => 'count', add_ipv6 => 'push', all_ipv6 => 'elements', }, default => sub {[]}, ); 89 | has ipv4_www => ( is => 'rw', isa => 'ArrayRef[Str]', traits => ['Array'], handles => { count_ipv4_www => 'count', add_ipv4_www => 'push', all_ipv4_www => 'elements', }, default => sub {[]}, ); 90 | has ipv6_www => ( is => 'rw', isa => 'ArrayRef[Str]', traits => ['Array'], handles => { count_ipv6_www => 'count', add_ipv6_www => 'push', all_ipv6_www => 'elements', }, default => sub {[]}, ); 91 | has ipv4_ns => ( is => 'rw', isa => 'ArrayRef[Str]', traits => ['Array'], handles => { count_ipv4_ns => 'count', add_ipv4_ns => 'push', all_ipv4_ns => 'elements', }, default => sub {[]}, ); 92 | has ipv6_ns => ( is => 'rw', isa => 'ArrayRef[Str]', traits => ['Array'], handles => { count_ipv6_ns => 'count', add_ipv6_ns => 'push', all_ipv6_ns => 'elements', }, default => sub {[]}, ); 93 | has ipv4_mx => ( is => 'rw', isa => 'ArrayRef[Str]', traits => ['Array'], handles => { count_ipv4_mx => 'count', add_ipv4_mx => 'push', all_ipv4_mx => 'elements', }, default => sub {[]}, ); 94 | has ipv6_mx => ( is => 'rw', isa => 'ArrayRef[Str]', traits => ['Array'], handles => { count_ipv6_mx => 'count', add_ipv6_mx => 'push', all_ipv6_mx => 'elements', }, default => sub {[]}, ); 95 | 96 | has _already_run => ( is => "rw", isa => "Bool", default => 0, ); 97 | 98 | #>>> 99 | 100 | 101 | =head1 METHODS 102 | 103 | =head2 ->run_check 104 | 105 | =cut 106 | 107 | 108 | sub run_check 109 | { 110 | my $self = shift; 111 | 112 | return $self->result if $self->_already_run; 113 | 114 | $self->add_ns( $self->get_ns ); 115 | $self->add_mx( $self->get_mx ); 116 | 117 | # $self->instance->cached_mx( $self->mx ); 118 | 119 | $self->add_ipv4( $self->_get_ip( $self->domain, "A" ) ); 120 | $self->add_ipv6( $self->_get_ip( $self->domain, "AAAA" ) ); 121 | 122 | $self->add_ipv4_www( $self->_get_ip( $self->www, "A" ) ); 123 | $self->add_ipv6_www( $self->_get_ip( $self->www, "AAAA" ) ); 124 | 125 | $self->add_ipv4_ns( $self->_get_ip( $ARG, "A" ) ) foreach $self->all_ns; 126 | $self->add_ipv6_ns( $self->_get_ip( $ARG, "AAAA" ) ) foreach $self->all_ns; 127 | 128 | $self->add_ipv4_mx( $self->_get_ip( $ARG, "A" ) ) foreach $self->all_mx; 129 | $self->add_ipv6_mx( $self->_get_ip( $ARG, "AAAA" ) ) foreach $self->all_mx; 130 | 131 | $self->_already_run(1); 132 | 133 | return $self->result; 134 | } ## end sub run_check 135 | 136 | 137 | =head2 get_ns 138 | 139 | returns the list of NS records for this Domain 140 | 141 | =cut 142 | 143 | sub get_ns 144 | { 145 | my $self = shift; 146 | my $domain = $self->domain; 147 | 148 | DEBUG "Start DNS Query for NS records for $domain"; 149 | my $reply = $self->_resolver->query( $domain, "NS" ); 150 | DEBUG "DNS NS Query for $domain finished"; 151 | 152 | unless ($reply) 153 | { 154 | DEBUG "No NS records for domain $domain Error: " . $self->_resolver->errorstring; 155 | $self->error( $self->_resolver->errorstring ); 156 | return; 157 | } 158 | 159 | my @ns = map { $ARG->nsdname } grep { $ARG->type eq 'NS' } $reply->answer; 160 | 161 | DEBUG "found some nameserver for $domain: @ns"; 162 | 163 | return @ns; 164 | 165 | } ## end sub get_ns 166 | 167 | sub _get_ip 168 | { 169 | my $self = shift; 170 | my $host = shift; 171 | my $type = shift // "A"; 172 | 173 | DEBUG "DNS query $type for $host"; 174 | my $reply = $self->_resolver->search( $host, $type ); 175 | DEBUG "Done DNS query $type for $host"; 176 | 177 | unless ($reply) 178 | { 179 | DEBUG "No $type record found for $host"; 180 | return; 181 | } 182 | 183 | my @result = map { $ARG->address } grep { $ARG->type eq $type } $reply->answer; 184 | 185 | DEBUG "Found $type addresses for $host: @result"; 186 | 187 | return @result; 188 | } ## end sub _get_ip 189 | 190 | # 191 | # get_mx is in the externaleo 192 | # 193 | 194 | =head2 supports_ipv4, supports_ipv6 195 | 196 | returns true, when the domain has an ipv4/ipv6 address record for the domain name OR a www subdomain 197 | 198 | =cut 199 | 200 | sub supports_ipv4 201 | { 202 | my $self = shift; 203 | return $self->count_ipv4 + $self->count_ipv4_www; 204 | } 205 | 206 | sub supports_ipv6 207 | { 208 | my $self = shift; 209 | return $self->count_ipv6 + $self->count_ipv6_www; 210 | } 211 | 212 | 213 | =head2 only_ipv4, only_ipv6, only_ipv4_ns, only_ipv6_ns, only_ipv4_mx, only_ipv6_mx 214 | 215 | returns true, when the domain or MX or NS only supports IPv4 respectively IPv6 216 | 217 | =cut 218 | 219 | sub only_ipv4 220 | { 221 | my $self = shift; 222 | return ( $self->supports_ipv4 and not $self->supports_ipv6 ); 223 | } 224 | 225 | sub only_ipv6 226 | { 227 | my $self = shift; 228 | return ( $self->supports_ipv6 and not $self->supports_ipv4 ); 229 | } 230 | 231 | sub only_ipv4_ns 232 | { 233 | my $self = shift; 234 | return ( $self->count_ipv4_ns and not $self->count_ipv6_ns ); 235 | } 236 | 237 | sub only_ipv6_ns 238 | { 239 | my $self = shift; 240 | return ( $self->count_ipv6_ns and not $self->count_ipv4_ns ); 241 | } 242 | 243 | sub only_ipv4_mx 244 | { 245 | my $self = shift; 246 | return ( $self->count_ipv4_mx and not $self->count_ipv6_mx ); 247 | } 248 | 249 | sub only_ipv6_mx 250 | { 251 | my $self = shift; 252 | return ( $self->count_ipv6_mx and not $self->count_ipv4_mx ); 253 | } 254 | 255 | 256 | =head2 has_ipv4_roundrobin, has_ipv6_roundrobin 257 | 258 | returns true, when the domain or MX or NS only supports IPv4 respectively IPv6 259 | 260 | =cut 261 | 262 | sub has_ipv4_roundrobin 263 | { 264 | my $self = shift; 265 | return 1 if $self->x; 266 | return; 267 | } 268 | 269 | sub has_ipv6_roundrobin 270 | { 271 | my $self = shift; 272 | return; 273 | } 274 | 275 | __PACKAGE__->meta->make_immutable; 276 | 277 | 1; 278 | 279 | -------------------------------------------------------------------------------- /lib/Security/TLSCheck/Checks/Dummy.pm: -------------------------------------------------------------------------------- 1 | package Security::TLSCheck::Checks::Dummy; 2 | 3 | # 4 | # Eech check is usually a Moose class, extending Security::TLSCheck::Checks 5 | # Or in other words: a subclass of Security::TLSCheck::Checks 6 | # or inheriting Security::TLSCheck::Checks 7 | # 8 | # Security::TLSCheck::Checks has the base methods for getting all results. 9 | # 10 | # And each check should use the Role Security::TLSCheck::Checks::Helper::Timing, 11 | # Which sets start and end time for the check automatically. 12 | # 13 | # Othervise the check MUST set start_time and end_time manually. 14 | # 15 | 16 | use Moose; 17 | extends 'Security::TLSCheck::Checks'; 18 | with 'Security::TLSCheck::Checks::Helper::Timing'; 19 | 20 | use Log::Log4perl::EasyCatch; 21 | 22 | 23 | =head1 NAME 24 | 25 | Security::TLSCheck::Checks::Dummy - Simple dummy check as example 26 | 27 | =encoding utf8 28 | 29 | =cut 30 | 31 | use version; our $VERSION = sprintf "%d", q$Revision: 658 $ =~ /(\d+)/xg; 32 | 33 | 34 | =head1 SYNOPSIS 35 | 36 | tls-check.pl --checks=Dummy [...] 37 | 38 | 39 | =head1 DESCRIPTION 40 | 41 | This test does not much; it is only a dummy example for testing and presentsation. 42 | 43 | =cut 44 | 45 | #<<< 46 | 47 | # 48 | # An info block with all sub tests 49 | # All tests have a name and description, a data type of the result and the 50 | # source method. The method with the name of the source will be called to 51 | # get the result of each key figure. 52 | # 53 | 54 | { 55 | my $key_figures = 56 | [ 57 | { name => "Length of domain", type => "int", source => "get_length", description => "Length of the domain name.", }, 58 | { name => "Top Level Domain", type => "group", source => "get_tld", description => "Top level domains.", }, 59 | { name => "TLD is .de", type => "flag", source => "is_de", description => "Is the TLD .de?" }, 60 | ]; 61 | 62 | has '+key_figures' => ( default => sub {return $key_figures} ); 63 | } 64 | 65 | has '+description' => ( default => "Dummy Checks" ); 66 | 67 | #>>> 68 | 69 | # 70 | # This example check has NO C method, it uses this from the 71 | # base class C. This only calls the result 72 | # method, and this collects everything from the methods given in the 73 | # above defined key figures. 74 | # THe C method can be used to initiate some states or whatever, 75 | # but in this example this is not necessary. 76 | # 77 | 78 | =head1 METHODS 79 | 80 | Here are the methods, used by the key figures of this test. 81 | 82 | =head2 get_length 83 | 84 | gets the length of the domain name 85 | 86 | =cut 87 | 88 | sub get_length 89 | { 90 | my $self = shift; 91 | return length( $self->domain ); 92 | } 93 | 94 | 95 | =head2 get_tld 96 | 97 | gets the tld 98 | 99 | =cut 100 | 101 | sub get_tld 102 | { 103 | my $self = shift; 104 | my ($tld) = $self->domain =~ m{ ([^.]+) $ }x; 105 | return $tld; 106 | } 107 | 108 | 109 | =head2 is_de 110 | 111 | returns true, if the TLD is .de 112 | 113 | =cut 114 | 115 | sub is_de 116 | { 117 | my $self = shift; 118 | return 1 if $self->get_tld eq "de"; 119 | return 0; 120 | } 121 | 122 | 123 | __PACKAGE__->meta->make_immutable; 124 | 125 | 1; 126 | -------------------------------------------------------------------------------- /lib/Security/TLSCheck/Checks/FinalScore.pm: -------------------------------------------------------------------------------- 1 | package Security::TLSCheck::Checks::FinalScore; 2 | 3 | use Moose; 4 | extends 'Security::TLSCheck::Checks'; 5 | with 'Security::TLSCheck::Checks::Helper::Timing'; 6 | 7 | use Log::Log4perl::EasyCatch; 8 | 9 | 10 | =head1 NAME 11 | 12 | Security::TLSCheck::Checks::FinalScore - Creates a summary score out of the other tests 13 | 14 | =encoding utf8 15 | 16 | =cut 17 | 18 | use version; our $VERSION = sprintf "%d", q$Revision: 658 $ =~ /(\d+)/xg; 19 | 20 | 21 | =head1 SYNOPSIS 22 | 23 | ... 24 | 25 | 26 | =head1 DESCRIPTION 27 | 28 | This check summarizes all checks and builds a global score. 29 | 30 | 31 | =cut 32 | 33 | #<<< 34 | 35 | { 36 | my $key_figures = 37 | [ 38 | { name => "Final Web Score", type => "int", source => "final_web_score", description => "The Final Web Score", }, 39 | { name => "Final Web Score Grouped", type => "group", source => "final_web_score", description => "The Final Web Score, but as group", }, 40 | ]; 41 | 42 | has '+key_figures' => ( default => sub {return $key_figures} ); 43 | } 44 | 45 | has '+description' => ( default => "Final Scores" ); 46 | 47 | #>>> 48 | 49 | 50 | 51 | =head1 METHODS 52 | 53 | =head2 final_web_score 54 | 55 | As the name says, this method calculates the final web score. 56 | 57 | 58 | Score wie bisher, zusätzlich: 59 | DONE! Wenn keine Verschlüsselung: Fix auf 0 60 | Wenn Heartbleed: fix auf -10 61 | Wenn kein valides Zertifikat (z.B. selbstsigniert): -10 62 | Wenn Domain nicht zum Zertifikat passt: -20 63 | Wenn Strict-Transport-Security: +5 // +10! 64 | Wenn Strict-Transport-Securoty aktiv abgeschaltet: -5 65 | Wenn Public-Key-Pinning: +5 66 | Wenn Umleitung von HTTP auf HTTPS: +5 67 | Wenn Umleitung von HTTPS auf HTTP: -10 68 | Wenn IPv6 unterstützt: +3 69 | 70 | Minimum: 0, wenn keine Verschlüsselung 71 | 72 | 73 | =cut 74 | 75 | 76 | sub final_web_score 77 | { 78 | ## no critic (ValuesAndExpressions::ProhibitMagicNumbers) 79 | # TODO: 80 | # use constants for +/- score! 81 | 82 | my $self = shift; 83 | 84 | my $web = $self->other_check("Security::TLSCheck::Checks::Web"); 85 | my $ciphers = $self->other_check("Security::TLSCheck::Checks::CipherStrength"); 86 | my $heartbleed = $self->other_check("Security::TLSCheck::Checks::Heartbleed"); 87 | my $dns = $self->other_check("Security::TLSCheck::Checks::DNS"); 88 | 89 | return 0 unless $web->https_active; 90 | return -10 if $heartbleed && $heartbleed->https_vulnerable; 91 | 92 | my $score = $ciphers->score; 93 | $score -= 10 unless $web->https_cert_verified; 94 | $score -= 20 unless $web->https_host_verified; 95 | $score += 10 if $web->hsts_max_age; 96 | $score -= 5 if $web->disables_hsts; 97 | $score += 5 if $web->has_hpkp; 98 | $score += 5 if $web->redirects_to_https; 99 | $score -= 10 if $web->redirects_to_http; 100 | 101 | $score += 3 if $dns->count_ipv6 or $dns->count_ipv6_www; 102 | 103 | # Not allowed for privacy reasons! 104 | # TRACE "INTERNALDEBUG: Final Web Score for ${ \$self->domain }: $score"; 105 | 106 | return $score; 107 | } ## end sub final_web_score 108 | 109 | 110 | 1; 111 | 112 | -------------------------------------------------------------------------------- /lib/Security/TLSCheck/Checks/Heartbleed.pm: -------------------------------------------------------------------------------- 1 | package Security::TLSCheck::Checks::Heartbleed; 2 | 3 | use 5.010; 4 | use strict; 5 | use warnings; 6 | 7 | use Carp; 8 | use English qw( -no_match_vars ); 9 | use FindBin qw($Bin); 10 | use Readonly; 11 | 12 | use Moose; 13 | extends 'Security::TLSCheck::Checks'; 14 | with 'Security::TLSCheck::Checks::Helper::Timing'; 15 | with 'Security::TLSCheck::Checks::Helper::MX'; 16 | 17 | use Log::Log4perl::EasyCatch; 18 | 19 | 20 | 21 | =head1 NAME 22 | 23 | Security::TLSCheck::Checks::Heartbleed - Heartbleed checks 24 | 25 | =encoding utf8 26 | 27 | =cut 28 | 29 | use version; our $VERSION = sprintf "%d", q$Revision: 658 $ =~ /(\d+)/xg; 30 | 31 | 32 | =head1 SYNOPSIS 33 | 34 | ... 35 | 36 | 37 | =head1 DESCRIPTION 38 | 39 | 40 | At the moment this calls Steffen Ullrichs check-ssl-heartbleed.pl, 41 | which can be found here: https://github.com/noxxi/p5-ssl-tools 42 | 43 | Later some parts of this should be integrated into this module, 44 | because running external executables is expensive. 45 | 46 | =cut 47 | 48 | #<<< 49 | 50 | { 51 | my $key_figures = 52 | [ 53 | { name => "HTTPS supported", type => "flag", source => "https_supported", description => "Is HTTPS supported?", }, 54 | { name => "HTTPS Heartbleed vulnerable", type => "flag", source => "https_vulnerable", description => "Is HTTPS vulnerable for Heartbleed?", }, 55 | { name => "HTTPS Other Error", type => "flag", source => "https_other_error", description => "Other Error in Heartbleed check?", }, 56 | { name => "# MX total", type => "count", source => "count_mx", description => "Number of all MX server" }, 57 | { name => "# MX with TLS", type => "count", source => "count_mx_tls", description => "Number of all MX supporting STARTTLS" }, 58 | { name => "# MX Heartbleed vulnerable", type => "count", source => "count_mx_vulnerable", description => "Number of MX server, which are vulnerable for Heartbleed", }, 59 | { name => "# MX Heartbleed Other Error", type => "count", source => "count_mx_other_error", description => "Number of MX server, which had other errors while checking Heartbleed", }, 60 | 61 | ]; 62 | 63 | has '+key_figures' => ( default => sub {return $key_figures} ); 64 | } 65 | 66 | #>>> 67 | 68 | 69 | has '+description' => ( default => "Checks for the Heartbleed vulnerability" ); 70 | 71 | has https_supported => ( is => "rw", isa => "Bool", ); 72 | has https_vulnerable => ( is => "rw", isa => "Bool", ); 73 | has https_other_error => ( is => "rw", isa => "Bool", ); 74 | has count_mx => ( is => "rw", isa => "Int", ); 75 | has count_mx_tls => ( is => "rw", isa => "Int", ); 76 | has count_mx_vulnerable => ( is => "rw", isa => "Int", ); 77 | has count_mx_other_error => ( is => "rw", isa => "Int", ); 78 | 79 | Readonly my $RC_OK => 0; 80 | Readonly my $RC_VULNERABLE => 256; 81 | 82 | 83 | 84 | =head1 METHODS 85 | 86 | =head2 run_check 87 | 88 | Do all the work for heartbleed. 89 | This method stores the result in attributes. 90 | 91 | For web: currently only test with www. 92 | 93 | =cut 94 | 95 | sub run_check 96 | { 97 | my $self = shift; 98 | 99 | $self->_check_www; 100 | $self->_check_mail; 101 | 102 | return $self->result; 103 | } 104 | 105 | 106 | sub _check_www 107 | { 108 | my $self = shift; 109 | 110 | my $www = $self->www; 111 | 112 | # check web only if there is some HTTPS 113 | unless ( $self->other_check("Security::TLSCheck::Checks::Web")->https_active ) 114 | { 115 | DEBUG "Skipped WWW Heartbleed for $www because no https active"; 116 | return; 117 | } 118 | 119 | my ( $result_ref, $rc ) = $self->_check_heartbleed($www); 120 | 121 | if ( $rc == $RC_OK ) 122 | { 123 | #TRACE "Webserver $www is OK"; 124 | $self->https_supported(1); 125 | $self->https_vulnerable(0); 126 | $self->https_other_error(0); 127 | } 128 | elsif ( $rc == $RC_VULNERABLE ) 129 | { 130 | # Not allowed for privacy reasons! 131 | TRACE "UUPS! Webserver $www is VULNERABLE!!!"; 132 | $self->https_supported(1); 133 | $self->https_vulnerable(1); 134 | $self->https_other_error(0); 135 | } 136 | elsif ( $result_ref->[-1] =~ m{^failed.to.connect:}msx ) 137 | { 138 | DEBUG "No Connection to Webserver $www: $result_ref->[-1]"; 139 | $self->https_supported(0); 140 | $self->https_vulnerable(0); 141 | $self->https_other_error(0); 142 | } 143 | else 144 | { 145 | DEBUG "Webserver $www has other Error: $result_ref->[-1]"; 146 | $self->https_supported(1); 147 | $self->https_vulnerable(0); 148 | $self->https_other_error(1); 149 | } 150 | 151 | return; 152 | 153 | } ## end sub _check_www 154 | 155 | # MX Checks 156 | sub _check_mail 157 | { 158 | my $self = shift; 159 | my $count_mx = 0; 160 | my $count_mx_tls = 0; 161 | my $count_mx_vulnerable = 0; 162 | my $count_mx_other_error = 0; 163 | 164 | foreach my $mx ( $self->get_mx ) 165 | { 166 | next if $self->mx_is_checked($mx); 167 | 168 | $count_mx++; 169 | 170 | my ( $result_ref, $rc ) = $self->_check_heartbleed( $mx, "smtp" ); 171 | 172 | if ( $rc == $RC_OK ) 173 | { 174 | #DEBUG "MX $mx is OK"; 175 | $count_mx_tls++; 176 | } 177 | elsif ( $rc == $RC_VULNERABLE ) 178 | { 179 | # Not allowed for privacy reasons! 180 | DEBUG "UUPS! MX $mx is VULNERABLE!!!"; 181 | $count_mx_tls++; 182 | $count_mx_vulnerable++; 183 | } 184 | elsif ( $result_ref->[-1] =~ m{^failed.to.connect:}msx ) 185 | { 186 | DEBUG "No Connection to MX $mx: $result_ref->[-1]"; 187 | } 188 | else 189 | { 190 | DEBUG "MX $mx has other Error: $result_ref->[-1]"; 191 | $count_mx_tls++; 192 | $count_mx_other_error++; 193 | } 194 | 195 | } ## end foreach my $mx ( $self->get_mx...) 196 | 197 | $self->count_mx($count_mx); 198 | $self->count_mx_tls($count_mx_tls); 199 | $self->count_mx_vulnerable($count_mx_vulnerable); 200 | $self->count_mx_other_error($count_mx_other_error); 201 | 202 | return; 203 | 204 | } ## end sub _check_mail 205 | 206 | 207 | # TODO: don't call external program, include the code here => much faster! 208 | sub _check_heartbleed 209 | { 210 | my $self = shift; 211 | my $host = shift; 212 | my $tls_type = shift; 213 | 214 | my $cli_params; 215 | 216 | if ($tls_type) { $cli_params = "--starttls $tls_type $host"; } 217 | else { $cli_params = "$host:https"; } 218 | 219 | my $EXTBIN_DIR = eval { return File::ShareDir::module_dir("Security::TLSCheck") } // "$Bin/ext"; 220 | 221 | die "check-ssl-heartbleed.pl not found\n" unless -x "$EXTBIN_DIR/check-ssl-heartbleed.pl"; 222 | 223 | DEBUG "Run heartbleed-Check with '$cli_params'"; 224 | my @result = qx($EXTBIN_DIR/check-ssl-heartbleed.pl $cli_params 2>&1); ## no critic (InputOutput::ProhibitBacktickOperators) 225 | my $rc = $CHILD_ERROR; 226 | chomp @result; 227 | DEBUG "Heartbleed check finished"; 228 | 229 | # Not allowed in production: 230 | #TRACE "Heartbleed-Response: $ARG" foreach @result; 231 | #TRACE "Return Code: $rc"; 232 | 233 | return \@result, $rc; 234 | } ## end sub _check_heartbleed 235 | 236 | 237 | __PACKAGE__->meta->make_immutable; 238 | 239 | 1; 240 | -------------------------------------------------------------------------------- /lib/Security/TLSCheck/Checks/Helper/MX.pm: -------------------------------------------------------------------------------- 1 | package Security::TLSCheck::Checks::Helper::MX; 2 | 3 | use Moose::Role; 4 | 5 | use English qw( -no_match_vars ); 6 | 7 | use Time::HiRes qw(time); 8 | use Net::DNS (); 9 | use File::Temp qw(tempdir); 10 | use IO::All; 11 | use Carp; 12 | 13 | use Log::Log4perl::EasyCatch; 14 | 15 | =head1 NAME 16 | 17 | Security::TLSCheck::Checks::Helper::MX - Get all MX, cache if already checked, ... 18 | 19 | =encoding utf8 20 | 21 | =cut 22 | 23 | use version; our $VERSION = qv( "v0.2." . ( sprintf "%d", q$Revision: 658 $ =~ /(\d+)/xg ) ); 24 | 25 | 26 | =head1 SYNOPSIS 27 | 28 | In a check: 29 | 30 | with 'Security::TLSCheck::Helper::GetMX'; 31 | 32 | # ... 33 | 34 | my @mx = $self->get_mx; 35 | 36 | 37 | =head1 DESCRIPTION 38 | 39 | Adds a method for getting mx records -- including caching. 40 | 41 | 42 | =cut 43 | 44 | my %mx_cache; 45 | 46 | 47 | has _resolver => ( is => 'ro', isa => 'Object', lazy_build => 1, ); 48 | 49 | sub _build__resolver 50 | { 51 | my $self = shift; 52 | 53 | return Net::DNS::Resolver->new; 54 | } 55 | 56 | 57 | =head2 get_mx 58 | 59 | returns the list of MX records for this Domain 60 | 61 | =cut 62 | 63 | sub get_mx 64 | { 65 | my $self = shift; 66 | my $domain = $self->domain; 67 | 68 | if ( $mx_cache{$domain} ) 69 | { 70 | DEBUG "Found cached values for MX of $domain"; 71 | return @{ $mx_cache{$domain} }; 72 | } 73 | 74 | DEBUG "Start DNS Query for MX for $domain"; 75 | my $reply = $self->_resolver->query( $domain, "MX" ); 76 | DEBUG "DNS MX Query for $domain finished"; 77 | 78 | unless ($reply) 79 | { 80 | DEBUG "No MX found for $domain"; 81 | return; 82 | } 83 | 84 | my @mx = map { $ARG->exchange } 85 | sort { $a->preference <=> $b->preference } 86 | grep { $ARG->type eq 'MX' } $reply->answer; 87 | 88 | DEBUG "found MX for $domain: @mx"; 89 | 90 | $mx_cache{$domain} = \@mx; 91 | 92 | return @mx; 93 | } ## end sub get_mx 94 | 95 | 96 | 97 | =head2 mx_is_checked 98 | 99 | Cache temporary, if MX is already analysed for this check (each check has his own cache) 100 | 101 | cache on disk, so this also works with multiprocessing 102 | 103 | =cut 104 | 105 | my $TEMPDIR = tempdir( CLEANUP => 1 ); 106 | 107 | sub mx_is_checked 108 | { 109 | my $self = shift; 110 | my $mx = shift || croak "No MX given!\n"; 111 | 112 | # Build Filename: "mx.domain.tld__CheckName_DomainCategory" 113 | $mx .= "__" . $self->name . "_" . $self->category; 114 | 115 | DEBUG "Test, if MX $mx is already checked"; 116 | 117 | my $lock = io("$TEMPDIR/$mx.lock")->lock; 118 | $lock->println( "locked " . localtime() ); 119 | 120 | my $is_checked = eval { my $content = io("$TEMPDIR/$mx")->all; return $content; }; 121 | 122 | if ($is_checked) 123 | { 124 | chomp $is_checked; 125 | DEBUG "MX $mx is checked: '$is_checked'"; 126 | return 1; 127 | } 128 | 129 | DEBUG "MX $mx is not yet checked."; 130 | io("$TEMPDIR/$mx")->print( "Checked $mx at " . localtime ); 131 | 132 | return 0; 133 | } ## end sub mx_is_checked 134 | 135 | 136 | 1; 137 | -------------------------------------------------------------------------------- /lib/Security/TLSCheck/Checks/Helper/Timing.pm: -------------------------------------------------------------------------------- 1 | package Security::TLSCheck::Checks::Helper::Timing; 2 | 3 | use Moose::Role; 4 | 5 | use Time::HiRes qw(time); 6 | 7 | 8 | =head1 NAME 9 | 10 | Security::TLSCheck::Checks::Helper::Timing - Timing helpers for run_check 11 | 12 | =encoding utf8 13 | 14 | =cut 15 | 16 | use version; our $VERSION = qv( "v0.2." . ( sprintf "%d", q$Revision: 640 $ =~ /(\d+)/xg ) ); 17 | 18 | 19 | =head1 SYNOPSIS 20 | 21 | As check subclass: 22 | 23 | package Security::TLSCheck::Checks::MyCheck 24 | 25 | use Moose; 26 | extends 'Security::TLSCheck::Checks'; 27 | with 'Security::TLSCheck::Helper::Timing'; 28 | 29 | 30 | =head1 DESCRIPTION 31 | 32 | This role sets method modifiers for timing. 33 | 34 | =cut 35 | 36 | requires qw(run_check start_time end_time); 37 | 38 | before run_check => sub { shift->start_time(time); }; 39 | after run_check => sub { my $self = shift; $self->end_time(time); }; 40 | 41 | 42 | 1; 43 | 44 | -------------------------------------------------------------------------------- /lib/Security/TLSCheck/Checks/Mail.pm: -------------------------------------------------------------------------------- 1 | package Security::TLSCheck::Checks::Mail; 2 | 3 | use 5.010; 4 | 5 | use Carp; 6 | use English qw( -no_match_vars ); 7 | use Net::SMTP 3.02; 8 | 9 | use Moose; 10 | extends 'Security::TLSCheck::Checks'; 11 | with 'Security::TLSCheck::Checks::Helper::Timing'; 12 | with 'Security::TLSCheck::Checks::Helper::MX'; 13 | 14 | use Log::Log4perl::EasyCatch; 15 | 16 | 17 | 18 | =head1 NAME 19 | 20 | Security::TLSCheck::Checks::Mail - Checks mailservers for TLS capability 21 | 22 | =encoding utf8 23 | 24 | =cut 25 | 26 | use version; our $VERSION = sprintf "%d", q$Revision: 658 $ =~ /(\d+)/xg; 27 | 28 | 29 | =head1 SYNOPSIS 30 | 31 | ... 32 | 33 | 34 | =head1 DESCRIPTION 35 | 36 | 37 | 38 | 39 | 40 | =cut 41 | 42 | #<<< 43 | 44 | { 45 | my $key_figures = 46 | [ 47 | { name => "#MX unique", type => "int", source => "count_mx_unique", description => "Number of unique MX Servers", }, 48 | { name => "#MX active", type => "int", source => "count_mx_active", description => "Number of connectable servers", }, 49 | { name => "#MX Supports STARTTLS", type => "int", source => "count_support_starttls", description => "Number of servers supporting STARTTLS", }, 50 | { name => "#MX STARTTLS OK", type => "int", source => "count_starttls_ok", description => "Number of servers with successful STARTTLS", }, 51 | ]; 52 | 53 | has '+key_figures' => ( default => sub {return $key_figures} ); 54 | } 55 | 56 | has '+description' => ( default => "Mail checks" ); 57 | 58 | has mx_unique => ( is => 'rw', isa => 'ArrayRef[Str]', traits => ['Array'], handles => { count_mx_unique => 'count', add_mx_unique => 'push', all_unique => 'elements', }, default => sub {[]}, ); 59 | has mx_active => ( is => 'rw', isa => 'ArrayRef[Str]', traits => ['Array'], handles => { count_mx_active => 'count', add_mx_active => 'push', all_active => 'elements', }, default => sub {[]}, ); 60 | has mx_support_starttls => ( is => 'rw', isa => 'ArrayRef[Str]', traits => ['Array'], handles => { count_support_starttls => 'count', add_mx_supports_starttls => 'push', all_supports_starttls => 'elements', }, default => sub {[]}, ); 61 | has mx_starttls_ok => ( is => 'rw', isa => 'ArrayRef[Str]', traits => ['Array'], handles => { count_starttls_ok => 'count', add_mx_starttls_ok => 'push', all_starttls_ok => 'elements', }, default => sub {[]}, ); 62 | 63 | # For Internal use, for forwarding it to CipherStrength check 64 | # has mx_for_cipher => ( is => 'rw', isa => 'ArrayRef[Str]', traits => ['Array'], handles => { count_for_cipher => 'count', add_mx_for_cipher => 'push', all_for_cipher => 'elements', }, default => sub {[]}, ); 65 | 66 | #>>> 67 | 68 | 69 | 70 | =head1 METHODS 71 | 72 | =head2 run_checks 73 | Run all the checks and store the results internally 74 | 75 | =cut 76 | 77 | sub run_check 78 | { 79 | my $self = shift; 80 | 81 | TRACE "Checking Mailservers for " . $self->domain; 82 | 83 | my @mx = $self->other_check("Security::TLSCheck::Checks::DNS")->all_mx; 84 | 85 | foreach my $mx (@mx) 86 | { 87 | TRACE "Check MX $mx"; 88 | next if $self->mx_is_checked($mx); 89 | 90 | $self->add_mx_unique($mx); 91 | 92 | my $smtp = Net::SMTP->new( Hello => $self->my_hostname, Host => $mx ); 93 | if ($smtp) 94 | { 95 | TRACE "SMTP-Connect to MX $mx OK, SMTP-Banner: " . $smtp->banner; 96 | $self->add_mx_active($mx); 97 | eval { 98 | 99 | if ( defined $smtp->supports("STARTTLS") ) 100 | { 101 | TRACE "MX $mx supports STARTTLS"; 102 | $self->add_mx_supports_starttls($mx); 103 | 104 | # $self->add_mx_for_cipher($mx); 105 | 106 | # if ( $smtp->starttls(SSL_verifycn_scheme => 'http', ) ) 107 | if ( $smtp->starttls ) 108 | { 109 | TRACE "MX $mx works with STARTTLS"; 110 | $self->add_mx_starttls_ok($mx); 111 | } 112 | else 113 | { 114 | TRACE "MX $mx: FAILED STARTTLS: $IO::Socket::SSL::SSL_ERROR"; 115 | } 116 | } 117 | else 118 | { 119 | TRACE "MX $mx does NOT support STARTTLS"; 120 | } 121 | 122 | 123 | $smtp->quit; 124 | return 1; 125 | } or ERROR "Unexpected SMTP Error (MX: $mx): $EVAL_ERROR"; 126 | 127 | } ## end if ($smtp) 128 | else 129 | { 130 | DEBUG "SMTP-Connect to MX $mx failed: $EVAL_ERROR"; # Net::SMTP sets EVAL_ERROR! 131 | } 132 | 133 | } ## end foreach my $mx (@mx) 134 | 135 | return $self->result; 136 | } ## end sub run_check 137 | 138 | 139 | 140 | __PACKAGE__->meta->make_immutable; 141 | 142 | 1; 143 | 144 | -------------------------------------------------------------------------------- /lib/Security/TLSCheck/Checks/MailCipherStrength.pm: -------------------------------------------------------------------------------- 1 | package Security::TLSCheck::Checks::MailCipherStrength; 2 | 3 | use Moose; 4 | extends 'Security::TLSCheck::Checks::CipherStrength'; 5 | with 'Security::TLSCheck::Checks::Helper::Timing'; 6 | 7 | use Log::Log4perl::EasyCatch; 8 | 9 | use Net::SSL::GetServerProperties; 10 | use Net::SSL::Handshake::StartTLS::SMTP; 11 | 12 | 13 | =head1 NAME 14 | 15 | Security::TLSCheck::Checks::MailCipherStrength - Checks mailservers for supported CipherSuites 16 | 17 | =encoding utf8 18 | 19 | =cut 20 | 21 | use version; our $VERSION = sprintf "%d", q$Revision: 640 $ =~ /(\d+)/xg; 22 | 23 | has '+description' => ( default => "Strength of CipherSuites and SSL/TLS Version of Mailservers (MX)" ); 24 | 25 | 26 | =head1 SYNOPSIS 27 | 28 | ... 29 | 30 | 31 | =head1 DESCRIPTION 32 | 33 | Gets list of MX to check from Mail check. 34 | 35 | Inherits all values from CipherStrength (Web). 36 | 37 | 38 | 39 | =cut 40 | 41 | =head2 run_check 42 | 43 | As always: runs the check ... 44 | 45 | But this one maybe return more then one result: one for each MX! 46 | 47 | =cut 48 | 49 | sub run_check 50 | { 51 | my $self = shift; 52 | 53 | TRACE "Checking Cipher Strength of Mailservers for " . $self->domain; 54 | 55 | my @mx = $self->other_check("Security::TLSCheck::Checks::Mail")->all_supports_starttls; 56 | 57 | TRACE "Have MX: @mx"; 58 | 59 | my @result; 60 | 61 | foreach my $mx (@mx) 62 | { 63 | TRACE "Get SSL/TLS properties for MX $mx"; 64 | 65 | my $prop = Net::SSL::GetServerProperties->new( 66 | host => $mx, 67 | port => 25, 68 | handshake_class => "Net::SSL::Handshake::StartTLS::SMTP", 69 | throttle_time => 2, 70 | timeout => $self->timeout, 71 | ); 72 | 73 | $self->properties( $prop->get_properties ); 74 | 75 | push @result, $self->result; 76 | 77 | TRACE "Finished properties for MX $mx"; 78 | 79 | } 80 | 81 | 82 | return @result; 83 | 84 | } ## end sub run_check 85 | 86 | 87 | 88 | 1; 89 | 90 | -------------------------------------------------------------------------------- /lib/Security/TLSCheck/Checks/TODO.txt: -------------------------------------------------------------------------------- 1 | 2 | More Checks: 3 | 4 | * Vulnerabilites: 5 | 6 | * https://tools.ietf.org/html/rfc7457 7 | 8 | * BEAST 9 | * https://de.wikipedia.org/wiki/Transport_Layer_Security#BEAST 10 | * http://www.hit.bme.hu/~buttyan/courses/EIT-SEC/abib/04-TLS/BEAST.pdf 11 | * https://packetstormsecurity.com/files/105499/Browser-Exploit-Against-SSL-TLS.html 12 | * CRIME (und BREACH) 13 | * https://en.wikipedia.org/wiki/CRIME 14 | * https://en.wikipedia.org/wiki/BREACH_(security_exploit) 15 | * TIME 16 | * https://media.blackhat.com/eu-13/briefings/Beery/bh-eu-13-a-perfect-crime-beery-wp.pdf 17 | * FREAK 18 | * Lucky 13 19 | * Poodle 20 | * Poodle on SSLv3 21 | * Poodle on TLS 22 | * Poodle TLS! 23 | * RC4 24 | * SLOTH 25 | * Logjam Check 26 | 27 | 28 | * more vulnerabilities ... 29 | 30 | * test sha1? Signing alg cert?!? 31 | * Mailserver String & Version? 32 | 33 | * Maybe implement somoe other simple tests from o-saft! https://www.owasp.org/index.php/Testing_for_Weak_SSL/TLS_Ciphers,_Insufficient_Transport_Layer_Protection_(OTG-CRYPST-001)#Example_9._Testing_O-Saft_-_OWASP_SSL_advanced_forensic_tool 34 | * => usually the check only cipher suites via Regexp; not always sufficient 35 | 36 | 37 | 38 | -------------------------------------------------------------------------------- /lib/Security/TLSCheck/Result.pm: -------------------------------------------------------------------------------- 1 | package Security::TLSCheck::Result; 2 | 3 | use Moose::Role; 4 | use 5.010; 5 | 6 | 7 | =head1 NAME 8 | 9 | Security::TLSCheck::Result -- Result storage, aggregation and output 10 | 11 | =head1 VERSION 12 | 13 | Version 0.2.x 14 | 15 | =cut 16 | 17 | #<<< 18 | my $BASE_VERSION = "1.0"; use version; our $VERSION = qv( sprintf "$BASE_VERSION.%d", q$Revision: 658 $ =~ /(\d+)/xg ); 19 | #>>> 20 | 21 | 22 | =head1 SYNOPSIS 23 | 24 | =encoding utf8 25 | 26 | 27 | =head1 DESCRIPTION 28 | 29 | 30 | =cut 31 | 32 | use English qw( -no_match_vars ); 33 | use FindBin qw($Bin); 34 | use Data::Dumper; 35 | 36 | use Log::Log4perl::EasyCatch; 37 | 38 | 39 | has results => ( 40 | is => "ro", 41 | isa => "HashRef[Any]", 42 | default => sub { {} }, 43 | traits => ['Hash'], 44 | handles => { 45 | result_categories => "keys", 46 | result_for_category => "get", 47 | }, 48 | ); 49 | 50 | 51 | 52 | =head1 METHODS 53 | 54 | 55 | =head2 add_result_for_category( $category => $result ) 56 | 57 | Helper method for adding a result. 58 | 59 | =cut 60 | 61 | sub add_result_for_category 62 | { 63 | my $self = shift; 64 | my $category = shift; 65 | my $result = shift; 66 | 67 | push @{ $self->results->{$category} }, @$result; 68 | push @{ $self->results->{"All Categories (Summary)"} }, @$result; 69 | 70 | return; 71 | } 72 | 73 | 74 | =head2 aggregate 75 | 76 | Aggregates all values for output 77 | 78 | 79 | %result is: 80 | 81 | ( 82 | Name => 83 | { 84 | class => "Security::TLSCheck::Checks::Name", 85 | aggregates => 86 | count => 87 | }, 88 | OtherName => ..... 89 | ) 90 | 91 | 92 | =cut 93 | 94 | my %agg_functions = ( 95 | flag => \&_agg_flag, 96 | count => \&_agg_count, 97 | int => \&_agg_count, 98 | num => \&_agg_count, 99 | group => \&_agg_group, 100 | set => \&_agg_set, 101 | ); 102 | 103 | sub _agg_flag 104 | { 105 | my $agg = shift; 106 | my $value = shift; 107 | 108 | $agg->{sum}++ if $value; 109 | $agg->{count}++; 110 | 111 | return; 112 | } 113 | 114 | sub _agg_count 115 | { 116 | my $agg = shift; 117 | my $value = shift; 118 | 119 | $agg->{sum} += $value // 0; 120 | push @{ $agg->{values} }, $value; # for median 121 | $agg->{count}++; 122 | 123 | return; 124 | } 125 | 126 | sub _agg_group 127 | { 128 | my $agg = shift; 129 | my $value = shift // ""; 130 | 131 | $agg->{group}{$value}++; 132 | $agg->{count}++; 133 | 134 | return; 135 | } 136 | 137 | sub _agg_set 138 | { 139 | my $agg = shift; 140 | my $value = shift // ""; 141 | 142 | $agg->{group}{$ARG}++ foreach split( /:/, $value ); 143 | $agg->{count}++; 144 | 145 | return; 146 | } 147 | 148 | 149 | 150 | sub aggregate 151 | { 152 | my $self = shift; 153 | my $category = shift; 154 | 155 | my %result; 156 | 157 | foreach my $check ( @{ $self->result_for_category($category) } ) 158 | { 159 | 160 | my $class = $check->{check}{class}; 161 | 162 | # no, this is TOO noisy! 163 | # TRACE "Aggregate check $check->{name} in class $class"; 164 | 165 | # check exists in result? 166 | if ( $result{ $check->{name} } ) 167 | { 168 | die 169 | "Class name of test $check->{name} does not match: $class vs. $result{$check->{name}}{class} -- duplicate check names?\n" 170 | if $class ne $result{ $check->{name} }{class}; 171 | } 172 | else 173 | { 174 | $result{ $check->{name} }{class} = $class; 175 | $result{ $check->{name} }{description} = $check->{check}{description}; 176 | } 177 | 178 | $result{ $check->{name} }{count}++; 179 | $result{ $check->{name} }{runtime} += $check->{check}{runtime}; 180 | 181 | # next unless $check->{result}; 182 | for my $pos ( 0 .. $#{ $check->{result} } ) 183 | { 184 | die "Name of check #$pos in $check->{name} differs!\n" 185 | if $result{ $check->{name} }{aggregates}[$pos] 186 | and $result{ $check->{name} }{aggregates}[$pos]{name} ne $check->{result}[$pos]{info}{name}; 187 | 188 | $result{ $check->{name} }{aggregates}[$pos]{name} //= $check->{result}[$pos]{info}{name}; 189 | $result{ $check->{name} }{aggregates}[$pos]{description} //= $check->{result}[$pos]{info}{description}; 190 | $result{ $check->{name} }{aggregates}[$pos]{type} //= $check->{result}[$pos]{info}{type}; 191 | 192 | my $agg_func = $agg_functions{ $check->{result}[$pos]{info}{type} } 193 | or die "No aggregate function for type $check->{result}[$pos]{info}{type}\n"; 194 | 195 | &$agg_func( $result{ $check->{name} }{aggregates}[$pos], $check->{result}[$pos]{value} ); 196 | 197 | } 198 | 199 | 200 | } ## end foreach my $check ( @{ $self...}) 201 | 202 | 203 | return \%result; 204 | } ## end sub aggregate 205 | 206 | 207 | =head2 output 208 | 209 | Prints the result. 210 | 211 | A subcluss usually overrides this with some more special output (CSV, ...) 212 | 213 | =cut 214 | 215 | sub output 216 | { 217 | my $self = shift; 218 | 219 | foreach my $category ( $self->result_categories ) 220 | { 221 | DEBUG "Running Aggregation for Category $category"; 222 | INFO "Category: $category ", Dumper( $self->aggregate($category) ); 223 | } 224 | 225 | return; 226 | } 227 | 228 | #__PACKAGE__->meta->make_immutable; 229 | 230 | 1; # End of TLS::Check 231 | -------------------------------------------------------------------------------- /lib/Security/TLSCheck/Result/CSV.pm: -------------------------------------------------------------------------------- 1 | package Security::TLSCheck::Result::CSV; 2 | 3 | use Moose::Role; 4 | use 5.010; 5 | 6 | with "Security::TLSCheck::Result"; 7 | 8 | =head1 NAME 9 | 10 | Security::TLSCheck::Result::CSV -- CSV output role 11 | 12 | =head1 VERSION 13 | 14 | Version 0.2.x 15 | 16 | =cut 17 | 18 | #<<< 19 | my $BASE_VERSION = "1.0"; use version; our $VERSION = qv( sprintf "$BASE_VERSION.%d", q$Revision: 658 $ =~ /(\d+)/xg ); 20 | #>>> 21 | 22 | 23 | =head1 SYNOPSIS 24 | 25 | =encoding utf8 26 | 27 | 28 | =head1 DESCRIPTION 29 | 30 | 31 | =cut 32 | 33 | use English qw( -no_match_vars ); 34 | use List::Util qw(sum); 35 | use POSIX qw(ceil); 36 | 37 | use Text::CSV_XS; 38 | use IO::All -utf8; 39 | 40 | use Log::Log4perl::EasyCatch; 41 | 42 | 43 | has outfile => ( is => "ro", isa => "Str", default => q{-}, documentation => "Output file name; - for STDOUT (default)" ); 44 | 45 | 46 | =head1 METHODS 47 | 48 | =head2 output 49 | 50 | CSV Output method 51 | 52 | Result: 53 | 54 | Category Module Class Class-Description Runtime Name Description Type All sum avg median group 55 | 1 56 | Dummy ...::Checks::Dummy Dummy Checks 0.000123 57 | "Test Name" "Test Description" count 50 150 3 2 58 | 59 | =cut 60 | 61 | 62 | sub output 63 | { 64 | ## no critic (BuiltinFunctions::ProhibitReverseSortBlock) 65 | my $self = shift; 66 | 67 | INFO "Output: CSV. File: " . $self->outfile; 68 | 69 | my $csv = Text::CSV_XS->new( { binary => 1, sep_char => $self->separator, } ); 70 | my $io = io( $self->outfile ); 71 | 72 | $csv->combine( 73 | qw( Category 74 | Module Class Class-Description Runtime 75 | Name Description Type All Sum Mean Percent Median Group ) 76 | ); 77 | 78 | $io->println( $csv->string ); 79 | 80 | foreach my $category ( sort $self->result_categories ) 81 | { 82 | DEBUG "Running Aggregation for Category $category"; 83 | 84 | $io->println(""); 85 | $io->println("Category $category"); 86 | 87 | my $aggregate = $self->aggregate($category); 88 | 89 | foreach my $check_name ( sort keys %$aggregate ) 90 | { 91 | my $check = $aggregate->{$check_name}; 92 | 93 | $csv->combine( undef, $check_name, $check->{class}, $check->{description}, $check->{runtime} ) 94 | or die "Error while creating CSV; broken input: '" . $csv->error_input . "', error: " . $csv->error_diag . "\n"; 95 | $io->println( $csv->string ); 96 | 97 | foreach my $result ( @{ $check->{aggregates} } ) 98 | { 99 | my $group; 100 | if ( $result->{group} ) 101 | { 102 | $group = join( ", ", 103 | map { "$ARG => $result->{group}{$ARG}" } 104 | sort { $result->{group}{$b} <=> $result->{group}{$a} } keys %{ $result->{group} } ); 105 | } 106 | else 107 | { 108 | $result->{sum} //= 0; 109 | } 110 | 111 | # TODO: beautify ;) and hash slice instead of map (make a sub with complete array) 112 | $csv->combine( 113 | undef, 114 | undef, 115 | undef, 116 | undef, 117 | undef, 118 | ( map { $result->{$ARG} } qw(name description type count sum) ), 119 | defined $result->{sum} ? $result->{sum} / $result->{count} : undef, 120 | defined( $result->{sum} and $result->{type} eq "flag" ) 121 | ? ( ( $result->{sum} / $result->{count} ) * 100 ) . q{%} 122 | : undef, 123 | $result->{values} ? median( $result->{values} ) : undef, 124 | $group, 125 | ) 126 | or die "Error while creating CSV; broken input: '" . $csv->error_input . "', error: " . $csv->error_diag . "\n"; 127 | $io->println( $csv->string ); 128 | } ## end foreach my $result ( @{ $check...}) 129 | 130 | } ## end foreach my $check_name ( sort...) 131 | 132 | # INFO "Category: $category ", Dumper( ); 133 | } ## end foreach my $category ( sort...) 134 | 135 | INFO "Output Finished."; 136 | 137 | return; 138 | } ## end sub output 139 | 140 | =head2 median 141 | 142 | calculates the median. 143 | 144 | =cut 145 | 146 | sub median 147 | { 148 | my $numbers = shift; 149 | return unless @$numbers; 150 | 151 | return sum( ( sort { $a <=> $b } map { $ARG // 0 } @$numbers )[ int( $#$numbers / 2 ), ceil( $#$numbers / 2 ) ] ) / 2; 152 | } 153 | 154 | #__PACKAGE__->meta->make_immutable; 155 | 156 | 1; 157 | -------------------------------------------------------------------------------- /t/000-load.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Test::More; 7 | 8 | my $IGNORE_MODULES = qr{^$}; 9 | 10 | 11 | =begin internal note 12 | 13 | Test Numbering: 14 | 15 | 0xx: init 16 | 1xx: external extras 17 | 2xx: base class(es) 18 | 3xx: output 19 | 4xx: checks base & helper classes 20 | 5xx: checks phase 1 21 | 6xx: 22 | 7xx: 23 | 8xx: Bugs 24 | 9xx: Style etc 25 | 26 | =cut 27 | 28 | 29 | 30 | # 31 | # Lade-Tests überspringen, wenn wir unter Devel::Cover laufen 32 | # Das ist sehr langsam, insbesondere unter Windows 33 | # Und bringt nicht wirklich etwas, da die MOdule auch später noch geladen werden. 34 | # 35 | 36 | #if ( $INC{'Devel/Cover.pm'} ) 37 | # { 38 | # Test::More::plan( skip_all => "Skip the load tests with 'testcover'(Devel::Cover)!" ); 39 | # } 40 | 41 | 42 | eval "use Test::Pod::Coverage 1.04"; 43 | 44 | if ($@) 45 | { 46 | diag "Need Test::Pod::Coverage to find all modules automatically..."; 47 | plan tests => 1; 48 | use_ok('Security::TLSCheck'); 49 | } 50 | else 51 | { 52 | my @modules = grep { not $_ =~ $IGNORE_MODULES } all_modules(); 53 | plan tests => scalar @modules; 54 | use_ok($_) for @modules; 55 | } 56 | 57 | -------------------------------------------------------------------------------- /t/122-ssl-handshake-smtp-starttls.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | use 5.010; 4 | use strict; 5 | use warnings FATAL => 'all'; 6 | use Test::More; 7 | use Test::Exception; 8 | use Test::Deep; 9 | use Test::Differences; 10 | 11 | use English qw( -no_match_vars ); 12 | 13 | use Data::Dumper; 14 | 15 | if ( $ENV{TRAVIS} ) { plan skip_all => "It looks like we can't run SMTP tests with Travis"; } 16 | else { plan tests => 8; } 17 | 18 | use Net::SSL::Handshake qw(:all); 19 | use Net::SSL::Handshake::StartTLS::SMTP; 20 | use Net::SSL::GetServerProperties; 21 | 22 | 23 | 24 | my $prop; 25 | 26 | lives_ok( 27 | sub { 28 | $prop = Net::SSL::GetServerProperties->new( 29 | host => "mail.a-blast.org", 30 | port => 25, 31 | handshake_class => "Net::SSL::Handshake::StartTLS::SMTP", 32 | ); 33 | }, 34 | "Net::SSL::GetServerProperties->new with handshake_class Net::SSL::Handshake::StartTLS::SMTP does not die" 35 | ); 36 | 37 | ok( $prop, "Server Properties object ..." ); 38 | lives_ok( sub { $prop->get_properties; }, "Run get all properties" ); 39 | 40 | ok( $prop->supports_tlsv12, "Supports TLS 1.2" ); 41 | ok( $prop->supports_tlsv11, "Supports TLS 1.1" ); 42 | ok( $prop->supports_tlsv1, "Supports TLS 1.0" ); 43 | ok( $prop->supports_sslv3, "Supports SSLv3" ); # uuuh, this server supports junky SSLv3.0 :/ 44 | ok( !$prop->supports_sslv2, "Supports SSLv2" ); 45 | 46 | 47 | # diag join " ", $prop->accepted_ciphers->names; 48 | 49 | 50 | # Again: 51 | # 52 | #lives_ok( 53 | # sub { 54 | # $prop = Net::SSL::GetServerProperties->new( 55 | # host => "mail.a-blast.org", 56 | # port => 25, 57 | # handshake_class => "Net::SSL::Handshake::StartTLS::SMTP", 58 | # ); 59 | # }, 60 | # "Net::SSL::GetServerProperties->new with handshake_class Net::SSL::Handshake::StartTLS::SMTP does not die" 61 | # ); 62 | # 63 | #ok( $prop, "Server Properties object ..." ); 64 | #lives_ok( sub { $prop->get_properties; }, "Run get all properties" ); 65 | # 66 | #ok( $prop->supports_tlsv12, "Supports TLS 1.2" ); 67 | #ok( $prop->supports_tlsv11, "Supports TLS 1.1" ); 68 | #ok( $prop->supports_tlsv1, "Supports TLS 1.0" ); 69 | # 70 | # 71 | #diag join " ", $prop->accepted_ciphers->names; 72 | # 73 | 74 | 75 | 76 | #use Data::Dumper; 77 | #$prop->ciphers_to_check->remove($prop->ciphers_to_check); 78 | #diag Dumper $prop; 79 | 80 | 81 | 82 | done_testing(); 83 | 84 | 85 | 86 | -------------------------------------------------------------------------------- /t/201-main.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | use 5.010; 4 | use strict; 5 | use warnings FATAL => 'all'; 6 | use FindBin qw($Bin); 7 | use English qw( -no_match_vars ); 8 | 9 | use Test::More; 10 | use Test::Exception; 11 | use Test::File; 12 | use Test::Differences; 13 | 14 | 15 | #plan tests => 15; 16 | 17 | 18 | use_ok("Security::TLSCheck::App"); 19 | use_ok("Security::TLSCheck"); 20 | can_ok( "Security::TLSCheck", qw(domain timeout user_agent_name) ); 21 | 22 | 23 | 24 | my $tc; 25 | lives_ok( sub { $tc = Security::TLSCheck->new( domain => "test.example" ) }, "Can create an tls-check-object" ); 26 | isa_ok( $tc, "Security::TLSCheck" ); 27 | 28 | # moved to the checks! 29 | # is( $tc->www, "www.test.example", "-> is www.test.example" ); 30 | 31 | 32 | # 33 | # Logging Test 34 | # 35 | # clean old logs 36 | unlink glob("$Bin/logs/*"); 37 | rmdir "$Bin/logs"; 38 | 39 | ok( ( not -d "$Bin/logs" ), "Test cleaned log dir" ); 40 | 41 | 42 | mkdir "$Bin/logs"; 43 | 44 | lives_ok( 45 | sub { 46 | $tc = Security::TLSCheck::App->new( log_config => "$Bin/log-test.properties" ); 47 | }, 48 | "Can create an tls-check-object with extra logging" 49 | ); 50 | 51 | dir_exists_ok( "$Bin/logs", "new log dir exists" ); 52 | file_exists_ok( "$Bin/logs/trace.log", "trace log exists" ); 53 | file_contains_like( 54 | "$Bin/logs/trace.log", 55 | qr(Logging initialised with non-default config), 56 | "trace log contains log conf message" 57 | ); 58 | 59 | 60 | # 61 | # run_all_checks 62 | # 63 | 64 | my $dummy_figures = [ 65 | { 66 | name => "Length of domain", 67 | type => "int", 68 | source => "get_length", 69 | description => "Length of the domain name.", 70 | pos => 0, 71 | }, 72 | { 73 | name => "Top Level Domain", 74 | type => "group", 75 | source => "get_tld", 76 | description => "Top level domains.", 77 | pos => 1 78 | }, 79 | { name => "TLD is .de", type => "flag", source => "is_de", description => "Is the TLD .de?", pos => 2, }, 80 | ]; 81 | 82 | 83 | 84 | throws_ok( 85 | sub { 86 | $tc = Security::TLSCheck->new( domain => "crash.example", 87 | app => Security::TLSCheck::App->new( checks => [qw(Nonexistent)] ) ); 88 | }, 89 | qr(Can't locate Security/TLSCheck/Checks/Nonexistent.pm), 90 | "Crashes when try to use nonexistent check" 91 | ); 92 | $tc = Security::TLSCheck->new( domain => "test.example", app => Security::TLSCheck::App->new( checks => [qw(Dummy)] ) ); 93 | my @result = $tc->run_all_checks; 94 | my $result = $tc->run_all_checks; 95 | my $expected = [ 96 | [ 97 | { info => $dummy_figures->[0], value => 12, }, 98 | { info => $dummy_figures->[1], value => "example", }, 99 | { info => $dummy_figures->[2], value => 0,, }, 100 | 101 | ], 102 | ]; 103 | 104 | my @check_results = map { $ARG->{result} } @result; 105 | my @check_names = map { $ARG->{name} } @result; 106 | my @check_results_from_aref = map { $ARG->{result} } @$result; 107 | 108 | # TODO: check for the (new) results in ->{check} 109 | # isa_ok( $result[0]{check}, "Security::TLSCheck::Checks::Dummy", "ISA of arrayref result" ); 110 | # isa_ok( $result->[0]{check}, "Security::TLSCheck::Checks::Dummy", "ISA of array result" ); 111 | is( scalar @result, scalar @$result, "count of array and arrayref result is the same" ); 112 | eq_or_diff( \@check_results, \@check_results_from_aref, "result array and arrayref are the same" ); 113 | 114 | eq_or_diff( \@check_results, $expected, "result as expected for test.example" ); 115 | eq_or_diff( \@check_names, [qw(Dummy)], "result as expected for test.example" ); 116 | 117 | 118 | 119 | $tc = Security::TLSCheck->new( domain => "my-tls-check.nonexistent-example.de", 120 | app => Security::TLSCheck::App->new( checks => [qw(Dummy)] ) ); 121 | @check_results = map { $ARG->{result} } $tc->run_all_checks; 122 | $expected = [ 123 | [ 124 | { info => $dummy_figures->[0], value => 35, }, 125 | { info => $dummy_figures->[1], value => "de", }, 126 | { info => $dummy_figures->[2], value => 1, }, 127 | 128 | ], 129 | ]; 130 | 131 | eq_or_diff( \@check_results, $expected, "arrayref result for my-tls-check.nonexistent-example.de" ); 132 | 133 | 134 | 135 | # 136 | # Todo: mehr wenn mehr da! 137 | # 138 | 139 | 140 | done_testing(); 141 | 142 | -------------------------------------------------------------------------------- /t/221-domain_filter.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | use 5.010; 4 | use strict; 5 | use warnings FATAL => 'all'; 6 | use FindBin qw($Bin); 7 | use English qw( -no_match_vars ); 8 | 9 | use utf8; 10 | 11 | use Test::More; 12 | 13 | plan tests => 188; 14 | 15 | package Test::DomainFilter; 16 | 17 | use Moose; 18 | with 'Security::TLSCheck::App::DomainFilter'; 19 | 20 | package main; 21 | 22 | 23 | my $df = Test::DomainFilter->new(); 24 | 25 | sub df_ok 26 | { 27 | my $input = shift; 28 | my $wanted = shift; 29 | my $message = shift; 30 | 31 | my $domain = $df->filter_domain($input); 32 | 33 | my $wanted_defined = $wanted // ""; 34 | $message = "'$input' => '$wanted_defined'" unless defined $message; 35 | return is( $domain, $wanted, $message ); 36 | } 37 | 38 | df_ok( "www.test.de", "test.de" ); 39 | df_ok( "test.de", "test.de" ); 40 | df_ok( "http://www.test.de", "test.de" ); 41 | df_ok( "http//www.test.de", "test.de" ); 42 | df_ok( "http:/www.test.de", "test.de" ); 43 | df_ok( "http:www.test.de", "test.de" ); 44 | df_ok( "http:\\\\www.test.de", "test.de" ); 45 | df_ok( "http:\\www.test.de", "test.de" ); 46 | df_ok( "https://www.test.de", "test.de" ); 47 | df_ok( "https//www.test.de", "test.de" ); 48 | df_ok( "https:/www.test.de", "test.de" ); 49 | df_ok( "https:www.test.de", "test.de" ); 50 | df_ok( "https:\\\\www.test.de", "test.de" ); 51 | df_ok( "https:\\www.test.de", "test.de" ); 52 | 53 | df_ok( "//www.test.de", "test.de" ); 54 | df_ok( "/www.test.de", "test.de" ); 55 | df_ok( "http:http://www.test.de", "test.de" ); 56 | df_ok( "http://http:www.test.de", "test.de" ); 57 | df_ok( "http://http://www.test.de", "test.de" ); 58 | df_ok( "http:/http://www.test.de", "test.de" ); 59 | df_ok( "http://http:/www.test.de", "test.de" ); 60 | 61 | 62 | df_ok( "htttp://www.test.de", "test.de" ); 63 | df_ok( "htp://www.test.de", "test.de" ); 64 | df_ok( "htpp://www.test.de", "test.de" ); 65 | 66 | # some undef lists ... 67 | 68 | foreach my $domain (qw(t-online.de arcor.de gmx.de web.de hotmail.de hotmail.com gmx.com yahoo.de yahoo.com t-online.com)) 69 | { 70 | df_ok( $domain, undef ); 71 | df_ok( "www.$domain", undef ); 72 | df_ok( "testbert\@$domain", undef ); 73 | } 74 | 75 | 76 | 77 | df_ok( "www test.de", "test.de" ); 78 | df_ok( "www test de", "test.de" ); 79 | df_ok( "www test:de", "test.de" ); 80 | df_ok( "test:de", "test.de" ); 81 | df_ok( "www.test:de", "test.de" ); 82 | df_ok( "www test-de", "test.de" ); 83 | df_ok( "test-de", "test.de" ); 84 | df_ok( "www.test-de", "test.de" ); 85 | df_ok( "www test,de", "test.de" ); 86 | df_ok( "test,de", "test.de" ); 87 | df_ok( "www.test,de", "test.de" ); 88 | df_ok( "www.test de", "test.de" ); 89 | df_ok( "test de", "test.de" ); 90 | df_ok( "test..de", "test.de" ); 91 | df_ok( "www.test..de", "test.de" ); 92 | df_ok( "www..test.de", "test.de" ); 93 | df_ok( "www. test.de", "test.de" ); 94 | df_ok( "test info", "test.info" ); 95 | df_ok( "www.info", "www.info" ); 96 | df_ok( "http://www.info", "www.info" ); 97 | df_ok( "www.info:80", "www.info" ); 98 | df_ok( "http://www.info:80", "www.info" ); 99 | df_ok( "http://www.test.info:80", "test.info" ); 100 | 101 | df_ok( "www,test.de", "test.de" ); 102 | df_ok( "test,de", "test.de" ); 103 | df_ok( "http://www,test,de", "test.de" ); 104 | 105 | 106 | df_ok( 'hans@wurst.de', 'wurst.de' ); 107 | df_ok( 'hans@www.wurst.de', 'wurst.de' ); 108 | 109 | df_ok( 'bettina.beispiel@t-online.de', undef ); 110 | df_ok( 'bettina.beispiel@tonline.de', undef ); 111 | df_ok( 'bettina.beispiel@t online.de', undef ); 112 | df_ok( 'irgendwer@arcor.de', undef ); 113 | df_ok( 'max-mustermann1988@gmx.de', undef ); 114 | df_ok( 'someone@hotmail.de', undef ); 115 | df_ok( 'someone@hotmail.com', undef ); 116 | df_ok( 'www.test.de@yahoo.de', undef ); 117 | df_ok( 'www.t-online.de', undef ); 118 | df_ok( 'http://home.t-online.de/emma.example', undef ); 119 | 120 | df_ok( 'http://www.some-domain.info/hansi.hanswurst', 'some-domain.info' ); 121 | df_ok( 'http://some-domain.info/hansi.hanswurst', 'some-domain.info' ); 122 | df_ok( 'some-domain.info/hansi.hanswurst', 'some-domain.info' ); 123 | df_ok( 'http:/www.some-domain.info/hansi.hanswurst', 'some-domain.info' ); 124 | df_ok( 'http//some-domain.info/hansi.hanswurst', 'some-domain.info' ); 125 | df_ok( 'some-domain.info/hansi.hanswurst/index.html', 'some-domain.info' ); 126 | 127 | df_ok( "bettina beispiel.de", "bettinabeispiel.de" ); 128 | df_ok( "bettina- beispiel.de", "bettina-beispiel.de" ); 129 | df_ok( "bettina -beispiel.de", "bettina-beispiel.de" ); 130 | 131 | df_ok( "mydomain.community", "mydomain.community" ); 132 | df_ok( "mydomain.community/test", "mydomain.community" ); 133 | df_ok( "mydomain.community/test.html", "mydomain.community" ); 134 | 135 | df_ok( "htp-online.de", "htp-online.de" ); 136 | df_ok( "www.htp-online.de", "htp-online.de" ); 137 | df_ok( "http-online.de", "http-online.de" ); 138 | df_ok( "www.http-online.de", "http-online.de" ); 139 | df_ok( "http://htp-online.de", "htp-online.de" ); 140 | df_ok( "http://www.htp-online.de", "htp-online.de" ); 141 | df_ok( "http://http-online.de", "http-online.de" ); 142 | df_ok( "http://www.http-online.de", "http-online.de" ); 143 | 144 | df_ok( "www-online.de", "www-online.de" ); 145 | df_ok( "www.www-online.de", "www-online.de" ); 146 | df_ok( "ww-online.de", "ww-online.de" ); 147 | df_ok( "www.ww-online.de", "ww-online.de" ); 148 | df_ok( "http://www-online.de", "www-online.de" ); 149 | df_ok( "http://www.www-online.de", "www-online.de" ); 150 | df_ok( "http://ww-online.de", "ww-online.de" ); 151 | df_ok( "http://www.ww-online.de", "ww-online.de" ); 152 | 153 | df_ok( "WWW.TEST.DE", "test.de" ); 154 | df_ok( "TEST.DE", "test.de" ); 155 | df_ok( "HTTP://WWW.TEST.DE", "test.de" ); 156 | df_ok( "HttP://WWW.TEST.DE", "test.de" ); 157 | df_ok( "http://WWW.TEST.DE", "test.de" ); 158 | df_ok( "www.TEST.DE", "test.de" ); 159 | df_ok( "t-online.DE", undef ); 160 | 161 | df_ok( "http.de", "http.de" ); 162 | df_ok( "www.http.de", "http.de" ); 163 | df_ok( "http://www.http.de", "http.de" ); 164 | df_ok( "http://http.de", "http.de" ); 165 | 166 | # now it is here: changed from .de to .gmbh: perhaps there will be a TLD gmbh in future! 167 | df_ok( "autohaus-hutzelhausen-gmbh", "autohaus-hutzelhausen.gmbh" ); 168 | df_ok( "www.autohaus-hutzelhausen-gmbh", "autohaus-hutzelhausen.gmbh" ); 169 | df_ok( "www..autohaus-hutzelhausen-gmbh", "autohaus-hutzelhausen.gmbh" ); 170 | df_ok( "http://www..autohaus-hutzelhausen-gmbh", "autohaus-hutzelhausen.gmbh" ); 171 | 172 | df_ok( "hutzelhausen-ag", "hutzelhausen.ag" ); 173 | df_ok( "www.hutzelhausen-ag", "hutzelhausen.ag" ); 174 | df_ok( "http://www.hutzelhausen-ag", "hutzelhausen.ag" ); 175 | df_ok( "http://www..hutzelhausen-ag", "hutzelhausen.ag" ); 176 | df_ok( "http://hutzelhausen-ag", "hutzelhausen.ag" ); 177 | 178 | df_ok( "blablacom", "blabla.com" ); 179 | df_ok( "blablade", "blabla.de" ); 180 | df_ok( "http://blablacom", "blabla.com" ); 181 | df_ok( "http://blablade", "blabla.de" ); 182 | df_ok( "http://www.blablacom", "blabla.com" ); 183 | df_ok( "http://www.blablade", "blabla.de" ); 184 | 185 | df_ok( "invalid.tld", undef ); 186 | 187 | df_ok( 'hans@wurst.de', 'wurst.de' ); 188 | df_ok( 'www.hans@wurst.de', 'wurst.de' ); 189 | df_ok( 'hans@www.wurst.de', 'wurst.de' ); 190 | df_ok( 'http://www.hans@www.wurst.de', 'wurst.de' ); 191 | 192 | df_ok( 'some.long.domain.info', 'some.long.domain.info' ); 193 | df_ok( 'www.some.long.domain.info', 'some.long.domain.info' ); 194 | df_ok( 'ww.some.long.domain.info', 'some.long.domain.info' ); 195 | df_ok( 'http://some.long.domain.info', 'some.long.domain.info' ); 196 | df_ok( 'http://www.some.long.domain.info', 'some.long.domain.info' ); 197 | df_ok( 'http:\\\\ww.some.long.domain.info', 'some.long.domain.info' ); 198 | df_ok( 'http.//some.long.domain.info', 'some.long.domain.info' ); 199 | 200 | df_ok( 'ätsch.de', 'ätsch.de' ); 201 | df_ok( 'www.ätsch.de', 'ätsch.de' ); 202 | df_ok( 'http://ätsch.de', 'ätsch.de' ); 203 | df_ok( 'http://www.ätsch.de', 'ätsch.de' ); 204 | 205 | df_ok( 'test.dee', 'test.de' ); 206 | df_ok( 'test.deu', 'test.de' ); 207 | df_ok( 'test.d', 'test.de' ); 208 | df_ok( 'test.e', 'test.de' ); 209 | 210 | df_ok( 'dee.test.dee', 'dee.test.de' ); 211 | df_ok( 'deu.test.deu', 'deu.test.de' ); 212 | df_ok( 'd.test.d', 'd.test.de' ); 213 | df_ok( 'e.test.e', 'e.test.de' ); 214 | 215 | df_ok( 'hkttp://www.test.de', 'test.de' ); 216 | df_ok( 'htto://www.test.de', 'test.de' ); 217 | df_ok( 'htttp://www.test.de', 'test.de' ); 218 | df_ok( 'httt://www.test.de', 'test.de' ); 219 | df_ok( 'hkttp://test.de', 'test.de' ); 220 | df_ok( 'htto://test.de', 'test.de' ); 221 | df_ok( 'htttp://test.de', 'test.de' ); 222 | df_ok( 'httt://test.de', 'test.de' ); 223 | 224 | df_ok( "www.ourworld.compuserve.com.homepages/Irgendwer", "ourworld.compuserve.com" ); 225 | 226 | df_ok( 'http://www.test-domain', 'test-domain.de' ); 227 | df_ok( 'www.test-domain', 'test-domain.de' ); 228 | df_ok( 'test-domain', undef ); 229 | df_ok( 'test domain', undef ); 230 | 231 | df_ok( 'www.domain.info ; www.andere-domain.info', 'domain.info' ); 232 | df_ok( 'www.domain.info.', 'domain.info' ); 233 | df_ok( 'www domain.info.', 'domain.info' ); 234 | 235 | 236 | df_ok( "replace-all", "everything-replaced.tld" ); 237 | 238 | df_ok( "localhost", "localhost" ); 239 | 240 | 241 | # 242 | done_testing(); 243 | -------------------------------------------------------------------------------- /t/401-checks-base.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | use 5.010; 4 | use strict; 5 | use warnings FATAL => 'all'; 6 | use Test::More; 7 | use Test::Exception; 8 | use Test::MockObject; 9 | 10 | use Time::HiRes qw(time); 11 | 12 | plan tests => 19; 13 | 14 | 15 | # 16 | # fake check for testing 17 | # 18 | 19 | package MyTest::Checks; 20 | 21 | use Moose; 22 | 23 | extends 'Security::TLSCheck::Checks'; 24 | with 'Security::TLSCheck::Checks::Helper::Timing'; 25 | 26 | has call_runtime => ( is => "rw", isa => "Bool" ); 27 | 28 | sub run_check 29 | { 30 | my $self = shift; 31 | 32 | $self->runtime if $self->call_runtime; 33 | 34 | return $self; 35 | 36 | } 37 | 38 | 39 | # 40 | # use the fake check 41 | # 42 | 43 | package main; 44 | 45 | 46 | my $mock = Test::MockObject->new(); 47 | my $mock_with_domain = Test::MockObject->new(); 48 | $mock_with_domain->set_always( domain => "test.example" ); 49 | 50 | 51 | dies_ok( sub { my $check = MyTest::Checks->new(); }, "without instance object" ); 52 | # The domain attibute is now directly delegated from instance and not build manually ... 53 | #throws_ok( sub { my $domain = MyTest::Checks->new( instance => $mock )->domain; }, qr(Missing domain), "without domain in instance object" ); 54 | 55 | my $check; 56 | lives_ok( sub { $check = MyTest::Checks->new( instance => $mock_with_domain ); }, "with domain in instance object" ); 57 | is($check->domain, "test.example", "Domain korrekt"); 58 | is($check->www(), "www.test.example", "WWW korrekt"); 59 | 60 | 61 | 62 | $check = MyTest::Checks->new( instance => $mock, call_runtime => 1 ); 63 | 64 | isa_ok( $check, "MyTest::Checks" ); 65 | can_ok( $check, qw(run_check runtime start_time end_time) ); 66 | 67 | is( $check->start_time, undef, "Start time undef before start" ); 68 | is( $check->end_time, undef, "End time undef before start" ); 69 | 70 | dies_ok( sub { $check->runtime }, "runtime dies before start" ); 71 | like( $@, qr{No start time}, "runtime dies before start message" ); 72 | 73 | dies_ok( sub { $check->run_check }, "runtime dies inside run_check" ); 74 | like( $@, qr{No end time}, "runtime dies inside run_check message" ); 75 | 76 | 77 | 78 | $check->call_runtime(0); 79 | 80 | lives_ok( sub { $check->run_check }, "call run_check" ); 81 | lives_ok( sub { $check->runtime }, "call runtime now ok" ); 82 | 83 | ok( $check->start_time > ( time - 1 ), "Start time is not older then 1 second" ); 84 | ok( $check->end_time > $check->start_time, "end time is after start time" ); 85 | ok( $check->end_time < time, "End time is before now" ); 86 | ok( $check->runtime < 1, "Runtime below 1 second" ); 87 | 88 | is( $check->name, "MyTest::Checks", "->name" ); 89 | 90 | 91 | 92 | -------------------------------------------------------------------------------- /t/900-perlcritic.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Test::More; 7 | 8 | use FindBin qw($Bin); 9 | 10 | unless ( $ENV{RELEASE_TESTING} || $ENV{TEST_AUTHOR} ) 11 | { 12 | plan( skip_all => "Author tests not required for installation (set TEST_AUTHOR)" ); 13 | } 14 | 15 | BEGIN 16 | { 17 | 18 | eval "use Test::Perl::Critic; use Perl::Critic::Utils;"; 19 | if ($@) 20 | { 21 | Test::More::plan( skip_all => "Test::Perl::Critic required for testing PBP compliance" ); 22 | } 23 | } 24 | 25 | #if ( $INC{'Devel/Cover.pm'} ) 26 | # { 27 | # Test::More::plan( skip_all => "Perl::Critic tests are too slow with 'testcover'!" ); 28 | # } 29 | 30 | 31 | # TODO: 32 | # Move this into perlcriticrc 33 | 34 | Test::Perl::Critic->import( 35 | -profile => "$Bin/perlcriticrc", 36 | -severity => 1, 37 | -verbose => $ENV{PC_VERBOSE} // 11, 38 | -exclude => [ 39 | qw( 40 | RequirePodSections 41 | RequirePodAtEnd 42 | 43 | Documentation::PodSpelling 44 | 45 | ValuesAndExpressions::ProhibitConstantPragma 46 | ValuesAndExpressions::ProhibitInterpolationOfLiterals 47 | ValuesAndExpressions::RequireInterpolationOfMetachars 48 | ValuesAndExpressions::ProhibitEmptyQuotes 49 | ValuesAndExpressions::RequireConstantVersion 50 | 51 | RegularExpressions::RequireDotMatchAnything 52 | RegularExpressions::RequireLineBoundaryMatching 53 | 54 | References::ProhibitDoubleSigils 55 | 56 | CodeLayout::ProhibitTrailingWhitespace 57 | CodeLayout::ProhibitParensWithBuiltins 58 | 59 | ControlStructures::ProhibitPostfixControls 60 | ControlStructures::ProhibitUnlessBlocks 61 | 62 | 63 | Modules::RequireVersionVar 64 | Miscellanea::ProhibitUnrestrictedNoCritic 65 | 66 | ) 67 | ] 68 | ); 69 | 70 | 71 | # exclude helpers, external scripts etc 72 | my @files = grep { not m{ (?: auto/share | (?:bin|script)/(?:test|helper) ) }x } all_perl_files("$Bin/../blib"); 73 | 74 | plan tests => scalar @files; 75 | 76 | 77 | my @failed; 78 | 79 | foreach my $file (@files) 80 | { 81 | SKIP: 82 | { 83 | skip "check_ciphers_single_domains must be rewritten", 1 if $file =~ m{check_ciphers_single_domains}x; 84 | critic_ok($file) or push @failed, $file; 85 | } 86 | } 87 | 88 | 89 | foreach my $failed (@failed) 90 | { 91 | diag " Perl::Critic failed for: $failed"; 92 | } 93 | 94 | 95 | -------------------------------------------------------------------------------- /t/910-boilerplate.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | use 5.006; 3 | use strict; 4 | use warnings FATAL => 'all'; 5 | use Test::More; 6 | 7 | plan tests => 3; 8 | 9 | sub not_in_file_ok 10 | { 11 | my ( $filename, %regex ) = @_; 12 | open( my $fh, '<', $filename ) 13 | or die "couldn't open $filename for reading: $!"; 14 | 15 | my %violated; 16 | 17 | while ( my $line = <$fh> ) 18 | { 19 | while ( my ( $desc, $regex ) = each %regex ) 20 | { 21 | if ( $line =~ $regex ) 22 | { 23 | push @{ $violated{$desc} ||= [] }, $.; 24 | } 25 | } 26 | } 27 | 28 | if (%violated) 29 | { 30 | fail("$filename contains boilerplate text"); 31 | diag "$_ appears on lines @{$violated{$_}}" for keys %violated; 32 | } 33 | else 34 | { 35 | pass("$filename contains no boilerplate text"); 36 | } 37 | } ## end sub not_in_file_ok 38 | 39 | sub module_boilerplate_ok 40 | { 41 | my ($module) = @_; 42 | not_in_file_ok( 43 | $module => 'the great new $MODULENAME' => qr/ - The great new /, 44 | 'boilerplate description' => qr/Quick summary of what the module/, 45 | 'stub function definition' => qr/function[12]/, 46 | ); 47 | } 48 | 49 | 50 | not_in_file_ok( "README.md" => "The README is used..." => qr/The README is used/, 51 | "'version information here'" => qr/to provide version information/, ); 52 | 53 | not_in_file_ok( Changes => "placeholder date/time" => qr(Date/time) ); 54 | 55 | module_boilerplate_ok('lib/Security/TLSCheck.pm'); 56 | -------------------------------------------------------------------------------- /t/920-manifest.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | use 5.006; 3 | use strict; 4 | use warnings FATAL => 'all'; 5 | use Test::More; 6 | 7 | # No reason to skip ... 8 | #unless ( $ENV{RELEASE_TESTING} || $ENV{TEST_AUTHOR} ) 9 | # { 10 | # plan( skip_all => "Author tests not required for installation (set TEST_AUTHOR)" ); 11 | # } 12 | 13 | plan( skip_all => "Test::CheckManifest fails with symlinked files!" ); 14 | 15 | my $min_tcm = 0.9; 16 | eval "use Test::CheckManifest $min_tcm"; 17 | plan skip_all => "Test::CheckManifest $min_tcm required" if $@; 18 | 19 | ok_manifest(); 20 | -------------------------------------------------------------------------------- /t/930-pod-coverage.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | use 5.006; 3 | use strict; 4 | use warnings FATAL => 'all'; 5 | use Test::More; 6 | 7 | # Ensure a recent version of Test::Pod::Coverage 8 | my $min_tpc = 1.08; 9 | eval "use Test::Pod::Coverage $min_tpc"; 10 | plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage" 11 | if $@; 12 | 13 | # Test::Pod::Coverage doesn't require a minimum Pod::Coverage version, 14 | # but older versions don't recognize some common documentation styles 15 | my $min_pc = 0.18; 16 | eval "use Pod::Coverage $min_pc"; 17 | plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage" 18 | if $@; 19 | 20 | all_pod_coverage_ok( { private => [ qw(^_), qr(BUILD), qr(CMD_OK), ] } ); 21 | -------------------------------------------------------------------------------- /t/931-pod.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | use 5.006; 3 | use strict; 4 | use warnings FATAL => 'all'; 5 | use Test::More; 6 | 7 | # Ensure a recent version of Test::Pod 8 | my $min_tp = 1.22; 9 | eval "use Test::Pod $min_tp"; 10 | plan skip_all => "Test::Pod $min_tp required for testing POD" if $@; 11 | 12 | all_pod_files_ok(); 13 | -------------------------------------------------------------------------------- /t/log-test.properties: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tls-check/TLS-Check/7ec514bfab17528d54107920a9b452873355d0d4/t/log-test.properties -------------------------------------------------------------------------------- /t/manual/check_lwp_preload.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | # call: time check_lwp_preload.pl 4 | 5 | 6 | use strict; 7 | use warnings; 8 | 9 | use 5.010; 10 | 11 | use LWP::Simple; 12 | use Parallel::ForkManager; 13 | 14 | #use LWP::UserAgent; 15 | #use HTTP::Status qw(HTTP_OK HTTP_INTERNAL_SERVER_ERROR); 16 | # 17 | ## Preload later required libraries (for parallel fork mode) 18 | #use HTTP::Response; 19 | #use HTTP::Request; 20 | #use LWP::Protocol::https; 21 | #use LWP::Protocol::http; 22 | #use Mozilla::CA; 23 | #use IO::Socket::SSL; 24 | # 25 | # getstore( "https://wurzelgnom.a-blast.org/", "dummy.out" ); 26 | 27 | 28 | # Testergebnisse nach lokal 29 | # ohne preload 30 | # 71.671u 10.781s 0:51.90 158.8% 10+166k 996+0io 0pf+0w 31 | # 72.038u 10.904s 0:52.55 157.8% 10+166k 1007+0io 0pf+0w 32 | 33 | # mit Preload UND pre-Getstore: 34 | # 16.736u 5.329s 0:44.20 49.8% 9+164k 1005+0io 0pf+0w 35 | # 16.825u 5.226s 0:51.08 43.1% 9+164k 984+0io 0pf+0w 36 | 37 | 38 | # mit Preload OHNE pre-Getstore: 39 | # 22.280u 6.506s 0:48.39 59.4% 10+166k 952+0io 0pf+0w 40 | # 22.006u 6.808s 0:48.32 59.6% 9+164k 992+0io 0pf+0w 41 | 42 | 43 | 44 | 45 | 46 | my @links = map { [ "https://wurzelgnom.a-blast.org/", "run-$_" ] } 1 .. 1000; 47 | 48 | # Max processes for parallel download 49 | my $pm = Parallel::ForkManager->new(20); 50 | 51 | LINKS: 52 | foreach my $linkarray (@links) 53 | { 54 | $pm->start and next LINKS; # do the fork 55 | 56 | my ( $link, $fn ) = @$linkarray; 57 | warn "Cannot get $fn from $link" 58 | if getstore( $link, $fn ) != RC_OK; 59 | 60 | $pm->finish; # do the exit in the child process 61 | } 62 | 63 | 64 | $pm->wait_all_children; 65 | -------------------------------------------------------------------------------- /t/one-testdomain.txt: -------------------------------------------------------------------------------- 1 | odem.org;1 2 | -------------------------------------------------------------------------------- /t/perlcriticrc: -------------------------------------------------------------------------------- 1 | [InputOutput::RequireCheckedSyscalls] 2 | functions = :builtins 3 | exclude_functions = print say 4 | 5 | 6 | [Subroutines::ProhibitUnusedPrivateSubroutines] 7 | private_name_regex = _(?!build_)\w+ 8 | 9 | 10 | [CodeLayout::RequireTidyCode] 11 | perltidyrc = t/perltidyrc 12 | 13 | [RegularExpressions::RequireExtendedFormatting] 14 | minimum_regex_length_to_complain_about = 4 15 | strict = 0 16 | 17 | [BuiltinFunctions::ProhibitComplexMappings] 18 | max_statements = 2 19 | 20 | # 100 (for 100 percent etc) is allowed too; 0, 1, 2 are the defaults 21 | [ValuesAndExpressions::ProhibitMagicNumbers] 22 | allowed_values = 0 1 2 100 23 | 24 | # Allow SSLv3/TLSv12 etc. 25 | [NamingConventions::Capitalization] 26 | # constant_exemptions = v\d+ 27 | constant_exemptions = .*(SSLv|TLSv).* 28 | 29 | -------------------------------------------------------------------------------- /t/perltidyrc: -------------------------------------------------------------------------------- 1 | # 2 | # Perltidy-Optionen 3 | # ================= 4 | # 5 | # Installation: 6 | # ------------- 7 | # 8 | # Diese Datei als ".perltidyrc" ins Homeverzeichnis legen (Unix) 9 | # 10 | # 11 | # Wesentliche Aenderungen gegenueber Original: 12 | # -------------------------------------------- 13 | # 14 | # Oeffnende und schliesende Klammern sind auf der gleichen Ebene 15 | # wie der Block 16 | # 17 | # Einrueckung drei Zeichen 18 | # 19 | # 20 | # Siehe auch: 21 | # ----------- 22 | # 23 | # Perltidy: http://search.cpan.org/~shancock/Perl-Tidy/bin/perltidy 24 | # http://search.cpan.org/~evdb/Test-PerlTidy/lib/Test/PerlTidy.pm 25 | # 26 | # 27 | # Autor: 28 | # ------ 29 | # 30 | # Alvar Freude, http://alvar.a-blast.org/ alvar@a-blast.org 31 | # 32 | # 33 | # 34 | # PBP .perltidyrc file 35 | 36 | -l=130 # Zeilenlaenge auf 110 im normallfall begrenzen 37 | # lange Zeilen ragen damit ueber die ueblichen 80 38 | # Zeichen raus, werden aber auch nicht gleich abgeschnitten 39 | 40 | -i=3 # Einrueckung: 3 Zeichen (default: 4) 41 | -ci=3 # Einrueckung beim Umbruch einer Zeile (Default: 2) 42 | 43 | -lp # line-up-parantheses (Klammerinhalte einruecken) 44 | -cti=1 # schliessendes auf oefnenhoehe 45 | -bli # oeffnende klammern iin naechster zeile und auf hoehe des Blocks 46 | 47 | -nolq # lange Quote-Zeilen NICHT nach links zurueck-ruecken 48 | -nola # lables NICHT nach links ausruecken 49 | 50 | #-pt=2 # keine leerzeichen bei oeffnenden/schliessenden klammern 51 | 52 | -bbb # fuege vor Bloecken ein Leerzeichen ein, ... 53 | -lbl=3 # ... wenn diese mind drei Zeilen haben 54 | 55 | -mbl=3 # Maximale Anzahl an Leerzeilen am Stueck. 56 | -nolc # lange kommentare nicht nach links schieben 57 | 58 | -fpsc=52 # Feste Position von seitlichen Kommentaren an Position 52 59 | 60 | 61 | -csc # fuege Kommentare beim Ende eines Blocks ein, wenn der lang ist 62 | -csci=20 # ab 20 Zeilen 63 | 64 | -vt=0 # Umbrueche bei KLammern grosszuegug setzen 65 | 66 | -bbt=0 # Bloecke luftiger 67 | -sfs # Semikolens bei for: mache Leerzeichen davor! 68 | 69 | 70 | # aus PBP 71 | 72 | -pt=1 # Mittlere Dichte bei runden Klammern 73 | -bt=1 # geschweifte 74 | -sbt=1 # eckige 75 | # Umbruch vor allen Operatoren 76 | -wbb="% + - * / x != == >= <= =~ !~ < > | & = **= += *= &= <<= &&= -= /= |= >>= ||= //= .= %= ^= x=" 77 | 78 | 79 | 80 | # 81 | #-l=78 # Max line width is 78 cols 82 | #-i=4 # Indent level is 4 cols 83 | #-ci=4 # Continuation indent is 4 cols 84 | #-st # Output to STDOUT 85 | #-se # Errors to STDERR 86 | #-vt=2 # Maximal vertical tightness 87 | #-cti=0 # No extra indentation for closing brackets 88 | #-pt=1 # Medium parenthesis tightness 89 | #-bt=1 # Medium brace tightness 90 | #-sbt=1 # Medium square bracket tightness 91 | #-bbt=1 # Medium block brace tightness 92 | #-nsfs # No space before semicolons 93 | #-nolq # Don't outdent long quoted strings 94 | #-wbb="% + - * / x != == >= <= =~ !~ < > | & >= < = **= += *= &= <<= && = -= /= |= >>= ||= .= %= ^= x=" 95 | # # Break before all operators 96 | -------------------------------------------------------------------------------- /t/ssl/server.pem: -------------------------------------------------------------------------------- 1 | -----BEGIN CERTIFICATE----- 2 | MIID9TCCAt2gAwIBAgIJAPbMBW8sUAJJMA0GCSqGSIb3DQEBCwUAMIGPMQswCQYD 3 | VQQGEwJERTEUMBIGA1UECAwLRHVtbXktU3RhdGUxDjAMBgNVBAcMBUR1bW15MRMw 4 | EQYDVQQKDApEdW1teSBHbWJIMRMwEQYDVQQLDApEdW1teSBUZWFtMRQwEgYDVQQD 5 | DAtkdW1teS5kdW1teTEaMBgGCSqGSIb3DQEJARYLZHVtbXlAZHVtbXkwIBcNMTUw 6 | NjIwMjA0ODA4WhgPMjExNTA1MjcyMDQ4MDhaMIGPMQswCQYDVQQGEwJERTEUMBIG 7 | A1UECAwLRHVtbXktU3RhdGUxDjAMBgNVBAcMBUR1bW15MRMwEQYDVQQKDApEdW1t 8 | eSBHbWJIMRMwEQYDVQQLDApEdW1teSBUZWFtMRQwEgYDVQQDDAtkdW1teS5kdW1t 9 | eTEaMBgGCSqGSIb3DQEJARYLZHVtbXlAZHVtbXkwggEiMA0GCSqGSIb3DQEBAQUA 10 | A4IBDwAwggEKAoIBAQClsshi0jied9SxTrQ3QJdwU+FosRyhbnNoXWmB//5daamj 11 | PAkQ7vpwJH7sSPc9K4PwKyW6sgzx4ns8q45RPHOXAblWdUrgObePkQMU6zdGUytW 12 | zFm+HZM9W4BJPzMFDBMBpct+dIptO8OUAPwLtdkLfxAunUPwglyKKt1uOuu7foiV 13 | VnSGZLQIg7HVWg/ei78nN0y3s0Mbk4JOO8soVGDcmA3AQ5i+Sqc3op+HA/5d/WUC 14 | YEdksuAAWQcfmlHnA2IoquBEm+vztloldJ7xTc24EVcGj06SB9ByQQxGtmI4N8d4 15 | WBOIKGqXRskFQIAg1MPWHqcWqqcaF2jg1gK59q4DAgMBAAGjUDBOMB0GA1UdDgQW 16 | BBT+zqnNIE70ZwYVoHUoLIKuSvLCFzAfBgNVHSMEGDAWgBT+zqnNIE70ZwYVoHUo 17 | LIKuSvLCFzAMBgNVHRMEBTADAQH/MA0GCSqGSIb3DQEBCwUAA4IBAQAHkNAn9CZb 18 | tVkc8caCLzWBpVwhSCUvSXSHuVa4ajzuFCZqH6H867//PUcoh1lnk3T0jGNx0rVR 19 | gYjg5g36tWmK5YDy8lrSxsxesB/CY1+Tht5v8CuQwUwAFqW1y1dT2eT3whk6tJxq 20 | YYxE2LeFSklqVtPCp9a7DFZ0HrbVYRgHqH9/onlonns9wu2SCkmV7zgnD46bV061 21 | yE/XqeI6Z/2IUzoXkW1K8m6ryXbwo23F6CtEDJhPJUw8tvQY9HK2zvTCZIq9kiIN 22 | mfEHMu72YKV0xSW81Fr+pf2V2NjiKX9iwCsehMFqcnmcyel4ZOQn+BHg1NHWW2DJ 23 | AEF6F+9urK7a 24 | -----END CERTIFICATE----- 25 | -----BEGIN PRIVATE KEY----- 26 | MIIEvgIBADANBgkqhkiG9w0BAQEFAASCBKgwggSkAgEAAoIBAQClsshi0jied9Sx 27 | TrQ3QJdwU+FosRyhbnNoXWmB//5daamjPAkQ7vpwJH7sSPc9K4PwKyW6sgzx4ns8 28 | q45RPHOXAblWdUrgObePkQMU6zdGUytWzFm+HZM9W4BJPzMFDBMBpct+dIptO8OU 29 | APwLtdkLfxAunUPwglyKKt1uOuu7foiVVnSGZLQIg7HVWg/ei78nN0y3s0Mbk4JO 30 | O8soVGDcmA3AQ5i+Sqc3op+HA/5d/WUCYEdksuAAWQcfmlHnA2IoquBEm+vztlol 31 | dJ7xTc24EVcGj06SB9ByQQxGtmI4N8d4WBOIKGqXRskFQIAg1MPWHqcWqqcaF2jg 32 | 1gK59q4DAgMBAAECggEAANwQlhKpIIlWnSTfYnn/TyHgRX7Fu0CrcJsrdPUzCKEH 33 | tEUXdvMGcZZ+4hLu1W5oXNKce394+bhHE2WAc4NwxhPINl6daNRj02bZMT6XJtI/ 34 | o0+kF4xnuyXCYJ7nUNtjLdsCV0Gbhj2NIjNvG1ByM9EQ8Gz4cUL73+uhAnVjy7E2 35 | OGSySnrgm6fBRj3dxu87N71M34qvUObaUgW/OInzLlM75otkPwZlW7qnpGrczDq9 36 | FxkycN3hyjrqbVs+BtLZcYRG3Tpnpkfe4Rfvo1HLdQDbBEz9YKQuOoeYQG1AOI2r 37 | 3OsxPxOWVVUYocFuL82NIGiZOUFCjQOYU7gnKEUJgQKBgQDYyPIPR/KnxvbrBI6+ 38 | vf8g1iUdx+ICquTJ2Hq/qOO7RTlxAVn7roLfvOiGU6qNMVR/b4hbxF6TY5t4503C 39 | oWp7wIHIMkTBpndB3f8wRGv8Fo312jsatk8miHeihHU4J74594X8lsmyz8oCmbx7 40 | PtPxKseLyauyFa8enIW9ZrU/MwKBgQDDrBQRiNwldHoBjCut444Ceth/ntUfnzzb 41 | 8S+LSFjDgHgK14olyIU7VpNrN3yrFOopdgPwGI6Iw1yvJPix24ag3FL40iNN7Ts1 42 | q70p9xjzqlAqFz3bSfvF/X8JXbwotLJ2eH8kSxhiweS1NsNPP5CwEHD7yZ66FNy9 43 | Ouq3dD0V8QKBgCybJFuKlV56bSIsnOaYl599EMQQ9etQmKUDuzYmnT1SYCBlg8tq 44 | vBkneLzzCDvnM5jJLUicnk07iKkXBwQOTKfME6hK16T1CMLv1+tpmMKVLX6x+clk 45 | S+ME34D8OlZkrxqkWNiBel0lrk5crdC6O8f64nZb98078v2cfVRchtzLAoGBAJJW 46 | PkgC18m3O4uuvff1R/54yzNeoTteBtDiptD+0Uuc56oMGog5V9LR47x6qeT05k8N 47 | sNI+O1Ly8H0YJFo3uI7TV8Y4uiiMdAymnPkmkGWjCQMBkMRQp1giRoDFtnOm+BT7 48 | 9vI4q0sogRg5lYXOHzJdiXH1Dp1R/ugSiPmcmBaxAoGBAJcOTMug5ix8mn72/vH2 49 | pqcVN3yRFtLQstRV+v7B5UrK1z70npApIrj6YfIXqS4e6gA7CjYgRftZmGiZ7kh1 50 | utPzrrLhhW+4g89M1ooc6JuuDP/3zSxPhzpATMXIPwr65//WbfUazbkWExmeKEH5 51 | /onSSxBIVwBOpIZ2IxKTHD25 52 | -----END PRIVATE KEY----- 53 | -------------------------------------------------------------------------------- /t/ssl/test.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 |

This is a simple Test.

6 | 7 | Yeah. A Test. 8 | 9 | 10 | 11 | -------------------------------------------------------------------------------- /t/testdomains.txt: -------------------------------------------------------------------------------- 1 | odem.org;1 2 | alvar-freude.de;2 3 | alvar.a-blast.org;2 4 | a-blast.org;1 5 | assoziations-blaster.de;1 6 | wen-waehlen.de;1 7 | wen-wählen.de;1 8 | lists.odem.org;3 9 | mail.a-blast.org;3 10 | -------------------------------------------------------------------------------- /t/umlautdomain.txt: -------------------------------------------------------------------------------- 1 | wen-wählen.de;1 2 | --------------------------------------------------------------------------------