--- detach.pl.orig 2007-07-13 17:44:01.000000000 -0400 +++ detach.pl 2011-09-14 11:14:41.000000000 -0400 @@ -1,4 +1,4 @@ -#!/usr/local/bin/perl -w +#!/usr/bin/perl -w ########################################################################### ### Strips attachments out of email messages (of certain types) @@ -10,12 +10,16 @@ ### This program by and copyright Ryan Hamilton , ### and Jason Fesler ### all rights reserved +### +### Edited by Jack Zielke and +### Bobby Burden +### http://linuxcoffee.com/detach ########################################################################### ### ### THIS SOFTWARE IS PROVIDED "AS-IS" WITHOUT WARRANTY OF ANY KIND. ### ########################################################################### -### $Id: detach,v 2.4 2007/07/13 21:39:17 ryan Exp ryan $ +### $Id: detach.pl 213 2011-09-14 15:14:41Z jzielke $ ########################################################################### package Detach; @@ -33,7 +37,7 @@ my $class = shift; my $self = {}; my $args = shift; - my %ARGS = map { $_ => 1 } qw(aggressive web_root dir_root hash shorten); + my %ARGS = map { $_ => 1 } qw(aggressive web_root dir_root hash shorten msize); DEBUG(Dumper(\%ARGS)); DEBUG(Dumper($args)); for my $key (keys %$args) { @@ -54,12 +58,15 @@ $stamp = strftime("%Y/%m/%d/%H:%M:%S-$$",localtime); } else { # use jfesler's hash based stamp - my $hash = md5_base64(join("",time,$$,$<,$>,@_)); - $hash =~ s/[^a-zA-Z0-9]//; # Really, I want base 62 - $hash =~ s/[oO0iIlL2Zz]//; # And, avoid pain with visual cut/paste, - # now base 52 - $stamp= substr($hash,0,2) . # 144555105949057024 combos (52^10); - "/" . substr($hash,2,8); + my $hash = ''; + do { + $hash .= md5_base64(join("",time,$$,$<,$>,$self)); + $hash =~ s/[^a-zA-Z0-9]//g; # Really, I want base 62 + $hash =~ tr/vVO0Il12Z5S/vV/sd; # And, avoid pain with visual cut/paste, + # now base 53 + } while (length($hash) < 10); # Just in case + $stamp= substr($hash,0,2) . # 168287943181908783 combos 53^10 - 2(53^9) + "/" . substr($hash,2,8); } $self->{dir_root} .= "/$stamp/"; $self->{web_root} .= "/$stamp/"; @@ -68,9 +75,10 @@ $self->{detached} = []; $self->{urls} = []; $self->{firsts} = {}; + $self->{cids} = {}; DEBUG(Dumper($self)); - + return $self; } @@ -79,16 +87,16 @@ my $parser = new MIME::Parser; $parser->output_under("/tmp"); - $parser->extract_uuencode(1); + $parser->extract_uuencode(1); my $envelope = ; my $entity = $parser->parse(\*STDIN); #$entity->dump_skeleton(\*STDERR); # for debugging $self->detach_all($entity); - ### if we're in aggressive mode, we need to + ### if we're in aggressive mode, we need to ### add the blurb to all text/* parts - $self->append_blurbs() if $self->{aggressive}; + $self->append_blurbs($entity) if $self->{aggressive}; print $envelope; $entity->print(); @@ -105,9 +113,21 @@ ### for each text/* mime type sub append_blurbs { my $self = shift; + my($entity) = @_; + DEBUG("appending blurbs ".Dumper([ keys %{$self->{firsts}}])); if (@{$self->{urls}}) { DEBUG("got urls"); + if (!scalar keys %{$self->{firsts}}) { + DEBUG("There are detachments and nothing to append the blurb to. Creating empty text/plain."); + my $part = build MIME::Entity ( + Type => 'text/plain; charset=us-ascii', + Data => '', + Encoding => 'quoted-printable', + ); + $entity->add_part($part, 0); + $self->{firsts}{'text/plain'} = $part; + } foreach my $m (keys %{$self->{firsts}}) { DEBUG($m); my $e = $self->{firsts}{$m}; @@ -126,7 +146,7 @@ $e->bodyhandle($b) ; } else { DEBUG("Failed to update body part with index while allocating new MIME::Body::InCore"); - } + } } } } @@ -138,27 +158,29 @@ DEBUG("appending blurb of type $type"); - my $header = "The following attachments have been detached and are available for viewing."; - my $footer = "Only click these links if you trust the sender, as well as this message."; + my $header = "The following attachments have been detached and are available for viewing."; + my $footer = "Only click these links if you trust the sender, as well as this message."; + my $footer2 = "Note: Attachments will be deleted after 30 days."; if ($type =~ m#text/plain#) { - return $self->append_blurb_plain($header, $footer, $lines); + return $self->append_blurb_plain($header, $footer, $footer2, $lines); } elsif ($type =~ m#text/html#) { - return $self->append_blurb_html($header, $footer, $lines); + return $self->append_blurb_html($header, $footer, $footer2, $lines); } elsif ($type =~ "text/(rich|enriched)#") { - return $self->append_blurb_rtf($header, $footer, $lines); + return $self->append_blurb_rtf($header, $footer, $footer2, $lines); } } sub append_blurb_plain { my $self = shift; - my($header, $footer, $lines) = @_; - + my($header, $footer, $footer2, $lines) = @_; + my @blurb = ("\n\n\n", " --- 8< --- detachments --- 8< ---\n", " $header\n", map(" $_\n", (@{$self->{urls}})), " $footer\n", + " $footer2\n", " --- 8< --- detachments --- 8< ---\n", "\n"); push(@$lines, @blurb); @@ -167,13 +189,28 @@ sub append_blurb_html { my $self = shift; - my($header, $footer, $lines) = @_; + my($header, $footer, $footer2, $lines) = @_; my @blurb = ("

