summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/bin/lwp-rget
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/bin/lwp-rget')
-rwxr-xr-xMaster/tlpkg/tlperl/bin/lwp-rget607
1 files changed, 0 insertions, 607 deletions
diff --git a/Master/tlpkg/tlperl/bin/lwp-rget b/Master/tlpkg/tlperl/bin/lwp-rget
deleted file mode 100755
index 2ac798f4bb0..00000000000
--- a/Master/tlpkg/tlperl/bin/lwp-rget
+++ /dev/null
@@ -1,607 +0,0 @@
-#!/usr/bin/perl -w
-
-=head1 NAME
-
-lwp-rget - Retrieve web documents recursively
-
-=head1 SYNOPSIS
-
- lwp-rget [--verbose] [--auth=USER:PASS] [--depth=N] [--hier] [--iis]
- [--keepext=mime/type[,mime/type]] [--limit=N] [--nospace]
- [--prefix=URL] [--referer=URL] [--sleep=N] [--tolower] <URL>
- lwp-rget --version
-
-=head1 DESCRIPTION
-
-This program will retrieve a document and store it in a local file. It
-will follow any links found in the document and store these documents
-as well, patching links so that they refer to these local copies.
-This process continues until there are no more unvisited links or the
-process is stopped by the one or more of the limits which can be
-controlled by the command line arguments.
-
-This program is useful if you want to make a local copy of a
-collection of documents or want to do web reading off-line.
-
-All documents are stored as plain files in the current directory. The
-file names chosen are derived from the last component of URL paths.
-
-The options are:
-
-=over 3
-
-=item --auth=USER:PASS<n>
-
-Set the authentication credentials to user "USER" and password "PASS" if
-any restricted parts of the web site are hit. If there are restricted
-parts of the web site and authentication credentials are not available,
-those pages will not be downloaded.
-
-=item --depth=I<n>
-
-Limit the recursive level. Embedded images are always loaded, even if
-they fall outside the I<--depth>. This means that one can use
-I<--depth=0> in order to fetch a single document together with all
-inline graphics.
-
-The default depth is 5.
-
-=item --hier
-
-Download files into a hierarchy that mimics the web site structure.
-The default is to put all files in the current directory.
-
-=item --referer=I<URI>
-
-Set the value of the Referer header for the initial request. The
-special value C<"NONE"> can be used to suppress the Referer header in
-any of subsequent requests. The Referer header will always be suppressed
-in all normal C<http> requests if the referring page was transmitted over
-C<https> as recommended in RFC 2616.
-
-=item --iis
-
-Sends an "Accept: */*" on all URL requests as a workaround for a bug in
-IIS 2.0. If no Accept MIME header is present, IIS 2.0 returns with a
-"406 No acceptable objects were found" error. Also converts any back
-slashes (\\) in URLs to forward slashes (/).
-
-=item --keepext=I<mime/type[,mime/type]>
-
-Keeps the current extension for the list MIME types. Useful when
-downloading text/plain documents that shouldn't all be translated to
-*.txt files.
-
-=item --limit=I<n>
-
-Limit the number of documents to get. The default limit is 50.
-
-=item --nospace
-
-Changes spaces in all URLs to underscore characters (_). Useful when
-downloading files from sites serving URLs with spaces in them. Does not
-remove spaces from fragments, e.g., "file.html#somewhere in here".
-
-=item --prefix=I<url_prefix>
-
-Limit the links to follow. Only URLs that start the prefix string are
-followed.
-
-The default prefix is set as the "directory" of the initial URL to
-follow. For instance if we start lwp-rget with the URL
-C<http://www.sn.no/foo/bar.html>, then prefix will be set to
-C<http://www.sn.no/foo/>.
-
-Use C<--prefix=''> if you don't want the fetching to be limited by any
-prefix.
-
-=item --sleep=I<n>
-
-Sleep I<n> seconds before retrieving each document. This options allows
-you to go slowly, not loading the server you visiting too much.
-
-=item --tolower
-
-Translates all links to lowercase. Useful when downloading files from
-IIS since it does not serve files in a case sensitive manner.
-
-=item --verbose
-
-Make more noise while running.
-
-=item --quiet
-
-Don't make any noise.
-
-=item --version
-
-Print program version number and quit.
-
-=item --help
-
-Print the usage message and quit.
-
-=back
-
-Before the program exits the name of the file, where the initial URL
-is stored, is printed on stdout. All used filenames are also printed
-on stderr as they are loaded. This printing can be suppressed with
-the I<--quiet> option.
-
-=head1 SEE ALSO
-
-L<lwp-request>, L<LWP>
-
-=head1 AUTHOR
-
-Gisle Aas <aas@sn.no>
-
-=cut
-
-use strict;
-
-use Getopt::Long qw(GetOptions);
-use URI::URL qw(url);
-use LWP::MediaTypes qw(media_suffix);
-use HTML::Entities ();
-
-use vars qw($VERSION);
-use vars qw($MAX_DEPTH $MAX_DOCS $PREFIX $REFERER $VERBOSE $QUIET $SLEEP $HIER $AUTH $IIS $TOLOWER $NOSPACE %KEEPEXT);
-
-my $progname = $0;
-$progname =~ s|.*/||; # only basename left
-$progname =~ s/\.\w*$//; #strip extension if any
-
-$VERSION = "5.827";
-
-#$Getopt::Long::debug = 1;
-#$Getopt::Long::ignorecase = 0;
-
-# Defaults
-$MAX_DEPTH = 5;
-$MAX_DOCS = 50;
-
-GetOptions('version' => \&print_version,
- 'help' => \&usage,
- 'depth=i' => \$MAX_DEPTH,
- 'limit=i' => \$MAX_DOCS,
- 'verbose!' => \$VERBOSE,
- 'quiet!' => \$QUIET,
- 'sleep=i' => \$SLEEP,
- 'prefix:s' => \$PREFIX,
- 'referer:s'=> \$REFERER,
- 'hier' => \$HIER,
- 'auth=s' => \$AUTH,
- 'iis' => \$IIS,
- 'tolower' => \$TOLOWER,
- 'nospace' => \$NOSPACE,
- 'keepext=s' => \$KEEPEXT{'OPT'},
- ) || usage();
-
-sub print_version {
- require LWP;
- my $DISTNAME = 'libwww-perl-' . LWP::Version();
- print <<"EOT";
-This is lwp-rget version $VERSION ($DISTNAME)
-
-Copyright 1996-1998, Gisle Aas.
-
-This program is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-EOT
- exit 0;
-}
-
-my $start_url = shift || usage();
-usage() if @ARGV;
-
-require LWP::UserAgent;
-my $ua = new LWP::UserAgent;
-$ua->agent("$progname/$VERSION ");
-$ua->env_proxy;
-
-unless (defined $PREFIX) {
- $PREFIX = url($start_url); # limit to URLs below this one
- eval {
- $PREFIX->eparams(undef);
- $PREFIX->equery(undef);
- };
-
- $_ = $PREFIX->epath;
- s|[^/]+$||;
- $PREFIX->epath($_);
- $PREFIX = $PREFIX->as_string;
-}
-
-%KEEPEXT = map { lc($_) => 1 } split(/\s*,\s*/, ($KEEPEXT{'OPT'}||0));
-
-my $SUPPRESS_REFERER;
-$SUPPRESS_REFERER++ if ($REFERER || "") eq "NONE";
-
-print <<"" if $VERBOSE;
-START = $start_url
-MAX_DEPTH = $MAX_DEPTH
-MAX_DOCS = $MAX_DOCS
-PREFIX = $PREFIX
-
-my $no_docs = 0;
-my %seen = (); # mapping from URL => local_file
-
-my $filename = fetch($start_url, undef, $REFERER);
-print "$filename\n" unless $QUIET;
-
-sub fetch
-{
- my($url, $type, $referer, $depth) = @_;
-
- # Fix http://sitename.com/../blah/blah.html to
- # http://sitename.com/blah/blah.html
- $url = $url->as_string if (ref($url));
- while ($url =~ s#(https?://[^/]+/)\.\.\/#$1#) {}
-
- # Fix backslashes (\) in URL if $IIS defined
- $url = fix_backslashes($url) if (defined $IIS);
-
- $url = url($url);
- $type ||= 'a';
- # Might be the background attribute
- $type = 'img' if ($type eq 'body' || $type eq 'td');
- $depth ||= 0;
-
- # Print the URL before we start checking...
- my $out = (" " x $depth) . $url . " ";
- $out .= "." x (60 - length($out));
- print STDERR $out . " " if $VERBOSE;
-
- # Can't get mailto things
- if ($url->scheme eq 'mailto') {
- print STDERR "*skipping mailto*\n" if $VERBOSE;
- return $url->as_string;
- }
-
- # The $plain_url is a URL without the fragment part
- my $plain_url = $url->clone;
- $plain_url->frag(undef);
-
- # Check PREFIX, but not for <IMG ...> links
- if ($type ne 'img' and $url->as_string !~ /^\Q$PREFIX/o) {
- print STDERR "*outsider*\n" if $VERBOSE;
- return $url->as_string;
- }
-
- # Translate URL to lowercase if $TOLOWER defined
- $plain_url = to_lower($plain_url) if (defined $TOLOWER);
-
- # If we already have it, then there is nothing to be done
- my $seen = $seen{$plain_url->as_string};
- if ($seen) {
- my $frag = $url->frag;
- $seen .= "#$frag" if defined($frag);
- $seen = protect_frag_spaces($seen);
- print STDERR "$seen (again)\n" if $VERBOSE;
- return $seen;
- }
-
- # Too much or too deep
- if ($depth > $MAX_DEPTH and $type ne 'img') {
- print STDERR "*too deep*\n" if $VERBOSE;
- return $url;
- }
- if ($no_docs > $MAX_DOCS) {
- print STDERR "*too many*\n" if $VERBOSE;
- return $url;
- }
-
- # Fetch document
- $no_docs++;
- sleep($SLEEP) if $SLEEP;
- my $req = HTTP::Request->new(GET => $url);
- # See: http://ftp.sunet.se/pub/NT/mirror-microsoft/kb/Q163/7/74.TXT
- $req->header ('Accept', '*/*') if (defined $IIS); # GIF/JPG from IIS 2.0
- $req->authorization_basic(split (/:/, $AUTH)) if (defined $AUTH);
- if ($referer && !$SUPPRESS_REFERER) {
- if ($req->uri->scheme eq 'http') {
- # RFC 2616, section 15.1.3
- $referer = url($referer) unless ref($referer);
- undef $referer if ($referer->scheme || '') eq 'https';
- }
- $req->referer($referer) if $referer;
- }
- my $res = $ua->request($req);
-
- # Check outcome
- if ($res->is_success) {
- my $doc = $res->content;
- my $ct = $res->content_type;
- my $name = find_name($res->request->uri, $ct);
- print STDERR "$name\n" unless $QUIET;
- $seen{$plain_url->as_string} = $name;
-
- # If the file is HTML, then we look for internal links
- if ($ct eq "text/html") {
- # Save an unprosessed version of the HTML document. This
- # both reserves the name used, and it also ensures that we
- # don't loose everything if this program is killed before
- # we finish.
- save($name, $doc);
- my $base = $res->base;
-
- # Follow and substitute links...
- $doc =~
-s/
- (
- <(img|a|body|area|frame|td)\b # some interesting tag
- [^>]+ # still inside tag (not strictly correct)
- \b(?:src|href|background) # some link attribute
- \s*=\s* # =
- )
- (?: # scope of OR-ing
- (")([^"]*)" | # value in double quotes OR
- (')([^']*)' | # value in single quotes OR
- ([^\s>]+) # quoteless value
- )
-/
- new_link($1, lc($2), $3||$5, HTML::Entities::decode($4||$6||$7),
- $base, $name, "$url", $depth+1)
-/giex;
- # XXX
- # The regular expression above is not strictly correct.
- # It is not really possible to parse HTML with a single
- # regular expression, but it is faster. Tags that might
- # confuse us include:
- # <a alt="href" href=link.html>
- # <a alt=">" href="link.html">
- #
- }
- save($name, $doc);
- return $name;
- }
- else {
- print STDERR $res->code . " " . $res->message . "\n" if $VERBOSE;
- $seen{$plain_url->as_string} = $url->as_string;
- return $url->as_string;
- }
-}
-
-sub new_link
-{
- my($pre, $type, $quote, $url, $base, $localbase, $referer, $depth) = @_;
-
- $url = protect_frag_spaces($url);
-
- $url = fetch(url($url, $base)->abs, $type, $referer, $depth);
- $url = url("file:$url", "file:$localbase")->rel
- unless $url =~ /^[.+\-\w]+:/;
-
- $url = unprotect_frag_spaces($url);
-
- return $pre . $quote . $url . $quote;
-}
-
-
-sub protect_frag_spaces
-{
- my ($url) = @_;
-
- $url = $url->as_string if (ref($url));
-
- if ($url =~ m/^([^#]*#)(.+)$/)
- {
- my ($base, $frag) = ($1, $2);
- $frag =~ s/ /%20/g;
- $url = $base . $frag;
- }
-
- return $url;
-}
-
-
-sub unprotect_frag_spaces
-{
- my ($url) = @_;
-
- $url = $url->as_string if (ref($url));
-
- if ($url =~ m/^([^#]*#)(.+)$/)
- {
- my ($base, $frag) = ($1, $2);
- $frag =~ s/%20/ /g;
- $url = $base . $frag;
- }
-
- return $url;
-}
-
-
-sub fix_backslashes
-{
- my ($url) = @_;
- my ($base, $frag);
-
- $url = $url->as_string if (ref($url));
-
- if ($url =~ m/([^#]+)(#.*)/)
- {
- ($base, $frag) = ($1, $2);
- }
- else
- {
- $base = $url;
- $frag = "";
- }
-
- $base =~ tr/\\/\//;
- $base =~ s/%5[cC]/\//g; # URL-encoded back slash is %5C
-
- return $base . $frag;
-}
-
-
-sub to_lower
-{
- my ($url) = @_;
- my $was_object = 0;
-
- if (ref($url))
- {
- $url = $url->as_string;
- $was_object = 1;
- }
-
- if ($url =~ m/([^#]+)(#.*)/)
- {
- $url = lc($1) . $2;
- }
- else
- {
- $url = lc($url);
- }
-
- if ($was_object == 1)
- {
- return url($url);
- }
- else
- {
- return $url;
- }
-}
-
-
-sub translate_spaces
-{
- my ($url) = @_;
- my ($base, $frag);
-
- $url = $url->as_string if (ref($url));
-
- if ($url =~ m/([^#]+)(#.*)/)
- {
- ($base, $frag) = ($1, $2);
- }
- else
- {
- $base = $url;
- $frag = "";
- }
-
- $base =~ s/^ *//; # Remove initial spaces from base
- $base =~ s/ *$//; # Remove trailing spaces from base
-
- $base =~ tr/ /_/;
- $base =~ s/%20/_/g; # URL-encoded space is %20
-
- return $base . $frag;
-}
-
-
-sub mkdirp
-{
- my($directory, $mode) = @_;
- my @dirs = split(/\//, $directory);
- my $path = shift(@dirs); # build it as we go
- my $result = 1; # assume it will work
-
- unless (-d $path) {
- $result &&= mkdir($path, $mode);
- }
-
- foreach (@dirs) {
- $path .= "/$_";
- if ( ! -d $path) {
- $result &&= mkdir($path, $mode);
- }
- }
-
- return $result;
-}
-
-
-sub find_name
-{
- my($url, $type) = @_;
- #print "find_name($url, $type)\n";
-
- # Translate spaces in URL to underscores (_) if $NOSPACE defined
- $url = translate_spaces($url) if (defined $NOSPACE);
-
- # Translate URL to lowercase if $TOLOWER defined
- $url = to_lower($url) if (defined $TOLOWER);
-
- $url = url($url) unless ref($url);
-
- my $path = $url->path;
-
- # trim path until only the basename is left
- $path =~ s|(.*/)||;
- my $dirname = ".$1";
- if (!$HIER) {
- $dirname = "";
- }
- elsif (! -d $dirname) {
- mkdirp($dirname, 0775);
- }
-
- my $extra = ""; # something to make the name unique
- my $suffix;
-
- if ($KEEPEXT{lc($type)}) {
- $suffix = ($path =~ m/\.(.*)/) ? $1 : "";
- }
- else {
- $suffix = media_suffix($type);
- }
-
- $path =~ s|\..*||; # trim suffix
- $path = "index" unless length $path;
-
- while (1) {
- # Construct a new file name
- my $file = $dirname . $path . $extra;
- $file .= ".$suffix" if $suffix;
- # Check if it is unique
- return $file unless -f $file;
-
- # Try something extra
- unless ($extra) {
- $extra = "001";
- next;
- }
- $extra++;
- }
-}
-
-
-sub save
-{
- my $name = shift;
- #print "save($name,...)\n";
- open(FILE, ">$name") || die "Can't save $name: $!";
- binmode FILE;
- print FILE $_[0];
- close(FILE);
-}
-
-
-sub usage
-{
- print <<""; exit 1;
-Usage: $progname [options] <URL>
-Allowed options are:
- --auth=USER:PASS Set authentication credentials for web site
- --depth=N Maximum depth to traverse (default is $MAX_DEPTH)
- --hier Download into hierarchy (not all files into cwd)
- --referer=URI Set initial referer header (or "NONE")
- --iis Workaround IIS 2.0 bug by sending "Accept: */*" MIME
- header; translates backslashes (\\) to forward slashes (/)
- --keepext=type Keep file extension for MIME types (comma-separated list)
- --limit=N A limit on the number documents to get (default is $MAX_DOCS)
- --nospace Translate spaces URLs (not #fragments) to underscores (_)
- --version Print version number and quit
- --verbose More output
- --quiet No output
- --sleep=SECS Sleep between gets, ie. go slowly
- --prefix=PREFIX Limit URLs to follow to those which begin with PREFIX
- --tolower Translate all URLs to lowercase (useful with IIS servers)
-
-}