#!/usr/bin/perl
# Filename:     forge
# Author:       David Ljung
# Description:  Forges email
use strict;

umask 022;

##################################################
# Setup the variables
##################################################
my $PROGNAME = $0;
$PROGNAME =~ s|.*/||;

	# Default identification -- EDIT THIS
my $DEFAULT_FROM =	$ENV{USER} || "root";
my $DEFAULT_FROM_FULL=	$ENV{FULLNAME} || "Some Forger";
my $DEFAULT_TO =	$ENV{USER} || "root";

	# If we create headers based on the "To" address
	# %d = domain, %D = domain.tld, %l = login, %t = full To
my $MAKE_HEADERS_FROM =	"%D\@$ENV{DOMAIN}";

	# Sig file (or a directory of sigs - we'll pick one randomly)
my $SIG="~/.sig";
my $DEFAULT_SIG = "-- \nForged email by $ENV{USER} at ".`hostname`;

	# My addresses to ignore when figuring out which address we
	# received email at (for "forge <num>")
my @IGNORE_ADDR = ("$ENV{USER}\@");

	# Where to save mail
my $OUTBOUND = "$ENV{HOME}/Mail/OUTBOUND/new";
   $OUTBOUND = "$ENV{HOME}/Mail/OUTBOUND" unless -f $OUTBOUND;

	# Where mail comes in
my $MAILBOX = $ENV{MAIL};

	# Forge pipe method:
my $FORGE_PIPE="/usr/bin/forge_pipe";

	# Sendmail method:
my $SENDMAIL="/usr/lib/sendmail";

	# Port 25 method:  Where we normally send mail through
my $DEFAULT_MAILHOST="localhost";
my $TELNET="/usr/bin/telnet";

	# Choose an editor
my $EDITOR = "/bin/vim";
$EDITOR = "/usr/bin/vim" if (!$EDITOR || ! -x $EDITOR);
$EDITOR = "/bin/vi" if (!$EDITOR || ! -x $EDITOR);
$EDITOR = "/usr/bin/vi" if (!$EDITOR || ! -x $EDITOR);
die("[$PROGNAME] Couldn't find editor to use\n")
  if (!$EDITOR || ! -x $EDITOR);

##################################################
# Usage
##################################################
sub usage {
  my $msg;
  foreach $msg (@_) { print "ERROR:  $msg\n"; }
  print "\n";
  print "Usage:\t$PROGNAME [num] [-f from] [-F name] [-s subject] [-t to]\n";
  print "      \t      [-d] [-25 [mail_host]] [destination]\n";
  print "\n";
  print "\tForges a mail message\n";
  print "\n";
  print "\t<num>        Forge reply to given message [$MAILBOX]\n";
  print "\t             (This is by order in the file, not necessarily the\n";
  print "\t              order that your mailer shows the messages in\n";
  print "\t-f           From address\n";
  print "\t-F           From full name\n";
  print "\t-t           To address\n";
  print "\t-s           Subject\n";
  print "\n";
  print "\tdestination  Create to/from based on a destination\n";
  print "\n";
  print "\t<num>        Create to/from based on # message in mbox\n";
  print "\t-g           - Group reply for <num>\n";
  print "\n";
  print "\t-d           Set debug mode\n";
  print "\t-sendmail    Use sendmail directly\n";
  print "\t-25          Use port 25 method\n";
  print "\n";
  exit -1;
}

# Unique push
sub add_list {
  my ($add,$arr) = @_;
  $add =~ s/\s+//g;
  push(@$arr,$add) unless !$add || grep(lc($add) eq lc($_), @$arr);
}

