#!/afs/athena.mit.edu/user/g/s/gsstark/bin/perl

# nndb --- an nntp server for mail, with a database backend.
# Copyright (C) 1996 Joe Hildebrand

# Author:   Joe Hildebrand <hildjj@fuentez.com>
# Keywords: news mail

# nndb is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.

# nndb is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.	 See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with GNU Emacs; see the file COPYING.  If not, write to the
# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA 02111-1307, USA.

require 5.002;

use strict;
use Socket;
use Getopt::Std;
use FileHandle;

package main;

init_globals();
getopts('ghvp:r:f:a:m:') or usage();
usage() if $::opt_h;

init_auth();
init_sock();
open_db();
read_rules();
read_leftovers();

if ($::opt_v) {
  print STDERR <<EOF;
nndb version $::version
  port     = $::opt_p
  maildir  = $::opt_m
  database = $::opt_d

EOF
  
}
# If the delivery agent was delivering when we started, we will have
# missed one message.  Wait one minute and look again.
alarm(60);

while (1) {
  process_event();
}

sub handle_HUP {
  $::SIG{HUP} = \&handle_HUP; # loathe sysV
  $::got_HUP  = 1;
}

sub handle_ALRM {
  $::SIG{ALRM} = \&handle_ALRM; # loathe sysV
  $::got_ALRM  = 1;
}

sub init_auth {
  if ($::opt_a) {
    if (m|([^/]+)/(.+)/|) {
      $::auth_user = $1;
      $::auth_pass = $2;
    } else {
      usage();
    }
  } else {
    my($file_name) = "$::home/.nntp-authinfo";
    if (-f $file_name) {
      open(AUTH, $file_name) or die "opening $file_name: $!";

      $_ = <AUTH>
	or die "File format for $file_name is username, newline, password";
      chomp;
      $::auth_user = $_;

      $_ = <AUTH>
	or die "File format for $file_name is username, newline, password";
      chomp;      
      $::auth_pass = $_;     
    }
  }
}

# accept and dispatch one event, either a new client or a client
# request. 
sub process_event {
  
  my($rin) = make_vec();
  my($rout);
  my($nfound, $timeleft);
  my($fd);

  # wait until something interesting happens
  ($nfound, $timeleft) = select($rout = $rin, undef, undef, undef);

  if ($::got_HUP) {
    $::got_HUP = 0;
    
    print STDERR "Rereading startup files.\n" if $::opt_v;
    
    init_auth();
    read_rules();
    read_leftovers();
  } elsif ($::got_ALRM) {
    $::got_ALRM = 0;
    read_leftovers();
  } else {
    if ($nfound == -1) {
      die "select: $!";
    }
    
    # for each of the sockets we are monitoring
    foreach $fd (@::all_socks) {
      
      # if it is ready to be read
      if (vec($rout, fileno($fd), 1)) {
	
	# if it is the well-known socket
	if ($fd == \*S) {
	  
	  # new client connection.  start up another socket to deal with
	  # it. 
	  my($new_fd) = new FileHandle;
	  accept($new_fd, S) || die "accept: $!";
	  
	  push(@::all_socks, $new_fd);
	  $new_fd->autoflush;
	  
	  if ($::auth_user) {
	    answer($new_fd, 480);
	  } else {
	    $::auth{$new_fd} = 1;
	    answer($new_fd, 200);
	  }
	  
	} else {
	  # if the client has exited without cleaning up
	  if (eof($fd)) {
	    close_fd($fd);
	  } else {
	    # process the client request, if authorized
	  dispatch($fd);
	}
      }
    } 
  }
}
}

# remove the descrptor from the appropriate variables, then close it.
sub close_fd {
  my($fd) = @_;

  if ($::current{$fd}) {
    undef $::current{$fd};
  }
  if ($::group{$fd}) {
    undef $::group{$fd};
  }

  @::all_socks = grep($_ != $fd, @::all_socks);
  close($fd);
}

