🚀 go-pugleaf

Here is a new version of display-ripem, designed to be a significant
improvement upon the display-ripem and ripemd included in the
distribution.  It is intended to improve the convenience and security
of displaying RIPEM mail.

This perl script will check the headers it is given access to for
consistency to some degree.  Note that it requires that MH be
installed on the system, because it uses MH's utility routines ap and
dp for checking.  In addition, if you are an MH user, it allows easy
composition of replies to messages.  You should be able, after
configuration, to use it the same way you would use ripemd.

It's been uploaded to rpub, and I assume it'll eventually be included
with the standard RIPEM distribution.

I'm not posting the new version of send-ripem, because it's only
useful for MH users and thus has limited appeal.  I'll mail it to you
if you want.

#!/usr/bin/perl

# display-ripem
# version 1.0
# Marc VanHeyningen <mvanheyn@whale.cs.indiana.edu>
# Bug reports welcome, bug fixes more welcome.
# But please be sure the bug is really in display-ripem and not in MH or RIPEM
# or how you have things set up.
# You may use and redistribute this code freely as long as you don't try to
# make money off it or represent it as your own.  (Like you would want to.)

# I use this code with MH 6.8 under SunOS 4, but it should be reasonably
# portable.  Your mileage may vary.

# A few configurations are needed as defaults.  This program is designed
# for use with the MH mail system.  It may be used with other mailers, but
# still needs to know where the MH library routines are; it uses ap and dp
# to parse addresses and dates for (crude) verification.

$mhlib = "/usr/local/mh/lib";

# The time_threshold is the time, in seconds, which is the maximum acceptable
# message latency; a message delay longer will result in a warning when the
# message is displayed.  I use 86400, or one day.

$time_threshold = 86400;

# The showproc is the default program used to view the plaintext.  It also
# may be modified by the command line argument -showproc.  The default is
# to use the PAGER environment variable.  more, less, xless, or show -file
# are all be reasonable values.

$showproc = $ENV{"PAGER"};

# This is a simple program designed to make RIPEM message reading more
# convenient and secure.  It is based on MH, but may be used with any mailer
# that can save its message to a file or send it down a pipe.  It does some
# crude sanity checking on the headers and warns of some unusual values.

# Use: display-ripem [ -[no]mh ] [ -showproc proc ] [ file [ ... ] ]
#  showproc specifies the program used to view the plaintext.
#   The default showproc is specified above.
#  If mh is set, display-ripem will allow extraction and replies to be
#   composed with standard MH techniques.  By default, mh will be set
#   if the environment variable mhfolder is set.
#  display-ripem will display all files in the list.  If the list is
#   empty, it will try to display the standard input as a message.

# Use in MH:
#  In a directory in your PATH, make a symlink to show called pshow
#  Put the line in your .mh_profile:
#      pshow: -showproc display-ripem
#  And you can just pshow RIPEM messages instead of showing them.  I prefer
#  having a different command, since it forces me to be cognizant of the
#  type of message I'm reading.

#  If you use mhn, you may want a line something like:
#      mhn-show-application/x-ripem: %l%e display-ripem -showproc 'show -file'
#  Note that when display-ripem is called by mhn, it does not get to see
#  the headers to the message, and thus cannot check their contents.

# Note that this program assumes that RIPEM environment variables like
# RIPEM_USER_NAME and the like are set up accordingly.

# This program will not work with non-RIPEM mail.  It will not display 
# the headers which are not cryptographically authenticated without an
# indication of their status.  This is not a bug, it's a feature.  It
# tries not to display suspect information without indicating it as such.

# display-ripem will check the headers for consistency; it will look at
# the external From: header, the Originator-Name PEM header, and the
# encapsulated From: header (if there is one.)  It will complain if they
# are not all the same.  In addition, the time stamps on the message are
# checked, and latencies greater than $time_threshold will result in a
# warning.  This is a rather crude attempt to increase the chances of the
# detection of playback attacks.  Neither of these checks is really of
# much value unless the plaintext contains a From: and Date: header, which
# (IMHO) messages should.  The send-ripem program generates these headers
# automatically.

