use strict; use warnings; package Net::IMP::Example::LogServerCertificate; use base 'Net::IMP::Base'; use Net::SSLeay; use fields ( 'done', # done or no SSL 'sbuf', # buffer on server side ); use Net::IMP qw(:log :DEFAULT); # import IMP_ constants use Net::IMP::Debug; use Carp 'croak'; sub INTERFACE { return ([ undef, [ IMP_PASS, IMP_PREPASS, IMP_LOG ] ]) } # create new analyzer object sub new_analyzer { my ($factory,%args) = @_; my $self = $factory->SUPER::new_analyzer(%args); $self->run_callback( # we are not interested in data from client [ IMP_PASS, 0, IMP_MAXOFFSET ], # and we will not change data from server, only inspect [ IMP_PREPASS, 1, IMP_MAXOFFSET ], ); $self->{sbuf} = ''; return $self; } sub data { my ($self,$dir,$data) = @_; return if $dir == 0; # should not happen return if $self->{done}; # done or no SSL return if $data eq ''; # eof from server my $buf = $self->{sbuf} .= $data; if ( _read_ssl_handshake($self,\$buf,2) # Server Hello and my $certs = _read_ssl_handshake($self,\$buf,11) # Certificates ) { $self->{done} = 1; my ($len) = unpack("xa3",substr($certs,0,4,'')); $len = unpack("N","\0$len"); substr($certs,$len) = ''; $len = unpack("N","\0".substr($certs,0,3,'')); substr($certs,$len) = ''; my $i = 0; while ($certs ne '') { my $clen = unpack("N","\0".substr($certs,0,3,'')); my $cert = substr($certs,0,$clen,''); length($cert) == $clen or die "invalid certificate length ($clen vs. ".length($cert).")"; if ( my $line = eval { _cert2line($cert) } ) { $self->run_callback([ IMP_LOG,1,0,0,IMP_LOG_INFO, sprintf("chain[%d]: %s",$i,$line)]); } else { warn "failed to convert cert to string: $@"; } $i++; } } $self->run_callback([ IMP_PASS,1,IMP_MAXOFFSET ]) if $self->{done}; } sub _cert2line { my $der = shift; my $bio = Net::SSLeay::BIO_new( Net::SSLeay::BIO_s_mem()); Net::SSLeay::BIO_write($bio,$der); my $cert = Net::SSLeay::d2i_X509_bio($bio); Net::SSLeay::BIO_free($bio); $cert or die "cannot parse certificate: ". Net::SSLeay::ERR_error_string(Net::SSLeay::ERR_get_error()); my $not_before = Net::SSLeay::X509_get_notBefore($cert); my $not_after = Net::SSLeay::X509_get_notAfter($cert); $_ = Net::SSLeay::P_ASN1_TIME_put2string($_) for($not_before,$not_after); my $subject = Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_subject_name($cert)); return "$subject | $not_before - $not_after"; } sub _read_ssl_handshake { my ($self,$buf,$expect_htype) = @_; return if length($$buf) < 22; # need way more data my ($ctype,$version,$len,$htype) = unpack('CnnC',$$buf); if ($ctype != 22) { debug("no SSL >=3.0 handshake record"); goto bad; } elsif ( $len > 2**14 ) { debug("length looks way too big - assuming no ssl"); goto bad; } elsif ( $htype != $expect_htype ) { debug("unexpected handshake type $htype - assuming no ssl"); goto bad; } length($$buf)-5 >= $len or return; # need more data substr($$buf,0,5,''); debug("got handshake type $htype length $len"); return substr($$buf,0,$len,''); bad: $self->{done} = 1; return; } # debugging stuff sub _hexdump { my ($buf,$len) = @_; $buf = substr($buf,0,$len) if $len; my @hx = map { sprintf("%02x",$_) } unpack('C*',$buf); my $t = ''; while (@hx) { $t .= join(' ',splice(@hx,0,16))."\n"; } return $t; } 1; __END__ =head1 NAME Net::IMP::Example::LogServerCertificate - Proof Of Concept IMP plugin for logging server certificate and chain of SSL connections =head1 SYNOPSIS my $factory = Net::IMP::Example::LogServerCertificate->new_factory; =head1 DESCRIPTION C<Net::IMP::Example::LogServerCertificate> implements an analyzer, which expects an SSL Server Hello on the server side, extracts the certificates and logs information about them. There are no further arguments. =head1 BUGS Sessions might be re-stablished with a session-id common between client and server. In this case no certificates need to be exchanged and thus certificate infos will not be tracked. To work around it one might track session-ids and implement caching. =head1 AUTHOR Steffen Ullrich <sullr@cpan.org> =head1 COPYRIGHT Copyright by Steffen Ullrich. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself.