#!/usr/local/bin/perl
#
# You might want to change this:
unshift(@INC,"/paper/homes/gettler/src/rcds/rcds/ftpmirror/w3mir");
#
# This has been modified to handle RCDS updates while mirroring web
# sites.  <gettler@cs.utk.edu> <http://www.netlib.org/rcds/>
#
# $Id: w3mir,v 1.2 1996/10/23 19:01:50 gettler Exp $
#
# This is a very modified version of Oscar Nierstrasz's <oscar@cui.unige.ch>
# htget script.
#
# Retrieves HTML pages, creating local copies in the _current_ 
# directory. The script will check for the last-modified stamp on the
# document, and will not fetch it if the document isn't changed.
#
# Known bugs:
# - Unfortunately we have some problems with the html library.  If someone
#   would fix or rewrite it please? I don't want to and it's not really
#   bothering _me_.
# - If you start at http://foo/bar/ index.html might be gotten twice.
# - There are no other bugs :-)
#
# Test cases for janl to use:
#   http://java.sun.com/progGuide/index.html check out the img things
#   http://www.math.uio.no/eye/  ncsa 1.2, with some problematic docs.
#   http://www.ifi.uio.no/~janl/ ncsa 1.3, If-Modified-Since does not work.
#   http://www.interlog.com/eye/News/Eyenet/EyeNet.html ncsa 1.4.1, 
#                                If-Modified-Since works.
#   http://rosin.ubb.uib.no/	 WinHttpd/1.4
#   http://www.spie.org/	 WebSTAR/1.2, a Macintosh server
#   http://www.byte.com/	 a NT server with a very long name
#   http://www.w3.org/		 Cern 3.0
#   http://www.netscape.com/	 Netscape-Communications/1.1
#
# Authors:
#   Oscar Nierstrasz <oscar@cui.unige.ch>
#   Gorm Haug Eriksen <gorm@usit.uio.no>
#   Nicolai Langfeldt <janl@ifi.uio.no>
#
# History :
#
# oscar 25/03/94 -- added -s option to send output to stdout
# oscar 28/03/94 -- made HTTP 1.0 the default
# oscar 30/05/94 -- special handling of directory URLs missing a trailing "/"
#  gorm 20/02/95 -- added mirror capacity + fixed a couple of bugs
#  janl ??/??/95 -- added a working commandline parser.
#  janl 18/09/95 -- Changed to use a net http library.  Removed dependency of
#		    url.pl.
#  janl 19/09/95 -- Extensive rewrite. Simplified a lot, works better. 
#		    Html files are now saved in a new and improved manner,
#		    which means they can be recognized as such w/o fancy
#		    filename extention type rules (no, -T is not good enough).

require "jhtml.pl";
require "jhttp.pl";

# Set params in the http package
$http'debug=0;
$http'version="1.0";

$debug=0;
$quiet=0;
$pause=0;
$retry=3;
$s=0;
$http'agent=$w3mirversion = "w3mir v0.9beta4 01/10/95 (10/22/96 RCDS Hack)";

&usage unless &parse_args(@ARGV);

chop($root=`pwd`) unless defined($root);
$retry--;

$root.='/' unless $root =~ /\/$/;

$reroot=''; # Shut up -w
($reroot=$root) =~ s/(\W)/$1/;

@got=@didntget=();

foreach $url (@list_of_urls) {
   &mir($url);
}

while ($retry-->0) {
    last unless $#didntget>=$[;
    warn "w3mir: Retrying.  $retry more times left\n" unless $quiet;

    # Save the ungoten url list, &mir will build a new one as it walks.
    @olddidntget=@didntget;

    # Flag each of the failed gets as not gotten.  They are marked as gotten
    # inside &mir so it won't retry them as often as they are referenced.
    foreach $url (@olddidntget) {
	$got{$url}=0;
    }

    # Now get
    foreach $url (@olddidntget) {
	next if $got{$url};
	&mir($url);
    }
}

warn "w3mir: That's all (".$http'xfbytes." bytes of it).\n" unless $quiet;

