view release on metacpan or  search on metacpan

lib/Metabrik/Client/Ssl.pm  view on Meta::CPAN

#
# $Id$
#
# client::ssl Brik
#
package Metabrik::Client::Ssl;
use strict;
use warnings;

use base qw(Metabrik);

sub brik_properties {
   return {
      revision => '$Revision$',
      tags => [ qw(unstable tls) ],
      author => 'GomoR <GomoR[at]metabrik.org>',
      license => 'http://opensource.org/licenses/BSD-3-Clause',
      attributes => {
         uri => [ qw(uri) ],
      },
      commands => {
         install => [ ], # Inherited
         verify_server => [ qw(uri|OPTIONAL) ],
         getcertificate => [ qw(uri|OPTIONAL) ],
         getcertificate2 => [ qw(host port) ],
      },
      require_modules => {
         'Data::Dumper' => [ ],
         'IO::Socket::SSL' => [ ],
         'LWP::UserAgent' => [ ],
         'LWP::ConnCache' => [ ],
         'URI' => [ ],
         'Net::SSLeay' => [ ],
         'Metabrik::String::Uri' => [ ],
      },
      need_packages => {
         ubuntu => [ qw(libssl-dev) ],
         debian => [ qw(libssl-dev) ],
         kali => [ qw(libssl-dev) ],
         centos => [ qw(openssl-devel) ],
         redhat => [ qw(openssl-devel) ],
      },
   };
}

sub verify_server {
   my $self = shift;
   my ($uri) = @_;

   $uri ||= $self->uri;
   $self->brik_help_run_undef_arg('verify_server', $uri) or return;

   my $su = Metabrik::String::Uri->new_from_brik_init($self) or return;
   my $parsed = $su->parse($uri) or return;

   my $host = $parsed->{host};
   my $port = $parsed->{port};

   $self->log->debug("verify_server: trying host [".$parsed->{host}."] ".
      "with port [".$parsed->{port}."]");

   my $client = IO::Socket::SSL->new(
      PeerHost => $parsed->{host},
      PeerPort => $parsed->{port},
      SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_PEER(),
      SSL_verifycn_name => $parsed->{host},
      SSL_verifycn_scheme => 'http',
   );
   if (! defined($client) && ! length($!)) {
      $self->log->verbose("verify_server: not verified: [".
         $IO::Socket::SSL::SSL_ERROR."]");
      return 0;
   }
   elsif (! defined($client)) {
      return $self->log->error("verify_server: connection failed with ".
         "error: [$!]");
   }

   $self->log->verbose("verify_server: verified");

   return 1;
}

#
# Note: works only with IO::Socket::SSL, not with Net::SSL (using Crypt::SSLeay)
#
sub getcertificate {
   my $self = shift;
   my ($uri) = @_;

   $uri ||= $self->uri;
   $self->brik_help_run_undef_arg('getcertificate', $uri) or return;

   if ($uri !~ /^https:\/\//) {
      return $self->log->error("must use https to get a certificate");
   }

   my $ua = LWP::UserAgent->new(
      #ssl_opts => { verify_hostname => 0 }, # will do manual check
      ssl_opts => { SSL_verify_mode => 'SSL_VERIFY_NONE'},
   );
   $ua->timeout(defined($self->global) && $self->global->rtimeout || 3);
   $ua->max_redirect(0);
   $ua->env_proxy;

   my $cache = LWP::ConnCache->new;
   $ua->conn_cache($cache);

   my $response = $ua->get($uri);
   # XXX: we ignore response?

   my $cc = $ua->conn_cache->{cc_conns};
   if (! defined($cc)) {
      return $self->log->error("unable to retrieve connection cache");
   }

   if (scalar(@$cc) == 0) {
      return $self->log->error("getcertificate: no connection cached");
   }

   my $sock = $cc->[0][0];

   my %info = ();
   # peer_certificate from IO::Socket::SSL/Crypt::SSLeay
   if ($sock->can('peer_certificate')) {
      my $authority = $sock->peer_certificate('authority'); # issuer
      my $owner = $sock->peer_certificate('owner'); # subject
      my $commonName = $sock->peer_certificate('commonName'); # cn
      my $subjectAltNames = $sock->peer_certificate('subjectAltNames');
      my $sslversion = $sock->get_sslversion;
      my $cipher = $sock->get_cipher;
      my $servername = $sock->get_servername; # Only when SNI is used
      #my $verify_hostname = $sock->verify_hostname('hostname', 'http');

      $info{authority} = $authority;
      $info{owner} = $owner;
      $info{commonName} = $commonName;
      $info{subjectAltNames} = $subjectAltNames;
      $info{sslversion} = $sslversion;
      $info{cipher} = $cipher;
      $info{servername} = $servername;
      #$info{verify_hostname} = $verify_hostname;

      print Data::Dumper::Dumper(\%info)."\n";
   }
   else {
      return $self->log->error("socket [$sock] cannot do 'peer_certificate'");
   }

   #$sock->stop_SSL;

   return $sock;
}

eval("use Net::SSLeay qw/XN_FLAG_RFC2253 ASN1_STRFLGS_ESC_MSB/;");

# Taken from http://cpansearch.perl.org/src/MIKEM/Net-SSLeay-1.57/examples/x509_cert_details.pl
sub get_cert_details {
  my $x509 = shift;
  my $rv = {};
  my $flag_rfc22536_utf8 = (Net::SSLeay::XN_FLAG_RFC2253()) & (~ Net::SSLeay::ASN1_STRFLGS_ESC_MSB());

  die 'ERROR: $x509 is NULL, gonna quit' unless $x509;

  #warn "Info: dumping subject\n";
  my $subj_name = Net::SSLeay::X509_get_subject_name($x509);
  my $subj_count = Net::SSLeay::X509_NAME_entry_count($subj_name);
  $rv->{subject}->{count} = $subj_count;
  $rv->{subject}->{oneline} = Net::SSLeay::X509_NAME_oneline($subj_name);
  $rv->{subject}->{print_rfc2253} = Net::SSLeay::X509_NAME_print_ex($subj_name);
  $rv->{subject}->{print_rfc2253_utf8} = Net::SSLeay::X509_NAME_print_ex($subj_name, $flag_rfc22536_utf8);
  $rv->{subject}->{print_rfc2253_utf8_decoded} = Net::SSLeay::X509_NAME_print_ex($subj_name, $flag_rfc22536_utf8, 1);
  for my $i (0..$subj_count-1) {
    my $entry = Net::SSLeay::X509_NAME_get_entry($subj_name, $i);
    my $asn1_string = Net::SSLeay::X509_NAME_ENTRY_get_data($entry);
    my $asn1_object = Net::SSLeay::X509_NAME_ENTRY_get_object($entry);
    my $nid = Net::SSLeay::OBJ_obj2nid($asn1_object);
    $rv->{subject}->{entries}->[$i] = {
          oid  => Net::SSLeay::OBJ_obj2txt($asn1_object,1),
          data => Net::SSLeay::P_ASN1_STRING_get($asn1_string),
          data_utf8_decoded => Net::SSLeay::P_ASN1_STRING_get($asn1_string, 1),
          nid  => ($nid>0) ? $nid : undef,
          ln   => ($nid>0) ? Net::SSLeay::OBJ_nid2ln($nid) : undef,
          sn   => ($nid>0) ? Net::SSLeay::OBJ_nid2sn($nid) : undef,