sanitizer 1.76-3 / usr / bin / simplify

#!/usr/bin/perl
#
my $revision = '$Id: simplify.pl,v 1.9 2003/06/18 11:02:24 bre Exp $';
my $version = 'Anomy 0.0.0 : simplify.pl';
#
##  Copyright (c) 2001 Bjarni R. Einarsson. All rights reserved.
##  This program is free software; you can redistribute it
##  and/or modify it under the same terms as Perl itself.  
#
# Usage: simplify.pl [args ...] <message >othermessage
#
# This is a crude script to simplify a MIME message.  The following arguments 
# are recognized:
#
#   mime=no                       Don't use MIME, no HTML mail allowed.
#   testing=yes                   Run in testing mode (suppress randonmess)
#   saveall=yes                   Save all attachments to files.
#   temp=/path/to/working/dir/    Defaults to /tmp.
#   url=http://box/path/          URL-prefix for printing paths to attachments
#   header=text...                Text preceding the attachment URL list.
#   textsig=/path/to/file         Text signature to append to text parts.
#   htmlsig=/path/to/file         HTML signature to append to HTML parts.
#
# If "saveall" is yes, then the script will save all attachments to disk so
# people can access their contents later.  If an URL is specified then that
# automatically implies "saveall=yes".  Without this, the default behavior is
# to only save text and html parts, and delete them and all working
# directories when the script is finished.
#
# This script never loads the entire message into memory, but does dump 
# it's entire contents to disk once.
#
BEGIN { push @INC, $ENV{"ANOMY"} . "/bin"; };
use strict;
use Anomy::MIMEStream;
use IO::Handle;


##[ Global variables, configuration ]#########################################

my @attachments = ( );
my @textparts = ( );
my @htmlparts = ( );

my $seentext = 0;
my $boundary = "";
my $filecounter = 0;
my $workdir = undef;

my $parsers = {
    "DEFAULT" => \&SaveIt,
    "multipart/*" => \&Anomy::MIMEStream::ParserMultipart,
};

# Defaults...
my $args = 
{
    "mime"    => "yes",
    "saveall" => "no",
    "testing" => "no",
    "temp"    => "/tmp",
    "url"     => undef,
    "header"  => "Attachments:",
    "lynx"    => "/usr/bin/lynx -dump %s",
    "textsig" => undef,
    "htmlsig" => undef,
};


##[ Main ]####################################################################

# Check args
#
foreach my $arg (@ARGV)
{
    if ($arg =~ /^\s*(mime|saveall|testing|temp|url|header|textsig|htmlsig)\s*=\s*(.*)$/si)
    {
        $args->{lc($1)} = $2;
    }
    else
    {
        die "Invalid argument: $arg\nStopped";
    }
}
$args->{"saveall"} = "yes" if ($args->{"url"});

# Parse message header
#
open (NULL, ">/dev/null");
my $message = Anomy::MIMEStream->New(*STDIN, *NULL, $parsers);
$message->ParseHeader();

# Create working directory
#
$workdir = CreateWorkdir();

# Dump attachments to files
#
$message->ParseBody();

# Print out new headers
#
$message->KillRawMimeHeaders();
chomp $message->{"rawheader"};
if ($args->{"mime"} =~ /no/i)
{
    # Without MIME...
    #
    print
        $message->{"UNIX-FROM"}, 
        "MIME-Version: 1.0\n",
        "Content-Type: text/plain; charset=iso-8859-1\n",
        "Content-Transfer-Encoding: 8bit\n",
        $message->{"rawheader"}, "\n";
}
else
{
    # With MIME...
    #
    $boundary = Anomy::MIMEStream::MakeBoundary();
    $boundary = "NotARandomBoundary" if ($args->{"testing"} =~ /yes/i);
    print
        $message->{"UNIX-FROM"}, 
        "Content-Type: multipart/alternative;\n\tboundary=\"",
        $boundary, "\"\n",
        "Content-Transfer-Encoding: 8bit\n",
        $message->{"rawheader"}, "\n";
}

PrintTextPartBoundary();
if (@textparts)
{
    # Dump all inline text parts in a row...
    #
    foreach my $tp (@textparts)
    {
        cat($args->{"temp"}."/".$tp);
    }
    print "\n";
}
elsif (@htmlparts)
{
    # No plain text part present, create one from the first HTML part
    # using lynx.
    #
    my $cmd = sprintf($args->{"lynx"}, $args->{"temp"}."/".$htmlparts[0]);
    
    if (open(PART, "$cmd |"))
    {
        while (<PART>)
        {
            print;
        }
        close(PART);
        print "\n";
    }
}
else
{
    # Default to an empty text message, containing links to attachments.
    # ... so we print nothing.
}
PrintTextPartAttachments();
PrintTextSignature();

