#!/usr/bin/perl -w
#The aim of this program is to make reading email convenient by 
#making the common things simple. For example, for me, 90% of the
#time an email I receive is plain text and has no attachments, and
#if I need to reply to it, I will only really want to whip up a 
#few text lines myself. This program lets you immediately see,
#read, and reply to such emails without having to start up your
#full mail client.
#
#This program is intended to be run when you have new mail, or to
#check if you have new mail. If you do, it will pop up a window 
#telling you so, and give you the option of viewing a list of the 
#messages in your inbox. From the list you can quickly popup a 
#window with the text of any email message, or start your full 
#mail client (if it is set in the environment variable MAILCLIENT)
#
#program name: porkmail
#author: Chris Sincock
#license: GPL
#version: 1.1
#requires: pgprompt version 1.3 or greater (and pgprompt requires perl-gtk)

#Bugs:
#- If any lines are too long, including headers, the call to sendmail below 
#  wraps them but only inserts a linefeed, instead of a CR LF combination. 
#  The solution may be to do the wrapping myself, but I have yet to check 
#  out exactly what is happening.
#- Replying to a message does not work if you are not viewing the message
#  with headers showing
#
#Todo:
#- command line handling of an extra argument after 'compose' so that you can 
#  specify the body, ie so that it can be scripted to send emails
#- include a compose button somewhere
#- poll command line option which makes it sleep and chekc mailbox every
#  so often, then pop up as normal when new mail arrives
#- need to add sent mail to Sent mailbox
#- perhaps have a 'mail sent ok' box or something

#Changelog:
#v1.1 20 Nov 2002
# Added With Headers/No Headers options to viewMessage
# Now strips quotes out of the from address before viewing message

my $programName="porkmail";
my $programVersion="1.1";
my %prefs=();
my $prefsFile=$ENV{"HOME"}."/.porkmailrc";
my $mailbox=$ENV{"MAIL"};
#"/var/spool/mail/".$ENV{"USER"};
my $true=1;
my $false=0;

my $DEBUG=0;
my $tmpsummaryfile="/tmp/.porkmailtmp-summary";
my %mailboxData=();
my @messages=();

sub debug
{
    if($DEBUG)
    {
	print STDERR @_;
    }
}

