### Local Variables: *** ### mode:perl *** ### comment-column:0 *** ### comment-start: "### " *** ### comment-end: "***" *** ### End: *** # # ****************DO NOT MOVE OR CHANGE LINES ABOVE THIS********************* # # The first set of lines runs perl from any shell. The second set of lines # identifies the rest of the file as PERL for EMACS autoformatting. # See end of copyright for more information. # # # ------------------------------------------------------------------- # X-BONE # # http://www.isi.edu/xbone # USC Information Sciences Institute (USC/ISI) # Marina del Rey, California 90292, USA # Copyright (c) 1998-2005 # # ------------------------------------------------------------------- # # Copyright (c) 1998-2005 by the University of Southern California. # All rights reserved. # # Permission to use, copy, modify, and distribute this software and # its documentation in source and binary forms for non-commercial # purposes and without fee is hereby granted, provided that the above # copyright notice appear in all copies and that both the copyright # notice and this permission notice appear in supporting # documentation, and that any documentation, advertising materials, # and other materials related to such distribution and use acknowledge # that the software was developed by the University of Southern # California, Information Sciences Institute. The name of the # University may not be used to endorse or promote products derived # from this software without specific prior written permission. # # THE UNIVERSITY OF SOUTHERN CALIFORNIA MAKES NO REPRESENTATIONS ABOUT # THE SUITABILITY OF THIS SOFTWARE FOR ANY PURPOSE. THIS SOFTWARE IS # PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, # INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF # MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. # # Other copyrights might apply to parts of this software and are so # noted when applicable. # # ------------------------------------------------------------------- # # Effort partly sponsored by the Defense Advanced Research Projects # Agency (DARPA) and Air Force Research Laboratory, Air Force Materiel # Command, USAF, under agreement numbers F30602-98-1-0200 (X-Bone) and # F30602-01-2-0529 (DynaBone). The views and conclusions contained # herein are those of the authors and should not be interpreted as # necessarily representing the official policies or endorsements, # either expressed or implied, of the Defense Advanced Research # Projects Agency (DARPA), the Air Force Research Laboratory, or the # U.S. Government. # # This work was partly supported by the NSF STI-XTEND (ANI-0230789) # and NETFS (ANI-0129689) projects. Any opinions, findings, and # conclusions or recommendations expressed in this material are those # of the authors and do not necessarily reflect the views of the # National Science Foundation. # # ------------------------------------------------------------------- # $RCSfile: XB_SMIME.pm,v $ # # $Revision: 1.15 $ # $Author: pingali $ # $Date: 2005/04/05 02:40:38 $ # $State: Exp $ # ---------------------------------------------------------------------------- # # Primary Author: Osama Dosary + Lars Eggert package XB_SMIME; require Exporter; @ISA = qw(Exporter); @EXPORT = qw(); @EXPORT_OK = qw(sign verify); use strict; use sigtrap; use XB_Log; use XB_Params; use XB_IPsec; # Sign() takes in a cleartext message and returns digitally signed # with the specified keypair in S/MIME format. Optionally encrypts # the message as well. # # Arguments: # $msg Message to sign. # $cert Principal's signing certificate. # $key Principal's signing key. # $enc If true, encrypt as well as sign the message (optional). # # Returns: # The signed (and optionally encrypted) message. # # Exceptions: # "XB_SMIME::sign" on failure sub sign($$$;$) { my $proc = "XB_SMIME::sign"; my ($msg, $cert, $key, $encrypt) = @_; my $result; XB_Log::log "info", "-> $proc: $cert, $key\n"; # Only show the whole message when it fails. XB_Log::log "debug7", "----------\n$msg\n=========="; # abuse IPsec::key to generate a secure temp file name my $clear = $XB_Params::TEMP_DIR . XB_IPsec::key("des"); my $signed = $XB_Params::TEMP_DIR . XB_IPsec::key("des"); # openssl command line my @cmd = ("openssl", "smime","-sign", "-in", $clear, "-out", $signed, "-signer", $cert, "-inkey", $key,"-text"); eval { open CLEAR, ">$clear" or XB_Log::log "err", "cannot open $clear: $!" and die; print CLEAR $msg; close CLEAR or XB_Log::log "err", "cannot close $clear: $!" and die; open SAVEERR, ">&STDERR"; open STDERR, ">/dev/null"; # suppress STDERR my $rc = 0xff & system(@cmd); ($rc == 0) or XB_Log::log "err", "@cmd failed: $!" and die; open STDERR, ">&SAVEERR"; # reenable STDERR open SIGNED,"<$signed" or XB_Log::log "err", "cannot open $signed: $!" and die; while () { $result .= $_; } close SIGNED or XB_Log::log "err", "cannot close $signed: $!" and die; }; # if the unlink fails, we can't really recover from it anyhow, plus # we need to do it for recovery in any case unlink $clear, $signed; XB_Log::log "info", "<- $proc\n"; unless ($@) { return $result; } XB_Log::log "err", " ! Failed to sign the following message:\n$msg"; die $proc; } # Verify() takes a messsage in S/MIME format and attempt to verify # it. Any signature by a key issued by the specified CA will result # in successful verification. # # Arguments: # $msg S/MIME message to verify. # # Returns: # Cleartext message on successful verification. Undef otherwise. # Signer's name # # Exceptions: # "XB_SMIME::verify" on failure sub verify($;$) { my $proc = "XB_SMIME::verify"; XB_Log::log "info", "-> $proc\n"; my ($msg, $decrypt) = @_; my ($result, $cannonical_peer); XB_Log::log "debug7", "----------\n$msg\n=========="; # abuse IPsec::key to generate a secure temp file name my $clear = $XB_Params::TEMP_DIR . XB_IPsec::key("des"); my $signed = $XB_Params::TEMP_DIR . XB_IPsec::key("des"); my $signercert = $XB_Params::TEMP_DIR . XB_IPsec::key("des"); my $signerinfo = $XB_Params::TEMP_DIR . XB_IPsec::key("des"); # openssl command line to verify and extract signer's certificate. my @cmd = ("openssl", "smime", "-verify", "-in", $signed, "-out", $clear, "-CAfile", $XB_Params::node_opts{"ca_cert"}, "-CApath", $XB_Params::node_opts{"ca_path"}, "-signer", $signercert, "-text"); eval { open SIGNED, ">$signed" or XB_Log::log"err", "cannot open $signed: $!" and die; print SIGNED $msg; close SIGNED or XB_Log::log "err", "cannot close $signed: $!" and die; open SAVEERR, ">&STDERR"; open STDERR, ">/dev/null"; # suppress STDERR my $rc = 0xff & system(@cmd); ($rc == 0) or XB_Log::log "err", "@cmd failed: $!" and die; open STDERR, ">&SAVEERR"; # reenable STDERR open CLEAR, $clear or XB_Log::log "err", "cannot open $clear: $!" and die; while () { $result .= $_; } close CLEAR or XB_Log::log "err", "cannot close $clear: $!" and die; # openssl command to extract signer's info from the certificate. @cmd = ("openssl", "x509", "-in", $signercert, "-out", $signerinfo, "-text"); $rc = 0xff & system(@cmd); ($rc == 0) or XB_Log::log "err", "@cmd failed : $!" and die; open INFO, $signerinfo or XB_Log::log "err", "cannot open $signerinfo: $!" and die; while () { if (/Subject/ and /CN=(.*)\/Email/i) { $cannonical_peer = $1; XB_Log::log "debug1", " cannonical peer : $cannonical_peer"; last; } } close INFO or XB_Log::log "err", "cannot close $signerinfo: $!" and die; }; # if the unlink fails, we can't really recover from it anyhow, plus # we need to do it for recovery in any case unlink $clear, $signed, $signercert, $signerinfo; XB_Log::log "info", "<- $proc\n"; unless ($@) { return ($result, $cannonical_peer); } XB_Log::log "err", " ! Failed to verify the following message:\n$msg\n"; die $proc; } 1;