# Dump all inline HTML parts in a row...
#
if (($args->{"mime"} !~ /no/i) && (@htmlparts))
{
    foreach my $tp (@htmlparts)
    {
        print
            "--", $boundary, "\n",
            "Content-Transfer-Encoding: 8bit\n",
            "Content-Disposition: inline\n",
            "Content-Type: text/html; charset=iso-8859-1\n\n";

        htmlcat($args->{"temp"}."/".$tp);
    }
    print "\n";
    
    if (($args->{"url"}) && (@attachments))
    {
        print "<h3>", $args->{"header"}, "</h3><ul>\n";
        foreach my $at (@attachments)
        {
            my $fn = $at;
            $fn =~ s/^.*\///g;
            print "<li><a href=\"", $args->{"url"}, $at, "\">", $fn, "</a>\n";
        }
        print "</ul>\n";
    }
    cat ($args->{"htmlsig"});
    print "</body></html>\n\n";
}

# Close multipart, if necessary.
#
if ($args->{"mime"} !~ /no/i)
{
    print "--", $boundary, "--\n",
}

if ($args->{"saveall"} !~ /yes/i)
{
    RemoveWorkdir();
}

##[ Subroutines ]##############################################################

sub CreateWorkdir
{
    my $prefix = sprintf("%x%x", ($$ % 10000), time());
    
    $prefix = "testing" if ($args->{"testing"} =~ /yes/i);
    
    if ($prefix =~ s/^(..)(..)(.*)$/$1\/$2\/$3/)
    {
        my ($a, $b, $c) = ($1, $2, $3);

        mkdir $args->{"temp"}."/$a", 0755;
        mkdir $args->{"temp"}."/$a/$b", 0755;
        mkdir $args->{"temp"}."/$a/$b/$c", 0755;
    }
    return $prefix;
}

sub RemoveWorkdir
{
    my $wd = $args->{"temp"};

    foreach my $att (@attachments, @textparts, @htmlparts)
    {
        unlink $wd ."/". $att;
    }
    
    $wd .= "/". $workdir;
    if ($wd =~ /^(((.*)\/.*?)\/.*?)\/?$/)
    {
        rmdir $1;
        rmdir $2;
        rmdir $3;
    }
}

sub SaveIt
{
    my $part = shift;
    my $fn = $part->{"mime"}->{"name"} || 
             $part->{"mime"}->{"filename"} || "unnamed";
    $fn =~ s/[^A-Za-z0-9\._-]/_/g;

    my $filename = sprintf("%s/%2.2d.%s", $workdir, $filecounter++, $fn);

    if ($part->{"mime"}->{"_disposition"} =~ /^attachment$/i)
    {
        push @attachments, $filename;
    }        
    elsif ($part->{"mime"}->{"_type"} =~ /^text\/plain$/i)
    {
        $filename .= ".txt" if ($filename !~ /\.txt$/i);
        push @textparts, $filename;
    }
    elsif ($part->{"mime"}->{"_type"} =~ /^text\/html$/i)
    {
        $filename .= ".html" if ($filename !~ /\.html$/i);
        push @htmlparts, $filename;
    }
    else
    {
        push @attachments, $filename;
    }
        
    open (FILE, ">".$args->{"temp"}."/$filename");
    while (my $l = $part->Read())
    {
        print FILE $l;
    }
    close(FILE);    
}

# Print text part preamble.
#
sub PrintTextSignature
{
    if (-r $args->{"textsig"})
    {
        print "-- \n";
        cat($args->{"textsig"});
        print "\n";
    }
}

# Print text part preamble.
#
sub PrintTextPartBoundary
{
    if ($args->{"mime"} !~ /no/i)
    {
        print
            "--", $boundary, "\n",
            "Content-Transfer-Encoding: 8bit\n",
            "Content-Disposition: inline\n",
            "Content-Type: text/plain; charset=iso-8859-1\n\n";
    }
}

# Print attachment list as text to stdout.
#
sub PrintTextPartAttachments
{
    if (($args->{"url"}) && (@attachments || @htmlparts))
    {
        print $args->{"header"}, "\n";
        foreach my $at (@attachments)
        {
            print " + ", $args->{"url"}, $at, "\n";
        }
        print "\n";
    }
}

# Dump the contents of a file...
#
sub cat
{
    my $fn = shift;
    
    open (FILE, "<$fn") || return undef;
    while (<FILE>)
    {
        print;
    }
    close(FILE);
}

# Dump the contents of an HTML file, disabling the </body> and </html> 
# tags, to allow us to append Stuff.
#
sub htmlcat
{
    my $fn = shift;
    
    open (FILE, "<".$args->{"temp"}."/$fn") || return undef;
    while (<FILE>)
    {
        s/<\/(body|html)/<END-$1/gi;
        print;
    }
    close(FILE);
}