sub readPrefs
{
    open(PREFS,"<$prefsFile");
    foreach my $line (<PREFS>)
    {
	if($line =~ /^([^\#][^=]*)=(.*)$/)
	{
	    $prefs{$1}=$2;
	    debug "pref:$1=$2\n";
	}
    }
    close PREFS;
}

sub writePrefs
{
    open(PREFS,">$prefsFile");
    foreach my $key (keys %prefs)
    {
	print PREFS "$key=$prefs{$key}\n";
    }
    close PREFS;
}

sub parseMailbox
{
    my ($from,$subject,$number,$blankline,$delivery,$deliveryline,$subjectline);
    my $summaryString="";
    $blankline=0;
    open(BOX,"egrep -n '^(From .*|From: .*|Subject: .*|)\$' $mailbox |");
    foreach my $line (<BOX>)
    {
#	debug("##########$line");
	if($line =~ /^(\d\d*):$/)
	{
	    $blankline=$1;
	    if($delivery)
	    {
		if(! ($from && $subject))
		{
		    debug("warning: missing From or Subject headers\n");
		}
		else
		{
		    $body=$blankline;
		}
	    }
	}
	elsif($line =~ /^(\d\d*):(From )(.*)$/)
	{
	    $deliveryline=$1;
	    if($blankline != $deliveryline -1 )
	    {
		debug("warning: Blank line/delivery line mismatch: line $1\n");
		next;
	    }
	    $delivery=$3;
	}
	elsif($line =~ /^(\d\d*):(From|Subject): (.*)$/)
	{
	    if($2 eq "From")
	    {
		if(!$delivery)
		{
		    #debug("warning: Delivery/From line mismatch: line $1\n");
		    next;
		}
		if($from)
		{
		    debug("warning: duplicate From lines: line $1\n");
		}
		$from=$3;
	    }
	    elsif($2 eq "Subject")
	    {
		if(!$delivery)
		{
		    #debug("warning: Delivery/Subject line mismatch: line $1\n");
		    next;
		}
		if($subject)
		{
		    debug("warning: duplicate Subject lines: line $1\n");
		}
		$subject=$3;
		$subjectline=$1;
	    }
	}
	if($delivery && $from && $subject && $body)
	{
		$number++;
		$mailboxData{$number."-line"}=$deliveryline;
		$mailboxData{$number."-from"}=$from;
		$mailboxData{$number."-subject"}=$subject;
		$mailboxData{$number."-summary"}=$from.": ".$subject;
		$mailboxData{$number."-body"}=$body;
		my $msgline=$number." $from : $subject";
		#print $msgline."\n";
		$summaryString.=$msgline."\n";
		push(@messages,$msgline);
		$from=undef;
		$subject=undef;
		$blankline=undef;
		$delivery=undef;
		$body=undef;
	}
    }
    $mailboxData{"msgcount"}=$number;
    close BOX;
    return $summaryString;
}

#returns 1 if the program was started
sub maybe_start_program
{
    my ($program)=@_;
    my $user=$ENV{"USER"};
    my $pid=`ps -wef | grep "$user " | grep ' $program ' | grep -v grep | awk '{print \$2}'`;
    chomp $pid;
#    print "pid:$pid\n";
    if($pid)
    {
	my $choice=`pgprompt ask TITLE="Start $program?" "MESSAGE=$program seems to be already running.\nAre you sure you wan't to start it?" BUTTONS="Yes No" CANCEL="" CANCELBUTTON="No"`;
	chomp $choice;
	if($choice ne "Yes")
	{
	    return 0;
	}
    }
    system("/bin/sh","-c","$program &");
    return 1;
}

sub viewBox
{
    my $width=500;
    my $mailClient=$ENV{"MAILCLIENT"};
    my $buttons="Exit/View";
    if($mailClient)
    {
	$buttons.="/Start $mailClient";
	$width=600;
    }
    my $choice=`cat "$tmpsummaryfile" | pgprompt list LISTSEP="\n" LISTSELECTION=browse OKBUTTON=View BUTTONSEP=/ BUTTONS="$buttons" CANCELBUTTON="Exit" CANCEL="" WIDTH=$width HEIGHT=300 LISTNUM=1 TITLE="New Mail" MESSAGE="You have mail" LIST="-"`;
    chomp $choice;

    if($choice)
    {
	if($choice =~ /^Start/)
	{
	    my $started=maybe_start_program($mailClient);
	    if(!$started)
	    {
		&viewBox;
	    }
	}
	elsif($choice eq "View")
	{
	    #no message item was selected, just pop up the list view again
	    &viewBox;
	}
	elsif($choice =~ "^View\n")
	{
	    my @choices = split "\n", $choice;
	    shift @choices; #throw away the first line
	    $choice=shift @choices;
	    viewMessage($choice,$false);
	    &viewBox;
	}
    }
 }   

sub viewMessage
{
    my ($number,$showHeaders)=@_;
    my $msgcount=$mailboxData{"msgcount"};
    my $summary=$mailboxData{$number."-summary"};
    my $lines=`wc -l $mailbox | awk '{print \$1}'`;
    my $deliveryline=$mailboxData{$number."-line"};
    my $tailLines="";
    my $bodyline=$mailboxData{$number."-body"};
    my $topline=$showHeaders ? $deliveryline : $bodyline+1;
    if($number == 1 && $msgcount == 1 && $topline == 0)
    {
	$cmd = "cat $mailbox";
    }
    elsif($number == 1 && $showHeaders)
    {
	my $nextmsgline=$mailboxData{( $number+1)."-line"};
	$cmd = "head -".($nextmsgline-1)." $mailbox";
    }
    elsif($number == $msgcount)
    {
	$tailLines=$lines-$topline+1;
	$cmd = "tail -$tailLines $mailbox ";
    }
    else
    {
	my $nextmsgline=$mailboxData{( $number+1)."-line"};
	$tailLines= $nextmsgline-$topline;
	$cmd = "head -".($nextmsgline-1)." $mailbox | tail -$tailLines";
    }

    $summary =~ s/\"//g;
    my $buttons = "Close/".($showHeaders?"No":"With")." Headers/Reply";
    
    my $choice = `pgprompt text TEXTREADONLY=1 "SELECTED=$cmd |" WIDTH=600 HEIGHT=400 "BUTTONS=$buttons" BUTTONSEP=/ "MESSAGE=$summary"`;
    chomp $choice;
    if ($choice =~ /Headers$/)
    {
       viewMessage($number,!$showHeaders);
    }
    elsif ($choice eq "Reply")
    {
	replyToMessage($number);
    }
}
sub replyToMessage($)
{
    my ($number)=@_;
    my $tmpmsg="/tmp/.porkmail-".$ENV{"USER"}."-compose";
    my $from= $mailboxData{$number."-from"};
    my $subject = $mailboxData{$number."-subject"};
    my $youWrote=$prefs{"youWroteString"};
    if(! $subject =~ /^[Rr][eE][:]/)
    {
	$subject = $prefs{"responsePrefix"} . $subject;
    }
    open (MSG,"$cmd |");
    @lines=<MSG>;
    close MSG;
    chomp @lines;
    
    open(COMPOSE,">$tmpmsg");
    my $headers="";
    
    $headers.= "From: ". $prefs{"email"} ."\n";
    $headers.= "To: " . $from . "\n";
    $headers.= "Subject: $subject\n";
    $headers.= "\n\n\n";
    
    print COMPOSE $headers;
    
    my $cursorPos=length($headers) -2;
    my $gotblank=$false;
    my %headers=();
    foreach my $line (@lines)
    {
	if($gotblank)
	{
	    print COMPOSE $prefs{"quoteString"}.$line."\n";
	}
	elsif(! $line)
	{
	    $gotblank=$true;
	    print COMPOSE $youWrote."\n";
	}
	elsif($line =~ /^([^:][^\s:]*)[:][\s]*(.*)$/)
	{
	    $headers{$1}=$2;
	    my $key=$1;
	    my $val=$2;
	    $youWrote =~ s/%${key}/${val}/;
	}
    }
    close COMPOSE;
    composeMessage("Reply to $from",$tmpmsg,$cursorPos);
}

sub composeNewMessage($$)
{
    my ($to,$subject)=@_;
    if(! $to)
    {
	$to="";
    }
    if(! $subject)
    {
	$subject="";
    }
    my $tmpmsg="/tmp/.porkmail-".$ENV{"USER"}."-compose";
    my $headers="";
    
    $headers.= "From: ". $prefs{"email"} ."\n";
    $headers.= "To: " . $to . "\n";
    $headers.= "Subject: ".$subject."\n";
    $headers.= "\n\n\n";
    #print $headers;
    open(COMPOSE,">$tmpmsg");
    print COMPOSE $headers;
    close COMPOSE;
    my $cursorPos=length($headers) -2;
    
    composeMessage("Compose",$tmpmsg,$cursorPos);
}

sub composeMessage($$$)
{
	my $edit=1;
	my ($title,$filename,$cursorPos)=@_;
	while($edit)
	{
	    $edit=0;
	    #print $title."\n";
	    #print $cursorPos."\n";
	    #print $filename."\n";
	    my $choice=`pgprompt text TITLE="$title" CURSORPOS=$cursorPos WIDTH=500 HEIGHT=600 BUTTONS="Cancel Send" SAVETEXT="$filename" "SELECTED=cat $filename|"`;
	    chomp $choice;
	    
	    if($choice eq "Send")
	    {
		my $sendlog=$ENV{"HOME"}."/.porkmail-sendlog"; 
		my $smtp_server=$prefs{"outgoingMailServer"};
		#make sure the message ends with a linefeed.
		`echo >> $filename`;
		my $result=smtp_pl($filename,$smtp_server,$sendlog);
		if(!$result)
		{
		    $choice=`pgprompt tell TITLE=Error MESSAGE="Sorry an error occurred." BUTTONS="Cancel Edit"`;
		    chomp $choice;
		    if($choice eq "Edit")
		    {
			$edit=1;
		    }
		}
	    }
	}
}


sub showVersion()
{
   print "$programName version $programVersion\n";
}


sub usage()
{
    showVersion;
    print qq{usage: $programName [-version|-help|new|view|check|showcheck]

parameters:
  -help: shows this help
  -version: shows the version number
  check: checks if there is new mail and if so, shows a popup giving 
         options to view a summary or exit.
  showcheck: like check, execpt that if there is no new mail, a popup is
         shown saying 'no new mail'
  view: go straight to the window showing a summary of your inbox
  new: immediately shows the popup window that the check option would
       show if there was new mail. ie it simulates new mail.
  
};
}


##################################################
#the work starts here

readPrefs;

my $cmd="check";

if(@ARGV)
{
    $cmd=shift @ARGV;
}
if($cmd =~ /^(help|-h|-help|--help|--h)/)
{
    usage;
    exit(0);
}
elsif($cmd =~ /^(-v|-version|version|--v|--version)/)
{
    showVersion;
    exit(0);
}
elsif($cmd =~ /^(check|showcheck)$/)
{
   my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks)
	= stat($mailbox);
   my $checktime=$prefs{"lastcheck"};

   if($checktime)
   {
       if($checktime > $mtime)
       {
	   if($cmd eq "showcheck")
	   {
	       system('pgprompt tell WIDTH=200 MESSAGE="No new mail."');
	   }
	   exit(0);
       }
   }
    $prefs{"lastcheck"}=time();
    writePrefs;
    
   if($size)
   {
       $cmd="new";
   }
}
elsif( $cmd =~ /^(new|view|compose)$/)
{
    #these two options are OK
    ;
}
else
{
    print STDERR "unrecognised parameter: $cmd\n";
    usage();
    exit(-1);
}

if($cmd eq "new")
{
    my $width=200;
    my $mailClient=$ENV{"MAILCLIENT"};
    my $buttons="Exit/Summary";
    if($mailClient)
    {
	$buttons.="/Start $mailClient";
	$width=300;
    }

    my $choice=`pgprompt ask MESSAGE="You have mail." WIDTH=$width BUTTONSEP=/ BUTTONS="$buttons"`;
    chomp $choice;
    if ($choice eq "Summary")
    {
	$cmd = "view";
    }
}
if($cmd eq "compose")
{
    my ($to,$subject)=@ARGV;
    composeNewMessage($to,$subject);
}
if($cmd eq "view")
{
    $list=parseMailbox;
    open(TMPFILE,">$tmpsummaryfile");
    print TMPFILE "$list";
    close(TMPFILE);
    viewBox;
}


use strict;
use Mail::Internet;
use Mail::Sendmail;



#this is  smtp.pl (found on the net)
#incorporated into one subroutine, and with a file specified instead 
#of reading stdin
sub smtp_pl($$)
{
    my ($filename,$mailServer,$sendlog)=@_;
    
#set output buffering ie force flushing after every write
    $|=1;
    
    my $mail;
    my $body;
    my $head;
    my %headers=();
    my $header;
    my @header_tags=();
    my $mailer;
    my $msg_line='';
    my %mailcfg=();
    my $mda_tag="Mail::Internet Mail::Sendmail Sendmail +mmhack 1.1 on Linux";
    my $rc;
    my $cc='';
    my $bcc='';
    my $date='';

    
# set my custom MDA tag
    $mailcfg{'X-MDA'}="$mda_tag";
    $mailcfg{message}='';
    $mailcfg{smtp}=$mailServer;
    
# accumulate the mail in mail object

    open (MAILHANDLE, "<$filename");
    $mail=new Mail::Internet [<MAILHANDLE>];
    
# get the head object from the mail object
    $head=$mail->head();
    
# get the body array reference
    $body=$mail->body;
    
# get all the header tags
    @header_tags=$head->tags();
    
    foreach $header (@header_tags)
    {
	my $tmp=$head->get("$header");
	chomp($tmp);
	
	# In-Reply-To created my mutt causes trouble if the mail is sent via
	# qmail. As the line contains a;, the module creates an empty LF.
	# look at: http://cr.yp.to/docs/smtplf.html
	# -- muquit@muqit.com, Jun-13-2000
	#
	# well in mutt, I changed set in_reply_to="%i" so no need to remove it
	# here  -- muquit@muquit.com, Jul-14-2000
##    next if ($header eq "In-Reply-To");
	
	$headers{$header}=$tmp;
	$mailcfg{$header}=$tmp;
    }
    
    $cc=$headers{'Cc'};
    $bcc=$headers{'Bcc'};
    $date=localtime();
    
# log
    foreach $msg_line (@{$body})
    {
	$mailcfg{message} .= $msg_line;
    }
    
# send the mail via SMTP
    $rc=sendmail(%mailcfg);
    
# open the log file
    open(FD,">>$sendlog");
    
# if exits with an non-zero exit code, mutt will catch the error. if $rc is
# 0, exit with  1 to tell mutt an error
# muquit@muquit.com, Jun-13-2000
    if (! $rc)
    {
	print STDOUT "$Mail::Sendmail::error\n";
	if($headers{'In-Reply-To'})
	{
	    print FD "XX In-Reply-To: $headers{'In-Reply-To'}\n";
	}
	close(FD);
	return $rc;
    }
    else
    {
	print FD "To: $headers{'To'}\n";
	print FD "Date: $date\n";
	print FD "Subject: $headers{'Subject'}\n";
	print FD "Cc: $cc\n" if $cc;
	print FD "Bcc: $bcc\n" if $bcc;
	print FD "\n";
	
	close(FD);
	
	return $rc;
    }    
}