### 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 (<SIGNED>) { $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 (<CLEAR>) { $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 (<INFO>) {
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;
syntax highlighted by Code2HTML, v. 0.9.1