# preparse the input line, extracting the command name.
sub dispatch {
  my($fd) = @_;
  my($command);
  
  $_ = <$fd>;
  print STDERR "line: $_\n";
  s/[\n\r\000]//g;
  ($command = $_) =~ s/([A-Z]+)\s*(.*)?/\U$1\E/i;
  
  print STDERR "$command: $2\n" if $::opt_v;


  if (($::auth{$fd}) ||
      ($command eq "AUTHINFO")||
      ($command eq "QUIT")) {
    
    if ($::command_lookup{$command}) {
      &{$::command_lookup{$command}}($fd, $2);
    } else {
      # unknown command
      answer($fd, 500);
    }
  } else {
    answer($fd, 480);
  }
}

sub init_globals {
  $::got_HUP    = 0;
  $::got_ALRM   = 0;
  $::SIG{HUP}   = \&handle_HUP;
  $::SIG{ALRM}  = \&handle_ALRM;
  $::SIG{PIPE}  = 'IGNORE';

  $::version        = 0.3;
  
  $::auth_user      = ();
  $::auth_pass      = ();
  %::auth           = ();
  %::auth_first     = ();
  %::command_lookup = ();
  %::current        = ();
  %::good_header    = ();
  %::group          = ();
  %::hash           = ();
  %::responses      = ();
  @::all_actions    = ();
  @::all_flags      = ();
  @::all_rules      = ();
  @::all_socks      = ();

  # response codes
  $::responses{"100"} = "100 help text follows\r\n";
  $::responses{"199"} = "199 debug output\r\n";
  $::responses{"200"} = "200 server ready - posting allowed\r\n";
  $::responses{"201"} = "201 server ready - no posting allowed\r\n";
  $::responses{"202"} = "202 slave status noted\r\n";
  $::responses{"205"} = "205 closing connection - goodbye!\r\n";
  $::responses{"211"} = "211 n f l s group selected\r\n";
  $::responses{"215"} = "215 list of newsgroups follows\r\n";
  $::responses{"220"} = "220 %d %s article retrieved - head and body follow\r\n";
  $::responses{"221"} = "221 %d %s article retrieved - head follows\r\n";
  $::responses{"222"} = "222 %d %s article retrieved - body follows\r\n";
  $::responses{"223"} = "223 %d %s article retrieved - request text separately\r\n";
  $::responses{"230"} = "230 list of new articles by message-id follows\r\n";
  $::responses{"224"} = "224  Overview information follows\r\n";
  $::responses{"231"} = "231 list of new newsgroups follows\r\n";
  $::responses{"235"} = "235 article transferred ok\r\n";
  $::responses{"240"} = "240 article posted ok\r\n";
  $::responses{"250"} = "250 article deleted ok\r\n";
  $::responses{"251"} = "251 article moved ok\r\n";
  $::responses{"281"} = "281 Authentication accepted\r\n";
  $::responses{"335"} = "335 send article to be transferred.  End with <CR-LF>.<CR-LF>\r\n";
  $::responses{"340"} = "340 send article to be posted. End with <CR-LF>.<CR-LF>\r\n";
  $::responses{"381"} = "381 More authentication information required\r\n";
  $::responses{"400"} = "400 service discontinued\r\n";
  $::responses{"411"} = "411 no such news group\r\n";
  $::responses{"412"} = "412 no newsgroup has been selected\r\n";
  $::responses{"420"} = "420 no current article has been selected\r\n";
  $::responses{"421"} = "421 no next article in this group\r\n";
  $::responses{"422"} = "422 no previous article in this group\r\n";
  $::responses{"423"} = "423 no such article number in this group\r\n";
  $::responses{"430"} = "430 no such article found\r\n";
  $::responses{"435"} = "435 article not wanted - do not send it\r\n";
  $::responses{"436"} = "436 transfer failed - try again later\r\n";
  $::responses{"437"} = "437 article rejected - do not try again.\r\n";
  $::responses{"440"} = "440 posting not allowed\r\n";
  $::responses{"441"} = "441 posting failed\r\n";
  $::responses{"480"} = "480 Authentication required\r\n";
  $::responses{"482"} = "482 Authentication rejected\r\n";
  $::responses{"500"} = "500 command not recognized\r\n";
  $::responses{"501"} = "501 command syntax error\r\n";
  $::responses{"502"} = "502 access restriction or permission denied\r\n";
  $::responses{"503"} = "503 program fault - command not performed\r\n";

  # these are the headers in the "overview" database
  %::good_header = ("subject"    => 1,
		    "from"       => 1,
		    "date"       => 1,
		    "message-id" => 1,
		    "references" => 1,
		    "bytes"      => 1,
		    "lines"      => 1);

  # what to do for each command
  %::command_lookup = ('ARTICLE'   => \&do_ARTICLE,
		       'AUTHINFO'  => \&do_AUTHINFO,
		       'BODY'      => \&do_BODY,
		       'COPY'      => \&do_COPY,
		       'DELETE'    => \&do_DELETE,
		       'GROUP'     => \&do_GROUP,
		       'HEAD'      => \&do_HEAD,
		       'LIST'      => \&do_LIST,
		       'MODE'      => \&do_MODE,
		       'MOVE'      => \&do_MOVE,
		       'NEWGROUPS' => \&do_NEWGROUPS,
		       'POST'      => \&do_POST,
		       'POSTRULE'  => \&do_POSTRULE,
		       'QUIT'      => \&do_QUIT,
		       'XOVER'     => \&do_XOVER,
		       'XOVERVIEW' => \&do_XOVER);

  # default values of the command-line parameters.
  $::home  = (getpwuid($<))[7]; 
  $::opt_d = "$::home/Mail/mail.db";
  $::opt_r = "$::home/.nndbrc";
  $::opt_m = ($::ENV{"MAILDIR"} || "$::home/Mail/incoming");
  $::opt_p = 9000;
  $::opt_v = 0;
  $::opt_g = 0;
  $::opt_h = 0;
  $::opt_a = ();
}