sub mir {
    # Mirror/get the requested url. Possebly recursively.
    # Working from whatever cwd is at invocation we'll retrive all files
    # under it in the file hierarchy. $file at all times contains the path
    # relative to cwd/first url. $prefix contains the base url.

    local($method,$server,$port,$path)=&http'parse_url(shift(@_));

    $url="$method://$server:$port$path";

    # baseurl always ends in a /
    ($baseurl) = $url =~ m~^(.*/)~;

    ($rebaseurl=$baseurl) =~ s/(\W)/\\$1/g;

    print STDERR "Baseurl: $baseurl\n" if $debug;

    @toget=($url);

    while (defined($url = shift (@toget))) {

	if (defined($got{$url}) && $got{$url}) {
	    warn "w3mir: already retrieved $url\n" if $debug>=2;
	    next;
	}

	sleep($pause) if $pause;

	# extract the file name, if empty or directory, assume index.html
	($file = $url) =~ s|^$rebaseurl||;

	$file.='index.html' if $file =~ m~/$~ || $file eq '';

	# Prefix always ends in a /
	($prefix) = $url =~ m~^(.*/)~;
	($reprefix = $prefix) =~ s/(\W)/\\$1/g;

	# If we're not checking the timestamp, or the file does not exist
	# then we get the file unconditionaly.  Otherwise we only want it
	# if it's updated.
	if ($fa || (!-f $file)) {
	    print STDERR "Getting $url\nPrefix: $prefix File: $file\n" 
		if $debug;
	    &http'query($http'GETURL,$url);
	} else {
	    print STDERR "Getting $url if modified\n".
		"Prefix: $prefix File: $file\n" if $debug;
	    &http'query($http'GETURL,$url,$http'IFMODF,$file);
	}

	print STDERR "http'result: '",$http'result,
	    "' doc size: ", length($http'document),
	    " doc type: -",$http'headval{'content-type'},
	    "- plaintexthtml: ",$http'plaintexthtml,"\n"
		if $debug;

	# Mark as retrived no matter what happened, it's no use to try again...
	# Later we'll add some code to do retrys if there is a timeout.
	$got{$url} = 1;	  

	if ($http'result==200) { # 200 OK 
	    # Only do URL manipulaitons is this is a html document
	    # with no special content-encoding.

	    if ($http'plaintexthtml) {

	        &html'canonize($http'document);

		if ($r) {
		    # make all relative URLs absolute.  The abs function
		    # does nothing to quote the url, this could be a problem
		    $page = &html'abs($prefix,$http'document);

		    # This patches over a deficiency in html'abs: If the
		    # url is (95%) absolute but lacks port then the port
		    # is not put in.
		    # This RE is a bit imprecise.  Someone spank me!
		    if (($altprefix=$prefix) =~ s/:80//) {
			($realtprefix=$altprefix) =~ s/(\W)/\\$1/g;
			$page =~ s/$realtprefix/$prefix/gi;
		    }

		    # extract all URLs with the required prefix
		    # Some ppl add extra whitespace: href = " http://...".
		    # I hate netscapes leniency. We fix it here in case
		    # the url is valid after that.  And, a space in a url can
		    # cause w3mir too loop indefinitly. Very Bad.
		    foreach $ref (grep(/^$reprefix/,&html'hrefs($page))) {
			warn "Ref: $ref\n" if $debug>=2;
			push(@toget,$ref) unless $got{$ref};
		    }

		    # Make all URLs with common prefix relative, so that
		    # the mirrored pages refer to each other, and not to
		    # the original pages!
		    $page =~ s|$reprefix||ig;
		    # Also make things under our startingpoint relative to root
		    $page =~ s|$rebaseurl|$reroot|ig;

		} elsif ($abs) {
		    $page=&html'abs($url,$http'document);
		} else {
		    $page=$http'document;
		}
	    } else {
	        $page=$http'document;
	    }
	    # Write page out
	    &writepage($file,$page);

            ###########################################################
            # At this point the file has been written to disk, so let's
            # grab it and through it at the RC Server
            ###########################################################

            print STDOUT "rcftp $server $path $file";

            open (RCFTP, "rcftp $server $path $file |") || die "can't run rcftp!\n";

	    print STDOUT $RCFTP,"\n";

	} elsif ($http'result==304) { # 304 Not modified
	    # We need to be recursing, and if Perl thinks it's a text file
	    # then we'll take a look at it.
	    next unless $r;
	    # If we're in forget mode then we'll just look at the fetched html
	    next if $s==2;
	    warn "w3mir: Looking at local $file\n";
	    next unless -T $file;

	    if (!open(TMPF,"$file")) {
		warn "Unable to open $file for reading: $!\n";
		next;
	    }
	    local($/)=0;	# local to this brace level, read a whole file
	    $page = <TMPF>;
	    close(TMPF);

	    # Check if it's a html file.  We know this tag is in all
	    # html files, because I put it there as I pull them in.
	    next unless ($page =~ /<!DOCTYPE HTML/i);

	    warn "$file is a html file\n" if $debug;
	    # This page has two kinds of URLs, I know this, because
	    # pulled it all down myself.  The two kinds are:
	    # - relative urls; we'll persue them
	    # - absolute urls; we'll ignore them
	    foreach $ref (&html'hrefs($page)) {
		# root might be a full http://www.../foo/bar so we remove it
		# first.
		$ref =~ s/$reroot//;
		# Skip quickly past all absolute urls as well as urls
		# like news: and mail-to:
		next if ($ref =~ m~^[^:]+:~);
		if ($ref =~ m~^/~) {
		    $absurl=$baseurl.$ref;
		} else {
		    $absurl=$prefix.$ref;
		}
		print STDERR "Ref: $ref = $absurl\n" if $debug>=2;
		if ($got{$absurl}) {
		    print STDERR " OLD NEWS" if $debug>=2;
		} else {
		    push(@toget,$absurl);
		}
		print STDERR "\n" if $debug>=2;
	    }
	} elsif ($http'result==302) {
	    # Cern and NCSA httpd sends 302 'redirect' if a ending / is
	    # forgotten on a url.  This only works if the http server
	    # has the right idea about it's name.
	    if ($url.'/' eq $http'headval{'location'}) {
		warn "w3mir: Missing / in $url\n";
		unshift(@toget,$url.'/');
	    } else {
		&printerror;
	    }
	} elsif ($http'result==404) {
	    # And some httpds sends 404 'file not found' when the ending /
	    # is missing.  So when we get 404 we check for ending / and if
	    # not there append it and try again.
	    # if ($url !~ /\/$/) {
	    #    warn "w3mir: $url: not found, trying to append /.\n";
	    #	unshift(@toget,$url.'/');
	    # } else {
	       &printerror;
	    # }
	} else {
	    &printerror;
	}
    }
}


