#-*-perl-*-
#
# Copyright (C) 1992 by Gustaf Neumann, Stefan Nusser
#
#      Wirtschaftsuniversitaet Wien,
#      Abteilung fuer Wirtschaftsinformatik
#      Augasse 2-6,
#      A-1090 Vienna, Austria
#      neumann@wu-wien.ac.at, nusser@wu-wien.ac.at
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appears in all copies and that both that
# copyright notice and this permission notice appear in all supporting
# documentation.  This software is provided "as is" without expressed or
# implied warranty.
#
# Date: Mon, Apr 13 1992
# Author: Gustaf Neumann
# Version: 0.9
#

package wafe_mu;
#
# mail utilities for wafe
#
# the following procedures must be defined: 
#      &main'Xui:   low level wafe communication
#      &main'info:  update status line in the label widget named info
#      &main'sendMode:  hook for mainprogram to provide code for switching
#            sendmode on and off


$main'MailIncludePrefix = $main'MailIncludePrefix || " |> ";
$main'signatureFile = $main'opt_s || $main'signatureFile ||  "$ENV{HOME}/.elm/signature";
$main'printCommand = $main'opt_p || $main'printCommand || "mp | multi | lpr";
$main'elmAliases = $main'elmAliases || "$ENV{'HOME'}/.elm/aliases.text";
$main'localHost = $ENV{'HOST'} || 
     chop($main'localHost = `/bin/hostname`) && $main'localHost;

#
# read in signature file into global variable $wafe_mu'signature 
#
if (open(SIGNATURE,"<$main'signatureFile")) {
    undef($/); $signature = <SIGNATURE>; $/="\n";
    close(SIGNATURE);
}

#
# maps a name into a foldername
#
sub folderName {
    local($Type,$_) = @_;
    return $_ if m/^[\.\/\|].*/;	# it is a path or a pipe
    return "$ENV{HOME}/$1"  if m/^\~\/(.*)/; # it starts with a tilde slash
    return (getpwnam($1))[7] . $2 if (m/^\~(\w+)(\/.+)/);  # it starts with a tilde name slash
    local($incoming) = "$ENV{HOME}/$Type/$_";
    unless((-d "$ENV{HOME}/$Type") || mkdir("$ENV{HOME}/$Type",0755)) {
                      &main'info("cannot create incoming directory $incoming");
               }
    return $incoming;    # must be in the mail- or news-directory
}

sub mailDateNow {
    local($_);
    undef $ENV{'LANG'};
    chop($_ = `/bin/date`);
    local($wday,$month,$day,$time,$tz,$dst,$year) = split;
    $year = $dst if !$year;
    local($yearNC) = $year % 100;
    return "$wday, $day $month $yearNC $time $tz";
}

sub widgetContent {
    local($filename,$widget) = @_;
    local($ds,$content) = ($/);

    &main'Xui("asciiSaveAsFile $widget $filename;echo done");
    $_ = <STDIN>; # we have to wait, until the file is saved!

    undef $/;   open(F,"<$filename") && ($content = <F>) && close(F);  $/ = $ds;

    $content;
}

sub printArgInto {
    local($article,$target) = @_;
    open(PRINT,$target) &&
	((print PRINT $article), close(PRINT), return 1)|| return 0;
}

sub fromHeader {
    local($_);
    undef $ENV{'LANG'};
    chop($_ = `/bin/date`);
    local($wday,$month,$day,$time,$tz,$year) = split; 
   "\nFrom $_[0] $wday $month $day $time $year\n$_[1]";
}

sub TeXencode {
    local($_) = @_;
    local($count);
    $count += s/ä/{\\"a}/g;     $count += s/ö/{\\"o}/g;     $count += s/ü/{\\"u}/g;
    $count += s/Ä/{\\"A}/g;     $count += s/Ö/{\\"O}/g;     $count += s/Ü/{\\"U}/g;
    $count += s/ß/{\\"ss}/g;
    s/\n\n/\nX-Encoding: TeX\n\n/ if $count;
    $_;
}
sub TeXdecode {
    local($_) = @_;
    s/{\\"a}/ä/g;     s/{\\"o}/ö/g;     s/{\\"u}/ü/g;
    s/{\\"A}/Ä/g;     s/{\\"O}/Ö/g;     s/{\\"U}/Ü/g;
    s/{\\"ss}/ß/g;
    $_;
}

sub exclusiveLock {
    local($fh) = @_;
    eval 'flock($fh,2);';
    fcntl($fh,7,pack('sslll',2,0,0,0,0)) if $@ =~ /unimplemented/;   #hpux
}
sub unLock {
    local($fh) = @_;
    eval 'flock($fh,8);';
    fcntl($fh,7,pack('sslll',3,0,0,0,0)) if $@ =~ /unimplemented/;   #hpux
}

# send a mailmessage 
# in the asciiTextwidget $widget 
# by saving its contents into $filename to check headers
# the maildistribution is done via /usr/lib/sendmail 
# returns 1 on success or 0 on failure
#
sub send {
    local($filename,$widget) = @_;
    local($date,$address,$toaddr,$theMail,$allAdresses,$_,$target,$header);

    $theMail = &widgetContent($filename,$widget);

    $header = (split(/\n\s*\n/,$theMail))[0];
    $*=1; $header =~ s/\n\s+/ /g; $* = 0;

    $date = $address = "";
    for (split("\n",$header)) {
	last if ! $_;
	$address .= ",$1", $adressedTo = $1 if m/^To: *(.*)/;
	$address .= ",$1" if m/^Cc: *(.*)/;
	$address .= ",$1" if m/^Bcc: *(.*)/;
	$date = $1 if m/^Date: *(.*)/;
    }
       
    if (!$address) { &main'info("Mail has Invalid Header, To-Field is missing"); return(0);}
    if (!$date) { &main'info("Mail has Invalid Header, Date-Field is missing"); return(0);}

    $theMail =~ s/^Bcc: .*//;
    $theMail = &TeXencode($theMail);
        
    $allAdresses = "";
    for (split(/[,]/,$address)) {
	$toaddr = join(' ',(&resolveAliases($_))); 
#	print "alias of <$_> returns <$toaddr>\n";
	($name,$toaddr) = &nameAddress($_) if ! $toaddr;
	if ($toaddr) {
	    $allAdresses .= "$toaddr ";
	};
    }			       
    
    &main'info("sending mail message ...");
    open(MAIL, "|/usr/lib/sendmail -oi $allAdresses") ||
	(&main'info("can't execute /usr/lib/sendmail"), return(0));
    print MAIL $theMail;
    close(MAIL);
    &main'info("mail message sent to $allAdresses");

    &main'sendMode(0);
    $adressedTo =~ m/(\w+)@?.*/;
    $target = &folderName("Mail",$1);

    &printArgInto(&fromHeader($ENV{'USER'},$theMail),">> $target");
}

sub resolveAliases {
    local($a,%sofar) = @_;
    local(@aliases,@local);
#    print "$a is aliased as $alias{$a}\n" if $alias{$a};
    for $k (split(/[, ]/,$alias{$a})) {
	next if $sofar{$k};
	@local =&resolveAliases($k,$a,1,%sofar);
	@local = ($k) if !@local;
#	print "local = ",join(' ',@local),"\n";
        push(aliases,@local);
    }
    @aliases;
}

#
# returnMail
# composes a new mail message from an existing one
# in file $filename in $widget, where $type is "reply" or "forward"
# $urgent is boolean; 

sub returnMail {
    local($filename,$widget,$type,$urgent,$from,$cc,$subject,$date,$mailbody) = @_;
    local($name,$fromaddr,$fullfromaddr);

    ($name,$fromaddr)=&nameAddress($from);
    $fullfromaddr = $name ? "$fromaddr ($name)" : $fromaddr;

    open(MAILTEXT,">$filename") || 
	(&main'info("can't open $filename for writing"), return(0));

    if ($type eq "reply") {
	print MAILTEXT "Subject: ".($subject =~ /^[Rr]e:/ ? $subject : "Re: $subject")."\n"
                  if $subject;
	print MAILTEXT "To: $fullfromaddr\n";
	print MAILTEXT "Cc: $cc\n" if $cc;
	print MAILTEXT "Priority: Urgent\n" if $urgent;
	print MAILTEXT "Date: ", &mailDateNow(), "\n\n",
 		   "In your message from [$date] you wrote:\n";
    } else {
	print MAILTEXT "Subject: [forwarded] $subject\n";
	print MAILTEXT "To: \n";
	print MAILTEXT "Priority: Urgent\n" if $urgent;
	print MAILTEXT "Date: ", &mailDateNow(), "\n\n",
 		   "Forwarded message from [$fullfromaddr]:\n";
     }
     for (split("\n",$mailbody)) {print MAILTEXT "$main'MailIncludePrefix$_\n";} 
     print MAILTEXT "\n\n--\n$signature" if $signature;
     close(MAILTEXT);

     &main'Xui("sV $widget type file string $filename");
     &main'sendMode(1);
     if ($type eq "reply") {
	&main'Xui("callActionProc $widget {} forward-paragraph");
	&main'Xui("callActionProc $widget {} next-line");
	&main'Xui("callActionProc $widget {} next-line");
     } else {
	&main'Xui("callActionProc $widget {} next-line");
	&main'Xui("callActionProc $widget {} end-of-line");
     }
    return 1;
}

#
# split name and address of a From:-line
#
sub nameAddress {
    local($address) = @_;
    local($name,$addr) = ();
    ($name,$addr) = ($2,$1) if ($address =~ m/^([^(]*)\s+\((.*)\)\s*$/); 
    ($name,$addr) = ($1,$2) if ($address =~ m/^(.*\S)\s*<(.*)>.*/);
    $addr = $address if !$addr;
    ($name,$addr);
}





if (open(ELMALIASES,"<$main'elmAliases")) {
    while(<ELMALIASES>) {
	if (/(.*) = (.*) = (.*)/) { 
#	    ($nick,$name,$mail) = ($1,$2,$3) ; 
#	    $alias{$nick} = "$mail ($name)";
	     $alias{$1} = $3;
#	     print "<$1> means <$3>\n";
	}
    }
    close(ELMALIASES);
}

1;
