[perl5.git] / Porting / checkURL.pl

#!perl
use strict;
use warnings;
use autodie;
use feature qw(say);
require File::Find::Rule;
require File::Slurp;
require File::Spec;
require IO::Socket::SSL;
use List::Util qw(sum);
require LWP::UserAgent;
require Net::FTP;
require Parallel::Fork::BossWorkerAsync;
require Term::ProgressBar::Simple;
require URI::Find::Simple;
$| = 1;

my %ignore;
while ( my $line = <main::DATA> ) {
    chomp $line;
    next if $line =~ /^#/;
    next unless $line;
    $ignore{$line} = 1;
}

my $ua = LWP::UserAgent->new(ssl_opts => { verify_hostname => 0 });
$ua->timeout(58);
$ua->env_proxy;

my @filenames = @ARGV;
@filenames = sort grep { $_ !~ /^\.git/ } File::Find::Rule->new->file->in('.')
    unless @filenames;

my $total_bytes = sum map {-s} @filenames;

my $extract_progress = Term::ProgressBar::Simple->new(
    {   count => $total_bytes,
        name  => 'Extracting URIs',
    }
);

my %uris;
foreach my $filename (@filenames) {
    next if $filename =~ /uris\.txt/;
    next if $filename =~ /check_uris/;
    next if $filename =~ /\.patch$/;
    next if $filename =~ 'cpan/Pod-Simple/t/perlfaqo?\.pod';
    next if $filename =~ /checkURL\.pl$/;
    my $contents = File::Slurp::read_file($filename);
    my @uris     = URI::Find::Simple::list_uris($contents);
    foreach my $uri (@uris) {
        next unless $uri =~ /^(http|ftp)/;
        next if $ignore{$uri};

        # no need to hit rt.perl.org
        next
            if $uri =~ m{^https?://rt.perl.org/(?:rt3/)?Ticket/Display.html?id=\d+$};

        # no need to hit rt.cpan.org
        next
            if $uri =~ m{^https?://rt.cpan.org/Public/Bug/Display.html?id=\d+$};

        # no need to hit google groups (weird redirect LWP does not like)
        next
            if $uri =~ m{^http://groups\.google\.com/};

        push @{ $uris{$uri} }, $filename;
    }
    $extract_progress += -s $filename;
}

my $bw = Parallel::Fork::BossWorkerAsync->new(
    work_handler   => \&work_alarmed,
    global_timeout => 120,
    worker_count   => 20,
);

foreach my $uri ( keys %uris ) {
    my @filenames = @{ $uris{$uri} };
    $bw->add_work( { uri => $uri, filenames => \@filenames } );
}

undef $extract_progress;

my $fetch_progress = Term::ProgressBar::Simple->new(
    {   count => scalar( keys %uris ),
        name  => 'Fetching URIs',
    }
);

my %filenames;
while ( $bw->pending() ) {
    my $response   = $bw->get_result();
    my $uri        = $response->{uri};
    my @filenames  = @{ $response->{filenames} };
    my $is_success = $response->{is_success};
    my $message    = $response->{message};

    unless ($is_success) {
        foreach my $filename (@filenames) {
            push @{ $filenames{$filename} },
                { uri => $uri, message => $message };
        }
    }
    $fetch_progress++;
}
$bw->shut_down();

my $fh = IO::File->new('> uris.txt');
foreach my $filename ( sort keys %filenames ) {
    $fh->say("* $filename");
    my @bits = @{ $filenames{$filename} };
    foreach my $bit (@bits) {
        my $uri     = $bit->{uri};
        my $message = $bit->{message};
        $fh->say("  $uri");
        $fh->say("    $message");
    }
}
$fh->close;

say 'Finished, see uris.txt';

sub work_alarmed {
    my $conf = shift;
    eval {
        local $SIG{ALRM} = sub { die "alarm\n" };    # NB: \n required
        alarm 60;
        $conf = work($conf);
        alarm 0;
    };
    if ($@) {
        $conf->{is_success} = 0;
        $conf->{message}    = 'Timed out';

    }
    return $conf;
}

sub work {
    my $conf      = shift;
    my $uri       = $conf->{uri};
    my @filenames = @{ $conf->{filenames} };

    if ( $uri =~ /^http/ ) {
        my $uri_without_fragment = URI->new($uri);
        my $fragment             = $uri_without_fragment->fragment(undef);
        my $response             = $ua->head($uri_without_fragment);

        $conf->{is_success} = $response->is_success;
        $conf->{message}    = $response->status_line;
        return $conf;
    } else {

        my $uri_object = URI->new($uri);
        my $host       = $uri_object->host;
        my $path       = $uri_object->path;
        my ( $volume, $directories, $filename )
            = File::Spec->splitpath($path);

        my $ftp = Net::FTP->new( $host, Passive => 1, Timeout => 60 );
        unless ($ftp) {
            $conf->{is_succcess} = 0;
            $conf->{message}     = "Can not connect to $host: $@";
            return $conf;
        }

        my $can_login = $ftp->login( "anonymous", '-anonymous@' );
        unless ($can_login) {
            $conf->{is_success} = 0;
            $conf->{message} = "Can not login ", $ftp->message;
            return $conf;
        }

        my $can_binary = $ftp->binary();
        unless ($can_binary) {
            $conf->{is_success} = 0;
            $conf->{message} = "Can not binary ", $ftp->message;
            return $conf;
        }

        my $can_cwd = $ftp->cwd($directories);
        unless ($can_cwd) {
            $conf->{is_success} = 0;
            $conf->{message} = "Can not cwd to $directories ", $ftp->message;
            return $conf;
        }

        if ($filename) {
            my $can_size = $ftp->size($filename);
            unless ($can_size) {
                $conf->{is_success} = 0;
                $conf->{message}
                    = "Can not size $filename in $directories",
                    $ftp->message;
                return $conf;
            }
        } else {
            my ($can_dir) = $ftp->dir;
            unless ($can_dir) {
                my ($can_ls) = $ftp->ls;
                unless ($can_ls) {
                    $conf->{is_success} = 0;
                    $conf->{message}
                        = "Can not dir or ls in $directories ",
                        $ftp->message;
                    return $conf;
                }
            }
        }

        $conf->{is_success} = 1;
        return $conf;
    }
}

__DATA__
# these are fine but give errors
ftp://ftp.stratus.com/pub/vos/posix/ga/ga.html
ftp://ftp.stratus.com/pub/vos/utility/utility.html

# these are missing, sigh
ftp://ftp.sco.com/SLS/ptf7051e.Z
http://perlmonks.thepen.com/42898.html
http://svn.mutatus.co.uk/wsvn/Scalar-List-Utils/trunk/
http://public.activestate.com/cgi-bin/perlbrowse
http://svn.mutatus.co.uk/browse/libnet/tags/libnet-1.17/ChangeLog
http://aspn.activestate.com/ASPN/Mail/Message/perl6-internals/2746631
http://my.smithmicro.com/mac/stuffit/
http://www.wg.omron.co.jp/cgi-bin/j-e/jfriedl.html
http://persephone.cps.unizar.es/general/gente/spd/gzip/gzip.html
http://www.openzaurus.org/
http://Casbah.org/
http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/nmake15.exe
http://www.pvhp.com/~pvhp/
http://www.pvhp.com/%7Epvhp/
http://www.pvhp.com/%7epvhp/
http://www.leo.org
http://www.madgoat.com
http://www.mks.com/s390/gnu/
http://www.research.att.com/sw/tools/uwin/
http://www.tpj.com/
http://safaribooksonline.com/
http://use.perl.org/~autrijus/journal/25768
http://www.s390.ibm.com/products/oe/bpxqp1.html
http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-02/msg01396.html
http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-02/msg01489.html
http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-02/msg01491.html
http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-02/msg01608.html
http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-02/msg02144.html
http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-02/msg02998.html
http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1999-03/msg00520.html
http://www.w3.org/Security/Faq/

# these are URI extraction bugs
http://www.perl.org/E
http://en.wikipedia.org/wiki/SREC_(file_format
http://somewhere.else',-type=/
ftp:passive-mode
ftp:
http:[-
http://search.cpan.org/src/KWILLIAMS/Module-Build-0.30/lib/Module/Build/Platform/Windows.pm:split_like_shell
http://www.xray.mpe.mpg.de/mailing-lists/perl5-
http://support.microsoft.com/support/kb/articles/Q280/3/41.ASP:
http://perl.come/
http://www.perl.come/

# these are used as an example
http://example.com/
http://something.here/
http://users.perl5.git.perl.org/~yourlogin/
http://github.com/USERNAME/perl/tree/orange
http://the.good.ship.lollypop.com:8080/cgi-bin/foo.cgi
http://the.good.ship.lollypop.com:8080/cgi-bin/foo.cgi/somewhere/else?game=chess;game=checkers;weather=dull;foo=bar
http://somewhere.else$/
http://somewhere.else$/
http://somewhere.else/bin/foo&bar',-Type=
http://the.good.ship.lollypop.com:8080/cgi-bin/foo.cgi
http://the.good.ship.lollypop.com:8080/cgi-bin/foo.cgi/somewhere/else?game=chess;game=checkers;weather=dull;foo=bar
http://www.perl.org/test.cgi
http://cpan2.local/
http://search.cpan.org/perldoc?
http://cpan1.local/
http://cpan.dev.local/CPAN
http:///
ftp://
ftp://myurl/
ftp://ftp.software.ibm.com/aix/fixes/v4/other/vac.C.5.0.2.6.bff
http://www14.software.ibm.com/webapp/download/downloadaz.jsp
http://www.cpan.org/modules/by-module/Archive/Archive-Zip-*.tar.gz
http://www.unicode.org/Public/MAPPINGS/ISO8859/8859-*.TXT
http://localhost/tmp/index.txt
http://example.com/foo/bar.html
http://example.com/Text-Bastardize-1.06.tar.gz
ftp://example.com/sources/packages.txt
http://example.com/sources/packages.txt
http://example.com/sources
ftp://example.com/sources
http://some.where.com/dir/file.txt
http://some.where.com/dir/a.txt
http://foo.com/X.tgz
ftp://foo.com/X.tgz
http://foo/
http://www.foo.com:8000/
http://mysite.com/cgi-bin/log.cgi/http://www.some.other.site/args
http://decoded/mirror/path
http://a/b/c/d/e/f/g/h/i/j
http://foo/bar.gz
ftp://ftp.perl.org
http://purl.org/rss/1.0/modules/taxonomy/
ftp://ftp.sun.ac.za/CPAN/CPAN/
ftp://ftp.cpan.org/pub/mirror/index.txt
ftp://cpan.org/pub/mirror/index.txt
http://example.com/~eh/
http://plagger.org/.../rss
http://umn.dl.sourceforge.net/mingw/gcc-g++-3.4.5-20060117-1.tar.gz
http://umn.dl.sourceforge.net/mingw/binutils-2.16.91-20060119-1.tar.gz
http://umn.dl.sourceforge.net/mingw/mingw-runtime-3.10.tar.gz
http://umn.dl.sourceforge.net/mingw/gcc-core-3.4.5-20060117-1.tar.gz
http://umn.dl.sourceforge.net/mingw/w32api-3.6.tar.gz
http://search.cpan.org/CPAN/authors/id/S/SH/SHAY/dmake-4.5-20060619-SHAY.zip  
http://module-build.sourceforge.net/META-spec-new.html
http://module-build.sourceforge.net/META-spec-v1.4.html
http://www.cs.vu.nl/~tmgil/vi.html
http://perlcomposer.sourceforge.net/vperl.html
http://www.perl.com/CPAN/authors/Tom_Christiansen/scripts/rep
http://w4.lns.cornell.edu/~pvhp/ptk/ptkTOC.html
http://world.std.com/~aep/ptkdb/
http://www.castlelink.co.uk/object_system/
http://www.fh-wedel.de/elvis/
ftp://ftp.blarg.net/users/amol/zsh/
ftp://ftp.funet.fi/pub/languages/perl/CPAN
http://search.cpan.org/CPAN/authors/id/S/SH/SHAY/dmake-4.5-20060619-SHAY.zip
http://users.perl5.git.perl.org/~USERNAME
http://foo/x//y/script.cgi/a//b
http://xxx/script.cgi/http://foo
http://foo/./x//z/script.cgi/a/../b//c
http://somewhere.else/in/movie/land
http://somewhere.else/finished.html
http://somewhere.else/bin/foo&bar$
http://somewhere.else/
http://proxy:8484/
http://proxy/
http://myrepo.example.com/
http://remote/source
https://example.com/
http://example.com:1024/
http:///path?foo=bar
http://[::]:1024/
http://([/
http://example.com:9000/index.html
http://proxy.example.com:8080/
http:///index.html
http://[www.json::pp.org]/
http://localhost/
http://foo.example.com/
http://abc.com/a.js
http://whatever/man/1/crontab
http://abc.com/c.js
http://whatever/Foo%3A%3ABar
http://abc.com/b.js
http://remote.server.com/jquery.css
http://some.other.com/page.html
https://text.com/1/2
https://text.com/1/2
http://link.included.here?o=1&p=2
http://link.included.here?o=1&amp;p=2
http://link.included.here?o=1&amp;p=2
http://link.included.here/
http://foo/x//y/script.cgi/a//b
http://xxx/script.cgi/http://foo
http://foo/./x//z/script.cgi/a/../b//c
http://somewhere.else/in/movie/land
http://somewhere.else/finished.html
http://webproxy:3128/
http://www/

# these are used to generate or match URLs
http://www.cpan.org/modules/by-authors/id/$1/$1$2/$dist
http://www.cpantesters.org/show/%s.yaml
ftp://(.*?)/(.*)/(.*
ftp://(.*?)/(.*)/(.*
ftp://(.*?)/(.*)/(.*
ftp://ftp.foo.bar/
http://$host/
http://wwwe%3C46/
ftp:/
http://$addr/mark?commit=$
http://search.cpan.org/~
http:/
ftp:%5Cn$url
http://www.ietf.org/rfc/rfc$2.txt
http://search.cpan.org/~
ftp:%5Cn$url

# weird redirects that LWP doesn't like
http://www.theperlreview.com/community_calendar
http://www.software.hp.com/portal/swdepot/displayProductInfo.do?productNumber=PERL
http://sunsolve.sun.com

# broken webserver that doesn't like HEAD requests
http://docs.sun.com/app/docs/doc/816-5168/syslog-3c?a=view
http://www.w3.org/TR/html4/loose.dtd

# these have been reported upstream to CPAN authors
http://www.gnu.org/manual/tar/html_node/tar_139.html
http://www.w3.org/pub/WWW/TR/Wd-css-1.html
http://support.microsoft.com/support/kb/articles/Q280/3/41.ASP
http://msdn.microsoft.com/workshop/author/dhtml/httponly_cookies.asp
http://search.cpan.org/search?query=Module::Build::Convert
http://www.refcnt.org/papers/module-build-convert
http://csrc.nist.gov/cryptval/shs.html
http://msdn.microsoft.com/workshop/author/dhtml/reference/charsets/charset4.asp
http://www.debian.or.jp/~kubota/unicode-symbols.html.en
http://www.mail-archive.com/perl5-porters@perl.org/msg69766.html
http://www.debian.or.jp/~kubota/unicode-symbols.html.en
http://rfc.net/rfc2781.html
http://www.icu-project.org/charset/
http://ppewww.ph.gla.ac.uk/~flavell/charset/form-i18n.html
http://www.rfc-editor.org/
http://www.rfc.net/
http://www.oreilly.com/people/authors/lunde/cjk_inf.html
http://www.oreilly.com/catalog/cjkvinfo/
http://www.cpan.org/modules/by-author/Damian_Conway/Filter-Simple.tar.gz
http://www.csse.monash.edu.au/~damian/CPAN/Filter-Simple.tar.gz
http://www.egt.ie/standards/iso3166/iso3166-1-en.html
http://www.bsi-global.com/iso4217currency
http://www.plover.com/~mjd/perl/Memoize/
http://www.plover.com/~mjd/perl/MiniMemoize/
http://www.sysadminmag.com/tpj/issues/vol5_5/
ftp://ftp.tpc.int/tpc/server/UNIX/
http://www.nara.gov/genealogy/
http://home.utah-inter.net/kinsearch/Soundex.html
http://www.nara.gov/genealogy/soundex/soundex.html
http://rfc.net/rfc3461.html
ftp://ftp.cs.pdx.edu/pub/elvis/
http://www.fh-wedel.de/elvis/
http://lists.perl.org/list/perl-mvs.html
http://www.cpan.org/ports/os2/
http://github.com/dagolden/cpan-meta-spec
http://github.com/dagolden/cpan-meta-spec/issues
http://www.opensource.org/licenses/lgpl-license.phpt
http://reality.sgi.com/ariel
http://www.chiark.greenend.org.uk/pipermail/ukcrypto/1999-February/003538.html
http://www.chiark.greenend.org.uk/pipermail/ukcrypto/1999-February/003538.html
http://www.nsrl.nist.gov/testdata/
http://public.activestate.com/cgi-bin/perlbrowse/p/31194
http://public.activestate.com/cgi-bin/perlbrowse?patch=16173
http://public.activestate.com/cgi-bin/perlbrowse?patch=16049
http://www.li18nux.org/docs/html/CodesetAliasTable-V10.html
http://aspn.activestate.com/ASPN/Mail/Message/perl5-porters/3486118
http://lxr.mozilla.org/seamonkey/source/intl/uconv/ucvlatin/vps.ut
http://lxr.mozilla.org/seamonkey/source/intl/uconv/ucvlatin/vps.uf
http://github.com/schwern/extutils-makemaker
https://github.com/dagolden/cpanpm/compare/master...private%2Fuse-http-lite
http://www.json.org/JSON::PP_checker/
ftp://ftp.kiae.su/pub/unix/fido/
http://www.gallistel.net/nparker/weather/code/
http://www.javaworld.com/javaworld/jw-09-2001/jw-0928-ntmessages.html
ftp://ftp-usa.tpc.int/pub/tpc/server/UNIX/
http://www.cis.ohio-state.edu/htbin/rfc/rfc959.html
http://public.activestate.com/cgi-bin/perlbrowse/p/33567
http://public.activestate.com/cgi-bin/perlbrowse/p/33566
http://www.dsmit.com/cons/
http://www.makemaker.org/wiki/index.cgi?ModuleBuildConversionGuide

__END__

=head1 NAME

checkURL.pl - Check that all the URLs in the Perl source are valid

=head1 DESCRIPTION

This program checks that all the URLs in the Perl source are valid. It
checks HTTP and FTP links in parallel and contains a list of known
bad example links in its source. It takes 4 minutes to run on my
machine. The results are written to 'uris.txt' and list the filename,
the URL and the error:

  * ext/Locale-Maketext/lib/Locale/Maketext.pod
    http://sunsite.dk/RFC/rfc/rfc2277.html
      404 Not Found
  ...

It should be run every so often and links fixed and upstream authors
notified.

Note that the web is unstable and some websites are temporarily down.
Commit	Line	Data
23c4d79e	1	#!perl
6e7dc4a9	2	use strict;
23c4d79e LB	3	use warnings;
	4	use autodie;
	5	use feature qw(say);
d4b5f70a NC	6	require File::Find::Rule;
	7	require File::Slurp;
	8	require File::Spec;
	9	require IO::Socket::SSL;
23c4d79e	10	use List::Util qw(sum);
d4b5f70a NC	11	require LWP::UserAgent;
	12	require Net::FTP;
	13	require Parallel::Fork::BossWorkerAsync;
	14	require Term::ProgressBar::Simple;
	15	require URI::Find::Simple;
23c4d79e LB	16	$\| = 1;
	17
	18	my %ignore;
	19	while ( my $line = <main::DATA> ) {
	20	chomp $line;
	21	next if $line =~ /^#/;
	22	next unless $line;
	23	$ignore{$line} = 1;
	24	}
6e7dc4a9	25
7c509e8a	26	my $ua = LWP::UserAgent->new(ssl_opts => { verify_hostname => 0 });
23c4d79e LB	27	$ua->timeout(58);
23c4d79e LB	28	$ua->env_proxy;
6e7dc4a9	29
23c4d79e LB	30	my @filenames = @ARGV;
	31	@filenames = sort grep { $_ !~ /^\.git/ } File::Find::Rule->new->file->in('.')
	32	unless @filenames;
	33
	34	my $total_bytes = sum map {-s} @filenames;
	35
	36	my $extract_progress = Term::ProgressBar::Simple->new(
	37	{ count => $total_bytes,
	38	name => 'Extracting URIs',
	39	}
	40	);
6e7dc4a9	41
23c4d79e LB	42	my %uris;
	43	foreach my $filename (@filenames) {
	44	next if $filename =~ /uris\.txt/;
	45	next if $filename =~ /check_uris/;
	46	next if $filename =~ /\.patch$/;
7c509e8a LB	47	next if $filename =~ 'cpan/Pod-Simple/t/perlfaqo?\.pod';
7c509e8a LB	48	next if $filename =~ /checkURL\.pl$/;
d4b5f70a NC	49	my $contents = File::Slurp::read_file($filename);
d4b5f70a NC	50	my @uris = URI::Find::Simple::list_uris($contents);
23c4d79e LB	51	foreach my $uri (@uris) {
	52	next unless $uri =~ /^(http\|ftp)/;
	53	next if $ignore{$uri};
6e7dc4a9	54
23c4d79e LB	55	# no need to hit rt.perl.org
23c4d79e LB	56	next
3ef6a87a	57	if $uri =~ m{^https?://rt.perl.org/(?:rt3/)?Ticket/Display.html?id=\d+$};
6e7dc4a9	58
23c4d79e LB	59	# no need to hit rt.cpan.org
23c4d79e LB	60	next
7c509e8a LB	61	if $uri =~ m{^https?://rt.cpan.org/Public/Bug/Display.html?id=\d+$};
	62
	63	# no need to hit google groups (weird redirect LWP does not like)
	64	next
	65	if $uri =~ m{^http://groups\.google\.com/};
	66
23c4d79e LB	67	push @{ $uris{$uri} }, $filename;
	68	}
	69	$extract_progress += -s $filename;
	70	}
	71
	72	my $bw = Parallel::Fork::BossWorkerAsync->new(
	73	work_handler => \&work_alarmed,
	74	global_timeout => 120,
	75	worker_count => 20,
	76	);
	77
	78	foreach my $uri ( keys %uris ) {
	79	my @filenames = @{ $uris{$uri} };
	80	$bw->add_work( { uri => $uri, filenames => \@filenames } );
	81	}
	82
	83	undef $extract_progress;
	84
	85	my $fetch_progress = Term::ProgressBar::Simple->new(
	86	{ count => scalar( keys %uris ),
	87	name => 'Fetching URIs',
	88	}
	89	);
	90
	91	my %filenames;
	92	while ( $bw->pending() ) {
	93	my $response = $bw->get_result();
	94	my $uri = $response->{uri};
	95	my @filenames = @{ $response->{filenames} };
	96	my $is_success = $response->{is_success};
	97	my $message = $response->{message};
	98
	99	unless ($is_success) {
	100	foreach my $filename (@filenames) {
	101	push @{ $filenames{$filename} },
	102	{ uri => $uri, message => $message };
6e7dc4a9 JH	103	}
6e7dc4a9 JH	104	}
23c4d79e	105	$fetch_progress++;
6e7dc4a9	106	}
23c4d79e	107	$bw->shut_down();
6e7dc4a9	108
23c4d79e LB	109	my $fh = IO::File->new('> uris.txt');
	110	foreach my $filename ( sort keys %filenames ) {
	111	$fh->say("* $filename");
	112	my @bits = @{ $filenames{$filename} };
	113	foreach my $bit (@bits) {
	114	my $uri = $bit->{uri};
	115	my $message = $bit->{message};
	116	$fh->say(" $uri");
	117	$fh->say(" $message");
0d6d7233 JH	118	}
0d6d7233 JH	119	}
23c4d79e	120	$fh->close;
0d6d7233	121
23c4d79e	122	say 'Finished, see uris.txt';
6e7dc4a9	123
23c4d79e LB	124	sub work_alarmed {
	125	my $conf = shift;
	126	eval {
	127	local $SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required
	128	alarm 60;
	129	$conf = work($conf);
	130	alarm 0;
	131	};
	132	if ($@) {
	133	$conf->{is_success} = 0;
	134	$conf->{message} = 'Timed out';
0d6d7233	135
23c4d79e LB	136	}
23c4d79e LB	137	return $conf;
0d6d7233 JH	138	}
0d6d7233 JH	139
23c4d79e LB	140	sub work {
	141	my $conf = shift;
	142	my $uri = $conf->{uri};
	143	my @filenames = @{ $conf->{filenames} };
0d6d7233	144
23c4d79e LB	145	if ( $uri =~ /^http/ ) {
	146	my $uri_without_fragment = URI->new($uri);
	147	my $fragment = $uri_without_fragment->fragment(undef);
	148	my $response = $ua->head($uri_without_fragment);
0d6d7233	149
23c4d79e LB	150	$conf->{is_success} = $response->is_success;
	151	$conf->{message} = $response->status_line;
	152	return $conf;
	153	} else {
0d6d7233	154
23c4d79e LB	155	my $uri_object = URI->new($uri);
	156	my $host = $uri_object->host;
	157	my $path = $uri_object->path;
	158	my ( $volume, $directories, $filename )
	159	= File::Spec->splitpath($path);
0d6d7233	160
23c4d79e LB	161	my $ftp = Net::FTP->new( $host, Passive => 1, Timeout => 60 );
	162	unless ($ftp) {
	163	$conf->{is_succcess} = 0;
	164	$conf->{message} = "Can not connect to $host: $@";
	165	return $conf;
	166	}
0d6d7233	167
23c4d79e LB	168	my $can_login = $ftp->login( "anonymous", '-anonymous@' );
	169	unless ($can_login) {
	170	$conf->{is_success} = 0;
	171	$conf->{message} = "Can not login ", $ftp->message;
	172	return $conf;
6e7dc4a9 JH	173	}
6e7dc4a9 JH	174
23c4d79e LB	175	my $can_binary = $ftp->binary();
	176	unless ($can_binary) {
	177	$conf->{is_success} = 0;
	178	$conf->{message} = "Can not binary ", $ftp->message;
	179	return $conf;
	180	}
	181
	182	my $can_cwd = $ftp->cwd($directories);
	183	unless ($can_cwd) {
	184	$conf->{is_success} = 0;
	185	$conf->{message} = "Can not cwd to $directories ", $ftp->message;
	186	return $conf;
	187	}
	188
	189	if ($filename) {
	190	my $can_size = $ftp->size($filename);
	191	unless ($can_size) {
	192	$conf->{is_success} = 0;
	193	$conf->{message}
	194	= "Can not size $filename in $directories",
	195	$ftp->message;
	196	return $conf;
	197	}
	198	} else {
	199	my ($can_dir) = $ftp->dir;
	200	unless ($can_dir) {
	201	my ($can_ls) = $ftp->ls;
	202	unless ($can_ls) {
	203	$conf->{is_success} = 0;
	204	$conf->{message}
	205	= "Can not dir or ls in $directories ",
	206	$ftp->message;
	207	return $conf;
	208	}
	209	}
	210	}
	211
	212	$conf->{is_success} = 1;
	213	return $conf;
6e7dc4a9 JH	214	}
	215	}
	216
23c4d79e LB	217	__DATA__
	218	# these are fine but give errors
	219	ftp://ftp.stratus.com/pub/vos/posix/ga/ga.html
	220	ftp://ftp.stratus.com/pub/vos/utility/utility.html
	221
7c509e8a	222	# these are missing, sigh
23c4d79e LB	223	ftp://ftp.sco.com/SLS/ptf7051e.Z
23c4d79e LB	224	http://perlmonks.thepen.com/42898.html
7c509e8a LB	225	http://svn.mutatus.co.uk/wsvn/Scalar-List-Utils/trunk/
	226	http://public.activestate.com/cgi-bin/perlbrowse
	227	http://svn.mutatus.co.uk/browse/libnet/tags/libnet-1.17/ChangeLog
	228	http://aspn.activestate.com/ASPN/Mail/Message/perl6-internals/2746631
	229	http://my.smithmicro.com/mac/stuffit/
	230	http://www.wg.omron.co.jp/cgi-bin/j-e/jfriedl.html
	231	http://persephone.cps.unizar.es/general/gente/spd/gzip/gzip.html
05558683 MM	232	http://www.openzaurus.org/
	233	http://Casbah.org/
	234	http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/nmake15.exe
	235	http://www.pvhp.com/~pvhp/
	236	http://www.pvhp.com/%7Epvhp/
	237	http://www.pvhp.com/%7epvhp/
	238	http://www.leo.org
	239	http://www.madgoat.com
	240	http://www.mks.com/s390/gnu/
	241	http://www.research.att.com/sw/tools/uwin/
	242	http://www.tpj.com/
	243	http://safaribooksonline.com/
	244	http://use.perl.org/~autrijus/journal/25768
	245	http://www.s390.ibm.com/products/oe/bpxqp1.html
	246	http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-02/msg01396.html
	247	http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-02/msg01489.html
	248	http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-02/msg01491.html
	249	http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-02/msg01608.html
	250	http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-02/msg02144.html
	251	http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-02/msg02998.html
	252	http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1999-03/msg00520.html
	253	http://www.w3.org/Security/Faq/
7c509e8a LB	254
7c509e8a LB	255	# these are URI extraction bugs
23c4d79e LB	256	http://www.perl.org/E
	257	http://en.wikipedia.org/wiki/SREC_(file_format
	258	http://somewhere.else',-type=/
	259	ftp:passive-mode
	260	ftp:
	261	http:[-
	262	http://search.cpan.org/src/KWILLIAMS/Module-Build-0.30/lib/Module/Build/Platform/Windows.pm:split_like_shell
	263	http://www.xray.mpe.mpg.de/mailing-lists/perl5-
	264	http://support.microsoft.com/support/kb/articles/Q280/3/41.ASP:
7c509e8a LB	265	http://perl.come/
7c509e8a LB	266	http://www.perl.come/
23c4d79e LB	267
	268	# these are used as an example
	269	http://example.com/
	270	http://something.here/
	271	http://users.perl5.git.perl.org/~yourlogin/
	272	http://github.com/USERNAME/perl/tree/orange
	273	http://the.good.ship.lollypop.com:8080/cgi-bin/foo.cgi
	274	http://the.good.ship.lollypop.com:8080/cgi-bin/foo.cgi/somewhere/else?game=chess;game=checkers;weather=dull;foo=bar
	275	http://somewhere.else$/
	276	http://somewhere.else$/
	277	http://somewhere.else/bin/foo&bar',-Type=
	278	http://the.good.ship.lollypop.com:8080/cgi-bin/foo.cgi
	279	http://the.good.ship.lollypop.com:8080/cgi-bin/foo.cgi/somewhere/else?game=chess;game=checkers;weather=dull;foo=bar
	280	http://www.perl.org/test.cgi
	281	http://cpan2.local/
	282	http://search.cpan.org/perldoc?
	283	http://cpan1.local/
	284	http://cpan.dev.local/CPAN
	285	http:///
	286	ftp://
	287	ftp://myurl/
	288	ftp://ftp.software.ibm.com/aix/fixes/v4/other/vac.C.5.0.2.6.bff
	289	http://www14.software.ibm.com/webapp/download/downloadaz.jsp
	290	http://www.cpan.org/modules/by-module/Archive/Archive-Zip-*.tar.gz
	291	http://www.unicode.org/Public/MAPPINGS/ISO8859/8859-*.TXT
	292	http://localhost/tmp/index.txt
	293	http://example.com/foo/bar.html
	294	http://example.com/Text-Bastardize-1.06.tar.gz
	295	ftp://example.com/sources/packages.txt
	296	http://example.com/sources/packages.txt
	297	http://example.com/sources
	298	ftp://example.com/sources
	299	http://some.where.com/dir/file.txt
	300	http://some.where.com/dir/a.txt
	301	http://foo.com/X.tgz
	302	ftp://foo.com/X.tgz
	303	http://foo/
	304	http://www.foo.com:8000/
	305	http://mysite.com/cgi-bin/log.cgi/http://www.some.other.site/args
	306	http://decoded/mirror/path
	307	http://a/b/c/d/e/f/g/h/i/j
	308	http://foo/bar.gz
	309	ftp://ftp.perl.org
	310	http://purl.org/rss/1.0/modules/taxonomy/
	311	ftp://ftp.sun.ac.za/CPAN/CPAN/
	312	ftp://ftp.cpan.org/pub/mirror/index.txt
	313	ftp://cpan.org/pub/mirror/index.txt
	314	http://example.com/~eh/
	315	http://plagger.org/.../rss
	316	http://umn.dl.sourceforge.net/mingw/gcc-g++-3.4.5-20060117-1.tar.gz
	317	http://umn.dl.sourceforge.net/mingw/binutils-2.16.91-20060119-1.tar.gz
	318	http://umn.dl.sourceforge.net/mingw/mingw-runtime-3.10.tar.gz
	319	http://umn.dl.sourceforge.net/mingw/gcc-core-3.4.5-20060117-1.tar.gz
	320	http://umn.dl.sourceforge.net/mingw/w32api-3.6.tar.gz
	321	http://search.cpan.org/CPAN/authors/id/S/SH/SHAY/dmake-4.5-20060619-SHAY.zip
	322	http://module-build.sourceforge.net/META-spec-new.html
	323	http://module-build.sourceforge.net/META-spec-v1.4.html
	324	http://www.cs.vu.nl/~tmgil/vi.html
	325	http://perlcomposer.sourceforge.net/vperl.html
	326	http://www.perl.com/CPAN/authors/Tom_Christiansen/scripts/rep
	327	http://w4.lns.cornell.edu/~pvhp/ptk/ptkTOC.html
	328	http://world.std.com/~aep/ptkdb/
	329	http://www.castlelink.co.uk/object_system/
	330	http://www.fh-wedel.de/elvis/
331	ftp://ftp.blarg.net/users/amol/zsh/
332	ftp://ftp.funet.fi/pub/languages/perl/CPAN
333	http://search.cpan.org/CPAN/authors/id/S/SH/SHAY/dmake-4.5-20060619-SHAY.zip
7c509e8a LB	334	http://users.perl5.git.perl.org/~USERNAME
	335	http://foo/x//y/script.cgi/a//b
	336	http://xxx/script.cgi/http://foo
	337	http://foo/./x//z/script.cgi/a/../b//c
	338	http://somewhere.else/in/movie/land
	339	http://somewhere.else/finished.html
	340	http://somewhere.else/bin/foo&bar$
	341	http://somewhere.else/
	342	http://proxy:8484/
	343	http://proxy/
	344	http://myrepo.example.com/
	345	http://remote/source
	346	https://example.com/
	347	http://example.com:1024/
	348	http:///path?foo=bar
	349	http://[::]:1024/
	350	http://([/
	351	http://example.com:9000/index.html
	352	http://proxy.example.com:8080/
	353	http:///index.html
	354	http://[www.json::pp.org]/
	355	http://localhost/
	356	http://foo.example.com/
	357	http://abc.com/a.js
	358	http://whatever/man/1/crontab
	359	http://abc.com/c.js
	360	http://whatever/Foo%3A%3ABar
	361	http://abc.com/b.js
	362	http://remote.server.com/jquery.css
	363	http://some.other.com/page.html
	364	https://text.com/1/2
	365	https://text.com/1/2
	366	http://link.included.here?o=1&p=2
	367	http://link.included.here?o=1&p=2
	368	http://link.included.here?o=1&p=2
	369	http://link.included.here/
	370	http://foo/x//y/script.cgi/a//b
	371	http://xxx/script.cgi/http://foo
	372	http://foo/./x//z/script.cgi/a/../b//c
	373	http://somewhere.else/in/movie/land
	374	http://somewhere.else/finished.html
	375	http://webproxy:3128/
	376	http://www/
23c4d79e LB	377
	378	# these are used to generate or match URLs
	379	http://www.cpan.org/modules/by-authors/id/$1/$1$2/$dist
	380	http://www.cpantesters.org/show/%s.yaml
	381	ftp://(.?)/(.)/(.*
	382	ftp://(.?)/(.)/(.*
	383	ftp://(.?)/(.)/(.*
	384	ftp://ftp.foo.bar/
	385	http://$host/
	386	http://wwwe%3C46/
	387	ftp:/
7c509e8a LB	388	http://$addr/mark?commit=$
	389	http://search.cpan.org/~
	390	http:/
	391	ftp:%5Cn$url
	392	http://www.ietf.org/rfc/rfc$2.txt
	393	http://search.cpan.org/~
	394	ftp:%5Cn$url
23c4d79e LB	395
	396	# weird redirects that LWP doesn't like
	397	http://www.theperlreview.com/community_calendar
	398	http://www.software.hp.com/portal/swdepot/displayProductInfo.do?productNumber=PERL
7c509e8a	399	http://sunsolve.sun.com
23c4d79e LB	400
	401	# broken webserver that doesn't like HEAD requests
	402	http://docs.sun.com/app/docs/doc/816-5168/syslog-3c?a=view
7c509e8a	403	http://www.w3.org/TR/html4/loose.dtd
23c4d79e LB	404
	405	# these have been reported upstream to CPAN authors
	406	http://www.gnu.org/manual/tar/html_node/tar_139.html
	407	http://www.w3.org/pub/WWW/TR/Wd-css-1.html
	408	http://support.microsoft.com/support/kb/articles/Q280/3/41.ASP
	409	http://msdn.microsoft.com/workshop/author/dhtml/httponly_cookies.asp
	410	http://search.cpan.org/search?query=Module::Build::Convert
	411	http://www.refcnt.org/papers/module-build-convert
	412	http://csrc.nist.gov/cryptval/shs.html
	413	http://msdn.microsoft.com/workshop/author/dhtml/reference/charsets/charset4.asp
	414	http://www.debian.or.jp/~kubota/unicode-symbols.html.en
	415	http://www.mail-archive.com/perl5-porters@perl.org/msg69766.html
	416	http://www.debian.or.jp/~kubota/unicode-symbols.html.en
	417	http://rfc.net/rfc2781.html
	418	http://www.icu-project.org/charset/
	419	http://ppewww.ph.gla.ac.uk/~flavell/charset/form-i18n.html
	420	http://www.rfc-editor.org/
	421	http://www.rfc.net/
	422	http://www.oreilly.com/people/authors/lunde/cjk_inf.html
	423	http://www.oreilly.com/catalog/cjkvinfo/
	424	http://www.cpan.org/modules/by-author/Damian_Conway/Filter-Simple.tar.gz
	425	http://www.csse.monash.edu.au/~damian/CPAN/Filter-Simple.tar.gz
	426	http://www.egt.ie/standards/iso3166/iso3166-1-en.html
	427	http://www.bsi-global.com/iso4217currency
	428	http://www.plover.com/~mjd/perl/Memoize/
	429	http://www.plover.com/~mjd/perl/MiniMemoize/
	430	http://www.sysadminmag.com/tpj/issues/vol5_5/
	431	ftp://ftp.tpc.int/tpc/server/UNIX/
	432	http://www.nara.gov/genealogy/
	433	http://home.utah-inter.net/kinsearch/Soundex.html
	434	http://www.nara.gov/genealogy/soundex/soundex.html
	435	http://rfc.net/rfc3461.html
	436	ftp://ftp.cs.pdx.edu/pub/elvis/
	437	http://www.fh-wedel.de/elvis/
7d0fb9b8	438	http://lists.perl.org/list/perl-mvs.html
7c509e8a LB	439	http://www.cpan.org/ports/os2/
	440	http://github.com/dagolden/cpan-meta-spec
	441	http://github.com/dagolden/cpan-meta-spec/issues
	442	http://www.opensource.org/licenses/lgpl-license.phpt
	443	http://reality.sgi.com/ariel
	444	http://www.chiark.greenend.org.uk/pipermail/ukcrypto/1999-February/003538.html
	445	http://www.chiark.greenend.org.uk/pipermail/ukcrypto/1999-February/003538.html
	446	http://www.nsrl.nist.gov/testdata/
	447	http://public.activestate.com/cgi-bin/perlbrowse/p/31194
	448	http://public.activestate.com/cgi-bin/perlbrowse?patch=16173
	449	http://public.activestate.com/cgi-bin/perlbrowse?patch=16049
	450	http://www.li18nux.org/docs/html/CodesetAliasTable-V10.html
	451	http://aspn.activestate.com/ASPN/Mail/Message/perl5-porters/3486118
	452	http://lxr.mozilla.org/seamonkey/source/intl/uconv/ucvlatin/vps.ut
	453	http://lxr.mozilla.org/seamonkey/source/intl/uconv/ucvlatin/vps.uf
	454	http://github.com/schwern/extutils-makemaker
	455	https://github.com/dagolden/cpanpm/compare/master...private%2Fuse-http-lite
	456	http://www.json.org/JSON::PP_checker/
	457	ftp://ftp.kiae.su/pub/unix/fido/
	458	http://www.gallistel.net/nparker/weather/code/
	459	http://www.javaworld.com/javaworld/jw-09-2001/jw-0928-ntmessages.html
	460	ftp://ftp-usa.tpc.int/pub/tpc/server/UNIX/
	461	http://www.cis.ohio-state.edu/htbin/rfc/rfc959.html
	462	http://public.activestate.com/cgi-bin/perlbrowse/p/33567
	463	http://public.activestate.com/cgi-bin/perlbrowse/p/33566
	464	http://www.dsmit.com/cons/
	465	http://www.makemaker.org/wiki/index.cgi?ModuleBuildConversionGuide
23c4d79e	466
6e7dc4a9	467	__END__
23c4d79e LB	468
	469	=head1 NAME
	470
	471	checkURL.pl - Check that all the URLs in the Perl source are valid
	472
	473	=head1 DESCRIPTION
	474
	475	This program checks that all the URLs in the Perl source are valid. It
	476	checks HTTP and FTP links in parallel and contains a list of known
	477	bad example links in its source. It takes 4 minutes to run on my
	478	machine. The results are written to 'uris.txt' and list the filename,
	479	the URL and the error:
	480
	481	* ext/Locale-Maketext/lib/Locale/Maketext.pod
	482	http://sunsite.dk/RFC/rfc/rfc2277.html
	483	404 Not Found
	484	...
	485
	486	It should be run every so often and links fixed and upstream authors
	487	notified.
	488
	489	Note that the web is unstable and some websites are temporarily down.