#! /usr/bin/perl
# Modtool 2.0 - all purpose PERL / UNIX moderation tool
# (C) Christian Alice Scarborough 1996
# Redistributable under the terms of the Gnu Public License (GPL)
# See the file COPYING for details

$version="2.0";
use Socket;

$validkeywds = "datafile savefile wd sigfile rejfile pager editor datecmd"
   . " outaddr maillist nomodcheck poster news_host post_host ihave modgroup"
   . " approved from_kludge extraheaders mailer mail_host hostname"
   . " from replyto modgroupdomain rejsub BSD_STYLE digest digfrom"
   . " digcfg digprefix digdir diginterval digthreshold digonly"
   . " digto digreplyto arepfrom arepreplyto arepsub arepfile arepcfg"
   . " arepincsig arepincmail pgpmoose dighdrfile dignoauto savedir";

@reqkeywds = ("datafile", "savefile", "wd", "sigfile", "rejfile",
   "pager", "editor", "datecmd", "from", "rejsub");

@day = ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat");
@month = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", 
          "Jul", "Aug", "Sep", "Oct", "Nov", "Dec");
@daysuf = ( "ww", "st", "nd", "rd", "th", "th","th", "th", "th", "th", 
            "th", "th", "th", "th", "th", "th", "th", "th", "th", "th", 
            "th", "st", "nd", "rd", "th", "th","th", "th", "th", "th",
            "th", "st");

$validargs = "f c d r";

# Program starts here

# Process arguments
$args = join(" ", @ARGV);
argcheck($args);

while ($0 =~ /\//go) {
  $mtpath = $`;
}

if ($args =~ /-f /) {
    ($mtcfg, $wibble) = split(/ /, $', 2);
} elsif (defined($ENV{MODTOOLRC})) {
    $mtcfg = $ENV{MODTOOLRC};
} else {
    $mtcfg = ".modtoolrc";
}

if (-e $mtcfg) {
#   That's fine, do nothing    
} elsif (-e "./$mtcfg") {
    $mtcfg = "./$mtcfg";
} elsif (-e "$ENV{HOME}/$mtcfg") {
    $mtcfg = "$ENV{HOME}/$mtcfg";
} elsif (-e "$mtpath/$mtcfg") {
    $mtcfg = "$mtpath/$mtcfg";
} else {
    die "Unable to find config file $mtcfg";
}

readcfg($mtcfg, $validkeywds, @reqkeywds);
if (!defined($hostname)) {
   $hostname=`hostname`;
   chop $hostname;
}
$nomodcheck = 1 if (defined($maillist));
$sigfile = $wd."/".$sigfile;
$rejfile = $wd."/".$rejfile;
diginit() if (defined($digest));
$post_host = $news_host if (defined($news_host) && !defined($post_host));

if (defined($extraheaders)) {
    $extraheaders =~ s/\\n/\n/go;
}

# Clean up any temporary files left lying around
`rm $wd/.mttmp* 2>&1 > /dev/null`;

# Check if being invoked to cancel articles
if ($0 =~ /cancel\Z/ || $args =~ /-c/) {
    cancelarticle();
    exit(0);
}

# Read sig file
$sigtext = readfile($sigfile);
$sigtext =~ s/\s+$//o;
$sigtext .= "\n";

# Check if being invoked as an auto-reply program
if ($0 =~ /reply\Z/ || $args =~ /-r/) {
    autoreply();
    exit(0);
}

# Also see if we're in digest creation mode
if ($0 =~ /digest\Z/ || $args =~ /-d/) {
    digestgroup();
    exit(0);
}

# if file is empty, quit.
if (-z $datafile) {
    print "No messages waiting in $datafile.\n";
    exit 0;
}

# Read the rejections data - it will read as many as you put in, but
# only the first ten are used
$rejnum = 0;
open(REJ, $rejfile) || die "Unable to open file: $rejfile";
while (<REJ>) {
   ($rejfilename[$rejnum], $rejdesc[$rejnum]) = split(/ /,$_, 2);
   $rejnum++;
}
$rejnum--;
close(REJ);

# Read the rejections files themselves
for ($i = 0; $i <= $rejnum; $i++) {
   $rejtext[$i] = readfile($wd.$rejfilename[$i]);
}

# Get moderated group names
getmodgroups() if (!defined($nomodcheck));

# Make a backup of file
print `cp $datafile $datafile.bak` && die "Unable to backup submissions file";

$lastpost = countposts($datafile);

# display posts and decide what to do with them
POST: for ($curpost = 1; $curpost <= $lastpost; 
      $curpost = (($curpost == $lastpost) && $lastpost > 0) 
               ? $lastpost : $curpost+1) {
#   Send this post to the pager
    open(PAGER, "|$pager") || die "Unable to spawn pager $PAGER: $!";
    local $SIG{PIPE} = sub { die "spooler pipe broke" };
    print PAGER $message = readpost($datafile, $curpost);

    close PAGER;

#   Get a key
    do { 
        print "\nPost ".$curpost." of ".$lastpost.".";
        print "\n(A)ccept, (R)eject, (S)ave, (J)unk, re(D)isplay, (P)revious, (N)ext, (Q)uit: "; 
        $command = lc(inputchar());

        if (!($command cmp "q")) {last POST} 
        if (!($command cmp "d")) {redo POST}
        if (!($command cmp "a")) {
            post() || next POST;
        }    
        if (!($command cmp "r")) {
            reject() || next POST;
        }
        if (!($command cmp "s")) 
{
            print `ls -C $savedir`;
            print "\nSave to file [$savefile] ? ";
            $outfile = <STDIN>;
            chop $outfile;

            $outfile = $savefile if ($outfile eq "");
            if (index($outfile, "/") != 0 && defined($savedir)) {
                $outfile = "$savedir/$outfile";
            }

            $keyval = "y";
            if (!-e $outfile) {
                $keyval = "";
                while ($keyval ne "y" && $keyval ne "n") {
                    print "\nFile $outfile does not exist.  Create (y/n)?";
                    $keyval = lc(inputchar());
                }
            }

            if ($keyval eq "y") {

                open(SAVE, ">>$outfile")
                   || die "Unable to write to $outfile: $!";
                $message =~ s/\s+$//;
                print SAVE "$message\n\n";
                close SAVE;
                delpost($datafile, $curpost);
                print "Post saved to $outfile";
                print "\nPress any key to continue: ";
                inputchar();
                next POST;
            } else {
                print "Save cancelled.\n";
            }           
        }
        if ($command eq "n") {
            if ($curpost == $lastpost) {
                print "Already on last post\n";
            } else {
                next POST;
            }
        }
        if ($command eq "p") {
            if ($curpost == 1) {
                print "Already at first post\n";
            } else {
                $curpost -= 2;
                next POST;
            }
        }
        if (!($command cmp "j")) {
            print "\nConfirm deletion (y/n)? ";
            $command = lc(inputchar());
            if (!($command cmp "y")) {
                delpost($datafile, $curpost);
                next POST;
            } 
        }        
    } while(1);   
}

# This subroutine to get a key input comes direct from the Perl man pages
# It works by magic, so don't ask me to fix it.

sub inputchar {
    if ($BSD_STYLE) {
        system "stty cbreak </dev/tty >/dev/tty 2>&1";
    }
    else {
        system "stty", '-icanon', 'eol', "\001"; 
    }
    $key = getc(STDIN);
    if ($BSD_STYLE) {
        system "stty -cbreak </dev/tty >/dev/tty 2>&1";
    }
    else {
        system "stty", 'icanon', 'eol', '^@'; # ascii null
    }
    print "\n";
    $key;
}

# This subroutine posts the accepted article
sub post {
    my $retval = 0, $discard, $body, $mailartto = "";
    readheaders($message);
    my $post = "";
    my $artfile = "";
    my($t1,$t2);

#   Prepare article for posting by creating new headers
    if (!defined($from_kludge)) {
        $post .= "From: $header{From}\n";
    } else {
        $post .=  "From: $from_kludge\n";
    }

    if (defined($outaddr)) {
       $post .= "To: $outaddr\n";
       $mailartto = $outaddr;
    }

    if (defined($header{Organization})) {
       $post .= "Organization: $header{Organization}\n";
    }
    
    if (!defined($maillist)) {
    if (defined($header{Newsgroups})) {
        if (index($header{Newsgroups},$modgroup) == -1) {
            $header{Newsgroups} = "$modgroup,".$header{Newsgroups};
        }
        $post .= "Newsgroups: $header{Newsgroups}\n";

#       Find any moderated groups
        $_ = "";
        $_ = nextmodgroup($header{Newsgroups}) if (!defined($nomodcheck));

        if ($_ ne "") {
            s/\./\-/g;
            $mailartto = $_."\@".$modgroupdomain;
            $post .= "To: $mailartto\n";
            $post .= "Resent-Date: ".`$datecmd`;
            $post .= "Resent-From: $from\n";
            $post .= "Resent-To: $mailartto\n";
        } 

    } else {
        $post .= "Newsgroups: $modgroup\n";
    } 

    if (defined($header{Approved})) {
        $post .= "Approved: $header{Approved},$approved\n";
#   PGPMoose adds an Approved: line if it think's that's a good idea
    } elsif (!defined($pgpmoose)) {
        $post .= "Approved: $approved\n";
    }
    }    

    if (defined($header{Expires})) {
        $post .= "Expires: $header{Expires}\n";
    }

    if (defined($header{FollowupTo})) {
        $post .= "Followup-To: $header{FollowupTo}\n";
    }

    if (defined($header{Keywords})) {
        $post .= "Keywords: $header{Keywords}\n";
    }

    if (defined($header{References})) {
        $post .=  "References: $header{References}\n";
    }

    if (defined($header{ReplyTo})) {
        $post .= "Reply-To: $header{ReplyTo}\n";
    } elsif (defined($from_kludge)) {
        $post .= "Reply-To: $header{From}\n";
    }

    if (defined($header{Subject})) {
        $post .= "Subject: $header{Subject}\n";
    }

    if (defined($header{Summary})) {
        $post .= "Summary: $header{Summary}\n";
    }

    if (defined($from_kludge)) {
        $post .= "X-Really-From: $header{From}\n";
    }

#   Do other X-headers
    for ($i = 0;  $i < @xheader; $i++) {
        $post .= "$xheaderorig[$i]: $xheader[$i]\n";
    }

    if (defined($extraheaders)) {
        $post .=  "$extraheaders";
    }

    $post .= "X-Posting-Tool: modtool v$version\n\n";

#   Extract body of message
    ($discard, $body) = split(/\n\n/, $message, 2);
#   Remove trailling whitespace
    $body =~ s/\s+\Z//;                                                                                
#   Remove whitespace at beginning of message
    $body =~ s/\A\s+//;
         
    $post .=  $body;

#   Sig file
    $post .=  "\n\n$sigtext";

    $tmp = 0;
    if (defined($pgpmoose)) {
        $artfile = writefile($post);
        $post = `$pgpmoose $modgroup $artfile`;
        if ($?) {
           print "PGP Moose invocation unsuccessful - article not posted\n";
           $tmp = 5;
        }
    }

#   What to do with it?
    while ($tmp == 0) {
        print "\n(P)ost, (E)dit, (L)ist, (C)ancel: ";
        $command = lc(inputchar());

        if (!($command cmp "c")) {
            $retval = 1;
            $tmp = 1;
        } elsif (!($command cmp "e")) {
            $artfile = writefile($post);
            system "$editor $artfile";
            $post = readfile($artfile);
        } elsif ($command eq "l") {
            open(PAGER, "|$pager") || die "Unable to spawn pager $pager";
            print PAGER $post;
            close PAGER;
        } elsif (!($command cmp "p")) {
            $sendoutput = "";
            if ((!defined($digest))||(!defined($digonly))) {
            if ($mailartto ne "") {
#               mail to next moderator
                print "Mailing to '$mailartto' for approval.\n"
                   if (!defined($outaddr));
                $sendoutput = mail($from, $mailartto, $post);
            } elsif (defined($poster)) {
#                  if you have a .signature in your home dir, we
#                  temporarily rename it to something else to stop it
#                  getting used by inews.
                if (-e "$ENV{HOME}/.signature") {
    system "mv $ENV{HOME}/.signature $ENV{HOME}/.signature.modtool";
                }
                $artfile = writefile($post);
                print $sendoutput=`$poster $artfile 2>&1`;
                if (-e "$ENV{HOME}/.signature.modtool") {
    system "mv $ENV{HOME}/.signature.modtool $ENV{HOME}/.signature";
                }

            } else {
#               If this fails, the program dies anyway
                NNTPpost($post);
                $sendoutput = "";
            }
            }

            if (!($sendoutput cmp '')) {
                 delpost($datafile, $curpost);
            } else {
                 print "Failed to post article\n";
                 undef $command;
                 $retval = 2;
            }

            if (defined($digest) && !defined($dignoauto)) {
               ($t1, $t2) = split (/\n\n/, $message, 2);
               $post = "$t1\n$post";
               $post =~ s/$sigtext$//s;
               digadd($post);
            }

            $tmp = 3;   
        }
   }

   system "rm $artfile" if ($artfile ne "");
   $retval;
}

# Brings up a menu of rejection reasons and allows you to choose one
sub reject {
   my $retval = 0;
   my $reply = "";
   my $tmpfile = "";

   print"\nForm rejection letters\n----------------------\n\n";

   for ($i = 0; $i <= $rejnum; $i++) {
       print "$i) $rejdesc[$i]";
   }

   $tmp = 0;
   do {
       print "\nLetter Number (0 - $rejnum), Compose (R)eply, (C)ancel: ";
       $command = lc(inputchar());

       if (!($command cmp "c")) {
           $retval = 1;
           $tmp = 1;
       } elsif (!($command cmp "r")) {
           $tmp = 2;
       } elsif ($command =~ /\d/ && ($command <= $rejnum)) {
           $tmp = 3;
       }           
   } while ($tmp == 0);

   if ( ! $retval) {
       readheaders($message);
       $to = defined($header{ReplyTo}) ? $header{ReplyTo} : $header{From};
       undef $senditto;
       $senditto = getaddr($to);
       if (!defined($senditto)) {
           print "Unable to determine sender's email address\n";
           $retval = 4;
       } else {

          $reply .= "From: $from\n";
          $reply .= "To: $to\n";
          if (defined($replyto)) {
              $reply .= "Reply-To: $replyto\n";
          }
          $reply .= "Subject: $rejsub\n\n";
          $reply .= $rejtext[$command] if $tmp == 3;
          $reply .= $sigtext;
          $reply .= 
"\n----------------------------------------------------------------------";
          $reply .= "\n\nText of your message:\n---------------------\n\n";
          $reply .= $message;
       
          if ($tmp == 2) {
              $tmpfile = writefile($reply);
              system "$editor $tmpfile";
              $reply = readfile($tmpfile);
          }
      
          $tmp = 0;
          while ($tmp == 0) {
             print "\n(S)end, (E)dit, (V)iew, (C)ancel: ";
             $command = lc(inputchar());
 
             if (!($command cmp "c")) { 
                 $retval = 1;
                 $tmp = 1;
             } elsif (!($command cmp "e")) {
                 $tmpfile = writefile($reply);
                 system "$editor $tmpfile";
                 $reply = readfile($tmpfile);
             } elsif ($command eq "v") {
                 open (PAGER, "|$pager") || 
                     die "Unable to spawn pager $pager";
                 print PAGER $reply;
                 close PAGER;
             } elsif (!($command cmp "s")) {
                 $sendoutput = mail($from, $senditto, $reply);

                 if (!($sendoutput cmp '')) {
                     delpost($datafile, $curpost);
                 } else {
                     print "Failed to send mail\n";
                     undef $command;
                     $retval = 2;
                 }
                 $tmp = 3;
             }
          }
       }     
   }

   system "rm", $tmpfile if ($tmpfile ne "");
   $retval;
}

# Stores the header information in a hash
sub readheaders {
    my $field, $orig, $content, $hdrcount = 0;
    undef %header;
    undef @xheader;
    undef @xheaderorig;
    $xauth = "";
    my($t1, $t2, $t3, $t4, $t5);
    my $message = shift;

    my @message = split(/\n/, $message);

#   First line isn't a header, so we ignore it
    HDR: for ($i = 0; $message[$i]; $i++) {
        next HDR if ($message[$i] !~ /: /);
        ($field, $content) = split(/: /, $message[$i], 2);
#       Perl doesn't like keys with dashes in them, so we remove dashes
        $orig = $field;
        $field =~ s/\-//g;
        $header{$field} = $content;
     
#       Want to preserve X- headers so we store their names 
#       No point in keeping empty ones though
        if ((index($orig, "X-") == 0) &&
            ($content ne "")) {
#           Remember which moderated groups have been PGP moosed
            if ($orig eq "X-Auth") {
                ($t1, $t2, $t3, $t4, $t5) = split(/\s/, $content, 5);
                $xauth .= "$t4 ";
            }

            $xheader[$hdrcount] = $content;
            $xheaderorig[$hdrcount++] = $orig;
#           This saves having to reconstruct the header later
        } 
    }

    $i;
}

# Extract an email address from a line
sub getaddr {
    my $retval;
    @word = split(/ /,$_[0]);

    WORD: foreach $word (@word) {
        if (index($word, "@") >= 0) {
            $retval = $word;
            last WORD;
        }
    }

    $retval =~ s/\<//go;
    $retval =~ s/\>//go;
    $retval =~ s/\"//go;

    $retval;
}

# More magic code, this timne to check for mod. newsgroups
# This comes courtesy of Thomas Koenig <tkoenig@ATHENA.MIT.EDU>
# with a few slight tweaks by me

sub getmodgroups {
    local(@groups) = @_;
    local($port, $sockaddr, $aliases, $proto, $name,
	  $port, $type, $len, $thataddr, $sockaddr,
	  $that, $hier, %newsgroups, $oldselect, $_);
    local($group, $from, $to, $flag);

    for (@groups) {
	$newsgroups{$_} ++;
    }

    $port = 119;

    $sockaddr = 'S n a4 x8';
    ($name, $aliases, $proto) = getprotobyname('tcp');
    ($name, $aliases, $port) = getservbyname($port, 'tcp')
	unless $port =~ /^\d+$/;
    ($name, $aliases, $type, $len, $thataddr) = gethostbyname($news_host);

    $that = pack($sockaddr, &AF_INET, $port, $thataddr);

    socket(GMGS, &PF_INET, &SOCK_STREAM, $proto) || die "socket: $!";
    connect(GMGS, $that) || die "connect to $news_host: $!.\n";

    $oldselect = select(GMGS); $| = 1; select($oldselect);

    # Read banner line
    ($_ = <GMGS>) || die "reading from $news_host: $!.\n";
    die "unexpected banner code from $news_host: $_" if ($_ !~ /^200\s+/);

    print GMGS "list\r\n";

    # Read the intro line to the listing
    ($_ = <GMGS>) || die "reading from $news_host: $!.\n";
    die "unexpected response code from $news_host: $_" if ($_ !~ /^215\s+/);
wloop:
    while(<GMGS>) {
	chop;
	if (/^\./) { last wloop; }
	($group, $from, $to, $flag) = split;
	if ($flag eq "m") {
            $modgroup[@modgroup] = $group;
	}
    }

    print GMGS "quit\r\n";

    close(GMGS);
}

# This one is all my work, so you have me to blame
# Calculates next moderated group in line 
sub nextmodgroup {
    $newsgroupsline = $_[0];
    my $return = "", @group, $check = 0;

    @group = split(/\,(\s*)/,$newsgroupsline);

    GRLOOP: foreach $group (@group) {
        next GRLOOP if ($group eq "") ;
        if ($group eq $modgroup) {
           $check = 1;
           next GRLOOP;
        }

        foreach $mgroup (@modgroup) {
            if ($check) {
               if (($mgroup eq $group) && (index($xauth, $group) == -1)) {
                   $return = $mgroup;
                   last GRLOOP;
               }
            } else {
            print 
    "Warning: assuming post approved for moderated group $group\n"
                if ($mgroup eq $group); 
            }
        }
    }

    $return;
}

# Post an article to a newsserver using NNTP (and an IHAVE message)
#
# syntax NNTPpost $news
sub NNTPpost {
    my @article = split(/\n/, shift);
    my $msgid, $time, $line;
    my $ready, $ok;
    local($port, $sockaddr, $aliases, $proto, $name,
          $port, $type, $len, $thataddr, $sockaddr,
          $that, $hier, %newsgroups, $oldselect, $_);

    $port = 119;

    $sockaddr = 'S n a4 x8';
    ($name, $aliases, $proto) = getprotobyname('tcp');
    ($name, $aliases, $port) = getservbyname($port, 'tcp')
        unless $port =~ /^\d+$/;
    ($name, $aliases, $type, $len, $thataddr) = gethostbyname($post_host);

    $that = pack($sockaddr, &AF_INET, $port, $thataddr);

    socket(NS, &PF_INET, &SOCK_STREAM, $proto) || die "socket: $!";
    connect(NS, $that) || die "connect to $post_host: $!.\n";

    $oldselect = select(NS); $| = 1; select($oldselect);

    # Read banner line
    ($_ = <NS>) || die "reading from $post_host: $!.\n";
    die "unexpected banner code from $post_host: $_" if ($_ !~/^200\s+/);

#    open(NS, ">/tmp/nntptest");

#   create a new message ID
    $msgid = "\<mt$version-$$-".time."\@$hostname\>";

    if (defined($ihave)) {
        $ready = "335";
        $ok = "235";

#       Send IHAVE message
        print NS "ihave $msgid\r\n";
    } else {
#       use POST
        $ready = "340";
        $ok = "240";

        print NS "post\r\n";
    }

    ($_ = <NS>) || die "reading from $post_host: $!.\n";
    die "unable to post article on $post_host: $_" if ($_ !~/^$ready\s+/);

#   Send article - first we need to add a few headers
    $time = `$datecmd`;
#    print "$datecmd $time";
    chomp $time;
    print NS "Date: $time\r\n";
#   This is a kludge.  We can't put the real hostname in here because
#   we might not see the article then
    if (defined($ihave)) {
        print NS "Path: modtool$$\r\n";
    }
    print NS "Message-ID: $msgid\r\n";

#   OK, now for the real thing
    foreach $line (@article) {
       $line =~ s/\n+\Z//;
       $line =~ s/\A\./\.\./;
       print NS $line."\r\n";
    }

    print NS ".\r\n";

#   Check that it went out OK
    ($_ = <NS>) || die "reading from $post_host: $!.\n";
    die "error posting article on $post_host: $_" if ($_ !~ /^$ok\s+/);

    print NS "quit\r\n";

    close(S);
}

# This subroutine sends mail via SMTP
# Usage: SMTPmail $sender $to $message
sub SMTPmail {
    my $from, $to, @message, $line;
    local($port, $sockaddr, $aliases, $proto, $name,
          $port, $type, $len, $thataddr, $sockaddr,
          $that, $hier, %newsgroups, $oldselect, $_);

    $from = shift;
    $to = shift;
    @message = split(/\n/, shift);
    $port = 25;

    $sockaddr = 'S n a4 x8';
    ($name, $aliases, $proto) = getprotobyname('tcp');
    ($name, $aliases, $port) = getservbyname($port, 'tcp')
        unless $port =~ /^\d+$/;
    ($name, $aliases, $type, $len, $thataddr) = gethostbyname($mail_host);

    $that = pack($sockaddr, &AF_INET, $port, $thataddr);

    socket(MS, &PF_INET, &SOCK_STREAM, $proto) || die "socket: $!";
    connect(MS, $that) || die "connect to $mail_host: $!.\n";

    $oldselect = select(MS); $| = 1; select($oldselect);

    # Read banner line
    $_ = "220-";
    do {
        ($_ = <MS>) || die "reading from $mail_host: $!.\n";
    } while ($_ =~ /^220-/);
    die "unexpected banner code from $mail_host: $_" if ($_!~/^220\s+/);

#   send HELO
    print MS "HELO $hostname\r\n";
    ($_ = <MS>) || die "reading from $mail_host: $!.\n";
    die "HELO failed on $mail_host: $_" if ($_!~/^250\s+/);

#   mail is from
    print MS "MAIL FROM: $from\r\n";
    ($_ = <MS>) || die "reading from $mail_host: $!.\n";
    die "$mail_host rejected sender: $_" if ($_!~/^250\s+/);

#   and to 
    print MS "RCPT TO: $to\r\n";
    ($_ = <MS>) || die "reading from $mail_host: $!.\n";
    die "$mail_host rejected recipient: $_" if ($_!~/^250\s+/);

#   Send mail
    print MS "DATA\r\n";
    ($_ = <MS>) || die "reading from $mail_host: $!.\n";
    die "$mail_host refused post: $_" if ($_!~/^354\s+/);

    foreach $line (@message) {
       chomp $line;
       $line =~ s/^\./\.\./;
       print MS "$line\r\n";
    }

#   end mail
    print MS ".\r\n";
    ($_ = <MS>) || die "reading from $mail_host: $!.\n";
    die "$mail_host rejected post: $_" if ($_!~/^250\s+/);

    print MS "quit\r\n";
    close MS;
}

# cancels an article piped to stdin 
# adapted from code by David C. Lawrence
sub cancelarticle {
    my $msgid = shift; 
    my $body, $star = $*, $slash = $/;
    my @cmsg, $artfile = $wd."/mtctmp$$";

    $* = 1;         # let ^ and $ work with newlines embedded in input.
    $/ = "";        # read until empty line mode
    $_ = <STDIN>;
    undef $/;       # read in whole file mode
    $body = <STDIN>;

    s/^Date: .*\n//i;
    s/^Approved: .*\n([ \t].*\n)*/Approved: $approved\n/i;
    s/^Control: .*\n([ \t].*\n)*//i;
    s/^Message-ID: <(.*)$/Message-ID: <c$$-$1/i;
    $msgid=$1;
    s/^Message-ID: <(.*)\n//i;
    s/^/Control: cancel <$msgid\n/i;
    s/^Subject: .*\n([ \t].*\n)*/Subject: cmsg cancel <$msgid\n/i;
    s/^Path: .*\n//i;
    s/^Lines: .*\n([ \t].*\n)*/Lines: 1\n/i;
    s/^Distribution: .*\n//i;
    s/^NNTP-Posting-Host: .*\n//i;

    $_ .= "Cancelled by the moderator - $from\n";

    $* = $star;
    $/ = $slash;
    
    if (defined($poster)) {
        open(ART, ">$artfile");
        print ART $_;
        close ART; 

        if (-e "$ENV{HOME}/.signature") {
            system "mv $ENV{HOME}/.signature $ENV{HOME}/.signature.modtool";
        }
        print $sendoutput=`$poster $artfile 2>&1`;
        if (-e "$ENV{HOME}/.signature.modtool") {
            system "mv $ENV{HOME}/.signature.modtool $ENV{HOME}/.signature";
        } 

        system("rm $artfile");
    } else {       
        @cmsg = split(/\n/, $_);
        NNTPpost(@cmsg);
    }
}

# This routine reads a numbered post (starting from 1) and returns it as a
# string
sub readpost {
   my $data, $i, $count = 0, $fromline = 0, $blank = 1, $tmp = "";
  
   my $datafile = shift;
   my $postnum = shift;

#  If file has changed (or first time routine called - find out how
#  many posts there are 
   $lastpost = countposts($datafile) if ($dfsize != -s $datafile);
   die "Post $postnum does not exist.  Aborted" 
      if ($postnum > $lastpost || $postnum < 1);

   open(DATA, $datafile) || die "Unable to open data file: $!";

   READLOOP: while (<DATA>) {
      if (($_ =~ /^\S+: /) && $fromline) {
          $count++;
          last READLOOP if $count > $postnum;
          $data = "";
      }
      $fromline = (($_ =~ /^From /) && $blank) ? 1 : 0;
      $blank = ($_ eq "\n") ? 1 : 0;

      $data .= $tmp;
      $tmp = $_;
   }

   close DATA;

   $data;
}

# counts the number of posts in the data file
sub countposts {
    my $count = 0, $blank = 1, $fromline = 0;
    my $datafile = shift;

    open(DATA, $datafile) || die "Unable to open data file: $!";

    while(<DATA>) {
       $count++ if ($fromline && ($_ =~ /^\S+: /));
       $fromline = (($_ =~ /^From /) && $blank) ? 1 : 0;
       $blank = ($_ eq "\n") ? 1 : 0;
    }

    close DATA;

    $dfsize = -s $datafile;
    $count;  
}

# Removes a post from the data file
sub delpost {
    my $count = 0, $data = "", $blank = 1, $fromline = 0, $tmp = "";

    my $datafile = shift;
    my $postnum = shift;

    $lastpost = countposts($datafile) if ($dfsize != -s $datafile);
    die "Post $postnum does not exist.  Aborted" 
       if ($postnum > $lastpost || $postnum < 1);

    open(DATA, $datafile) || die "Unable to open data file: $!";

    while(<DATA>) {
       $count++ if ($fromline && ($_ =~ /^\S+: /));
       $fromline = (($_ =~ /^From /) && $blank) ? 1 : 0;
       $blank = ($_ eq "\n") ? 1 : 0;  
       $data .= $tmp if ($count != $postnum);
       $tmp = $_;
    }
    $data .= $tmp if ($count != $postnum);

    close DATA;

#   Write out edited buffer
    open(DATA, ">$datafile") || die "Unable to write to data file: $!";
   
    print DATA $data;
    close DATA;

    $dfsize = -s $datafile;
    $lastpost--;
    $curpost--;
}

# Reads a config file
# Syntax: readcfg $cfgfile $validkeywds, @reqkeywds;
sub readcfg {
    local($tmp1, $tmp2, $keyword, $value, $line, $kw);
    local($cfgfile, $validkeywds, @reqkeywds);
    $cfgfile = shift;
    $validkeywds = shift;
    @reqkeywds = @_;
    local($cfgtext, @cfgtext, $linetxt, $cont);

    $cfgtext = readfile($cfgfile);
    @cfgtext = split(/\n/, $cfgtext);
 
    $line = 0;
    $cont = 0;
    CFGPROC: foreach $linetxt (@cfgtext) {
       $line++;
       if ($cont == 0) {
       next CFGPROC if ($linetxt =~ /^#/);
       $linetxt =~ s/^\s+//o;
       $linetxt =~ s/\s+$//o;
       next CFGPROC if ($linetxt eq "");

       if ($linetxt !~ /=/) {
           print STDERR
   "Ignoring invalid configuration statement in $cfgfile line $line\n";
          next CFGPROC;
       }

       ($keyword, $value) = split(/=/o, $linetxt, 2);
       $keyword =~ s/^\s+//o;
       $keyword =~ s/\s+$//o;

       if ($keyword eq "include") {
           $value =~ s/^\s+//o;
           $value = "$mtpath/$value" if (!-e "$value");
           readcfg($value, $validkeywds, @reqkeywds);
           next CFGPROC;
       }

       if ($validkeywds !~ /$keyword/) {
           print STDERR
       "Ignoring invalid keyword $keyword in $cfgfile at line $line\n";
           next CFGPROC;
       }
       if ($linetxt =~ /\\$/o) {
           $cont = 1;
           next CFGPROC;
       }

       } else {
            chop $value;
            $value .= $linetxt;
            $cont = 0 if ($linetxt !~ /\\$/o);
            next CFGPROC if ($cont);
       }

       $value =~ s/^\s+//o;
       $value =~ s/\s+$//o;

       if ($value =~ /^"/ && $value =~ /"$/o) {
           $value =~ s/^"//o;
           $value =~ s/"$//o;
       }

       if ($value eq "") {
           undef $$keyword;
       } else {
           $$keyword = "$value";
       }

    }

    foreach $kw (@reqkeywds) {

       if (!defined($$kw)) {
           die "Cannot continue: required keyword $kw undefined";
       }
    }
 
}

# Adds a message to a RFC1153 digest - creates the digest if it does not
# yet exist
#
# Syntax: digadd $post
sub digadd {
    my $filename;
    my($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst);
    my $post;
    $post = shift;
    my($head, $body, $tmp, $curdigsize);
    my($olddigest, $artnum, $before, $after, $line);
    my $curdate;
    $curdate = ""; $olddigest=""; $artnum = 0; $line="";

    ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);

#   Determine the filename to use for this digest file
    $curdate = `$diginterval` if (defined($diginterval));
    chomp($curdate);

    if (($curdate ne $diglast) || 
        (!-e "$digdir/$digprefix-$digyear-$dignum") ||
         (defined($digthreshold) && 
          ((-s "$digdir/$digprefix-$digyear-$dignum") >= $digthreshold))) {

       if (defined($digto) && -e "$digdir/$digprefix-$digyear-$dignum") {
           $olddigest = readfile("$digdir/$digprefix-$digyear-$dignum");
           mail(getaddr($digfrom), getaddr($digto), $olddigest);
       }

       if ($year ne $digyear) {
           $digyear = $year;
           $dignum = 1;
       } else {
           $dignum++ 
              if (-e "$digdir/$digprefix-$digyear-$dignum");
       }
       $diglast=$curdate;
       digsavecfg($digcfg);
    }
   
    $filename="$digdir/$digprefix-$digyear-$dignum";

#   Let's fill that digest
    ($head, $body) = split(/\n\n/, $post, 2);
    $body =~ s/^\s+//;
    $body =~ s/\s+$//;

    readheaders("rubbish\n$post");
    if (-e $filename) {
        $olddigest = readfile($filename);

        open(DIG, ">$filename") || die "Unable to write to $filename";

        ($before, $after) = split(/Topics in this digest:\n/,
                                  $olddigest, 2);

        print DIG $before;
        print DIG "Topics in this digest:";
        
        do {
           print DIG "$line\n";
           ($line, $after) = split(/\n/, $after, 2);
           $artnum++;
        } while ($line ne "");           

        print DIG "    $artnum) $header{Subject}\n\n";
        ($before, $after) = 
             split(/------------------------------\n\nEnd of/,
                   $after, 2);

        print DIG $before;
        print DIG "------------------------------\n\n";
        digaddarticle($body);

        print DIG "\n\n------------------------------\n\nEnd of";
        print DIG $after;

        close DIG;        
    } else {
        open(DIG, ">$filename") 
           || die "Unable to create digest file $filename";

        print DIG "From: $digfrom\n";
        print DIG "To: $digto\n" if (defined($digto));
        print DIG "Reply-To: $digreplyto\n" if (defined($digreplyto));
        print DIG "Subject: $digest Digest $year/$dignum\n\n";

        print DIG "$digest Digest - $day[$wday], $mday$daysuf[$mday] ".
                  "$month[$mon] $year - number $dignum\n\n";
        
        print DIG "Topics in this digest:\n";
        print DIG "    1) $header{Subject}\n\n";

        print DIG "$digheader\n\n" if (defined($digheader));

        print DIG 
"----------------------------------------------------------------------\n\n";

        digaddarticle($body);

        print DIG "\n\n------------------------------\n\n";

        $line = "End of $digest Digest $year/$dignum";
        print DIG "$line\n";
        for (1..length($line)) {
           print DIG "*";
        }
        print DIG "\n";        

        close(DIG);  
    }
}

# Subroutine called by digadd to include the actual article
sub digaddarticle {
    my $body = shift;

        if (defined($header{Date})) {
            print DIG "Date: $header{Date}\n";
        } else {
            print DIG "Date: ".`$datecmd`;
        }
        
        if (defined($header{From})) { 
            print DIG "From: $header{From}\n";
        }
 
        if (defined($header{To})) {
            print DIG "To: $header{To}\n";
        }

        if (defined($header{Cc})) {
            print DIG "Cc: $header{Cc}\n";
        }

        print DIG "Subject: $header{Subject}\n";

        if (defined($header{MessageID})) {
            print DIG "Message-ID: $header{MessageID}\n";
        }

        if (defined($header{Keywords})) {
            print DIG "Keywords: $header{Keywords}\n";
        }

        if (defined($header{Summary})) {
            print DIG "Summary: $header{Summary}\n";
        }

        print DIG "\n$body";
}

# initialise the Digest variables and make sure they are set to
# something vaguely sensible - also read header info if required
sub diginit {
    my($validkeywds, @reqkeywds);
    $validkeywds="dignum diglast diglastarticle digyear";
    @reqkeywds=( "dignum", "diglast", "digyear", "diglastarticle");
    my $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst;

    ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);

    $digfrom = $from if (!defined($digfrom));   
    $digprefix = $digest if (!defined($digprefix));
    if (!defined($digcfg)) {
        $digcfg = "$wd/.modtooldigest";
    } else {
        $digcfg = "$wd/$digcfg";
    }

    $diginterval = 'date +"%d%m%y"' 
        if (!defined($diginterval) && !defined($digthreshold));
    $digdir = $wd if(!defined($digdir));
    if (!-e $digdir) {
       mkdir($digdir,0700) 
          || die "Unable to create directory $digdir";
    }
#    $digthreshold = -1 if (!defined($digthreshold));   

    if (-e $digcfg) {
        readcfg($digcfg, $validkeywds, @reqkeywds);
        $diglast = "" if ($diglast == "none");

    } else { 
#       Assume this is the first ever digest
        $dignum = 1;
        $diglast = `$diginterval`;
        chop $diglast;
        $digyear = $year;
        $diglastarticle = "0";
        digsavecfg($digcfg);
    }

    if (defined($dighdrfile)) {
        $dighdrfile = "$wd/$dighdrfile" if (!-e $dighdrfile);
        $digheader = readfile($dighdrfile);
        $digheader =~ s/^\s+//;
        $digheader =~ s/\s+$//;
    }

}

# Save the digest config file
#
# Syntax: digsavecfg($configfile)
sub digsavecfg {
    my $configfile = shift;

    open(DIGCFG, ">$configfile") || die "Unable to open $configfile";
       
    print DIGCFG "# Digest config file for $digest\n"; 
    print DIGCFG "# This file will be overwritten by modtool, please\n";
    print DIGCFG "# do not modify by hand\n\n";
  
    print DIGCFG "# Current issue number\ndignum=$dignum\n\n";
    print DIGCFG "# This year\ndigyear=$digyear\n\n";
    print DIGCFG "# Last time digest file was modified\n";
    if ($diglast eq "") {
        print DIGCFG "diglast=none\n\n";
    } else {
        print DIGCFG "diglast=$diglast\n\n";
    }

    print DIGCFG "# Last article in group read from news server\n";
    print DIGCFG "diglastarticle=$diglastarticle\n";

    close DIGCFG;
}

# Replies automatically to mail piped to stdin

sub autoreply {
   my $mail = "";
   my $header, $subject, $replytext = "";
   my $reply, $line, $addrs = "", $date, $curdate, $realto;
   my $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst;

   ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
   $curdate = $mday."-".$mon."-".$year;

   while (<STDIN>) {
     $mail .= $_;
   }

   if (defined($arepfile)) {
       $arepfile = "$wd/$arepfile";
   } else {
       $arepfile = "$wd/autoreply";
   }

   readheaders($mail);

   $replytext = readfile($arepfile);
   $replytext =~ s/\%subject\%/$header{Subject}/g;

   if (defined($arepcfg)) {
       $arepcfg = "$wd/$arepcfg";
   } else {
       $arepcfg = "$wd/.mtrecent";
   }

   if (-e $arepcfg) {
       $addrs = readfile($arepcfg);
       ($date, $addrs) = split(/\n/, $addrs, 2);
       $addrs = "" if ($date ne $curdate);
   }     

   $arepfrom = $from if (!defined($arepfrom));
   $arepto = defined($header{ReplyTo}) ? $header{ReplyTo} : $header{From};
   $realto = getaddr($arepto);
   $arepsub = "Your mail has been received" if (!defined($arepsub));
   $arepsub =~ s/\%subject\%/$header{Subject}/g;
   $arepreplyto = $replyto
        if (!defined($arepreplyto) && defined($replyto));

   return(0) if (index($addrs, $realto) != -1);
   open(OUT, ">$arepcfg");
   print OUT "$curdate\n$addrs$realto\n";
   close OUT;

   $reply  = "From: $arepfrom\n";
   $reply .= "To: $arepto\n";
   $reply .= "Reply-To: $arepreplyto\n" if (defined($arepreplyto));
   $reply .= "Subject: $arepsub\n";

   while ($replytext =~ /\S+: /) {
      ($line, $replytext) = split(/\n/, $replytext, 2);
      $reply .= "$line\n";
   }

   $replytext =~ s/^\s//;
   $replytext =~ s/\s$//;

   $reply .= "\n$replytext\n";

   if (defined($arepincsig)) {
      $reply .= "\n$sigtext";
   }

   if (defined($arepincmail)) {
      $reply .= 
"\n----------------------------------------------------------------------\n\n";
      $reply .= "Text of your mail:\n\n$mail";
   }

   mail(getaddr($arepfrom), $realto, $reply);

   return(0);
}

# Selects the mail transport to be used, and sends the mail
#
# Syntax: mail $from $to $message
sub mail {
   my $from = shift;
   my $to = shift;
   my $mail = shift;
   my $output = "";
   my $mailfile;

   if (defined($mailer)) {
       $mailfile = writefile($mail);
       print $output = `$mailer $from <$mailfile 2>&1`;
       `rm $mailfile` if ($output eq "");
   } else {
       SMTPmail($from, $to, $mail);
   }

   $output;
}

# Put data in a file, returns file name
#
# Syntax: writefile $data;
sub writefile {
   my $data = shift;
   my $file = "$wd/.mttmp$$";

   open(TMP, ">$file") ||
          die "Unable to create file $file";
   print TMP $data;
   close TMP;
              
   $file;
}

# Read data from a file, returns data in a string
#
# Syntax: $data = readfile $file;
sub readfile {
    my $file = shift;
    my $data = "";

    open(TMP, $file) || die "Unable to read from file $file";

    while(<TMP>) {
       $data .= $_;
    }

    close TMP;

    $data;
}

# This subroutine reads posts from a group and stores them in a digest
 
sub digestgroup {
    local(@groups) = @_;
    local($port, $sockaddr, $aliases, $proto, $name,
          $port, $type, $len, $thataddr, $sockaddr,
          $that, $hier, %newsgroups, $oldselect, $_);
    local($group, $from, $to, $flag);
    local($article,$iii);
    local($t1,$t2,$t3, $first, $last);

    for (@groups) {
        $newsgroups{$_} ++;
    }

    $port = 119;

    $sockaddr = 'S n a4 x8';
    ($name, $aliases, $proto) = getprotobyname('tcp');
    ($name, $aliases, $port) = getservbyname($port, 'tcp')
        unless $port =~ /^\d+$/;
    ($name, $aliases, $type, $len, $thataddr) = gethostbyname($news_host);

    $that = pack($sockaddr, &AF_INET, $port, $thataddr);

    socket(DS, &PF_INET, &SOCK_STREAM, $proto) || die "socket: $!";
    connect(DS, $that) || die "connect to $news_host: $!.\n";

    $oldselect = select(DS); $| = 1; select($oldselect);

    # Read banner line
    ($_ = <DS>) || die "reading from $news_host: $!.\n";
    die "unexpected banner code from $news_host: $_" if ($_ !~ /^200\s+/);

    print DS "group $modgroup\r\n";

    # Read the intro line to the listing
    ($_ = <DS>) || die "reading from $news_host: $!.\n";
    die "unexpected response code from $news_host: $_" if ($_ !~ /^211\s+/);

    ($t1,$t2,$first,$last,$t3) = split(/ /, $_, 5);

    if ($diglastarticle == $last) {
        print "Digest up to date.\n";
        exit(0);
    }

    if ($diglastarticle > $last) {
        print STDERR "Someone has reset $modgroup.\n";
        print STDERR "Last read article has been reset to 0.\n\n";
        print STDERR
"You may need to edit the digests by hand - automatic digest mailing has\n"
."been disabled for this invocation of modtool only.\n\n";
        $diglastarticle = 0;
        undef($digto);
    }

    print "Reading new articles:\n";
    for ($iii = ($diglastarticle > $first ? $diglastarticle+1 : $first);
         $iii <= $last; $iii++) {
    print "$iii\n";

        print DS "article $iii\r\n";

        ($_ = <DS>) || die "reading from $news_host: $!.\n";
        next if ($_ =~ /^423\s+/ || $_ =~ /%^430\s+/);
        die "unexpected response code from $news_host: $_" 
              if ($_ !~ /^220\s+/);

        $article = "";
        while (<DS>) {
           last if ($_ =~ /^\.\s+/);
           s/\r//g;
           s/\n//g;
           $article  .= "$_\n";
        }

        $article =~ s/$sigtext$//s;
        digadd($article);
        $diglastarticle = $iii;
        digsavecfg($digcfg);
    }

    print DS "quit\r\n";
    close(DS);

    print "\nDone\n";

}

# Checks the syntax of the arguments 

sub argcheck {
   my $args = shift;
   my $t1, $t2, $t3, $total;
   my @ileagal = ("ac", "ca", "ad", "da", "cd", "dc");
   my $comb;

   $total = "";
   while ($args) {
      ($t1, $t2) = split(/-/, $args, 2);
      ($t1, $t3) = split(/\s/, $t2, 2);
      $args = $t3;

      badargs() if ($t1 eq "h" || (length($t1) != 1) 
          || index($validargs, $t1) == -1);
      $total .= $t1;
      foreach $comb (@ileagal) {
         badargs() if (index($total, $comb) != -1);
      }

      $args = "" if ($args !~ /-/);
   }
}

# prints a help message 
sub badargs {

          print "Usage: $0 [-r|-c|-d|-h [-f <file>]]\n\n";
          print 
   "Flags: -r auto-reply mode (message to reply to on stdin)\n"
  ."       -c cancel mode (article to cancel on stdin)\n"
  ."       -d digest creation mode (reads the newsgroup + puts it in a"
  ." digest)\n"	
  ."       -h help (this screen)\n"
  ."       -f <file> read configuration from file <file>\n";

           exit(0);

}          
   