# After reading the message, you are (if the mh mode is on) given the
# opportunity to reply to it with the plaintext included.  This is sort
# of un-MH-ish, since it means having a mode instead of having everything
# happen at the shell prompt.  However, it allows easy inclusion of the
# text without requiring the message to be decrypted a second time.
# In addition, if you type "m" at the prompt, it will generate an included
# reply using text/richtext as the type.  This mode is still being played
# with.

# The model of replying is the Rnmail interface from rn; a components file
# is built on the fly using here-is files in the code.  Thus, for the
# moment, the only way to change the form of that file is to modify this
# program.  This does, however, allow the text to be included easily by
# this program, and allows things like annotations and Cc: lines to work.

# An Encrypted: line is also added so that, if a mailer like send-ripem is
# used, the reply to a RIPEM message will be ENCRYPTED by default.

# You also may extract the plaintext into a new MH message.
# This allows manipulations like bursting and the like on the plaintext.
# Obviously this is a significant security risk, and you should only do
# this if the plaintext is itself an RFC 822 message.

# The plaintext is stored on a file on /tmp, and is overwritten when
# the program finishes.  However, some other copies, like draft files,
# may not be overwritten, a potential security risk.

sub parse_headers {
    local($filedes, $default, %rules) = @_;
    local($label, $contents, $label_index, $bogus);

    $_ = <$filedes>;
    while($_ ne "" && ! /^$|^-/) {
	($label, $contents) = /^([0-9A-Za-z\-]*):[ \t]*(.*\n)/;
	($label_index = $label) =~ tr/[A-Z]/[a-z]/;
	$_ = <$filedes>;

	while($_ ne "" && /^[ \t]/) {
	    $contents .= $_;
	    $_ = <$filedes>;
	}

	if(defined $rules{$label_index}) {
# the variable name indicates what I think about the fact that
# perl won't allow associative array values as arguments to "do".
	    $bogus = $rules{$label_index};
	    do $bogus ($label, $contents);
	}
	else {
	    do $default($label, $contents);
	}
    }
}

sub do_nothing {
}

sub print_header {
    local($label, $contents) = @_;
    print $label, ": ", $contents;
}

sub clobber {
    local($filename) = @_;
    local($size, $i);
    exit(0);
    $size = (stat($filename))[7];

    open(FD, ">> $filename");
    seek(FD, 0, 0);
    for($i = 0; $i < $size; $i++) {
	syswrite(FD, $i, 1);
    }
    close(FD);
    unlink $filename;
}

umask 077;
$tmpfile = "/tmp/rmh.$$";
$formfile = "/tmp/rmhform.$$";

sub cleanup {
    &clobber($tmpfile);
    &clobber($formfile);
}
$SIG{'HUP'} = $SIG{'INT'} = $SIG{'QUIT'} = $SIG{'TERM'} = 'cleanup';

$mh = defined $ENV{'mhfolder'};

ARGPARSE:
    while($argument = shift) {
	if($argument eq "-mh") { $mh = 1; }
	elsif($argument eq "-nomh") { $mh = 0; }
	elsif($argument eq "-showproc") { $showproc = shift; }
	elsif($argument eq "-") { push(@filelist, ($argument)); }
	elsif($argument =~ /^-/) {
	    print STDERR "Unrecognized option $argument\n";
	    print STDERR "Use:  $0 [ options ] [ files ]\n";
	    print STDERR "Valid options: -[no]mh -showproc proc\n";
	    exit -1;
	} else {
	    push(@filelist, ($argument));
	    push(@filelist, @ARGV);
	    last ARGPARSE;
	}
    }

# If you don't have termcap installed or something, this may be commented
# out.  It's just to increase the visibility of warning messages.

open(TTY, "<&STDERR");
require "ioctl.pl";
ioctl(TTY,$TIOCGETP,$foo) || warn "ioctl failed";
($ispeed,$ospeed) = unpack('cc',$foo);
require 'termcap.pl';
&Tgetent();

sub parse_received {
    local($label, $contents) = @_;
# we only want the first received: line
    if($date_received eq "") {
	($date_received) = $contents =~ /;(.*)\n/;
    }
}
$external_rules{"received"} = "parse_received";

sub parse_date {
    local($label, $contents) = @_;
    $date_sent = $contents;
    chop $date_sent;
}
$external_rules{"date"} = "parse_date";