sub usage {
  print STDERR <<EOF;
 usage: nndb [-g] [-v] [-p port] [-r rule file] [-m mail database]
             [-a username/password] [-h]
    -g: use GDBM, instead of Berkeley DB
    -v: verbose mode
    -p: port number.  defaults to 9000
    -r: rules file.  defaults to ~/.nndbrc
    -d: mail database file.  defaults to ~/Mail/mail.db.
    -a: use the given authorization username and password.
        defaults to using the ~/.nntp-authinfo file, if it exists,
        or no authorization if it does not.
    -m: which maildir directory to read leftover messages from.
        defaults to ~/Mail/incoming.
    -h: show this message
EOF
  
  exit 64;
}

# return an answer code to the client
sub answer {
  my($fd)   = shift;
  my($code) = shift;

  my($pat) = $::responses{$code};

  if ($pat) {
    print $fd sprintf($pat, @_);
  } else {
    print $fd "$code unknown error\r\n";
  }
}

# open the correct database file.
sub open_db {
  if ($::opt_g) {
    use GDBM_File;
    $::db_handle = tie %::hash, "GDBM_File", $::opt_d, &GDBM_WRCREAT, 0644 or
      die "Database open error on $::opt_d $!";
  } else {
    use DB_File;
    use Fcntl;
    $::db_handle = tie %::hash, "DB_File", $::opt_d, O_RDWR | O_CREAT, 0644, $DB_File::DB_HASH or
      die "Database open error on $::opt_d $!";
  }
}

# send the "last line" marker to the client
sub last_line {
  my($fd) = @_;
  print $fd ".\r\n";
}

# make a vector out of all of the sockets we are monitoring.
sub make_vec {
  my($key);
  my($vec);
  foreach $key (@::all_socks) {
    vec($vec, fileno($key), 1) = 1;
  }
  $vec;
}

# read the rule file.
# format of the file:
#
# : flags
# * regexp
# * regexp
# group
# group
#       <- blank line
#
# the regexps are "and"ed together.  if all of them match, the article
# is delivered to all of the specified groups.

