POE::Component::Server::NNTP 1.04

POE::Component::Server::NNTP is a Perl module that implements an RFC 977 http://www.faqs.org/rfcs/rfc977.html NNTP server. It is the companion component to POE::Component::Client::NNTP which implements NNTP client functionality.

You spawn an NNTP server component, create your POE sessions then register your session to receive events. Whenever clients connect, disconnect or send valid NNTP protocol commands you will receive an event and an unique client ID. You then parse and process the commands given and send back applicable NNTP responses.

This component doesn't implement the news database and as such is not by itself a complete NNTP daemon implementation.

SYNOPSIS

 use strict;
 use POE qw(Component::Server::NNTP);
 
 my %groups;
 
 while() {
 chomp;
 push @{ $groups{'perl.cpan.testers'}->{''} }, $_;
 }
 
 my $nntpd = POE::Component::Server::NNTP->spawn(
 alias => 'nntpd',
 posting => 0,
 port => 10119,
 );
 
 POE::Session->create(
 package_states => [
 'main' => [ qw(
 _start
 nntpd_connection
 nntpd_disconnected
 nntpd_cmd_post
 nntpd_cmd_ihave
 nntpd_cmd_slave
 nntpd_cmd_newnews
 nntpd_cmd_newgroups
 nntpd_cmd_list
 nntpd_cmd_group
 nntpd_cmd_article
 ) ],
 ],
 options => { trace => 0 },
 );
 
 $poe_kernel->run();
 exit 0;
 
 sub _start {
 my ($kernel,$heap) = @_[KERNEL,HEAP];
 $heap->{clients} = { };
 $kernel->post( 'nntpd', 'register', 'all' );
 return;
 }
 
 sub nntpd_connection {
 my ($kernel,$heap,$client_id) = @_[KERNEL,HEAP,ARG0];
 $heap->{clients}->{ $client_id } = { };
 return;
 }
 
 sub nntpd_disconnected {
 my ($kernel,$heap,$client_id) = @_[KERNEL,HEAP,ARG0];
 delete $heap->{clients}->{ $client_id };
 return;
 }
 
 sub nntpd_cmd_slave {
 my ($kernel,$sender,$client_id) = @_[KERNEL,SENDER,ARG0];
 $kernel->post( $sender, 'send_to_client', $client_id, '202 slave status noted' );
 return;
 }
 
 sub nntpd_cmd_post {
 my ($kernel,$sender,$client_id) = @_[KERNEL,SENDER,ARG0];
 $kernel->post( $sender, 'send_to_client', $client_id, '440 posting not allowed' );
 return;
 }
 
 sub nntpd_cmd_ihave {
 my ($kernel,$sender,$client_id) = @_[KERNEL,SENDER,ARG0];
 $kernel->post( $sender, 'send_to_client', $client_id, '435 article not wanted' );
 return;
 }
 
 sub nntpd_cmd_newnews {
 my ($kernel,$sender,$client_id) = @_[KERNEL,SENDER,ARG0];
 $kernel->post( $sender, 'send_to_client', $client_id, '230 list of new articles follows' );
 $kernel->post( $sender, 'send_to_client', $client_id, '.' );
 return;
 }
 
 sub nntpd_cmd_newgroups {
 my ($kernel,$sender,$client_id) = @_[KERNEL,SENDER,ARG0];
 $kernel->post( $sender, 'send_to_client', $client_id, '231 list of new newsgroups follows' );
 $kernel->post( $sender, 'send_to_client', $client_id, '.' );
 return;
 }
 
 sub nntpd_cmd_list {
 my ($kernel,$sender,$client_id) = @_[KERNEL,SENDER,ARG0];
 $kernel->post( $sender, 'send_to_client', $client_id, '215 list of newsgroups follows' );
 foreach my $group ( keys %groups ) {
 my $reply = join ' ', $group, scalar keys %{ $groups{$group} }, 1, 'n';
 $kernel->post( $sender, 'send_to_client', $client_id, $reply );
 }
 $kernel->post( $sender, 'send_to_client', $client_id, '.' );
 return;
 }
 
 sub nntpd_cmd_group {
 my ($kernel,$sender,$client_id,$group) = @_[KERNEL,SENDER,ARG0,ARG1];
 unless ( $group or exists $groups{lc $group} ) {
 $kernel->post( $sender, 'send_to_client', $client_id, '411 no such news group' );
 return;
 }
 $group = lc $group;
 $kernel->post( $sender, 'send_to_client', $client_id, "211 1 1 1 $group selected" );
 $_[HEAP]->{clients}->{ $client_id } = { group => $group };
 return;
 }
 
 sub nntpd_cmd_article {
 my ($kernel,$sender,$client_id,$article) = @_[KERNEL,SENDER,ARG0,ARG1];
 my $group = 'perl.cpan.testers';
 if ( !$article and !defined $_[HEAP]->{clients}->{ $client_id}->{group} ) {
 $kernel->post( $sender, 'send_to_client', $client_id, '412 no newsgroup selected' );
 return;
 }
 $article = 1 unless $article;
 if ( $article !~ /^$/ and $article ne '1' ) {
 $kernel->post( $sender, 'send_to_client', $client_id, '423 no such article number' );
 return;
 }
 if ( $article =~ /^$/ and !defined $groups{$group}->{$article} ) {
 $kernel->post( $sender, 'send_to_client', $client_id, '430 no such article found' );
 return;
 }
 foreach my $msg_id ( keys %{ $groups{$group} } ) {
 $kernel->post( $sender, 'send_to_client', $client_id, "220 1 $msg_id article retrieved - head and body follow" );
 $kernel->post( $sender, 'send_to_client', $client_id, $_ ) for @{ $groups{$group}->{$msg_id } };
 $kernel->post( $sender, 'send_to_client', $client_id, '.' );
 }
 return;
 }


Product's homepage

Requirements:

· Perl