sub parse_from {
    local($label, $contents) = @_;
    $from_extern = $contents;
    chop $from_extern;
}
$external_rules{"from"} = "parse_from";

sub parse_subject {
    local($label, $contents) = @_;
    $subject = $contents;
}
$external_rules{"subject"} = "parse_subject";
$plaintext_rules{"subject"} = "parse_subject";

sub parse_originator_name {
    local($label, $contents) = @_;
    $originator_name = $contents;
    chop $originator_name;
    &print_header($label,$contents);
}
$pem_rules{"originator-name"} = "parse_originator_name";

sub parse_proc_type {
    local($label, $contents) = @_;
    ($proc_type) = $contents =~ /,(.*)\n/;
    &print_header($label, $contents);
}
$pem_rules{"proc-type"} = "parse_proc_type";

sub parse_dek_type {
    local($label, $contents) = @_;
    ($dek_type) = $contents =~ /^(.*),/;
    print "Dek is $contents";
    &print_header($label, $contents);
}
$pem_rules{"dek-info"} = "parse_dek_type";

sub parse_date_plain {
    local($label, $contents) = @_;
    $date_plain = $contents;
    chop $date_plain;
}
$plaintext_rules{"date"} = "parse_date_plain";

sub parse_from_plain {
    local($label, $contents) = @_;
    $from_plain = $contents;
    chop $from_plain;
}
$plaintext_rules{"from"} = "parse_from_plain";

if($#filelist < $[) {
    push(@filelist, ("-"));
}

$show_filenames = $#filelist > $[;

