2 # Copyright (C) 2016 all contributors <meta@public-inbox.org>
3 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
5 my $usage = "$0 [-j JOBS] [-s SLOW_THRESHOLD] URL_OF_INBOX\n";
8 use File::Temp qw(tempfile);
10 use Getopt::Long qw(:config gnu_getopt no_ignore_case auto_abbrev);
13 use POSIX qw(:sys_wait_h);
14 use Time::HiRes qw(gettimeofday tv_interval);
19 '-j|jobs=i' => \$nproc,
20 '-s|slow-threshold=f' => \$slow,
22 GetOptions(%opts) or die "bad command-line args\n$usage";
23 my $root_url = shift or die $usage;
26 $SIG{TERM} = sub { exit 0 };
29 my $pid = waitpid(-1, WNOHANG);
30 return if !defined $pid || $pid <= 0;
31 my $p = delete $workers{$pid} || '(unknown)';
32 warn("$pid [$p] exited with $?\n") if $?;
36 my @todo = IO::Socket->socketpair(AF_UNIX, SOCK_SEQPACKET, 0);
37 die "socketpair failed: $!" unless $todo[1];
38 my @done = IO::Socket->socketpair(AF_UNIX, SOCK_SEQPACKET, 0);
39 die "socketpair failed: $!" unless $done[1];
42 foreach my $p (1..$nproc) {
44 die "fork failed: $!\n" unless defined $pid;
50 worker_loop($todo[0], $done[1]);
54 my ($fh, $tmp) = tempfile('www-check-XXXXXXXX',
55 SUFFIX => '.gdbm', UNLINK => 1, TMPDIR => 1);
56 my $gdbm = tie my %seen, 'GDBM_File', $tmp, &GDBM_WRCREAT, 0600;
57 defined $gdbm or die "gdbm open failed: $!\n";
62 $todo[1]->blocking(0);
63 $done[0]->blocking(0);
67 my @queue = ($root_url);
68 my $timeout = $slow * 4;
69 while (keys %workers) { # reacts to SIGCHLD
72 vec($rvec, fileno($done[0]), 1) = 1;
74 vec($wvec, fileno($todo[1]), 1) = 1;
75 } elsif ($ndone == $nsent) {
76 kill 'TERM', keys %workers;
79 if (!select($rvec, $wvec, undef, $timeout)) {
80 while (my ($k, $v) = each %seen) {
82 print "WAIT ($ndone/$nsent) <$k>\n";
85 while ($u = shift @queue) {
86 my $s = $todo[1]->send($u, MSG_EOR);
94 $r = $done[0]->recv($u, 65535, 0);
95 } while (!defined $r && $!{EINTR});
97 if ($u =~ s/\ADONE\t//) {
109 my ($todo_rd, $done_wr) = @_;
110 my $m = WWW::Mechanize->new(autocheck => 0);
111 my $cc = LWP::ConnCache->new;
114 $todo_rd->recv(my $u, 65535, 0);
117 my $t = [ gettimeofday ];
119 $t = tv_interval($t);
120 printf "SLOW %0.06f % 5d %s\n", $t, $$, $u if $t > $slow;
122 if ($r->is_success) {
124 (split('#', $_->URI->abs->as_string))[0] => 1;
126 $_->tag && $_->url !~ /:/
128 @links = keys %links;
129 } elsif ($r->code != 300) {
130 warn "W: ".$r->code . " $u\n"
134 my @at = grep(/@/, @links);
135 print "BAD: $u ", join("\n", @at), "\n" if @at;
139 foreach my $l (@links, "DONE\t$u") {
142 $s = $done_wr->send($l, MSG_EOR);
143 } while (!defined $s && $!{EINTR});
144 die "$$ send $!\n" unless defined $s;
146 die "$$ send truncated $s < $n\n" if $s != $n;