sub read_rules {
  @::all_flags   = ();
  @::all_rules   = ();
  @::all_actions = ();

  unless (-f $::opt_r) {
    return;
  }

  open(GROUP, $::opt_r) or die "opening $::opt_r";

  my($state) = 'START';
  my($flags);
  my($line);
  my($count) = -1;

  my($to_rule) = "(^((Original-)?(Resent-)?(To|Cc|Bcc)|(X-Envelope|Apparently(-Resent)?)-To):(.*[^a-zA-Z])?)";
  
  my($from_daemon) = '(^(Precedence:.*(junk|bulk|list)|To: Multiple recipients of |(((Resent-)?(From|Sender)|X-Envelope-From):|>?From )([^>]*[^(.%@a-z0-9])?(Post(ma?(st(e?r)?|n)|office)|(send)?Mail(er)?|daemon|mmdf|n?uucp|LIST(SERV|proc)|NETSERV|owner|r(e(quest|sponse)|oot)|b(ounce|bs\.smtp)|echo|mirror|s(erv(ices?|er)|mtp)|A(dmin(istrator)?|MMGR|utoanswer))(([^).!:a-z0-9][-_a-z0-9]*)?[%@>\t ][^<)]*(\(.*\).*)?)?$([^>]|$)))';

  my($from_mailer) = '(^(((Resent-)?(From|Sender)|X-Envelope-From):|>?From )([^>]*[^(.%\@a-z0-9])?(Post(ma(st(er)?|n)|office)|(send)?Mail(er)?|daemon|mmdf|n?uucp|r(esponse|oot)|(bbs\.)?smtp|serv(ices?|er)|A(dmin(istrator)?|MMGR))(([^).!:a-z0-9][-_a-z0-9]*)?[%@>\t ][^<)]*(\(.*\).*)?)?$([^>]|$))';
  
  while (<GROUP>) {
    # skip comments
    next if /^\s*\#/;

    chomp;

    $line = $_;

    # FSM parser
  SWITCH: for ($state) {
      /^START/ && do {
	if ($line =~ /^\s*:\s*(.*)/) {
	  $count++;
	  $state = 'PAT';
	  $::all_flags[$count]   = $1;
	  $::all_rules[$count]   = [];
	  $::all_actions[$count] = [];
	}
	last SWITCH;
      };

      # keep getting patterns until we find a group
      /^PAT/ && do {
	if ($line =~ /^\s*\*\s*(.*)/) {
	  my($pat) = $1;

	  #do procmail expansions
	  $pat =~ s/\^TO/$to_rule/;

	  
	  $pat =~ s/\^FROM_DAEMON/$from_daemon/;

	  $pat =~s/\^FROM_MAILER/$from_mailer/;
	  
	  push (@{$::all_rules[$count]}, $pat);
	} elsif ($line =~ /^\s*(.*)$/) {
	  $state = 'GROUP';
	  push (@{$::all_actions[$count]}, $1);
	}
	last SWITCH;
      };

      # get groups until we find a rule start, or a blank line.
      /^GROUP/ && do {
	if ($line =~ /^\s*:\s*(.*)/) {
	  $count++;
	  $state = 'PAT';
	  $::all_flags[$count]   = $1;
	  $::all_rules[$count]   = [];
	  $::all_actions[$count] = [];
	} elsif ($line =~ /^\s*$/) {
	  $state = 'START';
	} elsif ($line =~ /^\s*(.*)$/) {
	  push(@{$::all_actions[$count]}, $1);
	} else {
	  $state = 'START';
	}
	last SWITCH;
      }
    }
  }
}

