#!/usr/local/bin/perl --	# -*-Perl-*-

#----------------------------------------------------------------------
# variables you might have to change:

$nntp_server = "your.newshost.in.here";
$nntp_port   = 119;
$nntp_defart = "article";
$nntp_groups = "/usr/local/etc/go4gw.modules/NEWSGROUPS";
$nntp_reverse = 0;  # to list articles in reverse order

#----------------------------------------------------------------------

@nntp_acl=(
#     ipaddress  group    access + = allow, - = deny    
     '.*         ^clari   -',
     '.*         .*       +'
  );
# end of variables

# Commands this server responds to:
# 
# ""                         -> list top level groups
# ls  [$group] [$range]      -> list group's articles and sub-groups
# lsa [$group] [$range]      -> like "", sends "article" & "lsa" commands back
# lsb [$group] [$range]      -> "" sends "body" & "lsb" commands back
# lsh [$group] [$range]      -> "" sends "header" & "lsh" commands back
# article <id>               -> get article by ID
# article $group $number     -> get 1 article, number can be "last" or "first",
#                               or any numeric perl expression.
# body <id>                  -> like article, but just get text
# body $group $number        -> ""
# head <id>                  -> like article, but just get header
# head $group $number        -> ""
# sorry                      -> send sorry message
#
# The optional $range arguement has the following format:
#      n         - return 'n' most recent articles
#     x:y        - return articles x through y (inclusive)
#                  x and y can both be numeric perl expressions. The
#                  string 'last' is replaced with the last article in the
#                  group, and the string 'first' is replaced with the first.
#   first:last   - all articles (same as not specifiying a range
#   last:first   - all articles (in reverse order)
#  last-9:last   - return last 10 articles (same as specifiying 10)
#  last:last-9   - return last 10 articles in reverse order


sub nntp_main {
  local($_) = @_;

  &do_find($1, $nntp_defart, $2, "find") if /^find\s+(\S+)\s+(.*)/i;

  &do_ls("",$nntp_defart,"ls") if /^$/;
  &do_ls("",$nntp_defart,"ls") if /^ls\s*$/;
  &do_ls($1,$nntp_defart,"ls") if /^ls\s+(.*)/i;

  &do_ls("","article","lsa") if /^lsa\s*$/;
  &do_ls($1,"article","lsa") if /^lsa\s+(.*)/i;

  &do_ls("","body","lsb") if /^lsb\s*$/;
  &do_ls($1,"body","lsb") if /^lsb\s+(.*)/i;

  &do_ls("","head","lsh") if /^lsh\s*$/;
  &do_ls($1,"head","lsh") if /^lsh\s+(.*)/i;

  &do_article($1,$2,"ARTICLE") if /^article\s+(\S+)\s+(\S+)/i;
  &do_article_id($1,"ARTICLE") if /^article\s+(<.*>)/i;

  &do_article($1,$2,"HEAD") if /^head\s+(\S+)\s+(\S+)/i;
  &do_article_id($1,"HEAD") if /^head\s+(<.*>)/i;

  &do_article($1,$2,"BODY") if /^body\s+(\S+)\s+(\S+)/i;
  &do_article_id($1,"BODY") if /^body\s+(<.*>)/i;

  &Gsorry if /^sorry$/;
  &Gabort("Unknown command!");
  exit;
}

sub do_article_id {
  local($id,$cmd) = @_;
  &open_nntp;
  &Gsend("$cmd $id");
  $_ = &Grecv;
  &Gabort($_) if !/^2/;
 
  while(<GSERVER>) {
    print;
    last if /^\.\r\n$/;
  }

  &close_nntp;
  exit;

}

sub do_article {
  local($group,$number,$cmd) = @_;

  if (&check_access($group) eq '-')  { &Gsorry; }
  &open_nntp;

  &Gsend("GROUP $group");
  $_ = &Grecv;
  &Gabort($_) if !/^2/;
  ($n,$f,$l) = /\d+\s+(\d+)\s+(\d+)\s+(\d+)/;

  $number = int($number);
  $number = int($f) if $number =~ m/first/;
  $number = int($l) if $number =~ m/last/;

  &Gsend("$cmd $number");
  $_ = &Grecv;
  &Gabort($_) if !/^2/;
 
  while(<GSERVER>) {
    print;
    last if /^\.\r\n$/;
  }

  &close_nntp;
  exit;
}

