Add a '-b' option, to print the article number bounds of a newsgroup.
[sgt/utils] / nntpid / nntpid
1 #!/usr/bin/perl
2 #
3 # Script to retrieve a single article from a news server, either by
4 # message-id or by group name and article number.
5 #
6 # Usage: nntpid <messageid>
7 # or: nntpid messageid (angle brackets optional)
8 # or: nntpid news.group.name 1234 (group+number form)
9 # or: nntpid -a news.group.name (download all available articles)
10 #
11 # The name of your news server is obtained from the environment variable
12 # NNTPSERVER, or from the file /etc/nntpserver if that's not set.
13 #
14 # This script supports AUTHINFO GENERIC authentication using the
15 # environment variable NNTPAUTH. It will only attempt this if it receives
16 # a 480 response from the news server; if your news server isn't paranoid
17 # then the script will never need to look at NNTPAUTH.
18
19 # Copyright 2000,2004,2011 Simon Tatham. All rights reserved.
20
21 require 5.002;
22 use Socket;
23 use FileHandle;
24
25 $usage =
26 "usage: nntpid [ -v ] [ -d ] <article> [<article>...] display articles\n" .
27 " or: nntpid [ -v ] [ -d ] display articles read from standard input\n" .
28 " or: nntpid [ -v ] -a <newsgroup> dump a newsgroup in mbox format\n" .
29 "where: <article> a news article specified in one of several ways:\n" .
30 " - Message-Id in angle brackets\n" .
31 " - bare Message-Id without angle brackets\n" .
32 " - newsgroup and article number in separate words\n" .
33 " - newsgroup and article number separated by :\n" .
34 " -v verbose (print interaction with news server)\n" .
35 " -d direct output (don't consider using PAGER)\n" .
36 " -a dump all articles in group to stdout as mbox\n" .
37 " -b return current bounds on group's article numbers\n" .
38 " also: nntpid --version report version number\n" .
39 " nntpid --help display this help text\n" .
40 " nntpid --licence display (MIT) licence text\n";
41
42 $licence =
43 "nntpid is copyright 2000,2004,2011 Simon Tatham.\n" .
44 "\n" .
45 "Permission is hereby granted, free of charge, to any person\n" .
46 "obtaining a copy of this software and associated documentation files\n" .
47 "(the \"Software\"), to deal in the Software without restriction,\n" .
48 "including without limitation the rights to use, copy, modify, merge,\n" .
49 "publish, distribute, sublicense, and/or sell copies of the Software,\n" .
50 "and to permit persons to whom the Software is furnished to do so,\n" .
51 "subject to the following conditions:\n" .
52 "\n" .
53 "The above copyright notice and this permission notice shall be\n" .
54 "included in all copies or substantial portions of the Software.\n" .
55 "\n" .
56 "THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND,\n" .
57 "EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF\n" .
58 "MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND\n" .
59 "NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS\n" .
60 "BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN\n" .
61 "ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN\n" .
62 "CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE\n" .
63 "SOFTWARE.\n";
64
65 $pager = 1;
66 $verbose = 0;
67 $mode = 'list';
68
69 while ($ARGV[0] =~ /^-(.+)$/) {
70 shift @ARGV;
71 $verbose = 1, next if $1 eq "v";
72 $pager = 0, next if $1 eq "d";
73 $mode = 'all', next if $1 eq "a";
74 $mode = 'bounds', next if $1 eq "b";
75 if ($1 eq "-help") {
76 print STDERR $usage;
77 exit 0;
78 } elsif ($1 eq "-version") {
79 if ('$Revision$' =~ /Revision:\s+(\d+)/) {
80 print "nntpid revision $1\n";
81 } else {
82 print "nntpid: unknown revision\n";
83 }
84 exit 0;
85 } elsif ($1 eq "-licence" or $1 eq "-license") {
86 print $licence;
87 exit 0;
88 }
89 }
90
91 if ($mode eq 'all') {
92 # -a uses completely different command-line semantics from the
93 # normal ones..
94 die "nntpid: -a expected exactly one argument\n" if @ARGV != 1;
95 $group = $ARGV[0];
96 } elsif ($mode eq 'bounds') {
97 # -b has similar command-line semantics to -a.
98 die "nntpid: -b expected exactly one argument\n" if @ARGV != 1;
99 $group = $ARGV[0];
100 } elsif (!@ARGV) {
101 # We will read article ids from standard input once we've connected
102 # to the NNTP server.
103 $mode = 'stdin';
104 } else {
105 @list = ();
106 while (defined ($arg = shift @ARGV)) {
107 # See if this argument makes sense on its own.
108 ($group, $mid) = &parsearticle($arg);
109 if (defined $mid) {
110 push @list, $arg;
111 } else {
112 # If it doesn't, try concatenating it with a space to the next
113 # argument (so you can provide a group and article number in two
114 # successive command-line arguments).
115 $args = $arg . " " . $ARGV[0];
116 ($group, $mid) = &parsearticle($args);
117 if (defined $mid) {
118 push @list, $args;
119 shift @ARGV; # and eat the second argument
120 } else {
121 # If all else fails, die in panic.
122 die "nntpid: argument '$arg': unable to parse\n";
123 }
124 }
125 }
126 }
127
128 $ns=$ENV{'NNTPSERVER'};
129 if (!defined $ns or !length $ns) {
130 $ns = `cat /etc/nntpserver`;
131 chomp $ns;
132 }
133 $port = (getservbyname("nntp", "tcp"))[2];
134 $ns = inet_aton($ns);
135 $proto = getprotobyname("tcp");
136 $paddr = sockaddr_in($port, $ns);
137
138 &connect;
139 if ($mode eq 'all') {
140 # Write out the entire contents of a newsgroup in mbox format.
141 $numbers = &docmd("GROUP $group");
142 @numbers = split / /, $numbers;
143 $fatal = 0; # ignore failure to retrieve any given article
144 for ($mid = $numbers[1]; $mid <= $numbers[2]; $mid++) {
145 $art = &getart("$group:$mid");
146 if (defined $art) {
147 $art =~ s/\n(>*From )/\n>$1/gs;
148 print "From nntpid ".(localtime)."\n".$art."\n";
149 }
150 }
151 } elsif ($mode eq 'bounds') {
152 # Write out the bounds of the group's article numbers.
153 $numbers = &docmd("GROUP $group");
154 @numbers = split / /, $numbers;
155 print "$numbers[1] $numbers[2]\n";
156 } elsif ($mode eq 'stdin') {
157 while (<>) {
158 chomp;
159 s/^\s+//; s/\s+$//; # trim whitespace
160 &displayarticle($_);
161 }
162 } elsif ($mode eq 'list') {
163 for $item (@list) {
164 &displayarticle($item);
165 }
166 }
167
168 sub parsearticle {
169 # Article identifiers used as input to this program can be in a
170 # variety of formats. This function untangles one into a standard
171 # format, which is either (undef, message-id) or (group, article
172 # number). In case of parse failure, it returns (undef, undef).
173 my $art = shift @_;
174 if ($art =~ /^(.*<)?([^<>]*\@[^<>]*)(>.*)?$/) {
175 # Anything with an @ sign is treated as a Message-ID. We trim
176 # angle brackets and anything outside them.
177 return (undef, $2);
178 } elsif ($art =~ /^(\S+)(\s+|:)(\d+)$/) {
179 # A group name and article number separated by whitespace or a
180 # colon.
181 return ($1, $3);
182 } else {
183 # Unable to parse.
184 return (undef, undef);
185 }
186 }
187
188 sub displayarticle {
189 my $mid = shift @_;
190
191 &connect;
192
193 my $art = &getart($mid);
194 return unless defined $art;
195
196 if ($pager and -t STDOUT) {
197 # Close the NNTP connection before invoking the pager, in case the
198 # user spends so long looking at the article that the server times
199 # us out.
200 &disconnect;
201
202 $pagername = $ENV{"PAGER"};
203 $pagername = "more" unless defined $pagername;
204 open PAGER, "| $pagername";
205 print PAGER $art;
206 close PAGER;
207 } else {
208 print $art;
209 }
210 }
211
212 sub getart {
213 my $art = shift @_;
214 my $group;
215 my $mid;
216
217 ($group, $mid) = &parsearticle($art);
218 if (!defined $mid) {
219 warn "unable to parse '$art'\n";
220 return undef;
221 } elsif (defined $group) {
222 # This is a (group, article number) pair.
223 &docmd("GROUP $group");
224 $ret = &docmd("ARTICLE $mid");
225 } else {
226 # This is a Message-Id. Some NNTP servers will insist on having
227 # seen a GROUP command before 'ARTICLE <some.random@message.id>',
228 # so ensure we've sent one.
229 &docmd("GROUP misc.misc") unless $in_a_group;
230 $ret = &docmd("ARTICLE <$mid>");
231 }
232
233 return undef if !defined $ret;
234 $in_a_group = 1;
235
236 $art = "";
237 while (1) {
238 &getline;
239 s/[\r\n]//g;
240 last if /^\.$/;
241 s/^\.//;
242 $art .= "$_\n";
243 }
244 return $art;
245 }
246
247 sub putline {
248 my ($line) = @_;
249 print STDERR ">>> $line\n" if $verbose;
250 print S "$line\r\n";
251 }
252
253 sub getline {
254 $_ = <S>;
255 s/[\r\n]*$//s;
256 $code = substr($_,0,3);
257 print STDERR "<<< $_\n" if $verbose;
258 return substr($_,4);
259 }
260
261 sub connect {
262 return if $connected;
263 socket(S,PF_INET,SOCK_STREAM,$proto) or die "socket: $!";
264 connect(S,$paddr) or die "connect: $!";
265
266 S->autoflush(1);
267
268 $fatal = 1; # most errors need to be fatal
269
270 &getline;
271 $code =~ /^2\d\d/ or die "no initial greeting from server\n";
272
273 &docmd("MODE READER");
274
275 $connected = 1;
276 $in_a_group = 0;
277 }
278
279 sub disconnect {
280 &docmd("QUIT");
281 close S;
282 $connected = 0;
283 }
284
285 sub docmd {
286 my ($cmd) = @_;
287 # We go at most twice round the following loop. If the first attempt
288 # to fetch the article fails with a 480 response, we try again
289 # having authenticated first; but if the second attempt also fails
290 # with 480, then the authentication didn't work, so we should give
291 # up rather than try it pointlessly again.
292 for my $n (0,1) {
293 &putline($cmd);
294 $line = &getline;
295 if ($code eq "480") { &auth; } else { last; }
296 }
297 if ($code !~ /^2\d\d/) {
298 die "failed on `$cmd':\n$_\n" if $fatal;
299 return undef;
300 }
301 return $line;
302 }
303
304 sub auth {
305 # Authentication.
306 if ($ENV{"NNTPAUTH"}) {
307 $auth = $ENV{"NNTPAUTH"};
308 &putline("AUTHINFO GENERIC $auth");
309 pipe AUTHSTDIN, TOAUTH or die "unable to create pipes";
310 pipe FROMAUTH, AUTHSTDOUT or die "unable to create pipes";
311 $pid = fork;
312 if (!defined $pid) {
313 die "unable to fork for authentication helper";
314 } elsif ($pid == 0) {
315 # we are child
316 $ENV{"NNTP_AUTH_FDS"} = "0.1";
317 open STDIN, "<&AUTHSTDIN";
318 open STDOUT, ">&AUTHSTDOUT";
319 close S;
320 exec $auth;
321 }
322 # we are parent
323 close AUTHSTDIN;
324 close AUTHSTDOUT;
325 autoflush TOAUTH 1;
326 &getline; print TOAUTH "$_\n";
327 while (<FROMAUTH>) {
328 s/[\r\n]*$//s;
329 &putline($_);
330 &getline;
331 print TOAUTH "$_\n";
332 }
333 die "failed authentication\n" unless $? == 0;
334 }
335 }