sub read_leftovers {
  if (-d $::opt_m) {
    if (-d "$::opt_m/new") {
      opendir(NEW_DIR, "$::opt_m/new") or
	die "opening $::opt_m/new: $!";

      my(@allfiles) = grep(!/^\.\.?$/, readdir(NEW_DIR));
      closedir(NEW_DIR);

      my($f);
      my($status);
      foreach $f (@allfiles) {
	open(LEFTOVER, "$::opt_m/new/$f") or
	  die "opening $::opt_m/new/$f: $!";
	$status = maybe_post(\*LEFTOVER);
	close(LEFTOVER);

	unlink ("$::opt_m/new/$f") or
	  die "removing $::opt_m/new/$f: $!";
      }
    }
    
    if (-d "$::opt_m/tmp") {
      opendir(TMP_DIR, "$::opt_m/tmp") or
	die "opening $::opt_m/tmp: $!";

      my(@allfiles) = grep(!/^\.\.?$/, readdir(TMP_DIR));
      closedir(TMP_DIR);
      my($f);
      my($status);
      foreach $f (@allfiles) {
	if (-A "$::opt_m/tmp/$f" > 1.5) {
	  open(LEFTOVER, "$::opt_m/tmp/$f") or
	    die "opening $::opt_m/tmp/$f: $!";
	  $status = maybe_post(\*LEFTOVER);
	  close(LEFTOVER);
	  
	  unlink ("$::opt_m/tmp/$f") or
	    die "removing $::opt_m/tmp/$f: $!";
	}
      }
    }
  }
}

# add a group to the group list, if it isn't already there.
sub add_group {
  my($group) = @_;

  my($key);
  foreach $key (split(':', $::hash{"groups"})) {
    if ($key eq $group) {
      return;
    }
  }

  $::hash{$group,"time"} = time;
  if ($::hash{"groups"}) {
    $::hash{"groups"} .= ":$group";
  } else {
    $::hash{"groups"} = $group;
  }
}

# put an article into the database
sub write_article {
  my($group, $msg_header, $msg_body) = @_;

  my($last) = ($::hash{$group,"last"} or "0");
  $last++;

  my($key);
  
  foreach $key (keys %::good_header) {
    $::hash{$group,$last,$key} = $::good_header{$key};
  }
  
  $::hash{$group,$last,"head"} = $msg_header;
  $::hash{$group,$last,"body"} = $msg_body;
  $::hash{$group,"last"}       = $last;
  
  $::hash{"id",$::good_header{"message-id"},"art"}   = $last;
  $::hash{"id",$::good_header{"message-id"},"group"} = $group;
  
  if (! $::hash{$group,"first"}) {
    $::hash{$group,"first"} = $last;
  }

  if (! $::opt_g) {
    $::db_handle->sync();
  }

  print STDERR "Writing to $group:$last\n" if $::opt_v;
}

# initialize network connections.
sub init_sock {
  my($proto);
  my($sockaddr_in);
  
  $proto = (getprotobyname('tcp'))[2];
  socket(S, PF_INET, SOCK_STREAM, $proto) ||
    die "Socket: $!";
  setsockopt(S, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) ||
    die "setsockopt: $!";
  
  $sockaddr_in = pack_sockaddr_in($::opt_p,INADDR_ANY) ||
    die "pack: $!";
  
  bind(S, $sockaddr_in) ||
    die "bind: $!";
  
  listen(S,5) ||
    die "listen: $!";
  
  push (@::all_socks, \*S);
  select(S); $| = 1; select(STDOUT);
}

# print out a bit vector in string format.  useful for debugging.
sub print_vec {
  my($vec) = @_;
  print STDERR unpack('b*', $vec), "\n";
}