sub list_group {
  local($group,$type,$range) = @_;

  &Gsend("GROUP $group");
  $_ = &Grecv;
  &Gabort($_) if !/^211/;

  ($n,$f,$l) = /211\s+(\d+)\s+(\d+)\s+(\d+)/;

  if ($range =~ /^(\S+):(\S+)$/) {
      $low = $1; $high = $2;
      
      $low = int($low);
      $low = int($f) if (/first/);
      $low = int($l) if (/last/);

      $high = int($high);
      $high = int($f) if ($high =~ /first/);
      $high = int($l) if ($high =~ /last/);

      if ($low > $l) { $low = $l; }
      elsif ($low < $f) {$low = $f; }
      if ($high > $l) { $high = $l; }
      elsif ($high < $f) {$high = $f; }

      if ($high < $low)  {  $f = $high; $l = $low;  $nntp_reverse=1; }
      if ($low <= $high) {  $f = $low; $l = $high;  $nntp_reverse=0; }
        
  }
  elsif ($range ne '') {
       $range = int($range);
       $range = int($f) if ($range =~ /first/);
       $range = int($l) if ($range =~ /last/);
       if ($range >0 && $range < $n) {  $f = $l - $range + 1; }
  }

  &Gsend("XHDR Subject $f-$l");
  $_ = &Grecv;
  &Gabort($_) if !/^221/;
 
  while(<GSERVER>) {
    chop; chop;
    last if /^\.$/;
    ($article,$subject) = /^(\d+)\s+(.*)/;
    $subject =~ s/\t/ /g; # just in case!
    push(@martin_subject, $subject);
    push(@marticle, $article);
  }

  &Gsend("XHDR Lines $f-$l");
  $_ = &Grecv;
  &Gabort($_) if !/^221/;

  $i=0;
  while(<GSERVER>) {
    chop; chop;
    last if /^\.$/;
    ($lines) = /^\d+\s+(.*)/;
    $lines =~ s/\t/ /g; # just in case!
    $lines =~ s/\((.*)\)/$1/;
    $martin_subject[$i] = 
      sprintf("%-38.38s [%4.4s]", $martin_subject[$i], $lines);
    $i++;
  }

  &Gsend("XHDR From $f-$l");
  $_ = &Grecv;
  &Gabort($_) if !/^221/;

  $i=0;
  while(<GSERVER>) {
    chop; chop;
    last if /^\.$/;
    ($from) = /^\d+\s+(.*)/;
    $from =~ s/\t/ /g; # just in case!
    $from =~ s/<.*>\s(.*)/$1/;
    $from =~ s/(.*)\s<.*>/$1/;
    $from =~ s/.*\((.*)\).*/$1/;

    $martin_subject[$i] = sprintf("%s %-20.20s", $martin_subject[$i], $from);

    if ($nntp_reverse) {
      push(@reply, "0$martin_subject[$i]\t$Ggw $atype $group $marticle[$i]\t$Ghost\t$Gport");
    } else {
      &Greply("0$martin_subject[$i]\t$Ggw $atype $group $marticle[$i]\t$Ghost\t$Gport");
    }

    $i++;
  }

  if ($nntp_reverse) {
    for ($i=$#reply; $i!= -1; $i--) { &Greply($reply[$i]); } 
  }

  &Greply(".");
  &close_nntp;
  exit;
}

sub find_group {
  local($group, $atype, $query, $range) = @_;

  &Gsend("GROUP $group");
  $_ = &Grecv;
  &Gabort($_) if !/^211/;

  ($n,$f,$l) = /211\s+(\d+)\s+(\d+)\s+(\d+)/;

  if ($range =~ /^(\S+):(\S+)$/) {
      $low = $1; $high = $2;
      
      $low = int($low);
      $low = int($f) if (/first/);
      $low = int($l) if (/last/);

      $high = int($high);
      $high = int($f) if ($high =~ /first/);
      $high = int($l) if ($high =~ /last/);

      if ($low > $l) { $low = $l; }
      elsif ($low < $f) {$low = $f; }
      if ($high > $l) { $high = $l; }
      elsif ($high < $f) {$high = $f; }

      if ($high < $low)  {  $f = $high; $l = $low;  $nntp_reverse=1; }
      if ($low <= $high) {  $f = $low; $l = $high;  $nntp_reverse=0; }
        
  }
  elsif ($range ne '') {
      $range = int($range);
      $range = $f if ($range =~ /first/);
      $range = $l if ($range =~ /last/);
      if ($range >0 && $range < $n) {  $f = $l - $range + 1; }
  }

  &Gsend("XHDR Subject $f-$l");
  $_ = &Grecv;
  &Gabort($_) if !/^221/;
 
  while(<GSERVER>) {
    chop; chop;
    last if /^\.$/;
    ($article,$subject) = /^(\d+)\s+(.*)/;
    $subject =~ s/\t/ /g; # just in case!
    push(@martin_subject, $subject);
    push(@marticle, $article);
  }

  &Gsend("XHDR Lines $f-$l");
  $_ = &Grecv;
  &Gabort($_) if !/^221/;

  $i=0;
  while(<GSERVER>) {
    chop; chop;
    last if /^\.$/;
    ($lines) = /^\d+\s+(.*)/;
    $lines =~ s/\t/ /g; # just in case!
    $lines =~ s/\((.*)\)/$1/;
    $martin_subject[$i] = 
      sprintf("%-38.38s [%4.4s]", $martin_subject[$i], $lines);
    $i++;
  }

  &Gsend("XHDR From $f-$l");
  $_ = &Grecv;
  &Gabort($_) if !/^221/;

  $i=0;
  while(<GSERVER>) {
    chop; chop;
    last if /^\.$/;
    ($from) = /^\d+\s+(.*)/;
    $from =~ s/\t/ /g; # just in case!
    $from =~ s/<.*>\s(.*)/$1/;
    $from =~ s/(.*)\s<.*>/$1/;
    $from =~ s/.*\((.*)\).*/$1/;

    $martin_subject[$i] = sprintf("%s %-20.20s", $martin_subject[$i], $from);

    push(@reply, "0$martin_subject[$i]\t$Ggw $atype $group $marticle[$i]\t$Ghost\t$Gport");

    $i++;
  }

  @quer=split(" ",$query);

  foreach $rep (@reply) {
      foreach $que (@quer) {
	  if(grep(/$que/i,$rep)) {
	      push(@real_reply,$rep);
	      last;
	  }
      }
  }

  if ($nntp_reverse) {
    for ($i=$#real_reply; $i!= -1; $i--) { &Greply($real_reply[$i]); } 
  }
  else {
    for ($i=$1; $i <= $#real_reply; $i++) { &Greply($real_reply[$i]); }
  }

  &Greply(".");
  &close_nntp;
  exit;
}

sub do_ls {
  local($prefix,$atype,$lscmd) = @_;
  local($range);

  $prefix =~ s/\s+$//;

  if ($prefix =~ /(\S+)\s+(\S+)/) {
      $prefix = $1;
      $range  = $2;
  }
  elsif (($prefix =~ /^\d+$/) || ($prefix =~ /:/)) {
      $range = $prefix;
      $prefix = "";
  }

  if (&check_access($prefix) eq '-') {
      &Greply("0Sorry! No access off of campus!\t$Ggwsorry\t$Ghost\t$Gport");
      &Greply("."); 
      exit; 
  }

  &open_nntp;
  if ( $lscmd ne "lsa" || $prefix eq '') {
  &get_groups($prefix);
  } else {
	@groups=($prefix);
  }

  foreach(sort @groups) {
      $zin = index($_,$prefix);
      $zot = substr($_,length($prefix),1);
      $zit = substr($_,length($prefix) + 1, length($_));
      $zut = index($zit,'.');

      if($zut > 0) {
	  $zzz = substr($zit,0,$zut);
	  $zit = $zzz;
      }

      $old_thing = $_;

      if ($_ eq $prefix) { $do_list_group = $_; }
      elsif ($zin == 0 && $zot eq '.') {
	  $leaf=$zit;

	  $ov = $novs{"$prefix.$leaf"};
	  if($ov =~ /^[\t\s]/) {
	      $title = $leaf;
	  }
	  else {
	      $title = sprintf("%-15.15s $ov", $leaf);
	  }

	  $save{"$prefix.$leaf"} = 
	      "1$title\t$Ggw $lscmd $prefix.$leaf $range\t$Ghost\t$Gport";

	  if (join('.',$prefix,$leaf) eq $old_thing) {
	      $save{"$prefix.$leaf (idx)"} =
		  "7$title\t$Ggw find $prefix.$leaf $range\t$Ghost\t$Gport";
	  }
      }
      elsif ($prefix eq '' && /([^.]*)/) {
	  $ov = $novs{$1};
	  if($ov =~ /^[\t\s]/) {
	      $title = $1;
	  }
	  else {
	      $title = sprintf("%-15.15s $ov", $1);
	  }

	  $save{"$1"} = "1$title\t$Ggw $lscmd $1 $range\t$Ghost\t$Gport";

	  if ($1 eq $old_thing) {
	      $save{"$1 (idx)"} = 
		  "7$title\t$Ggw $lscmd $1 $range\t$Ghost\t$Gport";
	  }			
      }
  }

  foreach (sort keys %save) { &Greply($save{$_}); }
  &list_group($do_list_group,$atype,$range) if ($do_list_group);

  &Greply(".");
  &close_nntp;
  exit;
}

sub do_find {
  local($prefix,$atype,$query,$lscmd) = @_;
  local($range);

  $prefix =~ s/\s+$//;

  if ($prefix =~ /(\S+)\s+(\S+)/) {
      $prefix = $1;
      $range  = $2;
  }
  elsif (($prefix =~ /^\d+$/) || ($prefix =~ /:/)) {
      $range = $prefix;
      $prefix = "";
  }

  if (&check_access($prefix) eq '-') {
      &Greply("0Sorry! You don't have permission for that!\t$Ggw sorry\t$Ghost\t$Gport");
      &Greply("."); 
      exit; 
  }

  &open_nntp;
  &find_group($prefix,$atype,$query,$range);

  &Greply(".");
  &close_nntp;
  exit;
}

sub open_nntp {
  local($_);
  &GopenServer($nntp_server,$nntp_port);
  $_ = &Grecv;
  &Gabort($_) if !/^2/;
}

sub close_nntp {
  &Gsend("QUIT");
  close(GSERVER);
}

sub get_groups {
 local($prefix)=@_;
 if (open(GROUPS,$nntp_groups)) {
      if ($prefix ne '') {
	 while(<GROUPS>) {
	    chop;
	    if(index($_,$prefix) == 0) {
		($grp,$nov) = split(/\t/);
		push(@groups,$grp);
		$novs{$grp}=$nov;
	    }
	 }
      } else {
      while(<GROUPS>) {
          chop;
	  ($grp,$nov) = split(/\t/);
          push(@groups,$grp);
	  $novs{$grp}=$nov;
      }
  }
      close(GROUPS);
 } else {                  # can't open file, get list from server!
  &load_groups;
 }
}

sub load_groups {
  &open_nntp;
  &Gsend("LIST");
  $_ = &Grecv;
  &Gabort($_) if !/^215/;

  while(<GSERVER>) {
    chop; chop;
    last if /^\.$/;
    s/^(\S+).*/$1/;
    push(@groups,$_);
  }

}

sub create_groups { 
  &load_groups;
  open(GROUPS,">$nntp_groups") || die "$nntp_groups: $!";
  foreach (@groups) { print GROUPS "$_\n"; }
  close GROUPS;
  &close_nntp;
  exit;
}

sub check_access {
   local($group)=@_;

   return 1 if (-t STDIN);
   $sockaddr = 'S n a4 x8';
   $mysockaddr = getpeername(STDIN);
   ($ramily,$rport,$raddr) = unpack($sockaddr,$mysockaddr);
   ($a,$b,$c,$d) = unpack('C4',$raddr);
   $ipaddress = "$a.$b.$c.$d";

   foreach (@nntp_acl) {
      ($ipacl,$groupacl,$access)=split;
      return $access if  ($ipaddress =~ /$ipacl/) && ($group =~ /$groupacl/);
   }
   return '-'; #default is to restrict access
}

1; # for require
