Na}{

File Content: `nntp.pm`

package LWP::Protocol::nntp;

# Implementation of the Network News Transfer Protocol (RFC 977)

require LWP::Protocol;
@ISA = qw(LWP::Protocol);

require HTTP::Response;
require HTTP::Status;
require Net::NNTP;

use strict;


sub request
{
    my($self, $request, $proxy, $arg, $size, $timeout) = @_;

    $size = 4096 unless $size;

    # Check for proxy
    if (defined $proxy) {
	return HTTP::Response->new(&HTTP::Status::RC_BAD_REQUEST,
				   'You can not proxy through NNTP');
    }

    # Check that the scheme is as expected
    my $url = $request->uri;
    my $scheme = $url->scheme;
    unless ($scheme eq 'news' || $scheme eq 'nntp') {
	return HTTP::Response->new(&HTTP::Status::RC_INTERNAL_SERVER_ERROR,
				   "LWP::Protocol::nntp::request called for '$scheme'");
    }

    # check for a valid method
    my $method = $request->method;
    unless ($method eq 'GET' || $method eq 'HEAD' || $method eq 'POST') {
	return HTTP::Response->new(&HTTP::Status::RC_BAD_REQUEST,
				   'Library does not allow method ' .
				   "$method for '$scheme:' URLs");
    }

    # extract the identifier and check against posting to an article
    my $groupart = $url->_group;
    my $is_art = $groupart =~ /@/;

    if ($is_art && $method eq 'POST') {
	return HTTP::Response->new(&HTTP::Status::RC_BAD_REQUEST,
				   "Can't post to an article <$groupart>");
    }

    my $nntp = Net::NNTP->new($url->host,
			      #Port    => 18574,
			      Timeout => $timeout,
			      #Debug   => 1,
			     );
    die "Can't connect to nntp server" unless $nntp;

    # Check the initial welcome message from the NNTP server
    if ($nntp->status != 2) {
	return HTTP::Response->new(&HTTP::Status::RC_SERVICE_UNAVAILABLE,
				   $nntp->message);
    }
    my $response = HTTP::Response->new(&HTTP::Status::RC_OK, "OK");

    my $mess = $nntp->message;

    # Try to extract server name from greeting message.
    # Don't know if this works well for a large class of servers, but
    # this works for our server.
    $mess =~ s/\s+ready\b.*//;
    $mess =~ s/^\S+\s+//;
    $response->header(Server => $mess);

    # First we handle posting of articles
    if ($method eq 'POST') {
	$nntp->quit; $nntp = undef;
	$response->code(&HTTP::Status::RC_NOT_IMPLEMENTED);
	$response->message("POST not implemented yet");
	return $response;
    }

    # The method must be "GET" or "HEAD" by now
    if (!$is_art) {
	if (!$nntp->group($groupart)) {
	    $response->code(&HTTP::Status::RC_NOT_FOUND);
	    $response->message($nntp->message);
	}
	$nntp->quit; $nntp = undef;
	# HEAD: just check if the group exists
	if ($method eq 'GET' && $response->is_success) {
	    $response->code(&HTTP::Status::RC_NOT_IMPLEMENTED);
	    $response->message("GET newsgroup not implemented yet");
	}
	return $response;
    }

    # Send command to server to retrieve an article (or just the headers)
    my $get = $method eq 'HEAD' ? "head" : "article";
    my $art = $nntp->$get("<$groupart>");
    unless ($art) {
	$nntp->quit; $nntp = undef;
	$response->code(&HTTP::Status::RC_NOT_FOUND);
	$response->message($nntp->message);
	return $response;
    }

    # Parse headers
    my($key, $val);
    local $_;
    while ($_ = shift @$art) {
	if (/^\s+$/) {
	    last;  # end of headers
	}
	elsif (/^(\S+):\s*(.*)/) {
	    $response->push_header($key, $val) if $key;
	    ($key, $val) = ($1, $2);
	}
	elsif (/^\s+(.*)/) {
	    next unless $key;
	    $val .= $1;
	}
	else {
	    unshift(@$art, $_);
	    last;
	}
    }
    $response->push_header($key, $val) if $key;

    # Ensure that there is a Content-Type header
    $response->header("Content-Type", "text/plain")
	unless $response->header("Content-Type");

    # Collect the body
    $response = $self->collect_once($arg, $response, join("", @$art))
      if @$art;

    # Say goodbye to the server
    $nntp->quit;
    $nntp = undef;

    $response;
}

1;
Name	Size	Permission
GHTTP.pm	1766 bytes	0644
cpan.pm	1380 bytes	0644
data.pm	1252 bytes	0644
file.pm	3833 bytes	0644
ftp.pm	16816 bytes	0644
gopher.pm	5751 bytes	0644
http.pm	12828 bytes	0644
loopback.pm	601 bytes	0644
mailto.pm	4428 bytes	0644
nntp.pm	3873 bytes	0644
nogo.pm	630 bytes	0644
File Content: nntp.pm

File Content: `nntp.pm`