MESSAGE:
    while($message = shift @filelist) {
	
	print $TC{"so"}, "-- $message --\n", $TC{"me"} if($show_filenames);

	if(!open(MESSAGE, $message)) {
		print STDERR "Cannot open $message\n";
		next MESSAGE;
	}
	$time_file = ((stat(MESSAGE))[9]);

	$from_extern = "";
	$date_sent = "";
	$date_received = "";
	$subject = "";
	$date_plain = "";
	$from_plain = "";
	&parse_headers(MESSAGE, "do_nothing", %external_rules);

	while($_ ne "-----BEGIN PRIVACY-ENHANCED MESSAGE-----\n" &&
	      ($_ = <MESSAGE>)) { ; }
	if($_ ne "-----BEGIN PRIVACY-ENHANCED MESSAGE-----\n") {
	    print STDERR "Unable to find PEM header in $message\n";
	    next MESSAGE;
	}

	open(RIPEM, "| ripem -d > $tmpfile") || die "Cannot open ripem!"; 
	select RIPEM;
	print;
	$originator_name = "";
	$proc_type = "";
	$dek_type = "";
	&parse_headers(MESSAGE, "print_header", %pem_rules);
	print;
	select STDOUT;
	print "Proc-Type: $proc_type\n";
	print "DEK: $dek_type\n" if $dek_type ne "";
	select RIPEM;
	while(<MESSAGE>) { print; }
	close(MESSAGE);
	if(!close(RIPEM) || $? != 0) {
	    print STDERR "RIPEM returned with error code $? on $message\n";
	    next MESSAGE;
	}
	
	open(PLAINTEXT, $tmpfile);
	&parse_headers(PLAINTEXT, "do_nothing", %plaintext_rules);

	($time_plain, $time_sent, $time_received) =
	    split("\n", `$mhlib/dp -format '%(clock{text})' "$date_plain" "$date_sent" "$date_received"`);
	$time_plain = $time_sent if $time_plain == -1;
	$time_received = $time_file if $time_received == -1;
	$time_plain = $time_received if $time_plain == -1;

	@addrs = split("\n", `$mhlib/ap -format '%(putstr(addr{text}))' "$from_extern" "$from_plain" "$originator_name"`);

	select STDOUT;
	
	print "Subject: $subject" if($subject ne "");
	print $TC{"md"}, $TC{"mb"}, "Warning!", $TC{"me"}, $TC{"md"},
	 "  Extra address @addr[3] parsed!\n", $TC{"me"}
	if($#addr > 2);
	if($addr[0] ne $addr[1] && $addr[1] ne "" || 
	   $addr[1] ne $addr[2] && $addr[2] ne "") {
	    print $TC{"md"}, $TC{"mb"}, "Warning!", $TC{"me"}, $TC{"md"},
	     "  Inconsistent originator info:\n", $TC{"me"};
	    print "External-From: $from_extern\n" if($from_extern ne "");
	    print "Originator-Name: $originator_name\n";
	    print "Internal-From: $from_plain\n" if($from_plain ne "");
	    print $TC{"so"}, " WARNING!!! SOME OR ALL OF THE ABOVE APPEAR INACCURATE \n", $TC{"me"};
	} else {
	    if($from_plain eq "") {
		if($from_extern eq "") {
		    print "Originator-Name: $originator_name\n";
		} else {
		    print "External-From: $from_extern\n";
		}
	    } 
	}			

	if(($time_delta = $time_received - $time_plain) > $time_threshold) {
	    printf("%sCaution: message latency of %d days, %d hours, %d minutes%s\n",
		   $TC{"md"}, $time_delta / 86400,
		   ($time_delta % 86400) / 3600,
		   ($time_delta % 3600) / 60, $TC{"me"});
	}
	close PLAINTEXT;
	$| = 1; print $TC{"so"}, "--Hit RETURN for the plaintext--", $TC{"me"};
	<TTY>;
	$| = 0;
	system "$showproc $tmpfile";
	next MESSAGE unless $mh;
	$| = 1;
	print $TC{"so"}, "--<cr> to proceed, <r> to reply, <e> to extract--", $TC{"me"};
	$_ = <TTY>;
	$| = 0;
	if(/r/i || ($mime_rich = /m/i)) {
	    open(FORM, ">$formfile") || die "Cannot create $formfile";
	    select FORM;
	    print "Encrypted: RIPEM, ENCRYPTED\n";

	    if($from_plain ne "") { print "To: $from_plain\n"; }
	    else { print <<EOF;
%(lit)%(formataddr %<{reply-to}%|%<{from}%|%<{sender}%|%<{return-path}%>%>%>%>)\\
%<(nonnull)%(void(width))%(putaddr To: )\\n%>\\
EOF
            }			      
	    print <<EOF;
%(lit)%(formataddr{to})%(formataddr{cc})\\
%<(nonnull)%(void(width))%(putaddr cc: )\\n%>\\
%<{fcc}Fcc: %{fcc}\\n%>\\
%<{date}In-reply-to: Your message of "%<(nodate{date})%{date}%|%(pretty{date})%>."%<{message-id}
             %{message-id}%>\n%>\\
EOF

             if ($subject eq "")
	     { print <<EOF;
%<{subject}Subject: Re: %{subject}\\n%>\\
EOF
             }
	    else {if (!($subject =~ /^Re:/i)) { $subject = "Re: " . $subject; }
		  print "Subject: ", $subject; }
	    print "--------\n";
	    print '#<text/richtext\n<bold>' if($mime_rich);

	    if($from_plain ne "") { print "Previously, $from_plain said:\n"; }
	    else { print "Previously, $originator_name said:\n"; }
	    print '</bold><excerpt>\n' if $mime_rich;

	    open(MSGFD, $tmpfile) || die "Cannot read from $tmpfile";
	    while(<MSGFD>) { 
		print ">" unless $mime_rich;
		print '<nl>' if ($mime_rich && $_ =~ /^[>\t ]*\n/);
		print $_;
	    }
	    print '</excerpt>\n' if $mime_rich;
	    close MSGFD;
	    close FORM;
	    system "repl", "-form", $formfile;
	    &clobber($formfile);
	}			
    	elsif(/e/i) {
	    open(MSG_FD, $tmpfile) || die "Cannot read from $tmpfile";
	    $extfn = `mhpath new`;
	    open(NEW_FD, ">$extfn") || die "Cannot create $extfn";
	    while(<MSG_FD>) { print NEW_FD; }
	    close MSG_FD;
	    close NEW_FD;
	    print "Plaintext extracted into $extfn\n";
	}
	&clobber($tmpfile);
}
__END__
-- 
Marc VanHeyningen    mvanheyn@whale.cs.indiana.edu    MIME & RIPEM accepted
Oh, so UNIX uses slashes for directory stuff!  Did they get that idea
from MS-DOS?  
		- <name withheld to prevent terminal embarassment>