# Read a mail message in the standard mailbox and create headers according
# to that
my $NEW_MSG_RE = '^From (.+)\s+(\S+\s+\S+\s+\d+\s+[\d:]+\s+\d+)\s*$';
sub get_headers {
  my ($hdrs,$num,$group) = @_;

  my %got;

  open(MBOX,$MAILBOX) || usage("Can't read mail [$MAILBOX]!");

  # Find message
  my $cnt = 0;
  while (<MBOX>) {
    chomp;
    last if /$NEW_MSG_RE/ && ++$cnt==$num;
  }
  return unless $cnt==$num;

  # Grab headers
  my $hdr;
  while (<MBOX>) {
    chomp;
    last if /^\s*$/;
    if (/^(\S+):\s+(\S.*)$/) {
      $hdr = lc($1);  my $val = $2;
      $hdr =~ s/-/_/g;
      $got{$hdr}= $got{$hdr} ? "$got{$hdr}\n$val" : $val;
    } else {
      # Continuation of previous header
      s/^\s+/ /;
      $got{$hdr}.=$_;
    }
  }

  # Grab body
  while (<MBOX>) {
    last if /$NEW_MSG_RE/;
    $hdrs->{BODY} .= "> $_";
  }
  close MBOX;

  # What mail address did we receive at?
  if ($got{to} && !grep($got{to} =~ /$_/, @IGNORE_ADDR)) {
    $hdrs->{from} = $got{to};
  } else {
    my $r = $got{received};
    while ($r =~ /for <([^>]+)>/) {
      my $a = $1; $r = $';
      unless (grep($a =~ /$_/, @IGNORE_ADDR)) {
        $hdrs->{from} = $a;
        last;
      }
    }
  }

  $hdrs->{from_full} = $1 if ($got{to} =~ /^(.*\S)\s+<.*>/);

  # Who was the mail for?
  my @rcpt;
  add_list($got{'to'},\@rcpt);
  add_list($got{'cc'},\@rcpt);
  add_list($got{'x_apparently_to'},\@rcpt);

  my $reply_to = $got{reply_to} if ($got{reply_to});
  my $sender = $1 if ($got{from} =~ /^.*\S\s+<([^>]+\@[^>]+\.[^>]+)>/);
  add_list($reply_to,\@rcpt);
  add_list($sender,\@rcpt);
  my @TO = $group ?  @rcpt : ($reply_to || $sender);

  # Don't send to myself
  @TO = grep($_ ne $hdrs->{from}, @TO) if $#TO>0;

  $hdrs->{to} = join(',',@TO) if @TO;

  $hdrs->{subject} = $got{subject};
  $hdrs->{subject} =~ s/^\s?re:?\s?//ig;
  $hdrs->{subject} = "Re: $hdrs->{subject}";
  $hdrs->{in_reply} = $got{message_id};
  $hdrs->{references} = $got{references};
  $hdrs->{references} .= " ".$got{message_id} if $got{message_id};

  usage("Couldn't find message #$num [$MAILBOX]") if ($cnt<$num);
}

# Make headers based on a "to:" address
sub make_headers {
  my ($hdrs,$to) = @_;
  my ($login,$domain,$Domain) = ($to);
  ($login,$domain,$Domain) = ($1,$2,$2) if $to =~ /(.+)\@(.+)/;
  $domain =~ s/\.[^\.]+$//;

  $hdrs->{to} = $to;

  $hdrs->{from} = $MAKE_HEADERS_FROM;
  $hdrs->{from} =~ s/%d/$domain/g;
  $hdrs->{from} =~ s/%D/$Domain/g;
  $hdrs->{from} =~ s/%l/$login/g;
  $hdrs->{from} =~ s/%t/$to/g;

  $hdrs->{from_full} = $DEFAULT_FROM_FULL;
  $hdrs->{MADE} = 1;
}