sub maybe_post {
  my($in_fd) = @_;

  my($body) = 0;
  my($count);
  my($flags);
  my($group);
  my($header_name);
  my($header_val);
  my($key);
  my($lines) = 0;
  my($msg_body);
  my($msg_header);
  my($rule);
  my(%groups) = ();

  foreach $key (keys %::good_header) {
    $::good_header{$key} = "";
  }
  
  POSTRULE_MSG:
  while (<$in_fd>) {
    s/[\r\n]+$//;
    
    last POSTRULE_MSG if /^\.$/;

    RULE_LOOP:
    foreach $count (0 .. $#::all_rules) {
      $flags = $::all_flags[$count];

      SMALL_RULE_LOOP:
      foreach $rule (@{$::all_rules[$count]}) {
	# unless there is a B flag, don't grep the body.  If there is
	# one, only grep the header if there is also an H flag.
	if ($flags =~ /B/) {
	  next SMALL_RULE_LOOP unless ($body || ($flags =~ /H/));
	}

	# D controls case searching
	if ($flags =~ /D/) {
	  next RULE_LOOP unless /$rule/;
	} else {
	  next RULE_LOOP unless /$rule/i;
	}
      }

      foreach $group (@{$::all_actions[$count]}) {
	$groups{$group}++;
      }
      
      unless ($flags =~ /c/) {
	last RULE_LOOP;
      }
    }
    
    if ($body) {
      $msg_body .= "$_\r\n";
      $lines++;
    } else {
      if (/^$/) {
	$body = 1;
      } else {
	$msg_header .= "$_\r\n";
	/^([^:]+):\s+(.*)/ or /^\s*(.*)/;
	if ($2) {
	  $header_name = lc $1;
	  if (defined $::good_header{$header_name}) {
	    $::good_header{$header_name} = $2;
	  }
	} else {
	  if (defined $::good_header{$header_name}) {
	    $::good_header{$header_name} .= $2;
	  }
	}
      }
    }
  }

  
  if (! %groups) {
    $groups{"misc"}++;
  }
  
  $::good_header{"bytes"} = length($msg_body);
  $::good_header{"lines"} = $lines;

  # duplicate check
  if ($::hash{"id",$::good_header{"message-id"},"art"}) {
    return(437);
  }

  foreach $group (keys %groups) {
    add_group($group);

    write_article($group, $msg_header, $msg_body);    
  }

  return(240);
}

sub delete_article {
  my($group, $art) = @_;
  
  unless ($::hash{$group,$art,"head"}) {
    return 430;
  }

  delete $::hash{"id",$::hash{$group,$art,"message-id"},"art"};
  delete $::hash{"id",$::hash{$group,$art,"message-id"},"group"};
  
  # clean up xover info
  my($key);
  foreach $key (keys %::good_header) {
    delete $::hash{$group,$art,$key};
  }
  
  delete $::hash{$group,$art,"head"};
  delete $::hash{$group,$art,"body"};
  
  if (! $::opt_g) {
    $::db_handle->sync();
  }

  return 250;
}

sub do_ARTICLE {
  my($fd, $params) = @_;

  my($art)   = 0;
  my($group) = $::group{$fd};

  if ($params =~ /^[0-9]+$/) {
    $art = $params;
  } else {
    $art   = $::hash{"id",$params,"art"};
    $group = $::hash{"id",$params,"group"};
  };
  
  unless ($group) {
    answer($fd, 412);
    return;
  }
  
  if ($::hash{$group,$art,"head"}) {
    $::current{$fd} = $art;
    answer($fd, 220, $art, $::hash{$group,$art,"message-id"});
    print $fd <<EOF;
$::hash{$group,$art,"head"}\r
\r
$::hash{$group,$art,"body"}\r
EOF
    last_line($fd);
  } else {
    answer($fd, 423);
  }
}

sub do_AUTHINFO {
  my($fd, $params) = @_;

  if ($params =~ /(USER|PASS)\s+(.*)/i) {
    if ((uc $1) eq "USER") {
      if ($::auth_user eq $2) {
	$::auth_first{$fd} = 1;
	answer($fd, 381);
      } else {
	answer($fd, 482);
      }
    } elsif ((uc $1) eq "PASS") {
      if (($::auth_pass eq $2) && $::auth_first{$fd}) {
	$::auth{$fd} = 1;
	answer($fd, 281);
      } else {
	answer($fd, 482);
      }
    } else {
    answer($fd, 482);
    }
  } else {
    answer($fd, 482);
  }
}