sub printerror {
    # Print error status of last http connection.

    if ($!) {
    	# OS/Network error
	$msg = "$!";
	push(@didntget,$url);
    } else {
    	# HTTP error
	$msg = $http'result." ".$http'restext;
	$msg .= " =>> ".$http'headval{'location'}
	    if ($http'result =~ /30[23]/);
    }
    print STDERR "w3mir: $url: $msg\n";
}


sub writepage {
    # write a retrived page to whereever it's supposed to be written
    ($file,$page) = @_;
    # $s == 1 dump to stdout
    # $s == 2 forget
    if ($s==1) {
	print $page ;
	return;
    } elsif ($s==2) {
	warn "w3mir: (for)got $url\n" unless $quiet;
	return;
    }

    # Make all intermediate directories
    &mkdir($file);
    if (open(PAGE,">$file")) {
	print PAGE $page;
	close PAGE;
	print STDERR "w3mir: created $file (", length($page), " bytes)\n"
	    unless $quiet;
    } else {
	print STDERR "w3mir: can't write $url to $file: $!\n";
    }
}


sub mkdir {
    # Make all intermediate directories needed for a file

    local($file) = @_;
    local(@dirs) = split("/",$file);
    pop @dirs;
    local($path) = ".";
    foreach $dir (@dirs) {
	$path .= "/$dir";
	# only make if it isnt already there
	if (!-d $path) {
	    if (!mkdir($path,0755)) {
		if (-f $path) {
		    # Remove file then create dir...
		    unlink($path);
		    mkdir($path,0755);
		} else { 
		    print STDERR "w3mir: can't create $path -- $!\n";}
	    }
	}
    }
}


sub version {print $w3mirversion."\n";exit(0);}


sub parse_args {
    # 28/03/95, new better parser - janl@ifi.uio.no

    while ($f=shift) {
	$abs=1,next if ($f eq '-abs');
	$s=1,next if ($f eq '-s');
	$r=1,next if ($f eq '-r');
	$fa=1,next if ($f eq '-fa');
	$quiet=1,next if ($f eq '-q');
	&version,next if ($f eq '-v');
	$pause=shift,next if ($f eq '-p');
	# Dump pages, don't concert, is a waste of time
	$s=2,$http'convert=0,next if ($f eq '-f');
	$root=shift,next if ($f eq '-R');
	$retry=shift,next if ($f eq '-t');
	if ($f eq '-P') {
	    ($http'proxyserver,$http'proxyport)= shift =~ /([^:]+):?(\d+)?/;
	    $http'proxyport=80 unless $http'proxyport;
	    next;
	}
	if ($f eq '-C') {
	    $f=shift;
	    &mkdir($f);
	    chdir($f) || 
		die "w3mir: Can't change working directory to $f: $!\n";
	    next;
	}
	push(@list_of_urls,$f),next if ($f =~ /^http/);
	# If we get this far then the commandline is broken
	return 0;
    }

    return ($#list_of_urls!=-1);
}


sub usage {

    die 'w3mir: usage: w3mir [options] <http-urls>

    Options :
	-abs		- Relative URLs are converted to absolute URLs.
	-C direcotry	- Change to directory before getting files.
			  make it if it\'s missing.
	-f		- Forget all files, nothing is saved to disk
			  this can be used for link verification, or in
			  conjunction with -P to prime caching proxy servers.
	-fa		- Will not check timestamp (will work like
			  the old version of this script)
	-p n		- Pause n seconds before retriving each doc
	-P server:port	- Use host/port for proxy http requests
	-r		- All reachable UR"s with the same directory
			  prefixare fetched (will convert to rel. urls)
	-R rootpath     - Where this will reside. pwd is default. A likely
			  value is "/somepath/" if the mirror will be
			  accessable as http://www.somewhere/somepath/
	-s		- Will send output to stdout instead of file
	-t n		- How many times to (re)try getting a failed doc?
			  Default is 3;
	-q		- Quiet, turns off informational messages
';
}

__END__
