bagder: curl-www/programs Curl::easy.tgz, NONE, 1.1 bushpdf.txt, NONE, 1.1 checklinks.txt, NONE, 1.1 comhemlogin.bash, NONE, 1.1 comhemlogin.txt, NONE, 1.1 crawlink.txt, NONE, 1.1 curlmirror.txt, NONE, 1.1 display.cgi, NONE, 1.1 download.txt, NONE, 1.1 formfind.txt, NONE, 1.1 ftproxy.txt, NONE, 1.1 get_latest_kernel.txt, NONE, 1.1 getlinks.txt, NONE, 1.1 hotmacux.tar.gz, NONE, 1.1 recursiveftpget.txt, NONE, 1.1 tnord_login.pl, NONE, 1.1
[email protected] Thu, 17 Sep 2009 11:47:05 +0000
| Newsgroups | gmane.comp.web.curl.www.cvs |
|---|---|
| Message-ID | <[email protected]> |
Update of /cvsroot/curl/curl-www/programs In directory labb:/tmp/cvs-serv20417 Added Files: Curl::easy.tgz bushpdf.txt checklinks.txt comhemlogin.bash comhemlogin.txt crawlink.txt curlmirror.txt display.cgi download.txt formfind.txt ftproxy.txt get_latest_kernel.txt getlinks.txt hotmacux.tar.gz recursiveftpget.txt tnord_login.pl Log Message: lots of stuff lying around on the old site I commit now, let's see what to keep or not... --- NEW FILE: comhemlogin.txt --- #Personliga uppgifter: $username="u1234567"; $password="ABcDe123"; $curl="curl"; # sökväg till curl # _ _ _ __ ___ __ # | | | | / \ \ \/ | \/ / # | |_| | / _ \ \ / \ / # | _ |/ ___ \ / \ / \ # |_| |_/_/ \_Y_/\_Y_/\_\ # # http://www.haxx.se/ # Snabba lösningar för svåra problem. # # Det här skriptet är gjort för att automatiskt logga in på Comhems # kabelinternet. Fyll i användarnamn och lösenord upptill på sidan. # Till hjälp används curl (http://curl.haxx.se/) och du kan behöva modifiera # sökvägen till det programmet. # Metoden är att först hämta startsidan, plocka ut en dold tidsstämpel och # sedan posta tillbaka formuläret. # # Skrivet av [email protected] 2000 # # Uppdaterat 2001-02-14 av Kjell Ericson och Björn Stenberg $initpage="http://login1.telia.com/sd/init"; $loginpage="http://login1.telia.com/sd/login"; system "$curl $initpage"; $username=~ s/([^a-zA-Z0-9_.-])/uc sprintf("%%%02X",ord($1))/eg; $password=~ s/([^a-zA-Z0-9_.-])/uc sprintf("%%%02X",ord($1))/eg; $cmd="$curl -d \"username=$username&password=$password\" $loginpage"; $result=`$cmd`; print $result; --- NEW FILE: checklinks.txt --- #!/usr/local/bin/perl # # checklinks.pl # # This script extracts all links from a HTML page and checks their validity. # Written to use 'curl' for URL checking. # # Author: Daniel Stenberg <[email protected]> # Version: 0.7 Sept 30, 1998 # # HISTORY # # 0.5 - Cuts off the #-part from links before checking. # # 0.6 - Now deals with error codes 3XX better and follows the Location: # properly. # - Added the -x flag that only checks http:// -links # # 0.7 - Ok, http://www.viunga.se/main.html didn't realize this had no path # but a document. Now it does. # # $in=""; argv: if($ARGV[0] eq "-v" ) { $verbose = 1; shift @ARGV; goto argv; } elsif($ARGV[0] eq "-i" ) { $usestdin = 1; shift @ARGV; goto argv; } elsif($ARGV[0] eq "-l" ) { $linenumber = 1; shift @ARGV; goto argv; } elsif($ARGV[0] eq "-h" ) { $help = 1; shift @ARGV; goto argv; } elsif($ARGV[0] eq "-x" ) { $external = 1; shift @ARGV; goto argv; } $geturl = $ARGV[0]; if(($geturl eq "") || $help) { print "Usage: $0 [-hilvx] <full URL>\n", " Use a traling slash for directory URLs!\n", " -h This help text\n", " -i Read the initial page from stdin\n", " -l Line number report for BAD links\n", " -v Verbose mode\n", " -x Check non-local (external?) links only\n"; exit; } if($ARGV[1] eq "-") { print "We use stdin!\n"; $usestdin = 1; } # This is necessary from where I tried this: #$proxy =" -x 194.237.142.41:80"; # linkchecker, URL will be appended to the right of this command line # this is the one using HEAD: $linkcheck = "curl -s -m 20 -I$proxy"; # as a second attempt, this will be used. This is not using HEAD but will # get the whole frigging document! $linkcheckfull = "curl -s -m 20 -i$proxy"; # htmlget, URL will be appended to the right of this command line $htmlget = "curl -s$proxy"; # Parse the input URL and split it into the relevant parts: sub SplitURL { my $inurl = $_[0]; if($inurl=~ /^([^:]+):\/\/([^\/]*)\/(.*)\/(.*)/ ) { $getprotocol = $1; $getserver = $2; $getpath = $3; $getdocument = $4; } elsif ($inurl=~ /^([^:]+):\/\/([^\/]*)\/(.*)/ ) { $getprotocol = $1; $getserver = $2; $getpath = $3; $getdocument = ""; if($getpath !~ /\//) { $getpath =""; $getdocument = $3; } } elsif ($inurl=~ /^([^:]+):\/\/(.*)/ ) { $getprotocol = $1; $getserver = $2; $getpath = ""; $getdocument = ""; } else { print "Couldn't parse the specified URL, retry please!\n"; exit; } } &SplitURL($geturl); #print "protocol = $getprotocol\n"; #print "server = $getserver\n"; #print "path = $getpath\n"; #print "document = $getdocument\n"; #exit; if(!$usestdin) { open(HEADGET, "$linkcheck $geturl|") || die "Couldn't get web page for some reason"; headget: while(<HEADGET>) { # print $_; if($_ =~ /HTTP\/.*3\d\d /) { $pagemoved=1; } elsif($pagemoved && ($_ =~ /^Location: (.*)/)) { $geturl = $1; &SplitURL($geturl); $pagemoved++; last headget; } } close(HEADGET); if($pagemoved == 1) { print "Page is moved but we don't know where. Did you forget the ", "traling slash?\n"; exit; } open(WEBGET, "$htmlget $geturl|") || die "Couldn't get web page for some reason"; while(<WEBGET>) { $line = $_; push @indoc, $line; $line=~ s/\n//g; $line=~ s/\r//g; # print $line."\n"; $in=$in.$line; } close(WEBGET); } else { while(<STDIN>) { $line = $_; push @indoc, $line; $line=~ s/\n//g; $line=~ s/\r//g; $in=$in.$line; } } #print length($in)."\n"; sub LinkWorks { my $check = $_[0]; # URL encode: # $check =~s/([^a-zA-Z0-9_:\/.-])/uc sprintf("%%%02x",ord($1))/eg; @doc = `$linkcheck \"$check\"`; $head = 1; # print "COMMAND: $linkcheck \"$check\"\n"; # print $doc[0]."\n"; boo: if( $doc[0] =~ /^HTTP[^ ]+ (\d+)/ ) { $error = $1; if($error < 400 ) { return "GOOD"; } else { if($head && ($error >= 500)) { # This server doesn't like HEAD! @doc = `$linkcheckfull \"$check\"`; $head = 0; goto boo; } return "BAD"; } } return "BAD"; } sub GetLinks { my $in = $_[0]; my @result; getlinkloop: while($in =~ /[^<]*(<[^>]+>)/g ) { # we have a tag in $1 $tag = $1; if($tag =~ /^<!--/) { # this is a comment tag, ignore it } else { if($tag =~ /(src|href|background|archive) *= *(\"[^\"]\"|[^ )>]*)/i) { $url=$2; if($url =~ /^\"(.*)\"$/) { # this was a "string" now $1 has removed the quotes: $url=$1; } $url =~ s/([^\#]*)\#.*/$1/g; if($url eq "") { # if the link was nothing than a #-link it may now have # been emptied completely so then we skip the rest next getlinkloop; } if($done{$url}) { # if this url already is done, do next $done{$url}++; next getlinkloop; } $done{$url} = 1; # this is "done" push @result, $url; if($tag =~ /< *([^ ]+)/) { # print "TAG: $1\n"; $tagtype{$url}=$1; } } } } return @result; } @links = &GetLinks($in); linkloop: for(@links) { $url = $_; if($url =~ /^([^:]+):/) { $prot = $1; # if($prot !~ /(http|ftp|gopher)/i) { if($prot !~ /http/i) { # this is an unsupported protocol, we ignore this next linkloop; } $link = $url; } else { if($external) { next linkloop; } # this is a link on the save server: if($url =~ /^\//) { # from root $link = "$getprotocol://$getserver$url"; } else { # from the scanned page's dir $nyurl=$url; if(length($getpath) && ($getpath !~ /\/$/) && ($nyurl !~ /^\//)) { # lacks ending slash, add one to the document part: $nyurl = "/".$nyurl; } $link = "$getprotocol://$getserver/$getpath$nyurl"; } } #print "test $link\n"; #$success = "GOOD"; $success = &LinkWorks($link); $count = $done{$url}; $allcount += $count; print "$success $count <".$tagtype{$url}."> $link $url\n"; # If bad and -l, present the line numbers of the usage if("BAD" eq $success) { $badlinks++; if($linenumber) { $line =1; for(@indoc) { if($_ =~ /$url/) { print " line $line\n"; } $line++; } } } } if($verbose) { print "$allcount links were checked"; if($badlinks > 0) { print ", $badlinks were found bad"; } print "\n"; } --- NEW FILE: get_latest_kernel.txt --- #!/usr/bin/perl -w # $Id: get_latest_kernel.txt,v 1.1 2009-09-17 11:47:03 bagder Exp $ # Copyright (C) 2006 Fredrik Ax <[email protected]> # # get_latest_kernel.pl is free software; you may redistributed it and/or modify # it under the terms of the GNU General Public License, Version 2 or later. # ############################################################################### # Defaults my $baseurl= 'http://www.kernel.org/pub/linux/kernel/'; my $basever= '2.6'; ### No need to change anything below this ##################################### use strict; use HTML::TreeBuilder; use WWW::Curl::easy; my $showprog= 1; for my $arg (@ARGV) { if($arg =~ m/[0-9]+\.[0-9]+$/) { $basever= $arg; } elsif($arg eq '--no-progress') { $showprog= 0; } else { die "\nUSAGE: $0 [--no-progress] [<base-version>]\n\n(base version defaults to '2.6')\n\n"; } } my $body= ''; my $tot= my $prog= 0; my $code= 0; my $curl = WWW::Curl::easy->new(); $code+= $curl->setopt(CURLOPT_WRITEFUNCTION, \&tovar ); $code+= $curl->setopt(CURLOPT_FAILONERROR, 0); $code+= $curl->setopt(CURLOPT_FILE, \$body); $code+= $curl->setopt(CURLOPT_SSL_VERIFYPEER, 0); $code+= $curl->setopt(CURLOPT_SSL_VERIFYHOST, 0); $code+= $curl->setopt(CURLOPT_NOPROGRESS, 1); $code+= $curl->setopt(CURLOPT_VERBOSE, 0); $code+= $curl->setopt(CURLOPT_HEADER, 0); $code+= $curl->setopt(CURLOPT_HEADERFUNCTION, sub { return length(shift) } ); # ignore headers $code+= $curl->setopt(CURLOPT_URL, "${baseurl}v$basever/"); die 'Failed to initialize curl' if $code != 0; $curl->perform(); my $tree = HTML::TreeBuilder->new(); $tree->parse($body); my $lver= ''; for my $a ($tree->look_down('_tag', 'a', sub { defined($_[0]->attr('href')) && $_[0]->attr('href') =~ m/^LATEST-IS-/ } )) { $a->attr('href') =~ m/^LATEST-IS-(.*)/ or die 'Internal Error'; $lver= $1; last; } die "\nCould not find latest kernel of major version $basever!\n\n" unless length($lver); print "Looking for linux-$lver.tar.bz2 or linux-$lver.tar.gz ...\n"; my $kernel= ''; for my $a ($tree->look_down('_tag', 'a', sub { defined($_[0]->attr('href')) && $_[0]->attr('href') =~ m/^linux-$lver\.tar\.(bz2|gz)$/i } )) { $a->attr('href') =~ m/^linux-$lver\.tar\.(bz2|gz)$/i or die 'Internal Error 2'; $kernel= "linux-$lver.tar.$1"; last if $1 =~ m/^bz2/i; } die "\nCould not find linux-$lver.tar.bz2 or linux-$lver.tar.gz!\n\n" unless length($kernel); print "Downloading ${baseurl}v$basever/$kernel...\n"; open(TBZ2, ">$kernel") or die "\nopen: $!\n\n"; binmode TBZ2; if($showprog) { $code+= $curl->setopt(CURLOPT_HEADERFUNCTION, \&get_tot ); # get content-length from headers $code+= $curl->setopt(CURLOPT_WRITEFUNCTION, \&tofile_prog); $|= 1; } else { $code+= $curl->setopt(CURLOPT_WRITEFUNCTION, \&tofile); } $code+= $curl->setopt(CURLOPT_FILE, *TBZ2); $code+= $curl->setopt(CURLOPT_URL, "${baseurl}v$basever/$kernel"); die 'Failed to initialize curl' if $code != 0; $curl->perform(); close TBZ2; print "\n"; exit 0; # Call-back functions sub tovar { my ($data,$pointer)=@_; ${$pointer}.= $data; return length($data); } sub tofile { return syswrite($_[1], $_[0]); } sub tofile_prog { my $res= syswrite($_[1], $_[0]); return 0 unless defined $res; $prog+= $res; print "\r$prog", $tot ? (" / $tot bytes (".int(100*$prog/$tot)."%)") : ' bytes'; return $res; } sub get_tot { return length($_[0]) if $tot; $tot= $1 if $_[0] =~ m/content-length:\s*([0-9]+)\s*$/i; return length($_[0]); } --- NEW FILE: tnord_login.pl --- #!/usr/bin/perl # This script logs in to telenordia broadband using https # # Needed: # openssl, curl # # Made by [email protected] 2001.10.16 # # Personal stuff $name="username"; $passw="passwd"; # Just a cleanup $name=~ s/([^a-zA-Z0-9_.-])/uc sprintf("%%%02X",ord($1))/eg; $passwd=~ s/([^a-zA-Z0-9_.-])/uc sprintf("%%%02X",ord($1))/eg; # Path to curl $curl="/usr/local/bin/curl"; # URLs $baseurl="https://login.telenordia.se/login"; $loginpage="$baseurl/checkuser.php3"; $cmd="$curl -d \"name=$name&passw=$passw\" $loginpage"; @main = `$cmd`; $status=1; foreach $main_line (@main) { if ($main_line =~ /\<script\>openSessionWindow/) { $status=0; } print $main_line; } exit $status; --- NEW FILE: display.cgi --- #!/usr/bin/perl sub showit { my $file = $_[0]; if(open(FILE, "<$file")) { while(<FILE>) { print $_; } close(FILE); } else { print "bad file"; } } require CGI; $req = new CGI; $file = $req->param('file'); $file =~ s/\.\.//g; $file =~ s:\/::g; print "Content-Type: text/plain\n\n"; if(length($file) < 3) { print "bluerg\n"; exit; } showit($file); --- NEW FILE: bushpdf.txt --- <? /*Suppose that we have to download a serie of files from a site. All the files are named along this convention: http://site.com/xxxx[start]xxxxx[end].yyy Where site.com, and xx.. are anything kosher in an url address and yyy the file extension. [start] and [end] being two numbers, with [end] = [start] + increment For example With [start] = 201, [end] = 600 and an increment of 50, the files are: http://site.com/filename_201to250.pdf http://site.com/filename_251to300.pdf http://site.com/filename_301to350.pdf http://site.com/filename_351to400.pdf http://site.com/filename_401to450.pdf http://site.com/filename_451to500.pdf http://site.com/filename_501to550.pdf http://site.com/filename_51to100.pdf http://site.com/filename_551to600.pdf This is a short PHP script that can be used with cURL to get these files. */ function getitall ($urlbase,$start,$end,$increment){ for ($i = $start; $i <= $end; $i+=$increment) { #Edit the url address for each file $finish = $i+$increment-1; $address = str_replace( "[start]", $i, $urlbase); $address = str_replace( "[end]", $finish , $address); $file = basename($address); #Verify the file name echo $file ."<BR>"; flush(); #Get cURL going with it $fd = popen("curl -O $address","r"); } echo "all done"; } # end of function # Now use the above function to get all files in the default directory with #getitall ("http://site.com/filename_[start]to[end].pdf",201,600,50); #A 'live' example is the release of the donors list at the bush campaign. (No connection with me whatsoever..;) So with this script try: getitall ("http://webevents.broadcast.com/georgewbush/pdf/91099_FEC_[start]to[end].pdf",1,900,50); /* We can delete the above three lines and if the name of the program is: http://www.site.com/progname.php3 We can call the function from the browser with: http://www.site.com/progname.php3?urlbase=http://site.com/filename_[start]to[end].pdf&start=201&end=600&increment=50 For the bush campaign: http://www.sonic.net/alain/curl/bushpdf.php3?urlbase=http://webevents.broadcast.com/georgewbush/pdf/91099_FEC_[start]to[end].pdf"&start=1&end=900&increment=50 */ ?> --- NEW FILE: comhemlogin.bash --- #!/bin/bash # Version 2 (due to ComHem login changes at Oct 11 in the year 2000) # Personal data (CHANGE the example!) USERNAME="u1234567" PASSWORD="ABcDe123" # Path to cURL running in -silent mode and with -max transfer time 10 seconds # (CHANGE if necessary) CURL="/usr/local/bin/curl -s -m 10" # This shell script was originally based on a perl script by # Kjell.Ericson__at__haxx.se Intended use is to facilitate automatic # logins on ComHem's (aka Telia) Internet Cable. Main tool is the # u(r)ltimate URL processor cURL - which you'll find at # http://curl.haxx.se or elsewhere. *NIX, Win, Amiga versions available. # # The script's out of the box configuration is to write log files to /var/log # Since only root has (or should have...) write access to that directory # I recommend running it through a root cron process, say once every 10 # minutes. As a bonus you'll prevent ComHem disconnections due to inactivity. # # Method used in Version 1 was to get the start page (statically declared) # pick a hidden time stamp and then (FORM) post the necessary information. # But since ComHem now has skipped the time stamp and changed the page locations # a more flexible solution has been implemented. Anyway, prior to a login # we always check whether we indeed are disconnected, or not. # # Simplified, the Version 2 login technique can be explained in these steps: # # Ask for a redirection page (javascript at the base url http://10.0.0.6) # Crop the directory/-ies and "page" from the FQN url (currently /sd/init) # Tack that to the base url and ask for the login form. Do another crop to get # rid of the working page (leaves /sd/) and add the form's ACTION string to # that for sending our login information (gives http://10.0.0.6/sd/login) # # Written by voluspa__at__bigfoot.com September/October 2000 # login1.telia.com is currently located at the private LAN address 10.0.0.6 # To avoid possible DNS trouble (Telia's servers are at 10.0.0.1 and # 10.0.0.2 - slow and prone to crashes) while using a "real" server as the # primary one (I use sunic.sunet.se at 192.36.125.2), we state the IP # instead of the FQN # # Remember, a public DNS server knows nothing about private addresses like # login1.telia.com and the private DNS servers can very well be down without # you being disconnected from the external net or down while you _are_ # disconnected. Hence the use of IP-numbers. BASEURL="http://10.0.0.6" # Testing connectivity. First we try the external net with three ping packets # to basun.sunet.se aka basun.umdc.umu.se at IP 130.239.8.41 (_the_ most stable # server in Sweden?). If none are returned (exit code other than zero from ping) # we try pinging login1.telia.com. In case that works, we initiate a login. Else # bailing out - network is probably down. if /bin/ping -q -c 3 130.239.8.41 >/dev/null 2>&1; then exit else if /bin/ping -q -c 3 10.0.0.6 >/dev/null 2>&1; then # Ahh... Regular Expression time :-) sed (stream editor) should be available. # If not, try grep - and experiment. The first regexp is # .*replace("http:\/\/.*com which ignores everything until it reaches the # login page we are after (javascript initiated). The trailing text is then # cut off by [\"].* # Note: This takes care of FQN changes, like if they go from login1 to login2 # or something else in the future, but we still assume the IP remains fixed. LOGINPAGE=$($CURL $BASEURL | /usr/bin/sed -n -e 's/.*replace("http:\/\/.*com//p') LOGINPAGE=$(echo -n $LOGINPAGE | /usr/bin/sed -n -e 's/[\"].*//p') # Error checking. No sense in continuing if nothing valid is returned. They could # have changed the whole login procedure again... if [ $LOGINPAGE = "" ]; then echo "Could not retrieve login page information!" >/var/log/comhem.err exit fi # Now we bring home the expected login form (or an "already logged in" status page). FORM=$($CURL $BASEURL$LOGINPAGE) # Then try to isolate the form name with the regexp .*<FORM NAME=" and # cutting off everything trailing with the [\"].* again. FORMNAME=$(echo -n $FORM | /usr/bin/sed -n -e 's/.*<FORM NAME="//p') FORMNAME=$(echo -n $FORMNAME | /usr/bin/sed -n -e 's/[\"].*//p') # In the past, and presently, ComHem has called their login form "pwdenter". # We assume they still do... Version 1 of this script determined logged in # status from the existence or nonexistence of a hidden time stamp, but now # we have to rely on that form name. If it complies to our expectation, we # make cURL log us in, saving the returned page. # # Else we shake our heads and log the error. Basun.sunet.se could have been # down when we pinged (not likely), or the ping failure could be due to net # congestion (more likely). Anyway, no harm done. Comhemresult.html, when # not being an error message, is just a redirection to the Internet Cable # home page and a way for them to launch a logout window. I (we) don't care # about creating the logout page. Have a look at the page code and write # your own retrieval strings if you really feel the urge/itch ;-) if [ $FORMNAME = "pwdenter" ]; then # Regexp .*<FORM NAME="pwdenter" ACTION=" is for determining the "page" we # should send our information to. Once again, we cut off the rest of the text # with [\"].* SENDPAGE=$(echo $FORM | /usr/bin/sed -n -e 's/.*<FORM NAME="pwdenter" ACTION="//p') SENDPAGE=$(echo $SENDPAGE | /usr/bin/sed -n -e 's/[\"].*//p') # And this little cutie [^\/]\{1,\}$ gives us the directory where the page should # reside (picked from the already processed LOGINPAGE variable). Believe me, it # will fix any depth of directories! DIRECTORY=$(echo -n $LOGINPAGE | /usr/bin/sed -n -e 's/[^\/]\{1,\}$//p') # Finally, FORM posting our user information with cURL. Not checking whether the # fields indeed are called "username" and "password" might seem somewhat risky, # but hey! Live a little! Besides... those are standard strings and have been # present for a long time. RESULT=$($CURL -d "username=$USERNAME&password=$PASSWORD" $BASEURL$DIRECTORY$SENDPAGE) echo -n $RESULT >/var/log/comhemresult.html /bin/rm -f /var/log/comhem.err exit else echo "Already logged in, but network congestion/error - You decide..." >/var/log/comhem.err exit fi else echo "No connection with login1.telia.com! And you're _paying_ for this..." >/var/log/comhem.err exit fi fi --- NEW FILE: recursiveftpget.txt --- #!/usr/local/bin/perl # # Author: Daniel Stenberg <[email protected]> # Date: August 25 1998 # Version: 0.1 # # This is just meant as an example of why we wrote curl in the first place. # Quick n' easy scripting use. # $dir = $ARGV[0]; $target = $ARGV[1]; $maxdepth = $ARGV[2]; if($dir eq "" || $target eq "") { print "Usage: <URL> <dir> [max depth level] \n"; print " End the URL with a slash if a directory is specified, please\n"; exit; } if(($maxdepth ne "") && ($maxdepth == 0)) { # reached maximum depth, die print "Reached maximum recursive depth level ($maxdepth), exiting...\n"; exit; } # get dir @all = `curl -s $dir`; if($all[0] ne "") { print "Got the main $dir dir\n"; } line: for(@all) { chop; # cut off newline @linep= split(" ", $_); $name = $linep[$#linep]; $firstletter=substr($linep[0], 0, 1); if($firstletter eq "d") { # this is a subdir, recurse # if not . or .. of course if(($name eq ".") || ($name eq "..")) { next line; } print "Recursing for dir $dir$name in target $target/$name\n"; $nextdepth=$maxdepth-1; print `$0 $dir$name/ $target/$name $nextdepth`; } elsif($firstletter eq "-") { # this is a file, get it # oh, make sure the target dir exists first if(! -r $target ) { mkdir($target,0777); } print "Getting file $dir$name in target $target/$name\n"; print `curl -s $dir$name >$target/$name`; } } --- NEW FILE: download.txt --- # wrapper around curl to ensure # - auto-resume download until it completes # - auto save file into correct directory # ARGV[0] is the URL to download require URI; use File::Path; use File::Basename; $url = $ARGV[0]; print "Fetching $url\n"; # fetch header for Content-Length open HDR_IN, "curl --head --silent $url |" or die "Unable to open header."; while (<HDR_IN>) { if ($_ =~ /Content-Length: (\d*)/) { $content_length = $1; last; } } die "Content-Length not found in header." unless (defined($content_length)); print "$content_length"; $u = URI->new($url); # parse URL to determine location to save data $filename = $u->host . $u->path; ($name, $path, $suffix) = fileparse($filename, '\..*'); if ($name eq "") { $name = "00index"; $suffix = ".html"; } # make directory(s) if needed mkpath("$path"); $filename = "$path$name$suffix"; print "Saving to $filename.\n"; # do curl until we have the whole file $resume = 0; while (-s $filename != $content_length) { `curl --verbose --continue -output $filename $url`; $resume ++; } print "Obtained file in $resume tries.\n"; --- NEW FILE: hotmacux.tar.gz --- (This appears to be a binary file; contents omitted.) --- NEW FILE: formfind.txt --- #!/usr/local/bin/perl # # formfind.pl # # This script gets a HTML page from the specified URL and presents form # information you may need in order to machine-make a respond to the form. # # Written to use 'curl' for URL fetching. # # Author: Daniel Stenberg <[email protected]> # Version: 0.1 Nov 12, 1998 # # HISTORY # # 0.1 - Created now! # # TODO # respect file:// URLs for local file fetches! $in=""; $usestdin = 0; if($ARGV[0] eq "" ) { $usestdin = 1; } else { $geturl = $ARGV[0]; } if(($geturl eq "") && !$usestdin) { print "Usage: $0 <full source URL>\n", " Use a traling slash for directory URLs!\n"; exit; } # If you need a proxy for web access, edit your .curlrc file to feature # -x <proxy:port> # linkchecker, URL will be appended to the right of this command line # this is the one using HEAD: $linkcheck = "curl -s -m 20 -I"; # as a second attempt, this will be used. This is not using HEAD but will # get the whole frigging document! $linkcheckfull = "curl -s -m 20 -i"; # htmlget, URL will be appended to the right of this command line $htmlget = "curl -s"; # urlget, URL will be appended to the right of this command line # this stores the file with the remote file name in the current dir $urlget = "curl -O -s"; # Parse the input URL and split it into the relevant parts: sub SplitURL { my $inurl = $_[0]; if($inurl=~ /^([^:]+):\/\/([^\/]*)\/(.*)\/(.*)/ ) { $getprotocol = $1; $getserver = $2; $getpath = $3; $getdocument = $4; } elsif ($inurl=~ /^([^:]+):\/\/([^\/]*)\/(.*)/ ) { $getprotocol = $1; $getserver = $2; $getpath = $3; $getdocument = ""; if($getpath !~ /\//) { $getpath =""; $getdocument = $3; } } elsif ($inurl=~ /^([^:]+):\/\/(.*)/ ) { $getprotocol = $1; $getserver = $2; $getpath = ""; $getdocument = ""; } else { print "Couldn't parse the specified URL, retry please!\n"; exit; } } if(!$usestdin) { &SplitURL($geturl); #print "protocol = $getprotocol\n"; #print "server = $getserver\n"; #print "path = $getpath\n"; #print "document = $getdocument\n"; #exit; open(HEADGET, "$linkcheck $geturl|") || die "Couldn't get web page for some reason"; headget: while(<HEADGET>) { # print $_; if($_ =~ /HTTP\/.*3\d\d /) { $pagemoved=1; } elsif($pagemoved && ($_ =~ /^Location: (.*)/)) { $geturl = $1; &SplitURL($geturl); $pagemoved++; last headget; } } close(HEADGET); if($pagemoved == 1) { print "Page is moved but we don't know where. Did you forget the ", "traling slash?\n"; exit; } open(WEBGET, "$htmlget $geturl|") || die "Couldn't get web page for some reason"; while(<WEBGET>) { $line = $_; push @indoc, $line; $line=~ s/\n//g; $line=~ s/\r//g; # print $line."\n"; $in=$in.$line; } close(WEBGET); } else { while(<STDIN>) { $line = $_; push @indoc, $line; $line=~ s/\n//g; $line=~ s/\r//g; $in=$in.$line; } } getlinkloop: while($in =~ /[^<]*(<[^>]+>)/g ) { # we have a tag in $1 $tag = $1; if($tag =~ /^<!--/) { # this is a comment tag, ignore it } else { if(!$form && ($tag =~ /^< *form/i )) { $method= $tag; if($method =~ /method *=/i) { $method=~ s/.*method *= *(\"|)([^ \">]*).*/$2/gi; } else { $method="get"; # default method } $action= $tag; $action=~ s/.*action *= *(\"|)([^ \">]*).*/$2/gi; $method=uc($method); $enctype=$tag; if ($enctype =~ /enctype *=/) { $enctype=~ s/.*enctype *= *(\'|\"|)([^ \"\'>]*).*/$2/gi; if($enctype eq "multipart/form-data") { $enctype="multipart form upload [use -F]" } $enctype = "\n--- type: $enctype"; } else { $enctype=""; } print "--- FORM report. Uses $method to URL \"$action\"$enctype\n"; # print "TAG: $tag\n"; # print "METHOD: $method\n"; # print "ACTION: $action\n"; $form=1; } elsif($form && ($tag =~ /< *\/form/i )) { # print "TAG: $tag\n"; print "--- end of FORM\n"; $form=0; if( 0 ) { print "*** Fill in all or any of these: (default assigns may be shown)\n"; for(@vars) { $var = $_; $def = $value{$var}; print "$var=$def\n"; } print "*** Pick one of these:\n"; for(@alts) { print "$_\n"; } } undef @vars; undef @alts; } elsif($form && ($tag =~ /^< *(input|select)/i)) { $mtag = $1; # print "TAG: $tag\n"; $name=$tag; if($name =~ /name *=/i) { $name=~ s/.*name *= *(\"|)([^ \">]*).*/$2/gi; } else { # no name given $name=""; } # get value tag $value= $tag; if($value =~ /value *=/i) { $value=~ s/.*value *= *(\"|)([^ \">]*).*/$2/gi; } else { $value=""; } if($mtag =~ /select/i) { print "Select: $name\n"; push @vars, "$name"; $select = 1; } else { $type=$tag; if($type =~ /type *=/i) { $type =~ s/.*type *= *(\"|)([^ \">]*).*/$2/gi; } else { $type="text"; # default type } $type=uc($type); if(lc($type) eq "reset") { # reset types are for UI only, ignore. } elsif($name eq "") { # let's read the value parameter print "Button: \"$value\" ($type)\n"; push @alts, "$value"; } else { $info=""; if($value ne "") { $info="=$value"; } print "Input: $name$info ($type)\n"; push @vars, "$name"; # store default value: $value{$name}=$value; } } } elsif($select && ($tag =~ /^< *\/ *select/i)) { $select = 0; } } } --- NEW FILE: Curl::easy.tgz --- (This appears to be a binary file; contents omitted.) --- NEW FILE: ftproxy.txt --- #!/usr/bin/perl # ftproxy -- forward standard GET proxy requests to a user@host proxy # (derived from "fwdport.pl" by Tom Christiansen) use FileHandle; use IPC::Open2; use Getopt::Long; # for option processing use Net::hostent; # Example 17-8 # by-name interface for host info use IO::Socket; # for creating server and client sockets use POSIX ":sys_wait_h"; # for reaping our dead children my $localip = "146.253.130.135"; my $ftpgw = "ftp-gw"; my ( %Children, # hash of outstanding child processes $proxy_server, # the socket we accept() from $ME, # basename of this program ); ($ME = $0) =~ s,.*/,,; # retain just basename of script name start_proxy(); # launch our own server service_clients(); # wait for incoming die "NOT REACHED"; # you can't get here from there # begin our server sub start_proxy { $proxy_server = IO::Socket::INET->new(Listen => 5, LocalAddr => $localip, LocalPort => 8080, Proto => 'tcp' ) # Reuse => 1) or die "can't create proxy server: $@"; print "[Proxy server initialized"; print " on " . $proxy_server->sockhost() . ":" . $proxy_server->sockport() . "]\n"; } sub service_clients { my ( $local_client, # someone internal wanting out $lc_info, # local client's name/port information @rs_config, # temp array for remote socket options $rs_info, # remote server's name/port information $kidpid, # spawned child for each connection $getline, $host, $file ); $SIG{CHLD} = \&REAPER; # harvest the moribund print "Listening...\n"; # an accepted connection here means someone inside wants out while ($local_client = $proxy_server->accept()) { $lc_info = peerinfo($local_client); printf "[Connect from $lc_info]\n"; $kidpid = fork(); die "Cannot fork" unless defined $kidpid; if ($kidpid) { $Children{$kidpid} = time(); # remember his start time close $local_client; # likewise next; # go get another client } # now, read the GET line from the browser, reformat it # and pass it on to curl $getline = <$local_client>; $getline =~ m|GET ftp://([^/]+)(.*?) HTTP|; $host = $1; $file = $2; print "Getline: $getline\n"; print "host: $host\n"; print "file: $file\n"; #curl -O -u [email protected]:nothing ftp://ftp-gw/pub6/os/OpenBSD/patches/2.7.tar.gz $getline = "curl -v -u anonymous@".$host.":[email protected] ftp://$ftpgw$file"; print "Running: $getline\n"; $kidpid = open2( *Reader, *Writer, $getline ); # file or catalog? if ( $file =~ m|/$| ) { # Catalog. Parsing needed @lines = <Reader>; print $local_client "<html><body>\n"; print $local_client "<h3>$host:$file</h3>\n<pre>\n"; if ( $file ne "/" ) { print $local_client "$apa <a href=\"../\">Up to parent dir</a>\n"; } foreach ( @lines ) { s/\n//g; s/\r//g; $line = $_; if ( /(^.*\s(Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)\s+\d+\s+[\d:]+\s+)(.*)/i ) { $fname = $3; $apa = $1; } if ( /^d/ ) { print $local_client "$apa <a href=\"$fname/\">$fname/</a>\n"; } elsif ( /^l/ ) { $fname =~ /(.*?) -> (.*)/; print $local_client "$apa <a href=\"$1/\">$1/</a> ($2)\n"; } else { print $local_client "$apa <a href=\"$fname\">$fname</a>\n"; } } print $local_client "</pre></body></html>\n"; } else { # file - just sent everything to receiver while ( <Reader> ) { print $local_client $_; } } exit; # whoever's still alive bites it } } # helper function to produce a nice string in the form HOST:PORT sub peerinfo { my $sock = shift; my $hostinfo = gethostbyaddr($sock->peeraddr); return sprintf("%s:%s", $hostinfo->name || $sock->peerhost, $sock->peerport); } # somebody just died. keep harvesting the dead until # we run out of them. check how long they ran. sub REAPER { my $child; my $start; while (($child = waitpid(-1,WNOHANG)) > 0) { if ($start = $Children{$child}) { my $runtime = time() - $start; printf "Child $child ran %dm%ss\n", $runtime / 60, $runtime % 60; delete $Children{$child}; } else { print "Unknown child process $child exited $?\n"; } } # If I had to choose between System V and 4.2, I'd resign. --Peter Honeyman $SIG{CHLD} = \&REAPER; }; --- NEW FILE: getlinks.txt --- #!/usr/local/bin/perl # # getlinks.pl # # This script extracts all links from a HTML page, compares them to a pattern # entered on the command line and then downloads matching links into the # target dir (also specified on the command line). # # Written to use 'curl' for URL fetching, uses the source file names in the # target directory. # # Author: Daniel Stenberg <[email protected]> # Version: 0.1 Oct 7, 1998 # # HISTORY # # 0.1 - Created now! # $in=""; argv: if($ARGV[0] eq "-v" ) { $verbose = 1; shift @ARGV; goto argv; } if($ARGV[0] eq "-d" ) { $display = 1; shift @ARGV; goto argv; } elsif($ARGV[0] eq "-h" ) { $help = 1; shift @ARGV; goto argv; } $geturl = $ARGV[0]; $getdir = $ARGV[1]; $getregex = $ARGV[2]; if(($geturl eq "") || (($getdir eq "") && !$display) || $help) { print "Usage: $0 [-hv] <full source URL> <target dir> [regex]\n", " Use a traling slash for directory URLs!\n", " Use \"quotes\" around the regex!\n", " -h This help text\n", " -d Display matches only instead of downloading\n", " -v Verbose mode\n"; exit; } # change to target directory: chdir $getdir || die "couldn't cd into $getdir"; # This is necessary from where I tried this: #$proxy =" -x 194.237.142.41:80"; # linkchecker, URL will be appended to the right of this command line # this is the one using HEAD: $linkcheck = "curl -s -m 20 -I$proxy"; # as a second attempt, this will be used. This is not using HEAD but will # get the whole frigging document! $linkcheckfull = "curl -s -m 20 -i$proxy"; # htmlget, URL will be appended to the right of this command line $htmlget = "curl -s$proxy"; # urlget, URL will be appended to the right of this command line # this stores the file with the remote file name in the current dir $urlget = "curl -O -s$proxy"; # Parse the input URL and split it into the relevant parts: sub SplitURL { my $inurl = $_[0]; if($inurl=~ /^([^:]+):\/\/([^\/]*)\/(.*)\/(.*)/ ) { $getprotocol = $1; $getserver = $2; $getpath = $3; $getdocument = $4; } elsif ($inurl=~ /^([^:]+):\/\/([^\/]*)\/(.*)/ ) { $getprotocol = $1; $getserver = $2; $getpath = $3; $getdocument = ""; if($getpath !~ /\//) { $getpath =""; $getdocument = $3; } } elsif ($inurl=~ /^([^:]+):\/\/(.*)/ ) { $getprotocol = $1; $getserver = $2; $getpath = ""; $getdocument = ""; } else { print "Couldn't parse the specified URL, retry please!\n"; exit; } } &SplitURL($geturl); #print "protocol = $getprotocol\n"; #print "server = $getserver\n"; #print "path = $getpath\n"; #print "document = $getdocument\n"; #exit; if(!$usestdin) { open(HEADGET, "$linkcheck $geturl|") || die "Couldn't get web page for some reason"; headget: while(<HEADGET>) { # print $_; if($_ =~ /HTTP\/.*3\d\d /) { $pagemoved=1; } elsif($pagemoved && ($_ =~ /^Location: (.*)/)) { $geturl = $1; &SplitURL($geturl); $pagemoved++; last headget; } } close(HEADGET); if($pagemoved == 1) { print "Page is moved but we don't know where. Did you forget the ", "traling slash?\n"; exit; } open(WEBGET, "$htmlget $geturl|") || die "Couldn't get web page for some reason"; while(<WEBGET>) { $line = $_; push @indoc, $line; $line=~ s/\n//g; $line=~ s/\r//g; # print $line."\n"; $in=$in.$line; } close(WEBGET); } else { while(<STDIN>) { $line = $_; push @indoc, $line; $line=~ s/\n//g; $line=~ s/\r//g; $in=$in.$line; } } sub GetLinks { my $in = $_[0]; my @result; getlinkloop: while($in =~ /[^<]*(<[^>]+>)/g ) { # we have a tag in $1 $tag = $1; if($tag =~ /^<!--/) { # this is a comment tag, ignore it } else { if($tag =~ /(src|href|background|archive) *= *(\"[^\"]\"|[^ )>]*)/i) { $url=$2; if($url =~ /^\"(.*)\"$/) { # this was a "string" now $1 has removed the quotes: $url=$1; } $url =~ s/([^\#]*)\#.*/$1/g; if($url eq "") { # if the link was nothing than a #-link it may now have # been emptied completely so then we skip the rest next getlinkloop; } if($done{$url}) { # if this url already is done, do next $done{$url}++; next getlinkloop; } $done{$url} = 1; # this is "done" push @result, $url; if($tag =~ /< *([^ ]+)/) { # print "TAG: $1\n"; $tagtype{$url}=$1; } } } } return @result; } @links = &GetLinks($in); linkloop: for(@links) { $url = $_; if($url =~ /^([^:]+):/) { $link = $url; } else { # this is an absolute link on the same server: if($url =~ /^\//) { # from root $link = "$getprotocol://$getserver$url"; } else { # from the scanned page's dir $nyurl=$url; if(length($getpath) && ($getpath !~ /\/$/) && ($nyurl !~ /^\//)) { # lacks ending slash, add one to the document part: $nyurl = "/".$nyurl; } $link = "$getprotocol://$getserver/$getpath$nyurl"; } } if($link =~ /$getregex/) { if($display) { print "$link\n"; } else { if($verbose) { print "Gets $link\n"; } print `$urlget $link`; } } } --- NEW FILE: curlmirror.txt --- #!/usr/local/bin/perl # # curlmirror.pl # # Mirrors a web site by using curl to download each page. # The result is stored in a directory named "dest" by default. # Temporary files are stored in "/tmp". # # Author: [email protected] # # Limitations: # All links are right now based from the root, so there are a lot # of "../../" in pages. # # History: # # 1999-11-19 v0.9 - Kjell Ericson - First version # 1999-11-22 v0.10 - Kjell Ericson - Added some more flags # 1999-12-06 v0.11 - Kjell Ericson - Relative paths were not correctecd # 1999-12-06 v1.0 - Kjell Ericson - Satisfied and updated to v1.0 # 1999-12-07 v1.1 - Kjell Ericson - Added "-p" # 1999-12-08 v1.2 - Kjell Ericson - Added "-l" and "-c" # 1999-12-13 v1.3 - Kjell Ericson - Added match for images in stylesheets # 2000-08-07 v1.4 - Kjell Ericson - Handles both ' and " in links. # 2000-08-15 v1.5 - Kjell Ericson - Added -I. # 2000-08-16 v1.6 - Kjell Ericson - Added multiple -I and -B. # 2002-01-23 v1.7 - Anthony Thyssen - Changed the destination filename # 2002-07-14 v1.8 - Kjell Ericson - Corrected a temp-filename error # $max_deep=1000; $max_size=2; $dest_dir="dest"; $default_name="index.html"; $tmp="/tmp"; $filecounter=0; # For faster handling we have this regex: $nonhtmlfiles="jpg|gif|png|zip|doc|txt|pdf|exe|java"; $help= "Usage: curlmirror.pl [flags] [url]\n". "\n". "-a <args> : Curl specific arguments\n". "-B <url> : Only retrieve URL below this URL (default is [url]).\n". "-b <name> : Pattern that will be stripped from filename.\n". "-c : Ignore CGI's (i.e URL's with '?' in them) (default off).\n". "-d <number>: Depth to scan on (default unlimited).\n". "-f : Flat directory structure is made (be careful).\n". "-F : Flat directory structure but use path in filename.\n". "-i <name> : Default name for unknown filenames (default is 'index.html').\n". "-I <regex> : Don't handle files matching this pattern (default is \"\".\n". "-l : Only load HTML-pages - no images (default is to load all).\n". "-o <dir> : Directory to output result in (default is 'dest').\n". "-s <number>: Max size in Mb of downloaded data (default 2 Mb)\n". "-p : Always load images (default is not to).\n". "-t <dir> : Temporary directory (default is '/tmp').\n". "-v : Verbose output.\n". "\n". "Example:\n". "curlmirror.pl http://www.perl.com/\n". "\nAuthor: Kjell.Ericson\@haxx.se\n"; for ($i=0; $i<=$#ARGV; $i++) { $arg=$ARGV[$i]; if ($arg =~ s/^-//) { if ($arg =~ m/\?/) { print $help; exit(); } if ($arg =~ m/a/) { $curl_args=$ARGV[++$i]; } if ($arg =~ m/B/) { $base=$ARGV[++$i]; if ($base !~ m/(http:\/\/[^\/]*)/i) { print "***Malformed -B(ase)\n"; die($help); } $base=~ s/([+*~^()\\])/\\$1/g; # escape chars push @basematch, $base; } if ($arg =~ m/I/) { push @ignorepatt, $ARGV[++$i]; } if ($arg =~ m/b/) { $strip_from_file=$ARGV[++$i]; } if ($arg =~ m/c/) { $ignore_cgi=1; } if ($arg =~ m/d/) { $max_deep=$ARGV[++$i]; } if ($arg =~ m/o/) { $dest_dir=$ARGV[++$i]; $dest_dir=~ s/\/$//g; } if ($arg =~ m/t/) { $tmp=$ARGV[++$i]; $tmp=~ s/\/$//g; } if ($arg =~ m/s/) { $max_size=$ARGV[++$i]; } if ($arg =~ m/i/) { $default_name=$ARGV[++$i]; } if ($arg =~ m/l/) { $only_html=1; } if ($arg =~ m/v/) { $verbose=1; } if ($arg =~ m/p/) { $picture_load=1; } if ($arg =~ m/f/) { $flat=1; } if ($arg =~ m/F/) { $flat=2; } } else { #default $start=$arg; } } $curl="curl -s $curl_args "; if ($base eq "") { if ($start !~ m/(http:\/\/.+\/)/i) { if ($start =~ m/(http:\/\/.+)/i) { $start.="/"; } else { print "***Malformed start URL ($start)\n"; die($help); } } $base=$start; $base=~ s/\/[^\/]+$/\//; # strip docname $base=~ s/([+*~^()\\])/\\$1/g; # escape chars $basematch[0]=$base; } $follow_link{"start"}=0; $linktmp="[ \n\r]*=[ \r\n]*)([\"'][^\"']*[\"']|[^ )>]*)"; %follow=( "(<[^>]*a[^>]+href$linktmp", "link", "(<[^>]*area[^>]+href$linktmp", "link", "(<[^>]*frame[^>]+src$linktmp", "link", ); if ($only_html == 0) { %follow=(%follow, "(BODY[^>]*\{[^}>]*background-image:[^>}]*url[(])([^\}>\) ]+)", "img", # for stylesheets "(<[^>]*img[^>]+src$linktmp", "img", "(<[^>]*body[^>]+background$linktmp", "img", "(<[^>]*applet[^>]+archive$linktmp", "archive", "(<[^>]*td[^>]+background$linktmp", "img", "(<[^>]*tr[^>]+background$linktmp", "img", "(<[^>]*table[^>]+background$linktmp", "img", ); } $deep=0; $found=1; while ($found && $deep<$max_deep) { $found=0; foreach $url (keys %follow_link) { $current_depth=$follow_link{$url}; # print STDERR ">$url $current_depth\n"; if ($current_depth == $deep && $current_depth>=0 && $total_size<$max_size*1024*1024) { $found=1; $current_depth++; if ($url eq "start") { delete $follow_link{$url}; $url=$start; $url="stdin" if ($url eq ""); $start=""; } $follow_link{$url}=-1; $stop=0; $status_code=0; $content_type=""; $real_url=$url; $real_url=~s/#(.*)//; # strip bookmarks before loading if ( $url !~ m/[ \n\r]/) { $filecounter++; $this_file_name="$filecounter..$real_url"; $this_file_name =~ s/%([a-fA-F0-9][a-fA-F0-9])/chr hex $1/eg; #$this_file_name=~ s/[^a-zA-Z0-9.]+/_/g; $this_file_name=~ s/[^\w\d]+/_/g; $content_type=""; print STDERR "Get $deep:$url\n" if ($verbose); $head=`$curl -D - -o "$tmp/$this_file_name" "$real_url"`; $filenames{$real_url}=$this_file_name; if ($head =~ m/Location: *["]?(.*)["]?/i) { $loc=$1; $loc=~ s/[\r\n]//g; $loc=merge_urls($real_url, $loc); if (accept_url($loc) || ($picture_load && $linktype{$real_url} eq "img")) { `rm "$tmp/$this_file_name"`; delete $filenames{$real_url}; $real_url=$loc; $url=$loc; print STDERR "Reget $deep:$url\n" if ($verbose); $head=`$curl -D - -o "$tmp/$this_file_name" "$real_url"`; $filenames{$real_url}=$this_file_name; $follow_link{$real_url}=-1; } } $total_size+=-s "$tmp/$this_file_name"; if ($head =~ m/^HTTP[^\n\r]* ([0-9]+) ([^\n\r]*)/s) { $status_code=$1;#." ".$2; } if ($head =~ m/[\n\r]Content-Type:(.*)[\r\n]/si) { $content_type=$1; } $linktype{$real_url}=$content_type; if ($content_type !~ m/html/i) { if ($only_html) { # remove this file $total_size-=-s "$tmp/$this_file_name"; `rm "$tmp/$this_file_name"`; delete $filenames{$real_url}; } } else { $text=`cat "$tmp/$this_file_name"`; if ($current_depth<$max_deep) { $linktype{$real_url}="html"; $text="" if ($url =~ m/\#/); foreach $search (keys %follow) { while ($text =~ s/$search//si) { $link=$2; $link=~ s/[\"\']//g; $link=~ s/#.*//; $newurl=merge_urls($url, $link); if ($ignore_cgi==0 || $newurl !~ m/\?/) { if (accept_url($newurl) || ($picture_load && $follow{$search} eq "img")) { if (!exists $follow_link{$newurl}) { if ($only_html == 0 || $newurl !~ m/\.($nonhtmlfiles)$/i) { $follow_link{$newurl}=$current_depth; } } } } } } } } } } } $deep++; } print STDERR "Max size exceeded ($total_size bytes)!\n" if ($total_size>=$max_size*1024*1024); print STDERR "Total size loaded:$total_size bytes\n" if ($verbose); foreach $url (keys %filenames) { local $destname=$url; $destname=~ s/$basematch[0]//; local $destdir=$destname; $destdir="" if ($destdir !~ m/\//); $destdir =~ s/\/[^\/]*$/\//; $destname=~ s/^.*\///g; $destname=~s/#(.*)//; local $bookmark=$1; $destname=~ s/[^a-zA-Z0-9.]/_/g; # strip chars we don't want in a filename $destdir=~ s/$strip_from_file// if ($strip_from_file ne ""); $destdir=~ s/^([^\/]+):\/\//$1_/; $destdir=~ s/[^a-zA-Z0-9.\/_]/_/g; $destdir=~ s/(^\/)|(\/$)//g; # strip trailing/leading slashes if ($flat) { if ($flat==2) { $destdir=~ s/[\/:]/_/g; $destdir.="_"; } else { $destdir=""; } `mkdir -p "$dest_dir"`; } else { local $tmp="$dest_dir/$destdir"; $tmp=~ s/^\///g; `mkdir -p "$tmp"`; $destdir.="/" if ($destdir ne ""); } $destname=$default_name if ($destname eq ""); $destname=$destdir.$destname if ($destdir ne ""); if (($linktype{$url} =~ m/html/i) && ($destname !~ m/\.[s]?htm/i)) { $destname.=".html"; } $destfile{$url}=$destname; } foreach $url (keys %filenames) { $name=$filenames{$url}; $destname=$destfile{$url}; if ($linktype{$url} !~ m/html/) { `mv "$tmp/$name" "$dest_dir/$destname"`; } else { $text=`cat "$tmp/$name"`; foreach $search (keys %follow) { $text=~ s/$search/"$1\"".make_file_relative($url,merge_urls($url, $2))."\""/sgie; } if (open(OUT, ">$dest_dir/$destname")) { print OUT $text; close(OUT); } else { print STDERR "Couldn't save file '$dest_dir/$destname'\n"; } `rm "$tmp/$name"`; } } # Input: Base-URL, MakeRelative-URL # # Function: Convert and return "MakeRelativ-URL" to be relative # to "Base-URL". # sub make_file_relative { local ($from, $to)=@_; local $result=""; local $sourcename=$destfile{$from}; local $destname; local $bookmark; if ($to=~ s/(\#.*)$//) { # extract bookmarks $bookmark=$1; } $destname=$destfile{$to}; if ($destname eq "") { return $to.$bookmark } $sourcename="" if ($sourcename !~ m/\//); $sourcename=~ s/\/[^\/]*$/\//; #strip filename do { $sourcename=~ m/^([^\/]*\/)/; local $dir=$1; if ($dir ne "") { $dir=~ s/([*.\\\/\[\]()+|])/\\$1/g; if ($destname =~ s/^$dir//) { $sourcename=~ s/^$dir//; } else { $dir=""; } } } while ($dir ne ""); $sourcename=~ s/[^\/]+\//..\//g; # Relative it with some ../ $result="$sourcename$destname"; $result=~ s/^\///g; return $result.$bookmark; } # Function: If you are viewing location "$base" which is a full URL, and # click on "$new" that can be full or relative - where do you get? That # is what this function returns. # # Input: base-URL, new-URL (where to go) # Returns: a full format new-URL (without bookmark) # sub merge_urls { local ($org, $new)=@_; local $url, $new; $new =~ s/[\"\']//g; if ($new =~ m/.*:/) { $url=$new; } elsif ($new eq "") { $url=$org; } else { if ($org =~ m/(.*):\/\/([^\/]*)(.*)$/) { local $prot=$1; local $server=$2; local $pathanddoc=$3; local $path; local $doc=$3; if ($pathanddoc=~ m/^(.*)\/(.*)$/) { $path=$1; $doc=$2; } $doc=~s/#(.*)//; local $bookmark=$1; if ($new =~ m/^#/) { $url="$prot://$server$path/$doc$new"; } elsif ($new =~ m/^\//) { $url="$prot://$server$new"; } else { $url="$prot://$server$path/$new"; while ($url =~ s/\/[^\/]*\/\.\.\//\//){} while ($url =~ s/\.\///){}; } } } return $url; } sub accept_url { local ($url)=@_; local $ret=0; print "test $url\n"; for (@basematch) { if ($url =~ m/$_/) { $ret=1; } } return 0 if ($ret == 0); # No basematch for (@ignorepatt) { if ($url =~ m/$_/) { return 0; } } print "match $url\n"; return 1; } --- NEW FILE: crawlink.txt --- #!/usr/bin/perl # # crawlink.pl # # This script crawls across all found links below the given "root" URL. # It reports all good and bad links to stdout. This code was based on the # checklink.pl script I wrote ages ago. # # Written to use 'curl' for URL checking. # # Author: Daniel Stenberg <[email protected]> # Version: 0.1 Dec 14, 2000 # # HISTORY # # 0.1 - The given url works as the root. This script will only continue # and check other URLs if the leftmost part of the new URL is identical # to the root URL. # use strict; my $in=""; my $verbose=0; my $usestdin; my $linenumber; my $help; my $external; argv: if($ARGV[0] eq "-v" ) { $verbose++; shift @ARGV; goto argv; } elsif($ARGV[0] eq "-l" ) { $linenumber = 1; shift @ARGV; goto argv; } elsif($ARGV[0] eq "-h" ) { $help = 1; shift @ARGV; goto argv; } elsif($ARGV[0] eq "-x" ) { $external = 1; shift @ARGV; goto argv; } my $geturl = $ARGV[0]; my $firsturl= $geturl; # # Define a hash array to hold all root URLs to visit/we have visited # my %rooturls; $rooturls{$ARGV[0]}=1; if(($geturl eq "") || $help) { print "Usage: $0 [-hilvx] <full URL>\n", " Use a traling slash for directory URLs!\n", " -h This help text\n", " -l Line number report for BAD links\n", " -v Verbose mode\n", " -x Check non-local (external?) links only\n"; exit; } # This is necessary from where I tried this: my $proxy=""; #$proxy =" -x 194.237.142.41:80"; # linkchecker, URL will be appended to the right of this command line # this is the one using HEAD: my $linkcheck = "curl -s -m 20 -I$proxy"; # as a second attempt, this will be used. This is not using HEAD but will # get the whole frigging document! my $linkcheckfull = "curl -s -m 20 -i$proxy"; # htmlget, URL will be appended to the right of this command line my $htmlget = "curl -s$proxy"; # Parse the input URL and split it into the relevant parts: my $getprotocol; my $getserver; my $getpath; my $getdocument; my %done; my %tagtype; my $allcount=0; my $badlinks=0; sub SplitURL { my $inurl = $_[0]; if($inurl=~ /^([^:]+):\/\/([^\/]*)\/(.*)\/(.*)/ ) { $getprotocol = $1; $getserver = $2; $getpath = $3; $getdocument = $4; } elsif ($inurl=~ /^([^:]+):\/\/([^\/]*)\/(.*)/ ) { $getprotocol = $1; $getserver = $2; $getpath = $3; $getdocument = ""; if($getpath !~ /\//) { $getpath =""; $getdocument = $3; } } elsif ($inurl=~ /^([^:]+):\/\/(.*)/ ) { $getprotocol = $1; $getserver = $2; $getpath = ""; $getdocument = ""; } else { print "Couldn't parse the specified URL, retry please!\n"; exit; } } my @indoc; sub GetRootPage { my $geturl = $_[0]; my $in=""; my $code=200; my $type="text/plain"; my $pagemoved=0; open(HEADGET, "$linkcheck $geturl|") || die "Couldn't get web page for some reason"; while(<HEADGET>) { #print STDERR $_; if($_ =~ /HTTP\/1\.[01] (\d\d\d) /) { $code=$1; if($code =~ /^3/) { $pagemoved=1; } } elsif($_ =~ /^Content-Type: ([\/a-zA-Z]+)/) { $type=$1; } elsif($pagemoved && ($_ =~ /^Location: (.*)/)) { $geturl = $1; &SplitURL($geturl); $pagemoved++; last; } } close(HEADGET); if($pagemoved == 1) { print "Page is moved but we don't know where. Did you forget the ", "traling slash?\n"; exit; } open(WEBGET, "$htmlget $geturl|") || die "Couldn't get web page for some reason"; while(<WEBGET>) { my $line = $_; push @indoc, $line; $line=~ s/\n/ /g; $line=~ s/\r//g; # print $line."\n"; $in=$in.$line; } close(WEBGET); return ($in, $code, $type); } sub LinkWorks { my $check = $_[0]; # URL encode: # $check =~s/([^a-zA-Z0-9_:\/.-])/uc sprintf("%%%02x",ord($1))/eg; my @doc = `$linkcheck \"$check\"`; my $head = 1; # print "COMMAND: $linkcheck \"$check\"\n"; # print $doc[0]."\n"; boo: if( $doc[0] =~ /^HTTP[^ ]+ (\d+)/ ) { my $error = $1; if($error < 400 ) { return "GOOD"; } else { if($head && ($error >= 500)) { # This server doesn't like HEAD! @doc = `$linkcheckfull \"$check\"`; $head = 0; goto boo; } return "BAD"; } } return "BAD"; } sub GetLinks { my $in = $_[0]; my @result; while($in =~ /[^<]*(<[^>]+>)/g ) { # we have a tag in $1 my $tag = $1; if($tag =~ /^<!--/) { # this is a comment tag, ignore it } else { if($tag =~ /(src|href|background|archive) *= *(\"[^\"]\"|[^ \)>]*)/i) { my $url=$2; if($url =~ /^\"(.*)\"$/) { # this was a "string" now $1 has removed the quotes: $url=$1; } $url =~ s/([^\#]*)\#.*/$1/g; if($url eq "") { # if the link was nothing than a #-link it may now have # been emptied completely so then we skip the rest next; } if($done{$url}) { # if this url already is done, do next $done{$url}++; next; } $done{$url} = 1; # this is "done" push @result, $url; if($tag =~ /< *([^ ]+)/) { $tagtype{$url}=$1; } } } } return @result; } while(1) { $geturl=-1; for(keys %rooturls) { if($rooturls{$_} == 1) { if($_ !~ /^$firsturl/) { $rooturls{$_} += 1000; # don't do this, outside our scope if($verbose) { print "SKIP: $_\n"; } next; } $geturl=$_; last; } } if($geturl == -1) { last; } if($verbose) { print "ROOT: $geturl\n"; } # # Splits the URL in its different parts # &SplitURL($geturl); # # Returns the full HTML of the root page # my ($in, $error, $ctype) = &GetRootPage($geturl); $rooturls{$geturl}++; # increase to prove we have already got it if($ctype ne "text/html") { # this is not HTML, we skip this if($verbose == 2) { print "Non-HTML link, skipping\n"; next; } } if($error >= 400) { print "$geturl return $error, exiting\n"; exit; } if($verbose == 2) { printf("Error code $error, Content-Type: $ctype, got %d bytes\n", length($in)); } #print "protocol = $getprotocol\n"; #print "server = $getserver\n"; #print "path = $getpath\n"; #print "document = $getdocument\n"; #exit; # # Extracts all links from the given HTML buffer # my @links = &GetLinks($in); for(@links) { my $url = $_; my $link; if($url =~ /^([^:]+):/) { my $prot = $1; if($prot !~ /http/i) { # this is an unsupported protocol, we ignore this next; } $link = $url; } else { if($external) { next; } # this is a link on the same server: if($url =~ /^\//) { # from root $link = "$getprotocol://$getserver$url"; } else { # from the scanned page's dir my $nyurl=$url; if(length($getpath) && ($getpath !~ /\/$/) && ($nyurl !~ /^\//)) { # lacks ending slash, add one to the document part: $nyurl = "/".$nyurl; } $link = "$getprotocol://$getserver/$getpath$nyurl"; } } my $success = &LinkWorks($link); my $count = $done{$url}; $allcount += $count; print "$success $count <".$tagtype{$url}."> $link $url\n"; $rooturls{$link}++; # check this if not checked already if("BAD" eq $success) { $badlinks++; if($linenumber) { my $line =1; for(@indoc) { if($_ =~ /$url/) { print " line $line\n"; } $line++; } } } } } if($verbose) { print "$allcount links were checked"; if($badlinks > 0) { print ", $badlinks were found bad"; } print "\n"; } _______________________________________________ curl-www-commits mailing list [email protected] http://cool.haxx.se/cgi-bin/mailman/listinfo/curl-www-commits