sub do_BODY {
  my($fd, $params) = @_;

  my($art)   = 0;
  my($group) = $::group{$fd};
  
  if ($params =~ /^[0-9]+$/) {
    $art = $params;
  } else {
    $art   = $::hash{"id",$params,"art"};
    $group = $::hash{"id",$params,"group"};
  };

  unless ($group) {
    answer($fd, 412);
    return;
  }
  
  if ($::hash{$group,$art,"body"}) {
    $::current{$fd} = $art;
    answer($fd, 222, $art, $::hash{$group,$art,"message-id"});
    print $fd $::hash{$group,$art,"body"};
    last_line($fd);
  } else {
    answer($fd, 423);
  }
}

sub do_COPY {
  my($fd, $params) = @_;

  my($art)       = 0;
  my($group)     = $::group{$fd};
  my($new_group) = ();
  
  if ($params =~ /^([0-9]+)\s+(\S+)/) {
    $art       = $1;
    $new_group = $2;
  } elsif ($params =~ /^(\S+)\s+(\S+)$/) {
    $art       = $::hash{"id",$1,"art"};
    $group     = $::hash{"id",$1,"group"};
    $new_group = $2;
  };

  unless ($group && $new_group) {
    answer($fd, 412);
    return;
  }

  unless ($::hash{$group,$art,"head"}) {
    answer($fd, 430);
    return;
  }
  
  my($key);
  foreach $key (keys %::good_header) {
    $::good_header{$key} = $::hash{$group,$art,$key}
  }
  
  write_article($new_group,
		$::hash{$group,$art,"head"},
		$::hash{$group,$art,"body"});

  answer($fd, 240);
}

sub do_DELETE {
  my($fd, $params) = @_;

  my($art)   = 0;
  my($group) = $::group{$fd};
  
  if ($params =~ /^([0-9]+)/) {
    $art = $1;
  } else {
    $art   = $::hash{"id",$1,"art"};
    $group = $::hash{"id",$1,"group"};
  };

  unless ($group) {
    answer($fd, 412);
    return;
  }
  
  answer($fd, delete_article($group, $art));
}

sub do_GROUP {
  my($fd, $group) = @_;

  $::group{$fd} = $group;
  my($last)  = ($::hash{$::group{$fd},"last"} or "0");
  my($first) = ($::hash{$::group{$fd},"first"} or "0");
  my($total) = $last - $first;
  print $fd "211 $total $first $last $::group{$fd}\r\n";

  add_group($group);
}

sub do_HEAD {
  my($fd, $params) = @_;

  my($art)   = 0;
  my($group) = $::group{$fd};
  
  if ($params =~ /^[0-9]+$/) {
    $art = $params;
  } else {
    $art   = $::hash{"id",$params,"art"};
    $group = $::hash{"id",$params,"group"};
  }

  print STDERR "art: $art\n";
  
  unless ($group) {
    answer($fd, 412);
    return;
  }
  
  if ($::hash{$group,$art,"head"}) {
    $::current{$fd} = $art;
    answer($fd, 222, $art, $::hash{$group,$art,"message-id"});
    print $fd $::hash{$group,$art,"head"};
    last_line($fd);
  } else {
    answer($fd, 423);
  }
}

sub do_LIST {
  my($fd, $params) = @_;

  answer($fd, 215);

  my($group, $first, $last);
  foreach $group (split(':', $::hash{"groups"})) {
    $last  = $::hash{$group,"last"};
    $first = $::hash{$group,"first"};
    
    print $fd "$group $last $first y\r\n";
  }
  
  last_line($fd);
}

sub do_MODE {
  my($fd,$params) = @_;
  answer($fd,200);
}

