scripts/ChiarkNNTP.pm

   1 #!/usr/bin/perl
   2
   3 use strict qw(subs);
   4 use warnings;
   5
   6 require 5.002;
   7 use Socket;
   8 use FileHandle;
   9
  10
  11 BEGIN {
  12     use Exporter   ();
  13     our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
  14
  15     # set the version for version checking
  16     $VERSION     = 1.00;
  17
  18     @ISA         = qw(Exporter);
  19     @EXPORT      = qw(cnntp_connect);
  20     %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],
  21
  22     @EXPORT_OK   = qw();
  23 }
  24 our @EXPORT_OK;
  25
  26 sub cnntp_connect ($) {
  27     my ($verbose) = @_;
  28
  29     my $ns=$ENV{'NNTPSERVER'};
  30     if (!defined $ns or !length $ns) {
  31         $ns = `cat /etc/nntpserver`;
  32         chomp($ns);
  33     }
  34     my $port = (getservbyname("nntp", "tcp"))[2];
  35     $ns = inet_aton($ns);
  36     my $proto = getprotobyname("tcp");
  37     my $paddr = sockaddr_in($port, $ns);
  38
  39     my $sock = new IO::Handle;
  40     socket($sock,PF_INET,SOCK_STREAM,$proto) or die "socket: $!";
  41     connect($sock,$paddr) or die "connect: $!";
  42
  43     $sock->autoflush(1);
  44
  45     return bless { S => $sock, V => $verbose };
  46 }
  47
  48 sub banner_reader ($) {
  49     my ($c) = @_;
  50     my ($code,$l) = $c->getline();
  51     $code =~ /^2\d\d/ or die "no initial greeting from server\n";
  52     $c->docmd("MODE READER");
  53 }
  54
  55 sub disconnect ($) {
  56     my ($c) = @_;
  57     close $c->{S};
  58 }
  59
  60 sub putline ($$) {
  61     my ($c, $line) = @_;
  62     my $s = $c->{S};
  63     my $v = $c->{V};
  64     print $v ">>> $line\n" if $v;
  65     print $s "$line\r\n";
  66 }
  67
  68 sub getline_raw ($) {
  69     my ($c) = @_;
  70     my $s = $c->{S};
  71     my $l = <$s>;
  72     return $l;
  73 }
  74
  75 sub getline ($) {
  76     my ($c) = @_;
  77     my $v = $c->{V};
  78     my $l = $c->getline_raw();
  79     $l =~ s/[\r\n]*$//s;
  80     my $code = substr($l,0,3);
  81     print $v "<<< $l\n" if $v;
  82     return ($code,$l);
  83 }
  84
  85 sub docmd ($$;$) {
  86     my ($c,$cmd,$nocheck) = @_;
  87     my ($code,$l);
  88     for my $n (0,1) {
  89         $c->putline($cmd);
  90         ($code,$l) = $c->getline();
  91         if ($code eq "480") { $c->auth(); } else { last; }
  92     }
  93     if (!$nocheck) {
  94         $code =~ /^2\d\d/ or die "failed on `$cmd':\n$l\n";
  95     }
  96     return ($code,$l);
  97 }
  98
  99 sub auth ($) {
 100     my ($c) = @_;
 101     # Authentication.
 102     return if $c->{Authed}++;
 103     my $auth = $ENV{"NNTPAUTH"};
 104     if (defined $auth) {
 105         $c->putline("AUTHINFO GENERIC $auth");
 106         pipe AUTHSTDIN, TOAUTH or die "unable to create pipes";
 107         pipe FROMAUTH, AUTHSTDOUT or die "unable to create pipes";
 108         flush STDOUT;
 109         my $pid = fork;
 110         if (!defined $pid) {
 111             die "unable to fork for authentication helper";
 112         } elsif ($pid == 0) {
 113             # we are child
 114             $c->{V} = undef if $c->{V} eq 'STDOUT';
 115             $ENV{"NNTP_AUTH_FDS"} = "0.1";
 116             open STDIN, "<&AUTHSTDIN";
 117             open STDOUT, ">&AUTHSTDOUT";
 118             close $c->{S};
 119             exec $auth;
 120             die $!;
 121         }
 122         # we are parent
 123         close AUTHSTDIN;
 124         close AUTHSTDOUT;
 125         autoflush TOAUTH 1;
 126         my ($code,$l) = $c->getline(); print TOAUTH "$l\n";
 127         while (<FROMAUTH>) {
 128             s/[\r\n]*$//s;
 129             $c->putline($_);
 130             ($code,$l) = $c->getline();
 131             print TOAUTH "$l\n";
 132         }
 133         die "failed authentication\n" unless $? == 0;
 134     }
 135 }
 136
 137 1;