sub parse_args {
  my $host;
  my %hdrs;

  my $group=0;

  # DEFAULTS
  $hdrs{from} = $DEFAULT_FROM;
  $hdrs{from_full} = $DEFAULT_FROM_FULL;
  $hdrs{to} = $DEFAULT_TO;

  while ($#ARGV>=0) {
    $a=shift(@ARGV);
    if ($a =~ /^-h$/) { &usage; }
    if ($a =~ /^-d$/) { $MAIN::DEBUG=1; next; }
    if ($a =~ /^-25$/) { $MAIN::PORT25=1; next; }
    if ($a =~ /^-sendmail$/) { $MAIN::SENDMAIL=1; next; }
    if ($a =~ /^-f$/) { $hdrs{from}=shift(@ARGV); next; }
    if ($a =~ /^-F$/) { $hdrs{from_full}=shift(@ARGV); next; }
    if ($a =~ /^-t$/) { $hdrs{to}=shift(@ARGV); next; }
    if ($a =~ /^-s$/) { $hdrs{subject}=shift(@ARGV); next; }
    if ($a =~ /^-g$/) { $group=1; next; }
    if ($a =~ /^-/) { usage("Unknown option: $a"); }
    if ($a =~ /^\d+$/) { get_headers(\%hdrs,$a,$group); next; }
    if ($a =~ /\@/) { make_headers(\%hdrs,$a); next; }
    usage("You can only specify one mailhost [$a and $host]") if(defined($host));
    $host=$a;
  }
  $host=$DEFAULT_MAILHOST if(!defined($host));

  ($host,\%hdrs);
}

##################################################
# Char-by-char mode
##################################################
sub char_mode {
  my $ttyname=`/usr/bin/tty`;
  system "/bin/stty -icanon -echo min 1 < $ttyname " if (! $?);
}

sub line_mode {
  my $ttyname=`/usr/bin/tty`;
  `/usr/bin/tty -s`;
  system "/bin/stty icanon echo < $ttyname " if (! $? );
}

sub get_char {
  my $ans;
  read(STDIN,$ans,1);
  return $ans;
}

##################################################
# Get the header fields
##################################################
sub get_header {
  my ($query,$default,$just_show) = @_;

  if ($just_show) {
    print STDERR "$query: $default\n";
    return $default;
  }

  my $ret;
  print STDERR $default ? "$query [$default]: " : "$query: ";
  chomp($ret = <>);
  $ret || $default;
}

##################################################
# Get the signature file
##################################################
sub get_sig {
  my $txt;

  my $sig_file=$SIG;

  # Handle '~' in path
  $sig_file =~ s/\~/$ENV{HOME}/g if (defined($ENV{HOME}));

  # If it's a directory then pick one file
  if (-d $sig_file) {
    if (!opendir(SIG,$sig_file)) {
      print STDERR "Couldn't open sig directory: $sig_file\n";
      sleep 1;
      return "";
    }
    my @sigs=grep(!/^\.{1,2}$/,readdir(SIG));
    closedir(SIGS);
    $sig_file="$sig_file/".$sigs[int(rand(scalar(@sigs)))];
  }

  # Read the file and return the text
  if (open(SIG,"<$sig_file")) {
    $txt=join('',<SIG>);
    close(SIG);
    return $txt;
  }
  return $DEFAULT_SIG;

#  print STDERR "Couldn't open sig file: $sig_file\n";
#  sleep 1;
#  return "";
}

##################################################
# Date needs to be of the format:
#   Date: Fri, 1 Mar 2002 00:05:52 -0800
# Not what 'scalar gmtime()' returns, sadly
##################################################
use POSIX qw(strftime);
sub get_date {
#  my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime;
#  $wday = (qw(Sun Mon Tue Wed Thu Fri Sat))[$wday];
#  $mon = (qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec))[$mon];
#  $year += 1900;
#  sprintf("$wday, $mday $mon $year %0.2d:%0.2d:%0.2d",$hour,$min,$sec);
  strftime "%a, %d %b %Y %H:%M:%S %z", localtime;
}   

##################################################
# Main code
##################################################
sub main {
  my ($host,$hdrs) = parse_args();

  my $file = "${PROGNAME}.$$";
  die unless $file =~ /^([-\w.]+)$/;
  $file = $1;
  $file = "/tmp/$file";

  #########################
  # Get the mail information
  #########################
  $hdrs->{from}=get_header("From address",$hdrs->{from},$hdrs->{MADE});
  $hdrs->{from_full}=get_header("From name",$hdrs->{from_full},$hdrs->{MADE});
  $hdrs->{to}=get_header("To",$hdrs->{to},$hdrs->{MADE});
  $hdrs->{subject}=get_header("Subject",$hdrs->{subject});
  $hdrs->{date} = get_date();

  my $sig=get_sig();

  #########################
  # Create the file
  #########################
  open(FILE,">$file") || die("Couldn't write $file\n");
  # Headers
  print FILE "From: $hdrs->{from_full} <$hdrs->{from}>\n";
  print FILE "Subject: $hdrs->{subject}\n";
  print FILE "To: $hdrs->{to}\n";
  print FILE "Date: $hdrs->{date}\n";
  print FILE "X-Mailer: DaveMail [version 6.0]\n";
  print FILE "In-Reply-To: $hdrs->{in_reply}\n" if ($hdrs->{in_reply});
  print FILE "References: $hdrs->{references}\n" if ($hdrs->{references});
  print FILE "\n";
  # Body
  print FILE $hdrs->{BODY} || "EMAIL_TEXT_GOES_HERE\n";
  # Sig
  print FILE "\n$sig";
  close(FILE);

  #########################
  # Edit loop
  #########################
  while(1) {
    system("$EDITOR $file");
    print STDERR "S)end the message, E)dit it again, F)orget it (saved), X)eXit\n";
    print STDERR "\nWhat is your choice? s";
    char_mode();
    my $ans=get_char;
    line_mode();
    print "$ans\n";
    if ($ans =~ /X/i) {
      unlink($file);
      exit;
    }
    if ($ans =~ /F/i) {
      print "File saved in: $file\n";
      exit;
    }
    next if ($ans =~ /E/i);
    last if ($ans =~ /S/i || $ans =~ /\n/);
  }

  #########################
  # Get the from/to info from the file, in case it was edited
  #########################
  open(FILE,"<$file") || die("Couldn't read $file\n");
  while(<FILE>) {
    last if (/^$/);
    ($hdrs->{from_full},$hdrs->{from}) = ($1,$2) if (/^From: (.+) <(.+)>$/);
    $hdrs->{to} = $1 if (/^To: (.+)/);
  }
  close(FILE);

  #########################
  # TO is an email only version of to
  #########################
  my @to = split(/,/,$hdrs->{to});
  @to = map { s/.*<(.+)>.*/$1/;  s/\s*$//;  $_; } @to;
  $hdrs->{TO} = join(",", @to);

  #########################
  # Mail it
  #########################
  if ($MAIN::PORT25) {
    open(FILE,"<$file") || die("Couldn't open mail file! $file\n");

    open(MAIL,"|$TELNET $host 25 > /dev/null") || die("Couldn't open socket to $host\n");
    my $from_machine=$hdrs->{from};
    $from_machine =~ s/.*\@//;
    print MAIL "helo $from_machine\n";
    print MAIL "mail from: $hdrs->{from}\n";
    print MAIL "rcpt to: $hdrs->{TO}\n";
    print MAIL "data\n";
    while(<FILE>) {
      # Make sure we don't die early
      s/^\.$/. /g;
      print MAIL;
    }
    print MAIL ".\n";
    print MAIL "quit\n";
    close(MAIL);
    close(FILE);
  } elsif ($MAIN::SENDMAIL || ! -x $FORGE_PIPE) {
    system("$SENDMAIL -i -f $hdrs->{from} -F \"$hdrs->{from_full}\" $hdrs->{TO} < $file");
  } else {
    system("$FORGE_PIPE -f $hdrs->{from} -F \"$hdrs->{from_full}\" $hdrs->{TO} $file");
  }

  # Save a copy (hack!)
  if ($OUTBOUND && open(OUT,">>$OUTBOUND")) {
    if (open(MAIL,"<$file")) {
      print OUT "\nFrom $hdrs->{from} ",(scalar gmtime),"\n";
      while (<MAIL>) { print OUT; }
      close(MAIL);
    }
    close(OUT);
  }

  # Delete the file
  unlink($file);
} main();