sub do_MOVE {
  my($fd,$params) = @_;

  my($art)       = 0;
  my($group)     = $::group{$fd};
  my($new_group) = ();
  
  if ($params =~ /^([0-9]+)\s+(\S+)/) {
    $art       = $1;
    $new_group = $2;
  } elsif ($params =~ /^(\S+)\s+(\S+)$/) {
    $art       = $::hash{"id",$1,"art"};
    $group     = $::hash{"id",$1,"group"};
    $new_group = $2;
  };

  unless ($group && $new_group) {
    answer($fd, 412);
    return;
  }

  unless ($::hash{$group,$art,"head"}) {
    answer($fd, 430);
    return;
  }
  
  my($key);
  foreach $key (keys %::good_header) {
    $::good_header{$key} = $::hash{$group,$art,$key}
  }
  
  write_article($new_group,
		$::hash{$group,$art,"head"},
		$::hash{$group,$art,"body"});
  
  my($status) = delete_article($group, $art);
  if ($status == 250) {
    answer($fd, 251);
  } else {
    answer($fd, $status);
  }
}

sub do_NEWGROUPS {
  my($fd,$params) = @_;
  answer($fd,231);
  last_line($fd);
}

sub do_POST {
  my($fd, $params) = @_;

  my($body) = 0;
  my($header_name);
  my($header_val);
  my($lines) = 0;
  my($key);
  my($msg_body);
  my($msg_header);
  
  answer($fd,340);
  
  foreach $key (keys %::good_header) {
    $::good_header{$key} = "";
  }
  
  POST_MSG:
  while (<$fd>) {
    s/[\r\n]+$//;
    
    last POST_MSG if /^\.$/;
    if ($body) {
      $msg_body .= "$_\r\n";
      $lines++;
    } else {
      if (/^$/) {
	$body = 1;
      } else {
	$msg_header .= "$_\r\n";
	/^([^:]+):\s+(.*)/ or /^\s*(.*)/;
	if ($2) {
	  $header_name = lc $1;
	  if (defined $::good_header{$header_name}) {
	    $::good_header{$header_name} = $2;
	  }
	} else {
	  if (defined $::good_header{$header_name}) {
	    $::good_header{$header_name} .= $2;
	  }
	}
      }
    }
  }

  $::good_header{"bytes"} = length($msg_body);
  $::good_header{"lines"} = $lines;

  if ($::hash{"id",$::good_header{"message-id"},"art"}) {
    answer($fd, 437);
    return;
  }
  
  write_article($::group{$fd},
		$msg_header, $msg_body);
  
  answer($fd, 240);
}

sub do_POSTRULE {
  my($fd, $params) = @_;

  
  answer($fd,340);
  
  answer($fd, maybe_post($fd));
}

sub do_QUIT {
  my($fd, $params) = @_;
  
  close_fd($fd);
}

sub do_XOVER {
  my($fd, $params) = @_;

  unless ($::group{$fd}) {
    answer($fd, 412);
    return;
  }

  my($first,$last);
  
  $params =~ /([0-9]+)\s*-?\s*([0-9]+)?/;

  if ($1) {
    $first = $1;
    $last  = $1; 
  } elsif ($::current{$fd}) {
    $first = $::current{$fd};
    $last  = $::current{$fd};
  } else {
    answer($fd,420);
    return;
  }
  
  if ($2) {
    $last = $2;
  } 

  answer($fd, 224);

  my($art);
  print STDERR "$first - $last\n" if $::opt_v;
  
  foreach $art ($first..$last) {
    if ($::hash{$::group{$fd},$art,"head"}) {
      print $fd "$art\t";
      print $fd $::hash{$::group{$fd},$art,"subject"} , "\t";
      print $fd $::hash{$::group{$fd},$art,"from"} , "\t";
      print $fd $::hash{$::group{$fd},$art,"date"} , "\t";
      print $fd $::hash{$::group{$fd},$art,"message-id"} , "\t";
      print $fd $::hash{$::group{$fd},$art,"references"} , "\t";
      print $fd $::hash{$::group{$fd},$art,"bytes"} , "\t";
      print $fd $::hash{$::group{$fd},$art,"lines"} , "\r\n";
    }
  }
  
  last_line($fd);
}

END {
  untie %::hash;
}

# Emacs local variables.  Needed since otherwise Emacs thinks this is
# a bourne shell script.
# Local Variables:
# mode: perl
# End: