Embed your openssl commands in Perl

There are many modules on CPAN for manipulating OpenSSL from within your Perl application; however, they all require that you rewrite the OpenSSL command into a combination of function or method calls that the module understands. How much cooler would it be to just copy-and-paste the commands into your application, and have Perl do the right thing?

This module, which I've called OpenSSL::Cmd, allows you to do that.

When it's had some proper testing, I'll submit it to CPAN.

Usage:

#!/usr/bin/perl
use strict;
use warnings;
use File::Temp qw(tempfile);
use OpenSSL::Cmd;
use IPC::Run; 

my($cert) = openssl s_client -connect myhost.com:443;

my($tmpfh,$tempfile) = tempfile(DIR=>'/tmp',UNLINK=>1);
croak "Failed to open temp file:$!" unless( defined($tmpfh) );
$tmpfh->print( $cert );
$tmpfh->close;

my($enddate) = openssl x509 -enddate -noout -in $tempfile;
($enddate)=~s{notAfter=}{};
print "Certificate expires on :", $enddate;

exit;
[download]

Features:

It's a source filter, built using Filter::Simple. It looks for bits of code beginning 'openssl ....' and attempts to convert these into an expression that can be executed by one of its supported transport mechanisms, or, if none are specified, by the backticks operator.
Supported transports are IPC::Cmd and IPC::Run. (IPC::Cmd::Exec is one of my modules; basically a wrapper round IPC::Open3).
You can assign the output from the openssl command to a Perl variable, or give it to print(), etc.
The module currently does a limited amount of sanity-checking of supplied arguments; this could be extended to allow, e.g. automated setting of default values.

Bugs/Limitations:

Has had only limited testing, so serious bugs cannot be discounted. This is strictly alpha software!
So far, only a limited set of openssl/x509 commands are supported.
There's very little error handling in place.
Because of the way the source filtering works, your transport mechanism must be specified after the 'use OpenSSL::Cmd;' call.
Probably won't play nicely with other source-filtering modules.

#!/usr/bin/perl
package OpenSSL::Cmd;
use strict;
use warnings;
use Carp;
use Filter::Simple;
use Scalar::Util qw(looks_like_number);
use vars qw($VERSION);
$VERSION = '0.01';

{ 
    my(%cmdexec) = (

    'Run' => sub {
        return <<'CMD';
do {
my($in,$out,$err);
%s::run([split /\s+/, "%s"],\$in,\$out,\$err);
carp $err if($err);
$out;
};

CMD

    },

    'Cmd::Exec' => sub {
        return <<'CMD';
do {
my($runstate) = %s::cmdexec(["%s"]);
carp @{$runstate->error_data} unless( $runstate->ok );
my($val) = join '' => @{$runstate->output_data};
$val;
};

CMD

    },

    Cmd => sub {
       return <<'EXEC';
do {
my($ok,$buffer);
$ok = scalar %s::run(
    command=>"%s",
    verbose=>0,buffer=>\$buffer);

carp $buffer unless($ok);
$buffer;
};

EXEC

    },

    default => sub {
        return <<'CMD';
do {
    join '' => qx[%s];
};

CMD

    },

    );

sub _set_run {
    my($exec_type) = shift;
    my($sub_type)  = shift;

    if($exec_type eq 'default') {
        *exec_type = sub {
            return sprintf( $cmdexec{default}->(), @_ );
        };
    }
    else {
        if(exists $cmdexec{$sub_type}) {
            *exec_type = sub {
                return sprintf( $cmdexec{$sub_type}->(), $exec_type, @
+_ );
            };
        }
        else {
            croak "Unknown subtype $sub_type in " . (caller(0))[3];
        }
    }
}

}

{
    my(%actions);
    (%actions) = (
        '-connect' => sub {
            my($cmd) = shift;
            my($arg) = shift;
            my($host,$port) = split ':' => $arg ;

            $actions{fatal_err}->('Syntax: -connect host:port') unless
+ (
                   (defined($host) && $host=~/\w/)
                && (defined($port) && looks_like_number($port)));

            return join ' ' =>
                $actions{default}->($cmd, 's_client', '-connect'),
                $arg ;
        },

        '-starttls' => sub {
            my($cmd) = shift;
            my($type) = shift;

            $actions{fatal_err}->("syntax: -starttls pop3|smtp")
                unless(    defined($type) 
                        && $type eq 'smtp' or $type eq 'pop3');

            return join ' ' =>
                $actions{default}->($cmd, s_client => '-starttls'),
                $type;
        },

        '-dates' => sub {
            return $actions{default}->(shift, x509 => '-dates' );
        },

        -enddate => sub {
            return $actions{default}->(shift, x509 => '-enddate');
        },

        '-noout' => sub {
            return $actions{default}->(shift, x509 => '-noout');
        },

        '-issuer' => sub {
            return $actions{default}->(shift, x509 => '-issuer');
        },

        '-text' => sub {
            return $actions{default}->(shift, x509 => '-text');
        },

        '-fingerprint' => sub {
            return $actions{default}->(shift, x509 => '-fingerprint');
        },

        '-in' => sub {
            my($cmd)  = shift;
            my($file) = shift;

            $actions{fatal_err}->(
                "syntax: '-in $file' in $cmd") unless (
                defined($file) && $file );

            return join ' ' =>
                $actions{default}->($cmd, x509 => '-in'),
                $file;
        },

        '-certopt' => sub {
            my($cmd) = shift;
            my($opt) = shift;

            $actions{fatal_err}->("syntax: '-certopt opt1[, ...]' in $
+cmd") unless (
                defined($opt) && $opt );

            return join ' ' =>
                $actions{default}->($cmd, x509 => '-certopt'),
                $opt;
        },

        default => sub {
            my($cmd,$check,$return) = @_;
            $actions{fatal_err}->($cmd) unless( $cmd eq $check );
            return $return;
        },

        fatal_err => sub {
            croak "Invalid args: @_";  
        },
    );

sub _filter {
    my($preamble) = shift;
    my($path)     = shift;
    my($cmd)      = shift;
    my($args)     = shift;

    my(@cmd) = ($path, $cmd);
    while(($args)=~m{(\-\b[^-]+)}g) {
        my($arg) = $1;
        ($arg)=~s{;\z}{};
        my($opt,$extra) = split /\s+/, $arg, 2;
        push @cmd, 
            exists $actions{$opt} 
                 ? $actions{$opt}->($cmd,$extra) 
                 : $actions{fatal_err}->($cmd);
    }

    my($output) = exec_type( join ' ' => @cmd );
   
    return $preamble . $output; 
}

}

FILTER { 
    if( m{^use (IPC::(Run|Cmd.*));} ) {
        _set_run($1,$2);
    }
    else {
        _set_run('default');
    }
    s/^(?!#+)(.*)([^\s]*openssl) \s*(.*?) \s*(.*)$/_filter($1,$2,$3,$4
+)/egm;
};

1;

__END__
=pod

=head1 NAME

OpenSSL::Cmd - Perl interface to openssl

=head1 AUTHOR

Stephen Cardie, E<lt>stephenca@ls26.netE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2007 by Stephen Cardie

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.8 or,
at your option, any later version of Perl 5 you may have available.

=cut
[download]

Comment on Embed your openssl commands in Perl Select or Download Code

Replies are listed 'Best First'.
Re: Embed your openssl commands in Perl by grinder (Bishop) on Oct 17, 2007 at 13:07 UTC
The idea of cut'n'paste between Perl and shell is seductive. I know I'm fond of heredocs and SQL. But I wonder if having to use a source filter is worth the pain. With a bit of infrastructure it wouldn't be hard to produce a more Perlish interface. Consider a skeletal `#! /usr/bin/perl package OpenSSL; use strict; use warnings; use Exporter; use vars qw(@ISA @EXPORT); @ISA = 'Exporter'; @EXPORT = qw(openssl connect in s_client); sub openssl { return bless {}, __PACKAGE__; } sub s_client { my $self = shift; $self->{s_client} = 1; } sub connect { my $self = shift; my $uri = shift; my $cert = frantic_hand_waving($uri); return $cert; } 1;` [download] This lets you write perfectly legal Perl code that looks like: `use OpenSSL; my $cert = openssl->s_client->connect('myhost.com:443');` [download] That would be fine by me. But then again, it's your itch, not mine. I think the idea is definitely worth pursuing one way or another. update: well DUH! Should have read the opening line a bit more carefully... so there are modules that already do this, more fool me. That said, I'm sure there must be a way to convince the interpreter that the openssl command line is valid Perl. I'll have to think about it. • another intruder with the mooring in the heart of the Perl	[reply] [d/l] [select]
Re^2: Embed your openssl commands in Perl by Anonymous Monk on Dec 08, 2008 at 18:24 UTC
It appears that many of the Perl modules that interface to OpenSSL are for the cryptographic aspects, not for the protocol/certificate handling, such as the 's_client' example. So, I agree with your original comments on making the interface more Perlish.	[reply]