Detachments - $header\n", - "

    ", - map("
  • $_\n", (@{$self->{urls}})), - "
$footer\n", - "

",); + "

    ",); + foreach(@{$self->{urls}}) { + my $pretty_url = $_; + $pretty_url =~ s/\%([A-Fa-f0-9]{2})/pack('C', hex($1))/seg; + push (@blurb, "
  • $pretty_url\n"); + my $cid = $self->{cids}{$_}; + if ($cid) { + $cid =~ /<(.+)>/; + $cid = $1; + my $url = $_; + DEBUG("Replacing cid:$cid with $url"); + foreach (@$lines) { + $_ =~ s#cid:$cid#$url#g; + } + } + } + push(@blurb, ("
$footer
\n", + "$footer2\n", + "

",)); DEBUG("Adding html blurb: ". join("\n", @blurb)); @@ -194,15 +231,16 @@ sub append_blurb_rtf { my $self = shift; - my($header, $footer, $lines) = @_; - + my($header, $footer, $footer2, $lines) = @_; + my @blurb = (" \\par\n--- 8< --- detachments --- 8< ---\\par\n", "$header\\par\n", map(" $_\\par\n", (@{$self->{urls}})), "$footer\\par\n", + "$footer2\\par\n", "\\par\n"); - $lines->[@$lines-1] =~ #}$##; Remove trailing container bracker + $lines->[@$lines-1] =~ #}$##; Remove trailing container bracket push(@$lines, @blurb); $lines->[@$lines-1] .= "}"; # Replace trailing container bracket @@ -214,7 +252,7 @@ my($entity) = @_; for my $part ($entity->parts()) { - if ($part->head()->recommended_filename()) { + if ($part->head()->recommended_filename() || $part->head()->get('Content-ID',0)) { my($h,$b) = $self->detach_part($part); } elsif ($part->parts()) { $self->detach_all($part); @@ -240,16 +278,30 @@ my $src = $entity->bodyhandle()->path(); my $base = basename($src); - system("mkdir", "-p", $self->{dir_root}) == 0 + if ($self->{msize}) { + my $filesize = -s $src; + DEBUG("File name: ".$src); + DEBUG("File size: ".$filesize); + if ($self->{msize} > $filesize) { + return; + } + } + + system("mkdir", "-p", $self->{dir_root}) == 0 or die "ERROR: unable to create $self->{dir_root} : $!\n"; chmod(0777, $self->{dir_root}); my $name = $self->uniq_name($self->{dir_root},$base); my $dest = $self->{dir_root} . $name; - $name =~ s/([^A-Za-z0-9.])/sprintf("%%%02X", ord($1))/seg; + $name =~ s/([^A-Za-z0-9.])/sprintf("%%%02X", ord($1))/seg; my $url = $self->{web_root} . $name; - system("/bin/cp",$src,$dest); + my $cid = $entity->head()->get('Content-ID',0); + if ($cid) { + $self->{cids}{$url} = $cid; + } + + system("/bin/mv",$src,$dest); push(@{$self->{detached}},$dest); push(@{$self->{urls}},$url); @@ -308,7 +360,7 @@ print F "

From: $from\nSubj: $subj\n
    \n"; for (@{$self->{detached}}) { my $u = substr($_,length($self->{dir_root})); - $u =~ s/([^A-Za-z0-9])/sprintf("%%%02X", ord($1))/seg; + $u =~ s/([^A-Za-z0-9])/sprintf("%%%02X", ord($1))/seg; my $b = basename($_); my $size = format_bytes((stat($_))[7]); @@ -330,12 +382,13 @@ umask(0000); -my($opt_web, $opt_dir, $opt_verbose, $opt_help, $opt_aggressive, $opt_hash, $opt_shorten); +my($opt_web, $opt_dir, $opt_verbose, $opt_help, $opt_aggressive, $opt_hash, $opt_shorten, $opt_size); if (!GetOptions("d|dir-root=s" => \$opt_dir, "w|web-root=s" => \$opt_web, "a|aggressive" => \$opt_aggressive, "s|shorten" => \$opt_shorten, "hash" => \$opt_hash, + "size=s" => \$opt_size, "v|verbose" => \$opt_verbose, "h|help" => \$opt_help) || $opt_help) { print STDERR < $opt_dir, - web_root => $opt_web, +my $detach = new Detach( { dir_root => $opt_dir, + web_root => $opt_web, aggressive => $opt_aggressive, shorten => $opt_shorten, + msize => $opt_size, hash => $opt_hash }); $detach->detach_message();