File Coverage

blib/lib/LWP/Protocol/nntp.pm
Criterion Covered Total %
statement 35 71 49.3
branch 10 42 23.8
condition 4 15 26.6
subroutine 3 3 100.0
pod 1 1 100.0
total 53 132 40.1


line stmt bran cond sub pod time code
1             package LWP::Protocol::nntp;
2             $LWP::Protocol::nntp::VERSION = '6.29';
3             # Implementation of the Network News Transfer Protocol (RFC 977)
4              
5 1     1   6 use base qw(LWP::Protocol);
  1         3  
  1         165  
6              
7             require HTTP::Response;
8             require HTTP::Status;
9             require Net::NNTP;
10              
11 1     1   6 use strict;
  1         2  
  1         553  
12              
13              
14             sub request {
15 1     1 1 6 my ($self, $request, $proxy, $arg, $size, $timeout) = @_;
16              
17 1 50       4 $size = 4096 unless $size;
18              
19             # Check for proxy
20 1 50       3 if (defined $proxy) {
21 0         0 return HTTP::Response->new(HTTP::Status::RC_BAD_REQUEST,
22             'You can not proxy through NNTP');
23             }
24              
25             # Check that the scheme is as expected
26 1         8 my $url = $request->uri;
27 1         14 my $scheme = $url->scheme;
28 1 50 33     32 unless ($scheme eq 'news' || $scheme eq 'nntp') {
29 0         0 return HTTP::Response->new(HTTP::Status::RC_INTERNAL_SERVER_ERROR,
30             "LWP::Protocol::nntp::request called for '$scheme'");
31             }
32              
33             # check for a valid method
34 1         5 my $method = $request->method;
35 1 0 33     18 unless ($method eq 'GET' || $method eq 'HEAD' || $method eq 'POST') {
      33        
36 0         0 return HTTP::Response->new(HTTP::Status::RC_BAD_REQUEST,
37             'Library does not allow method ' . "$method for '$scheme:' URLs");
38             }
39              
40             # extract the identifier and check against posting to an article
41 1         13 my $groupart = $url->_group;
42 1         49 my $is_art = $groupart =~ /@/;
43              
44 1 50 33     8 if ($is_art && $method eq 'POST') {
45 0         0 return HTTP::Response->new(HTTP::Status::RC_BAD_REQUEST,
46             "Can't post to an article <$groupart>");
47             }
48              
49 1         8 my $nntp = Net::NNTP->new(
50             $url->host,
51              
52             #Port => 18574,
53             Timeout => $timeout,
54              
55             #Debug => 1,
56             );
57 1 50       632673 die "Can't connect to nntp server" unless $nntp;
58              
59             # Check the initial welcome message from the NNTP server
60 1 50       15 if ($nntp->status != 2) {
61 0         0 return HTTP::Response->new(HTTP::Status::RC_SERVICE_UNAVAILABLE,
62             $nntp->message);
63             }
64 1         29 my $response = HTTP::Response->new(HTTP::Status::RC_OK, "OK");
65              
66 1         98 my $mess = $nntp->message;
67              
68             # Try to extract server name from greeting message.
69             # Don't know if this works well for a large class of servers, but
70             # this works for our server.
71 1         19 $mess =~ s/\s+ready\b.*//;
72 1         8 $mess =~ s/^\S+\s+//;
73 1         20 $response->header(Server => $mess);
74              
75             # First we handle posting of articles
76 1 50       133 if ($method eq 'POST') {
77 0         0 $nntp->quit;
78 0         0 $nntp = undef;
79 0         0 $response->code(HTTP::Status::RC_NOT_IMPLEMENTED);
80 0         0 $response->message("POST not implemented yet");
81 0         0 return $response;
82             }
83              
84             # The method must be "GET" or "HEAD" by now
85 1 50       7 if (!$is_art) {
86 0 0       0 if (!$nntp->group($groupart)) {
87 0         0 $response->code(HTTP::Status::RC_NOT_FOUND);
88 0         0 $response->message($nntp->message);
89             }
90 0         0 $nntp->quit;
91 0         0 $nntp = undef;
92              
93             # HEAD: just check if the group exists
94 0 0 0     0 if ($method eq 'GET' && $response->is_success) {
95 0         0 $response->code(HTTP::Status::RC_NOT_IMPLEMENTED);
96 0         0 $response->message("GET newsgroup not implemented yet");
97             }
98 0         0 return $response;
99             }
100              
101             # Send command to server to retrieve an article (or just the headers)
102 1 50       7 my $get = $method eq 'HEAD' ? "head" : "article";
103 1         9 my $art = $nntp->$get("<$groupart>");
104 1 50       149207 unless ($art) {
105 1         8 $nntp->quit;
106 1         148337 $response->code(HTTP::Status::RC_NOT_FOUND);
107 1         30 $response->message($nntp->message);
108 1         34 $nntp = undef;
109 1         40 return $response;
110             }
111              
112             # Parse headers
113 0           my ($key, $val);
114 0           local $_;
115 0           while ($_ = shift @$art) {
116 0 0         if (/^\s+$/) {
    0          
    0          
117 0           last; # end of headers
118             }
119             elsif (/^(\S+):\s*(.*)/) {
120 0 0         $response->push_header($key, $val) if $key;
121 0           ($key, $val) = ($1, $2);
122             }
123             elsif (/^\s+(.*)/) {
124 0 0         next unless $key;
125 0           $val .= $1;
126             }
127             else {
128 0           unshift(@$art, $_);
129 0           last;
130             }
131             }
132 0 0         $response->push_header($key, $val) if $key;
133              
134             # Ensure that there is a Content-Type header
135 0 0         $response->header("Content-Type", "text/plain")
136             unless $response->header("Content-Type");
137              
138             # Collect the body
139 0 0         $response = $self->collect_once($arg, $response, join("", @$art)) if @$art;
140              
141             # Say goodbye to the server
142 0           $nntp->quit;
143 0           $nntp = undef;
144              
145 0           $response;
146             }
147              
148             1;