#!/usr/bin/perl
# $Id: sfax.pl,v 1.1 1994/06/22 06:40:52 agl Exp agl $
# /usr/local/bin/sfax.pl

sub aexit {
#    unlink($topgp);
    ($status)=@_;
    exit $status;
}
push(@INC,"/usr/local/lib/apc"); require("alib.pl");
sub routecash {
    print ABORT "--DEBUG-- sfax.pl: routing $_[0] to $_[1].\n";
    local($pages,$dest,$from)=@_;
    if(!open(ROUTE, "<$faxrouteout")) {
	print ABORT "--ERROR-- sfax.pl: can't open fax routing file.\n";
	&aexit(-1);
    }
    while(<ROUTE>) {
	next if /^#/; local($service,$modifier,$cost,$regexp,$cmd,$transform) =
	    split(/[\t ]+/);
	if( $dest =~ /$regexp/ ) {
	    if   ($cost==3) { $fpc = 2.60; $npc=2.51; }
	    elsif($cost==4) { $fpc = 0.45; $npc=0.40; }
	    elsif($cost==5) { $fpc = 1.60; $npc=1.50; }
	    else {
		print ABORT "--ERROR-- sfax.pl: can't find cost $cost.\n";
		&aexit(-1);
	    }
	    close(ROUTE);
	    $credit=$fpc+($pages-1)*$npc; print ABORT "cr: $credit\n";
	    return $credit;
	}
    }
    print ABORT	"--WARNING-- sfax.pl: no regexp match for the fax to $dest.\n";
    $tty="|/usr/bin/smail ".$from; # $tty = ">/dev/tty";
    if(!open(TTY,$tty)) {
	print ABORT	"--WARNING-- sfax.pl: can't open TTY!\n";
    }
    print TTY "
--- Route to $dest is UNKNOWN! Fax to the $dest won't sent ---
Sincerely, 
GlasNet fax delivery subsystem
";
    close(TTY);
    return -1;
}
open(ABORT, ">/dev/console") ||
    system("echo 'sfax.pl: Can't open /dev/console!'|smail root");
if (chdir($faxdir) != 1) {
	print ABORT "--ERROR-- sfax.pl: can't cd to $faxdir.\n";
	&aexit(-1);
}
#------------- Now bill the user
if(!open(MESG, "<$ARGV[0]")) {
    print ABORT "--ERROR-- sfax.pl: can't open source for reading.\n";
    &aexit(-1);
}
while(<MESG>)
{
    goto parse if /^To\s*:\s*(.*)$/i;
    goto parse if /^Cc\s*:\s*(.*)$/i;
    goto parse if /^Bcc\s*:\s*(.*)$/i;
    $from=$1   if /^From\s*:\s*(.*)$/i;
    $subject=$1 if /^Subject\s*:\s*(.*)$/i;
    last if /^$/;
    next;
  parse:;
#    $ST =~ s/\D//g;
    foreach(split(/[\s,]+/,$1)) { $_ =~ s/\D//g; next if /^$/;
				   push(@faxes, $_);
    }
}
if(!$from)
{
    print ABORT "--ERROR-- sfax.pl: From: is NOT found\n";
    &aexit(-1);
}
if(!open(JUSTBODY, ">$justbody")) {
    print ABORT "--ERROR-- sfax.pl: can't open file JUSTBODY for writing.\n";
    &aexit(-1);
}
# --- writing down the file with the valid fax# only
if(!open(TOPGP, ">$postpgp")) {
    print ABORT "--ERROR-- sfax.pl: can't open file TOPGP for writing.\n";
    &aexit(-1);
}
print TOPGP "Subject: $subject" if($subject);
print TOPGP "From: $from" if($from);
print TOPGP "To: "; @mesg=<MESG>;
close(MESG); $flag=0; $counter=@mesg;
$pages=1;
if( $counter > $firstpage)
{
    $pages += ($counter+$nextpage-1)/$nextpage;
}
    print ABORT "--DEBUG--$pages pages $counter lines.\n";
foreach(@faxes) { $t=$_;
    print ABORT "--DEBUG--from $from to $_.\n";
    if( ($status = &routecash($pages,$_,$from)) > 0) {
	print TOPGP ',' if($flag++);
	print TOPGP $t;
	&charge($from, "--FAX--", $status);
    }
}
print TOPGP "\n\n";
print TOPGP @mesg;
close(TOPGP);
#-------------------
#if (system ($pgp, '-sa', $postpgp) != 0) {
#    print ABORT "--ERROR-- sfax.pl: pgp signature FAILED.\n";
#    &exit(-1);
#}
#if (system ("cat $postpgp.asc|uux -gD - $faxsys!rfaxpgp `uname -n`")!=0) {
#    print ABORT "--ERROR-- sfax.pl: uux FAILED.\n";
#    &aexit(-1);
#}
unlink $ARGV[0], $signed; # Cleaning up the original and signed
&aexit(0);
