зеркало из https://github.com/mozilla/gecko-dev.git
548 строки
16 KiB
Perl
Executable File
548 строки
16 KiB
Perl
Executable File
#!/usr/local/bin/perl
|
|
|
|
# This Source Code Form is subject to the terms of the Mozilla Public
|
|
# License, v. 2.0. If a copy of the MPL was not distributed with this
|
|
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
|
|
|
#
|
|
# smime.pl - frontend for S/MIME message generation and parsing
|
|
#
|
|
|
|
use Getopt::Std;
|
|
|
|
@boundarychars = ( "0" .. "9", "A" .. "F" );
|
|
|
|
# path to cmsutil
|
|
$cmsutilpath = "cmsutil";
|
|
|
|
#
|
|
# Thanks to Gisle Aas <gisle@aas.no> for the base64 functions
|
|
# originally taken from MIME-Base64-2.11 at www.cpan.org
|
|
#
|
|
sub encode_base64($)
|
|
{
|
|
my $res = "";
|
|
pos($_[0]) = 0; # ensure start at the beginning
|
|
while ($_[0] =~ /(.{1,45})/gs) {
|
|
$res .= substr(pack('u', $1), 1); # get rid of length byte after packing
|
|
chop($res);
|
|
}
|
|
$res =~ tr|` -_|AA-Za-z0-9+/|;
|
|
# fix padding at the end
|
|
my $padding = (3 - length($_[0]) % 3) % 3;
|
|
$res =~ s/.{$padding}$/'=' x $padding/e if $padding;
|
|
# break encoded string into lines of no more than 76 characters each
|
|
$res =~ s/(.{1,76})/$1\n/g;
|
|
$res;
|
|
}
|
|
|
|
sub decode_base64($)
|
|
{
|
|
local($^W) = 0; # unpack("u",...) gives bogus warning in 5.00[123]
|
|
|
|
my $str = shift;
|
|
my $res = "";
|
|
|
|
$str =~ tr|A-Za-z0-9+=/||cd; # remove non-base64 chars
|
|
if (length($str) % 4) {
|
|
require Carp;
|
|
Carp::carp("Length of base64 data not a multiple of 4")
|
|
}
|
|
$str =~ s/=+$//; # remove padding
|
|
$str =~ tr|A-Za-z0-9+/| -_|; # convert to uuencoded format
|
|
while ($str =~ /(.{1,60})/gs) {
|
|
my $len = chr(32 + length($1)*3/4); # compute length byte
|
|
$res .= unpack("u", $len . $1 ); # uudecode
|
|
}
|
|
$res;
|
|
}
|
|
|
|
#
|
|
# parse headers into a hash
|
|
#
|
|
# %headers = parseheaders($headertext);
|
|
#
|
|
sub parseheaders($)
|
|
{
|
|
my ($headerdata) = @_;
|
|
my $hdr;
|
|
my %hdrhash;
|
|
my $hdrname;
|
|
my $hdrvalue;
|
|
my @hdrvalues;
|
|
my $subhdrname;
|
|
my $subhdrvalue;
|
|
|
|
# the expression in split() correctly handles continuation lines
|
|
foreach $hdr (split(/\n(?=\S)/, $headerdata)) {
|
|
$hdr =~ s/\r*\n\s+/ /g; # collapse continuation lines
|
|
($hdrname, $hdrvalue) = $hdr =~ m/^(\S+):\s+(.*)$/;
|
|
|
|
# ignore non-headers (or should we die horribly?)
|
|
next unless (defined($hdrname));
|
|
$hdrname =~ tr/A-Z/a-z/; # lowercase the header name
|
|
@hdrvalues = split(/\s*;\s*/, $hdrvalue); # split header values (XXXX quoting)
|
|
|
|
# there is guaranteed to be at least one value
|
|
$hdrvalue = shift @hdrvalues;
|
|
if ($hdrvalue =~ /^\s*\"(.*)\"\s*$/) { # strip quotes if there
|
|
$hdrvalue = $1;
|
|
}
|
|
|
|
$hdrhash{$hdrname}{MAIN} = $hdrvalue;
|
|
# print "XXX $hdrname = $hdrvalue\n";
|
|
|
|
# deal with additional name-value pairs
|
|
foreach $hdrvalue (@hdrvalues) {
|
|
($subhdrname, $subhdrvalue) = $hdrvalue =~ m/^(\S+)\s*=\s*(.*)$/;
|
|
# ignore non-name-value pairs (or should we die?)
|
|
next unless (defined($subhdrname));
|
|
$subhdrname =~ tr/A-Z/a-z/;
|
|
if ($subhdrvalue =~ /^\s*\"(.*)\"\s*$/) { # strip quotes if there
|
|
$subhdrvalue = $1;
|
|
}
|
|
$hdrhash{$hdrname}{$subhdrname} = $subhdrvalue;
|
|
}
|
|
|
|
}
|
|
return %hdrhash;
|
|
}
|
|
|
|
#
|
|
# encryptentity($entity, $options) - encrypt an S/MIME entity,
|
|
# creating a new application/pkcs7-smime entity
|
|
#
|
|
# entity - string containing entire S/MIME entity to encrypt
|
|
# options - options for cmsutil
|
|
#
|
|
# this will generate and return a new application/pkcs7-smime entity containing
|
|
# the enveloped input entity.
|
|
#
|
|
sub encryptentity($$)
|
|
{
|
|
my ($entity, $cmsutiloptions) = @_;
|
|
my $out = "";
|
|
my $boundary;
|
|
|
|
$tmpencfile = "/tmp/encryptentity.$$";
|
|
|
|
#
|
|
# generate a random boundary string
|
|
#
|
|
$boundary = "------------ms" . join("", @boundarychars[map{rand @boundarychars }( 1 .. 24 )]);
|
|
|
|
#
|
|
# tell cmsutil to generate a enveloped CMS message using our data
|
|
#
|
|
open(CMS, "|$cmsutilpath -E $cmsutiloptions -o $tmpencfile") or die "ERROR: cannot pipe to cmsutil";
|
|
print CMS $entity;
|
|
unless (close(CMS)) {
|
|
print STDERR "ERROR: encryption failed.\n";
|
|
unlink($tmpsigfile);
|
|
exit 1;
|
|
}
|
|
|
|
$out = "Content-Type: application/pkcs7-mime; smime-type=enveloped-data; name=smime.p7m\n";
|
|
$out .= "Content-Transfer-Encoding: base64\n";
|
|
$out .= "Content-Disposition: attachment; filename=smime.p7m\n";
|
|
$out .= "\n"; # end of entity header
|
|
|
|
open (ENC, $tmpencfile) or die "ERROR: cannot find newly generated encrypted content";
|
|
local($/) = undef; # slurp whole file
|
|
$out .= encode_base64(<ENC>), "\n"; # entity body is base64-encoded CMS message
|
|
close(ENC);
|
|
|
|
unlink($tmpencfile);
|
|
|
|
$out;
|
|
}
|
|
|
|
#
|
|
# signentity($entity, $options) - sign an S/MIME entity
|
|
#
|
|
# entity - string containing entire S/MIME entity to sign
|
|
# options - options for cmsutil
|
|
#
|
|
# this will generate and return a new multipart/signed entity consisting
|
|
# of the canonicalized original content, plus a signature block.
|
|
#
|
|
sub signentity($$)
|
|
{
|
|
my ($entity, $cmsutiloptions) = @_;
|
|
my $out = "";
|
|
my $boundary;
|
|
|
|
$tmpsigfile = "/tmp/signentity.$$";
|
|
|
|
#
|
|
# generate a random boundary string
|
|
#
|
|
$boundary = "------------ms" . join("", @boundarychars[map{rand @boundarychars }( 1 .. 24 )]);
|
|
|
|
#
|
|
# tell cmsutil to generate a signed CMS message using the canonicalized data
|
|
# The signedData has detached content (-T) and includes a signing time attribute (-G)
|
|
#
|
|
# if we do not provide a password on the command line, here's where we would be asked for it
|
|
#
|
|
open(CMS, "|$cmsutilpath -S -T -G $cmsutiloptions -o $tmpsigfile") or die "ERROR: cannot pipe to cmsutil";
|
|
print CMS $entity;
|
|
unless (close(CMS)) {
|
|
print STDERR "ERROR: signature generation failed.\n";
|
|
unlink($tmpsigfile);
|
|
exit 1;
|
|
}
|
|
|
|
open (SIG, $tmpsigfile) or die "ERROR: cannot find newly generated signature";
|
|
|
|
#
|
|
# construct a new multipart/signed MIME entity consisting of the original content and
|
|
# the signature
|
|
#
|
|
# (we assume that cmsutil generates a SHA1 digest)
|
|
$out .= "Content-Type: multipart/signed; protocol=\"application/pkcs7-signature\"; micalg=sha1; boundary=\"${boundary}\"\n";
|
|
$out .= "\n"; # end of entity header
|
|
$out .= "This is a cryptographically signed message in MIME format.\n"; # explanatory comment
|
|
$out .= "\n--${boundary}\n";
|
|
$out .= $entity;
|
|
$out .= "\n--${boundary}\n";
|
|
$out .= "Content-Type: application/pkcs7-signature; name=smime.p7s\n";
|
|
$out .= "Content-Transfer-Encoding: base64\n";
|
|
$out .= "Content-Disposition: attachment; filename=smime.p7s\n";
|
|
$out .= "Content-Description: S/MIME Cryptographic Signature\n";
|
|
$out .= "\n"; # end of signature subentity header
|
|
|
|
local($/) = undef; # slurp whole file
|
|
$out .= encode_base64(<SIG>); # append base64-encoded signature
|
|
$out .= "\n--${boundary}--\n";
|
|
|
|
close(SIG);
|
|
unlink($tmpsigfile);
|
|
|
|
$out;
|
|
}
|
|
|
|
sub usage {
|
|
print STDERR "usage: smime [options]\n";
|
|
print STDERR " options:\n";
|
|
print STDERR " -S nick generate signed message, use certificate named \"nick\"\n";
|
|
print STDERR " -p passwd use \"passwd\" as security module password\n";
|
|
print STDERR " -E rec1[,rec2...] generate encrypted message for recipients\n";
|
|
print STDERR " -D decode a S/MIME message\n";
|
|
print STDERR " -p passwd use \"passwd\" as security module password\n";
|
|
print STDERR " (required for decrypting only)\n";
|
|
print STDERR " -C pathname set pathname of \"cmsutil\"\n";
|
|
print STDERR " -d directory set directory containing certificate db\n";
|
|
print STDERR " (default: ~/.netscape)\n";
|
|
print STDERR "\nWith -S or -E, smime will take a regular RFC822 message or MIME entity\n";
|
|
print STDERR "on stdin and generate a signed or encrypted S/MIME message with the same\n";
|
|
print STDERR "headers and content from it. The output can be used as input to a MTA.\n";
|
|
print STDERR "-D causes smime to strip off all S/MIME layers if possible and output\n";
|
|
print STDERR "the \"inner\" message.\n";
|
|
}
|
|
|
|
#
|
|
# start of main procedures
|
|
#
|
|
|
|
#
|
|
# process command line options
|
|
#
|
|
unless (getopts('S:E:p:d:C:D')) {
|
|
usage();
|
|
exit 1;
|
|
}
|
|
|
|
unless (defined($opt_S) or defined($opt_E) or defined($opt_D)) {
|
|
print STDERR "ERROR: -S and/or -E, or -D must be specified.\n";
|
|
usage();
|
|
exit 1;
|
|
}
|
|
|
|
$signopts = "";
|
|
$encryptopts = "";
|
|
$decodeopts = "";
|
|
|
|
# pass -d option along
|
|
if (defined($opt_d)) {
|
|
$signopts .= "-d \"$opt_d\" ";
|
|
$encryptopts .= "-d \"$opt_d\" ";
|
|
$decodeopts .= "-d \"$opt_d\" ";
|
|
}
|
|
|
|
if (defined($opt_S)) {
|
|
$signopts .= "-N \"$opt_S\" ";
|
|
}
|
|
|
|
if (defined($opt_p)) {
|
|
$signopts .= "-p \"$opt_p\" ";
|
|
$decodeopts .= "-p \"$opt_p\" ";
|
|
}
|
|
|
|
if (defined($opt_E)) {
|
|
@recipients = split(",", $opt_E);
|
|
$encryptopts .= "-r ";
|
|
$encryptopts .= join (" -r ", @recipients);
|
|
}
|
|
|
|
if (defined($opt_C)) {
|
|
$cmsutilpath = $opt_C;
|
|
}
|
|
|
|
#
|
|
# split headers into mime entity headers and RFC822 headers
|
|
# The RFC822 headers are preserved and stay on the outer layer of the message
|
|
#
|
|
$rfc822headers = "";
|
|
$mimeheaders = "";
|
|
$mimebody = "";
|
|
$skippedheaders = "";
|
|
while (<STDIN>) {
|
|
last if (/^$/);
|
|
if (/^content-\S+: /i) {
|
|
$lastref = \$mimeheaders;
|
|
} elsif (/^mime-version: /i) {
|
|
$lastref = \$skippedheaders; # skip it
|
|
} elsif (/^\s/) {
|
|
;
|
|
} else {
|
|
$lastref = \$rfc822headers;
|
|
}
|
|
$$lastref .= $_;
|
|
}
|
|
|
|
#
|
|
# if there are no MIME entity headers, generate some default ones
|
|
#
|
|
if ($mimeheaders eq "") {
|
|
$mimeheaders .= "Content-Type: text/plain; charset=us-ascii\n";
|
|
$mimeheaders .= "Content-Transfer-Encoding: 7bit\n";
|
|
}
|
|
|
|
#
|
|
# slurp in the entity body
|
|
#
|
|
$saveRS = $/;
|
|
$/ = undef;
|
|
$mimebody = <STDIN>;
|
|
$/ = $saveRS;
|
|
chomp($mimebody);
|
|
|
|
if (defined $opt_D) {
|
|
#
|
|
# decode
|
|
#
|
|
# possible options would be:
|
|
# - strip off only one layer
|
|
# - strip off outer signature (if present)
|
|
# - just print information about the structure of the message
|
|
# - strip n layers, then dump DER of CMS message
|
|
|
|
$layercounter = 1;
|
|
|
|
while (1) {
|
|
%hdrhash = parseheaders($mimeheaders);
|
|
unless (exists($hdrhash{"content-type"}{MAIN})) {
|
|
print STDERR "ERROR: no content type header found in MIME entity\n";
|
|
last; # no content-type - we're done
|
|
}
|
|
|
|
$contenttype = $hdrhash{"content-type"}{MAIN};
|
|
if ($contenttype eq "application/pkcs7-mime") {
|
|
#
|
|
# opaque-signed or enveloped message
|
|
#
|
|
unless (exists($hdrhash{"content-type"}{"smime-type"})) {
|
|
print STDERR "ERROR: no smime-type attribute in application/pkcs7-smime entity.\n";
|
|
last;
|
|
}
|
|
$smimetype = $hdrhash{"content-type"}{"smime-type"};
|
|
if ($smimetype eq "signed-data" or $smimetype eq "enveloped-data") {
|
|
# it's verification or decryption time!
|
|
|
|
# can handle only base64 encoding for now
|
|
# all other encodings are treated as binary (8bit)
|
|
if ($hdrhash{"content-transfer-encoding"}{MAIN} eq "base64") {
|
|
$mimebody = decode_base64($mimebody);
|
|
}
|
|
|
|
# if we need to dump the DER, we would do it right here
|
|
|
|
# now write the DER
|
|
$tmpderfile = "/tmp/der.$$";
|
|
open(TMP, ">$tmpderfile") or die "ERROR: cannot write signature data to temporary file";
|
|
print TMP $mimebody;
|
|
unless (close(TMP)) {
|
|
print STDERR "ERROR: writing signature data to temporary file.\n";
|
|
unlink($tmpderfile);
|
|
exit 1;
|
|
}
|
|
|
|
$mimeheaders = "";
|
|
open(TMP, "$cmsutilpath -D $decodeopts -h $layercounter -i $tmpderfile |") or die "ERROR: cannot open pipe to cmsutil";
|
|
$layercounter++;
|
|
while (<TMP>) {
|
|
last if (/^\r?$/); # empty lines mark end of header
|
|
if (/^SMIME: /) { # add all SMIME info to the rfc822 hdrs
|
|
$lastref = \$rfc822headers;
|
|
} elsif (/^\s/) {
|
|
; # continuation lines go to the last dest
|
|
} else {
|
|
$lastref = \$mimeheaders; # all other headers are mime headers
|
|
}
|
|
$$lastref .= $_;
|
|
}
|
|
# slurp in rest of the data to $mimebody
|
|
$saveRS = $/; $/ = undef; $mimebody = <TMP>; $/ = $saveRS;
|
|
close(TMP);
|
|
|
|
unlink($tmpderfile);
|
|
|
|
} else {
|
|
print STDERR "ERROR: unknown smime-type \"$smimetype\" in application/pkcs7-smime entity.\n";
|
|
last;
|
|
}
|
|
} elsif ($contenttype eq "multipart/signed") {
|
|
#
|
|
# clear signed message
|
|
#
|
|
unless (exists($hdrhash{"content-type"}{"protocol"})) {
|
|
print STDERR "ERROR: content type has no protocol attribute in multipart/signed entity.\n";
|
|
last;
|
|
}
|
|
if ($hdrhash{"content-type"}{"protocol"} ne "application/pkcs7-signature") {
|
|
# we cannot handle this guy
|
|
print STDERR "ERROR: unknown protocol \"", $hdrhash{"content-type"}{"protocol"},
|
|
"\" in multipart/signed entity.\n";
|
|
last;
|
|
}
|
|
unless (exists($hdrhash{"content-type"}{"boundary"})) {
|
|
print STDERR "ERROR: no boundary attribute in multipart/signed entity.\n";
|
|
last;
|
|
}
|
|
$boundary = $hdrhash{"content-type"}{"boundary"};
|
|
|
|
# split $mimebody along \n--$boundary\n - gets you four parts
|
|
# first (0), any comments the sending agent might have put in
|
|
# second (1), the message itself
|
|
# third (2), the signature as a mime entity
|
|
# fourth (3), trailing data (there shouldn't be any)
|
|
|
|
@multiparts = split(/\r?\n--$boundary(?:--)?\r?\n/, $mimebody);
|
|
|
|
#
|
|
# parse the signature headers
|
|
($submimeheaders, $submimebody) = split(/^$/m, $multiparts[2]);
|
|
%sighdrhash = parseheaders($submimeheaders);
|
|
unless (exists($sighdrhash{"content-type"}{MAIN})) {
|
|
print STDERR "ERROR: signature entity has no content type.\n";
|
|
last;
|
|
}
|
|
if ($sighdrhash{"content-type"}{MAIN} ne "application/pkcs7-signature") {
|
|
# we cannot handle this guy
|
|
print STDERR "ERROR: unknown content type \"", $sighdrhash{"content-type"}{MAIN},
|
|
"\" in signature entity.\n";
|
|
last;
|
|
}
|
|
if ($sighdrhash{"content-transfer-encoding"}{MAIN} eq "base64") {
|
|
$submimebody = decode_base64($submimebody);
|
|
}
|
|
|
|
# we would dump the DER at this point
|
|
|
|
$tmpsigfile = "/tmp/sig.$$";
|
|
open(TMP, ">$tmpsigfile") or die "ERROR: cannot write signature data to temporary file";
|
|
print TMP $submimebody;
|
|
unless (close(TMP)) {
|
|
print STDERR "ERROR: writing signature data to temporary file.\n";
|
|
unlink($tmpsigfile);
|
|
exit 1;
|
|
}
|
|
|
|
$tmpmsgfile = "/tmp/msg.$$";
|
|
open(TMP, ">$tmpmsgfile") or die "ERROR: cannot write message data to temporary file";
|
|
print TMP $multiparts[1];
|
|
unless (close(TMP)) {
|
|
print STDERR "ERROR: writing message data to temporary file.\n";
|
|
unlink($tmpsigfile);
|
|
unlink($tmpmsgfile);
|
|
exit 1;
|
|
}
|
|
|
|
$mimeheaders = "";
|
|
open(TMP, "$cmsutilpath -D $decodeopts -h $layercounter -c $tmpmsgfile -i $tmpsigfile |") or die "ERROR: cannot open pipe to cmsutil";
|
|
$layercounter++;
|
|
while (<TMP>) {
|
|
last if (/^\r?$/);
|
|
if (/^SMIME: /) {
|
|
$lastref = \$rfc822headers;
|
|
} elsif (/^\s/) {
|
|
;
|
|
} else {
|
|
$lastref = \$mimeheaders;
|
|
}
|
|
$$lastref .= $_;
|
|
}
|
|
$saveRS = $/; $/ = undef; $mimebody = <TMP>; $/ = $saveRS;
|
|
close(TMP);
|
|
unlink($tmpsigfile);
|
|
unlink($tmpmsgfile);
|
|
|
|
} else {
|
|
|
|
# not a content type we know - we're done
|
|
last;
|
|
|
|
}
|
|
}
|
|
|
|
# so now we have the S/MIME parsing information in rfc822headers
|
|
# and the first mime entity we could not handle in mimeheaders and mimebody.
|
|
# dump 'em out and we're done.
|
|
print $rfc822headers;
|
|
print $mimeheaders . "\n" . $mimebody;
|
|
|
|
} else {
|
|
|
|
#
|
|
# encode (which is much easier than decode)
|
|
#
|
|
|
|
$mimeentity = $mimeheaders . "\n" . $mimebody;
|
|
|
|
#
|
|
# canonicalize inner entity (rudimentary yet)
|
|
# convert single LFs to CRLF
|
|
# if no Content-Transfer-Encoding header present:
|
|
# if 8 bit chars present, use Content-Transfer-Encoding: quoted-printable
|
|
# otherwise, use Content-Transfer-Encoding: 7bit
|
|
#
|
|
$mimeentity =~ s/\r*\n/\r\n/mg;
|
|
|
|
#
|
|
# now do the wrapping
|
|
# we sign first, then encrypt because that's what Communicator needs
|
|
#
|
|
if (defined($opt_S)) {
|
|
$mimeentity = signentity($mimeentity, $signopts);
|
|
}
|
|
|
|
if (defined($opt_E)) {
|
|
$mimeentity = encryptentity($mimeentity, $encryptopts);
|
|
}
|
|
|
|
#
|
|
# XXX sign again to do triple wrapping (RFC2634)
|
|
#
|
|
|
|
#
|
|
# now write out the RFC822 headers
|
|
# followed by the final $mimeentity
|
|
#
|
|
print $rfc822headers;
|
|
print "MIME-Version: 1.0 (NSS SMIME - http://www.mozilla.org/projects/security)\n"; # set up the flag
|
|
print $mimeentity;
|
|
}
|
|
|
|
exit 0;
|