--- /dev/null
+#!/usr/bin/perl
+
+use strict qw(subs);
+use warnings;
+
+require 5.002;
+use Socket;
+use FileHandle;
+
+
+BEGIN {
+ use Exporter ();
+ our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
+
+ # set the version for version checking
+ $VERSION = 1.00;
+
+ @ISA = qw(Exporter);
+ @EXPORT = qw(cnntp_connect);
+ %EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ],
+
+ @EXPORT_OK = qw();
+}
+our @EXPORT_OK;
+
+sub cnntp_connect ($) {
+ my ($verbose) = @_;
+
+ my $ns=$ENV{'NNTPSERVER'};
+ if (!defined $ns or !length $ns) {
+ $ns = `cat /etc/nntpserver`;
+ chomp($ns);
+ }
+ my $port = (getservbyname("nntp", "tcp"))[2];
+ $ns = inet_aton($ns);
+ my $proto = getprotobyname("tcp");
+ my $paddr = sockaddr_in($port, $ns);
+
+ my $sock = new IO::Handle;
+ socket($sock,PF_INET,SOCK_STREAM,$proto) or die "socket: $!";
+ connect($sock,$paddr) or die "connect: $!";
+
+ $sock->autoflush(1);
+
+ return bless { S => $sock, V => $verbose };
+}
+
+sub banner_reader ($) {
+ my ($c) = @_;
+ my ($code,$l) = $c->getline();
+ $code =~ /^2\d\d/ or die "no initial greeting from server\n";
+ $c->docmd("MODE READER");
+}
+
+sub disconnect ($) {
+ my ($c) = @_;
+ close $c->{S};
+}
+
+sub putline ($$) {
+ my ($c, $line) = @_;
+ my $s = $c->{S};
+ my $v = $c->{V};
+ print $v ">>> $line\n" if $v;
+ print $s "$line\r\n";
+}
+
+sub getline_raw ($) {
+ my ($c) = @_;
+ my $s = $c->{S};
+ my $l = <$s>;
+ return $l;
+}
+
+sub getline ($) {
+ my ($c) = @_;
+ my $v = $c->{V};
+ my $l = $c->getline_raw();
+ $l =~ s/[\r\n]*$//s;
+ my $code = substr($l,0,3);
+ print $v "<<< $l\n" if $v;
+ return ($code,$l);
+}
+
+sub docmd ($$;$) {
+ my ($c,$cmd,$nocheck) = @_;
+ my ($code,$l);
+ for my $n (0,1) {
+ $c->putline($cmd);
+ ($code,$l) = $c->getline();
+ if ($code eq "480") { $c->auth(); } else { last; }
+ }
+ if (!$nocheck) {
+ $code =~ /^2\d\d/ or die "failed on `$cmd':\n$l\n";
+ }
+ return ($code,$l);
+}
+
+sub auth ($) {
+ my ($c) = @_;
+ # Authentication.
+ return if $c->{Authed}++;
+ my $auth = $ENV{"NNTPAUTH"};
+ if (defined $auth) {
+ $c->putline("AUTHINFO GENERIC $auth");
+ pipe AUTHSTDIN, TOAUTH or die "unable to create pipes";
+ pipe FROMAUTH, AUTHSTDOUT or die "unable to create pipes";
+ flush STDOUT;
+ my $pid = fork;
+ if (!defined $pid) {
+ die "unable to fork for authentication helper";
+ } elsif ($pid == 0) {
+ # we are child
+ $c->{V} = undef if $c->{V} eq 'STDOUT';
+ $ENV{"NNTP_AUTH_FDS"} = "0.1";
+ open STDIN, "<&AUTHSTDIN";
+ open STDOUT, ">&AUTHSTDOUT";
+ close $c->{S};
+ exec $auth;
+ die $!;
+ }
+ # we are parent
+ close AUTHSTDIN;
+ close AUTHSTDOUT;
+ autoflush TOAUTH 1;
+ my ($code,$l) = $c->getline(); print TOAUTH "$l\n";
+ while (<FROMAUTH>) {
+ s/[\r\n]*$//s;
+ $c->putline($_);
+ ($code,$l) = $c->getline();
+ print TOAUTH "$l\n";
+ }
+ die "failed authentication\n" unless $? == 0;
+ }
+}
+
+1;