#!/usr/bin/perl -w

# by Christian Wolff
# decodes the payload of sircam mails.
# Header, text and data of the mail is stored under the same filename
# with .header, .text and .data appended to the name, respectively.
# Also, a symlink from the real filename to the .data file is created.
# http://www.mcafee.com/anti-virus/viruses/sircam/default.asp?cid=2360
# http://www.symantec.com/avcenter/venc/data/w32.sircam.worm@mm.html

use strict;
use integer;

#
#  write_file(where,what)
#    writes 'what' into the new created file 'where'
sub write_file {
  my($where,$what) = @_;
  if (open(DATEI,'>'.$where)) {
    print DATEI $what;
    close DATEI;
    return 0;
  } else {
    return 1;
  }
}

sub decode_qp ($)
{
    my $res = shift;
    $res =~ s/[ \t]+?(\r?\n)/$1/g;  # rule #3 (trailing space must be deleted)
    $res =~ s/=\r?\n//g;            # rule #5 (soft line breaks)
    $res =~ s/=([\da-fA-F]{2})/pack("C", hex($1))/ge;
    $res;
}

sub decode_base64 ($)
{
    local($^W) = 0; # unpack("u",...) gives bogus warning in 5.00[123]

    my $str = shift;
    $str =~ tr|A-Za-z0-9+=/||cd;            # remove non-base64 chars
    if (length($str) % 4) {
			# print "Length of base64 data not a multiple of 4";
    }
    $str =~ s/=+$//;                        # remove padding
    $str =~ tr|A-Za-z0-9+/| -_|;            # convert to uuencoded format

    return join '', map( unpack("u", chr(32 + length($_)*3/4) . $_),
			$str =~ /(.{1,60})/gs);
}

sub decode_header ($) 
{
  my $header = shift;
  my %header=();
#  print "HEADER:\n$header\n\n";
  $header=~s/\n\s+/ /g;
  %header=('FROM', split /^([-\w]+):\s/m, $header); # ,;
#  chomp(values %header);  # grmph, values no lvalue...
  my $key;
  foreach $key (keys %header) {
    chomp($header{$key});
    $header{lc($key)}=$header{$key};
  }
  return wantarray ? %header : $header{'content-type'};
}

sub decode_mail ($)
{
  my $mail='';
  my $filename = shift || '-';

  print "Decoding $filename\n";
  open FILE,"<$filename" or return 1;
  while (<FILE>) {
    $mail .= $_;
  }

  $mail=~s/\r\n?/\n/g;
  my($header,$body)=split /\n\n/s, $mail, 2; # ,;
  write_file($filename.'.header',$header);
  
  my %header = decode_header($header);
#  print "HEADER hash:\n";
#  my ($key,$value);
#  while (($key,$value) = each %header) {
#    print "${key}: [${value}]\n";
#  }
  
  return 0 unless defined $header{'content-type'};
  if ($header{'content-type'}=~/^multipart/i) {
    my $boundary='';
    while (!$boundary) {
      ($boundary,$body) = split /\n/s, $body, 2; # ,;
    }
#print "Boundary: [${boundary}]\n";
    $boundary=~s/([\(\)\{\}\[\]\\\+\?\.\*\^\$\|\/])/\\$1/g;
    for (split (/$boundary/,$body)) {
      next if (length($_) <= 4);
      my ($part_header,$part_body)=split /\n\n/s,$_,2; #,;
      $part_body=substr($part_body,0,-2);
#print "Part-Header: [${part_header}]\n";
      my %part_header=decode_header($part_header);
      if (defined $part_header{'content-disposition'}) {
#print "content-dispo: [$part_header{'content-disposition'}]\n";
        if ($part_header{'content-disposition'}=~/^message ?text$/i) {
          $part_body = decode_qp($part_body);
          write_file($filename.'.text',$part_body);
        } elsif ($part_header{'content-disposition'}=~/^attachment/i) {
          $part_body = decode_base64($part_body);
          $part_body = substr($part_body, 137216);
          write_file($filename.'.data',$part_body);
          if ($part_header{'content-disposition'}=~/filename=\"?(.*)\.\w{1,3}\"?$/i) {
            my $name = "${1}";
            $name=~tr/\/'/__/;
            print "  Payload: $name\n";
            if ($filename=~/^(.*\/)/) { $name=$1.$name; }
            system("ln -sf '${filename}.data' '${name}'");
            system("ln -sf '${filename}.header' '${name}.txt'");
          }
        }
      }            
    }
  }
  return 0;
}

my $name;
if (scalar(@ARGV) == 0) {
  decode_mail('-');
} else {
  while ($name=shift) {
    decode_mail($name);
  }
}