NAME

VERSION

SYNOPSIS

  use strict;
  use POE qw(Component::Server::NNTP);

  my %groups;

  while(<DATA>) {
    chomp;
    push @{ $groups{'perl.cpan.testers'}->{'<perl.cpan.testers-381062@nntp.perl.org>'} }, $_;
  }

  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;
  }

  __END__
  Newsgroups: perl.cpan.testers
  Path: nntp.perl.org
  Date: Fri,  1 Dec 2006 09:27:56 +0000
  Subject: PASS POE-Component-IRC-5.14 cygwin-thread-multi-64int 1.5.21(0.15642)
  From: chris@bingosnet.co.uk
  Message-ID: <perl.cpan.testers-381062@nntp.perl.org>

  This distribution has been tested as part of the cpan-testers
  effort to test as many new uploads to CPAN as possible.  See
  http://testers.cpan.org/

DESCRIPTION

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.

CONSTRUCTOR

"spawn"

Takes a number of optional arguments:

  'alias', set an alias on the component;
  'address', bind the component to a particular address, defaults to INADDR_ANY;
  'port', start the listening server on a different port, defaults to 119;
  'options', a hashref of POE::Session options;
  'posting', a true or false value that determines whether the poco
             responds with a 200 or 201 to clients;
  'handle_connects', true or false whether the poco sends 200/201 
             responses to connecting clients automagically;
  'extra_cmds', an arrayref of additional NNTP commands that you
             wish to implement.
    

Returns a POE::Component::Server::NNTP object.

METHODS

"session_id"

Returns the POE::Session ID of the component.

"shutdown"

Terminates the component. Shuts down the listener and disconnects connected clients.

"send_event"

Sends an event through the component's event handling system.

"send_to_client"

Send some output to a connected client. First parameter must be a valid client id. Second parameter is a string of text to send.

INPUT

"register"

Takes N arguments: a list of event names that your session wants to listen for, minus the 'nntpd_' prefix, ( this is similar to POE::Component::IRC ).

Registering for 'all' will cause it to send all NNTPD-related events to you; this is the easiest way to handle it.

"unregister"

Takes N arguments: a list of event names which you don't want to receive. If you've previously done a 'register' for a particular event which you no longer care about, this event will tell the NNTPD to stop sending them to you. (If you haven't, it just ignores you. No big deal).

"shutdown"

Terminates the component. Shuts down the listener and disconnects connected clients.

"send_event"

Sends an event through the component's event handling system.

"send_to_client"

Send some output to a connected client. First parameter must be a valid client ID. Second parameter is a string of text to send.

OUTPUT

"nntpd_registered"

This event is sent to a registering session. ARG0 is POE::Component::Server::NNTP object.

"nntpd_listener_failed"

Generated if the component cannot either start a listener or there is a problem accepting client connections. ARG0 contains the name of the operation that failed. ARG1 and ARG2 hold numeric and string values for $!, respectively.

"nntpd_connection"

Generated whenever a client connects to the component. ARG0 is the client ID, ARG1 is the client's IP address, ARG2 is the client's TCP port. ARG3 is our IP address and ARG4 is our socket port.

"nntpd_disconnected"

Generated whenever a client disconnects. ARG0 is the client ID.

"nntpd_cmd_*"

Generated for each NNTP command that a connected client sends to us. ARG0 is the client ID. ARG1 .. ARGn are any parameters that are sent with the command. Check the RFC <http://www.faqs.org/rfcs/rfc977.html> for details.

"nntpd_posting"

When the component receives a posting from a client, either as the result of a IHAVE or POST command, this event is issued. ARG0 will be the client ID. ARG1 will be either a '335' or '340' indicating what the posting relates to ( either an IHAVE or POST ). ARG2 will be an arrayref containing the raw lines that the client sent us. No additional parsing is undertaken on this data.

PLUGINS

  use POE::Component::Server::NNTP::Constants qw(:ALL);

        package Plugin;

        # Import the constants, of course you could provide your own
        # constants as long as they map correctly.
        use POE::Component::Server::NNTP::Constants qw( :ALL );

        # Our constructor
        sub new {
                ...
        }

        # Required entry point for plugins
        sub plugin_register {
                my( $self, $nntpd ) = @_;

                # Register events we are interested in
                $nntpd->plugin_register( $self, 'NNTPD', qw(all) );

                # Return success
                return 1;
        }

        # Required exit point for pluggable
        sub plugin_unregister {
                my( $self, $nntpd ) = @_;

                # Pluggable will automatically unregister events for the plugin

                # Do some cleanup...

                # Return success
                return 1;
        }

        sub _default {
                my( $self, $nntpd, $event ) = splice @_, 0, 3;

                print "Default called for $event\n";

                # Return an exit code
                return NNTPD_EAT_NONE;
        }

SEE ALSO

RFC 977 <http://www.faqs.org/rfcs/rfc977.html>

RFC 1036 <http://www.faqs.org/rfcs/rfc1036.html>

POE::Component::Pluggable

AUTHOR

COPYRIGHT AND LICENSE

This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself.