Test which Schannel (Windows SSL) ciphers work for curl --ciphers

test-schannel-ciphers.pl

#!/usr/bin/env perl

=begin comment
README

./test-schannel-ciphers.pl <CIPHERS.md> <curl> <host | ssl-url>

Test which Schannel (Windows SSL) ciphers work for curl --ciphers

Written in response to https://github.com/curl/curl/issues/3389

Requires curl and the curl repo (to extract schannel ciphers from CIPHERS.md).

Copyright (C) 2019 Jay Satiro <raysatiro@yahoo.com>
http://curl.haxx.se/docs/copyright.html

https://gist.github.com/jay/51f8511e411fd6bf9ea0d531f30f27d6
=end comment
=cut

use strict;
use warnings;

use IO::Handle;

if($#ARGV+1 != 3) {
  die "Usage: test-schannel-ciphers.pl <CIPHERS.md> <curl> <host | ssl-url>\n";
}

my ($mdfile, $curl, $url) = @ARGV;
my $fh;
my $parse;
my @ciphers;

$ENV{CURL_SSL_BACKEND} = "schannel";

grep(/schannel|winssl/i, `"$curl" -V`) || die "Fatal: curl missing schannel\n";

if(!open($fh, "<:crlf", $mdfile)) {
  die "Fatal: Failed opening CIPHERS.md: $!\n";
}

while(<$fh>) {
  if($parse) {
    last if /^## /;
    push(@ciphers, $1) if /`(CALG_[0-9A-Z_]+?)`/i;
  }
  elsif(/^## (schannel|winssl)/i) {
    $parse = 1;
  }
}

close($fh);

print "Host/SSL-URL: $url\n\n";

print "Testing " . ($#ciphers + 1) . " schannel ciphers from CIPHERS.md";

# CURLE_SSL_CONNECT_ERROR (35) + SEC_E_ALGORITHM_MISMATCH
my @ciphers_error_mismatch;

# CURLE_SSL_CONNECT_ERROR (35) + SEC_E_ILLEGAL_MESSAGE
my @ciphers_error_illegal;

# CURLE_SSL_CONNECT_ERROR (35) + other SEC_E error
my @ciphers_error_connect;

# CURLE_SSL_CIPHER (59)
my @ciphers_error_setting;

# other CURLE error
my @ciphers_error_other;

# no error
my @ciphers_error_none;

for my $cipher (@ciphers) {
  STDOUT->flush();
  sleep(1);

  my $cmd = "\"$curl\" --proto-default https  --ciphers $cipher \"$url\" 2>&1";
  my $output = `$cmd`;
  my $rc = $? >> 8;

  if(!$rc) {
    push @ciphers_error_none, $cipher;
  } elsif($rc == 35 && $output =~ /SEC_E_ALGORITHM_MISMATCH/) {
    push @ciphers_error_mismatch, $cipher;
  } elsif($rc == 35 && $output =~ /SEC_E_ILLEGAL_MESSAGE/) {
    push @ciphers_error_illegal, $cipher;
  } elsif($rc == 35) {
    push @ciphers_error_connect, $cipher;
  } elsif($rc == 59) {
    push @ciphers_error_setting, $cipher;
  } else {
    # unexpected error, try to work around transient errors
    sleep(5);
    `$cmd`;
    redo if $rc != $? >> 8;
    push @ciphers_error_other, $cipher;
  }

  print ".";
}

print "\n\n";

my $delim = ", ";

if(@ciphers_error_mismatch) {
  print "CURLE_SSL_CONNECT_ERROR (35) + SEC_E_ALGORITHM_MISMATCH: \n" .
    join($delim, @ciphers_error_mismatch) . "\n\n";
}

if(@ciphers_error_illegal) {
  print "CURLE_SSL_CONNECT_ERROR (35) + SEC_E_ILLEGAL_MESSAGE: \n" .
    join($delim, @ciphers_error_illegal) . "\n\n";
}

if(@ciphers_error_connect) {
  print "CURLE_SSL_CONNECT_ERROR (35) + other SEC_E error: \n" .
    join($delim, @ciphers_error_connect) . "\n\n";
}

if(@ciphers_error_setting) {
  print "CURLE_SSL_CIPHER (59): \n" .
    join($delim, @ciphers_error_setting) . "\n\n";
}

if(@ciphers_error_other) {
  print "other CURLE error: \n" .
    join($delim, @ciphers_error_other) . "\n\n";
}

if(@ciphers_error_none) {
  print "No error: \n" .
    join($delim, @ciphers_error_none) . "\n\n";
}