home *** CD-ROM | disk | FTP | other *** search
/ Nebula 1 / Nebula One.iso / Internet / WWW / Perl_WWW_Utilities / webxref.pl < prev   
Encoding:
Perl Script  |  1996-04-24  |  22.4 KB  |  1,043 lines
  1. #!/usr/bin/perl
  2.  
  3. # webxref
  4. # ------
  5. # Webxref is a WWW link checker and cross referencing tool, intended
  6. # to quickly check a local set of HTML documents for missing files,
  7. # anchors etc. You simply call webxref with a HTML document as the parameter. 
  8. # Webxref compiles a list of HTML documents, URLs, name anchors, images etc 
  9. # and the html files that reference those, i.e. a cross-reference list.
  10. # 
  11. # usage: webxref [-nohttp -htmlonly -avoid regexp] file.html
  12. #
  13. #   -nohttp tells webxref *not* to check http:// URLs via the network
  14. #
  15. #   -htmlonly tells webxref to *only* inspect files with the .html
  16. #             extension for further links.
  17. #
  18. #   -silent tells webxref to only output error messages and keep quiet 
  19. #             about things that are ok.
  20. #
  21. #   -avoid regexp: when regexp matches a filename/URL/... the item is
  22. #             not further inspected. Make sure this parameter is
  23. #             supplied in quotes, else the shell will interpret various
  24. #             characters like *,$,.,?,...
  25. #
  26. # Examples
  27. #   webxref file.html
  28. #             checks file.html and files/URLs referenced from file.html
  29. #   webxref -nohttp file.html
  30. #             checks file.html, but not external URLs
  31. #   webxref -htmlonly file.html
  32. #             checks file.html, but no files without .html extension
  33. #   webxref -avoid '.*Archive.*' file.html
  34. #             checks file.html but avoids files with names containing
  35. #             'Archive'
  36. #   webxref -avoid '.*Archive.*|.*Distribution.*' file.html
  37. #             Same as above, but also files with names containing
  38. #             'Distribution' are skipped.
  39. #
  40. # Lists are made of:
  41. # - html files
  42. # - directories
  43. # - binary files (images)
  44. # - named anchors
  45. # - mailto's
  46. # - news
  47. # - ftp
  48. # - telnet
  49. # - gopher
  50. # - external URLs
  51. # - cgi-bin scripts
  52. # - file:'s
  53. # - files that can't be found
  54. # - files that are not world readable
  55. # - directories that can't be found
  56. # - name anchors that can't be found
  57. # - http:// ok references
  58. # - http:// failed references
  59. #
  60. # Written July 1995 by Rick Jansen at SARA as part of the SURFACE project 
  61. # (SURFnet Advanced Communication Environment)
  62. # email:  rick@sara.nl
  63. # url:    http://www.sara.nl/Rick.Jansen
  64. #
  65. # 11-JUL-95 lcheck version 0.0.0
  66. # 18-JUL-95 renamed webxref 0.0.1
  67. # 20-JUL-95 webxref 0.0.2
  68. # 21-JUL-95 webxref 0.0.3 root handling
  69. # 27-JUL-95 webxref 0.0.4 metachar interpretation in substitutions fixed
  70. # 28-JUL-95 webxref 0.0.5 pass associative array to sub
  71. # 08-AUG-95 webxref 0.0.6 parsing with temp file
  72. # 08-AUG-95 webxref 0.0.7 handle Welcome/welcome/index.html in case of dir
  73. # 08-AUG-95 webxref 0.0.8 'file:' refs
  74. # 10-AUG-95 webxref 0.0.9 Extensible default_files
  75. # 14-AUG-95 webxref 0.1.0 Some perl lint removed, cgi-bin added
  76. # 28-SEP-95 webxref 0.1.1 1-level external URL checking added
  77. # 04-OCT-95 webxref 0.1.2 options -nohttp -htmlonly and -avoid added
  78. # 04-OCT-95 webxref 0.1.3 Restriction on tags not being allowed to spread
  79. #                         over more than 1 source line removed, thanks to
  80. #                         Hans Hoppe (hopha@sci.kun.nl)
  81. # 10-OCT-95 webxref 0.1.4 -silent option
  82. # 15-APR-96 webxref 0.1.5 Temporary fix for $SOCK_STREAM
  83. #                          
  84. #
  85. # New versions can be obtained from:
  86. #   http://www.sara.nl/Rick.Jansen
  87.  
  88.  
  89. #---------------------------------------------
  90. # Configurable things:
  91.  
  92. # Files to try in case of a directory reference like ../..
  93. @default_files = ('Welcome.html','welcome.html','index.html',
  94.                   'index.shtml','README.html');
  95. #---------------------------------------------
  96.  
  97. $debug = 0;
  98.  
  99. $temp_file = "/tmp/webxref.$$";
  100.  
  101. #---------------------------------------------
  102. # HTTP status codes and messages
  103.  
  104. %OkStatusMsgs = (
  105.   200, "OK 200",
  106.   201, "CREATED 201",
  107.   202, "Accepted 202",
  108.   203, "Partial Information 203",
  109.   204, "No Response 204",
  110. );
  111.  
  112. %FailStatusMsgs = (
  113.   -1,  "Could not lookup server",
  114.   -2,  "Could not open socket",
  115.   -3,  "Could not bind socket",
  116.   -4,  "Could not connect",
  117.   301, "Found, but moved",
  118.   302, "Found, but data resides under different URL (add a /)",
  119.   303, "Method",
  120.   304, "Not Modified",
  121.   400, "Bad request",
  122.   401, "Unauthorized",
  123.   402, "PaymentRequired",
  124.   403, "Forbidden",
  125.   404, "Not found",
  126.   500, "Internal Error",
  127.   501, "Not implemented",
  128.   502, "Service temporarily overloaded",
  129.   503, "Gateway timeout ",
  130.   600, "Bad request",
  131.   601, "Not implemented",
  132.   602, "Connection failed (host not found?)",
  133.   603, "Timed out",
  134. );
  135.  
  136.  
  137. #---------------------------------------------
  138. # Process parameters
  139.  
  140. $Do_External_URLs = 1; # Default we do check external URLs
  141.  
  142. $HTML_only = 0;        # If 0, referenced files are checked for links
  143.                        # even if the file has no .html extension
  144.  
  145. $Avoid = "";           # Regexp to avoid certain URLs, files,...
  146.  
  147. $Silent = 0;           # If silent=1 only error msgs will be printed
  148.  
  149. $InFile = "";
  150. while ($ARGV[0] =~ /^-/) {
  151.   if ($ARGV[0] eq "-help") {&PrintHelp;}
  152.   elsif ($ARGV[0] eq "-nohttp") {$Do_External_URLs = 0; }
  153.   elsif ($ARGV[0] eq "-htmlonly") {$HTML_only = 1; }
  154.   elsif ($ARGV[0] eq "-silent") {$Silent = 1; }
  155.   elsif ($ARGV[0] eq "-avoid") {
  156.     shift;
  157.     $Avoid = $ARGV[0];
  158.     print "Avoided: $Avoid\n";
  159.     }
  160.   else {&PrintUsage;}
  161.  
  162.   shift;
  163. }
  164. $InFile = $ARGV[0];
  165.  
  166. if ($InFile eq "") {
  167.   print "No input file.\n";
  168.   exit;
  169. }
  170.  
  171.  
  172. #---------------------------------------------
  173.  
  174. # Does the file exist at all?
  175. stat($InFile);
  176. die "Cannot find file $InFile\n" unless -e $InFile;
  177.  
  178.  
  179. #---------------------------------------------
  180.  
  181. if ($debug) {
  182. print "=======================\n";
  183. print "\n input file: $InFile\n";
  184. }
  185.  
  186. # Assume webxref is called in the document root directory
  187. $root = `pwd`;
  188. chop($root);
  189.  
  190. if (!$Silent) { print "\nChecking $InFile\n\n"; }
  191. &Get_Refs($InFile,"<none>");
  192.  
  193. &Print_Lists;
  194.  
  195. # Check external URLs
  196. if ($Do_External_URLs) {
  197.   if (! $Silent) {
  198.   print <<"E_O_T";
  199.  
  200. - - - - - - - - - - - - - - - - - - - - - - - - - - -
  201. Going to really check external URLs via the network.
  202. This may take some time. Simply abort webxref if you
  203. are out of patience.
  204. - - - - - - - - - - - - - - - - - - - - - - - - - - -
  205. E_O_T
  206.  
  207.   }
  208.  
  209.   &Check_External_URLs(%HTTPList, "Checking external URLs:");
  210.   print "\nAll done.\n";
  211. }
  212.  
  213.  
  214. exit;
  215.  
  216.  
  217. sub PrintUsage {
  218.  
  219. print <<"E_O_T";
  220.  
  221. Usage: webxref -help -nohttp -htmlonly -silent -avoid regexp file.html
  222.  
  223. E_O_T
  224.  
  225. exit;
  226. }
  227.  
  228.  
  229.  
  230. sub PrintHelp {
  231.  
  232. print <<"E_O_T";
  233.  
  234. Usage: webxref -help -nohttp -htmlonly -silent -avoid regexp file.html
  235.  
  236.  -nohttp: do not check external URLs
  237.  -htmlonly: only inspect files with the .html extension
  238.  -silent: only output error/problem messages
  239.  -avoid regexp: avoid files with names matching regexp for inspection
  240.  
  241.  Examples
  242.    webxref file.html
  243.              checks file.html and files/URLs referenced from file.html
  244.    webxref -nohttp file.html
  245.              checks file.html, but not external URLs
  246.    webxref -htmlonly file.html
  247.              checks file.html, but only files with the .html extension
  248.    webxref -avoid '.*Archive.*' file.html
  249.              checks file.html but avoids files with names containing
  250.              'Archive'
  251.    webxref -avoid '.*Archive.*|.*Distribution.*' file.html
  252.              Same as above, but also files with names containing
  253.   
  254. E_O_T
  255.  
  256. exit;
  257. }
  258.  
  259. #---------------------------------------------
  260.  
  261. sub Get_PWD {
  262.  
  263. # Get the pwd, make sure it ends with a slash
  264.  
  265. local($dir);
  266.  
  267. $dir = `pwd`;
  268. $dir =~ s/\n//g;
  269. if (!($dir =~ m#.*/$#)) {
  270.   $dir = "$dir/";
  271. }
  272.  
  273. return $dir;
  274.  
  275. }
  276.  
  277.  
  278.  
  279. sub Get_Refs {
  280.  
  281. # Recursively get all referenced files a from the file
  282.  
  283. local(%newlist);
  284. local($file);
  285. local($dir);
  286. local($Old_Dir);
  287. local($filename);
  288.  
  289. $dir=&Dir_Name($_[0]);
  290. if ($dir eq "") {
  291.   $dir = &Get_PWD;
  292. }
  293. $file=&Base_Name($_[0]);
  294. #print "--------------------\n";
  295. if ($debug) {
  296. print "arg=$_[0]\n";
  297. print "dir=$dir\n";
  298. print "file=$file\n";
  299. }
  300.  
  301.  
  302.  
  303. # http?
  304. if ($_[0] =~ m/.*(http:.*)/i) {
  305.   if (!defined($HTTPList{$1})) {
  306.     $HTTPList{$1} = $_[1]; 
  307.     }
  308.   else {
  309.     $HTTPList{$1} = "$HTTPList{$1} $_[1]";
  310.   }
  311.   return;
  312. }
  313.  
  314.  
  315.  
  316. # ftp?
  317. if ($_[0] =~ m/.*(ftp:.*)/i) {
  318.   if (!defined($FTPList{$1})) {
  319.     $FTPList{$1} = $_[1]; 
  320.     }
  321.   else {
  322.     $FTPList{$1} = "$FTPList{$1} $_[1]";
  323.   }
  324.   return;
  325. }
  326.  
  327.  
  328. # telnet?
  329. if ($_[0] =~ m/.*(telnet:.*)/i) {
  330.   if (!defined($TelnetList{$1})) {
  331.     $TelnetList{$1} = $_[1]; 
  332.     }
  333.   else {
  334.     $TelnetList{$1} = "$TelnetList{$1} $_[1]";
  335.   }
  336.   return;
  337. }
  338.  
  339.  
  340. # gopher?
  341. if ($_[0] =~ m/.*(gopher:.*)/i) {
  342.   if (!defined($GopherList{$1})) {
  343.     $GopherList{$1} = $_[1]; 
  344.     }
  345.   else {
  346.     $GopherList{$1} = "$GopherList{$1} $_[1]";
  347.   }
  348.   return;
  349. }
  350.  
  351.  
  352.  
  353. # mailto?
  354. if ($_[0] =~ m/.*(mailto:.*)/i) {
  355.   if (!defined($MailList{$1})) {
  356.     $MailList{$1} = $_[1]; 
  357.     }
  358.   else {
  359.     $MailList{$1} = "$MailList{$1} $_[1]";
  360.   }
  361.   return;
  362. }
  363.  
  364.  
  365. # news?
  366. if ($_[0] =~ m/.*(news:.*)/i) {
  367.   if (!defined($NewsList{$1})) {
  368.     $NewsList{$1} = $_[1]; 
  369.     }
  370.   else {
  371.     $NewsList{$1} = "$NewsList{$1} $_[1]";
  372.   }
  373.   return;
  374. }
  375.  
  376.  
  377. # file:?
  378. if ($_[0] =~ m/.*(file:.*)/i) {
  379.   if (!defined($ExtFileList{$1})) {
  380.     $ExtFileList{$1} = $_[1]; 
  381.     }
  382.   else {
  383.     $ExtFileList{$1} = "$ExtFileList{$1} $_[1]";
  384.   }
  385.   return;
  386. }
  387.  
  388.  
  389. # cgi-bin script?
  390. if ($_[0] =~ m#(^/cgi-bin/.*)#i) {
  391.   $_[0] =~ m#(^/cgi-bin/.*)=.*#i;  # Delete cgi-parameters
  392.   
  393.   if (!defined($CGIList{$1})) {
  394.     $CGIList{$1} = $_[1]; 
  395.     }
  396.   else {
  397.     $CGIList{$1} = "$CGIList{$1} $_[1]";
  398.   }
  399.   return;
  400. }
  401.  
  402.  
  403. # directory reference?
  404. if ($file eq "") {
  405.  
  406.   if ($debug) {
  407.     print "$dir must be a dir, refd by $_[1]!\n";
  408.   }
  409.   if (-d $_[0]) {
  410.     if (!defined($DirList{$_[0]})) {
  411.       $DirList{$_[0]} = $_[1];
  412.       }
  413.     else {
  414.       $DirList{$_[0]} = "$DirList{$_[0]} $_[1]";
  415.     }
  416.   }
  417.   else {
  418.  
  419.     if (!defined($DirNotFoundList{$_[0]})) {
  420.       $DirNotFoundList{$_[0]} = $_[1];
  421.     }
  422.     else {
  423.       $DirNotFoundList{$_[0]} = "$DirNotFoundList{$_[0]} $_[1]";
  424.     }
  425.   }
  426.  
  427.   return;
  428. }
  429.  
  430.  
  431.  
  432. # Move to the specified directory
  433. $Old_Dir = &Get_PWD;
  434. if ($debug) {
  435.   print "Chdir to $dir\n";
  436. }
  437. chdir($dir);
  438. $dir=&Get_PWD;
  439. if ($debug) {
  440.   print "Now in $dir\n";
  441. }
  442. $filename = $dir . $file;
  443.  
  444. if (! $Silent) {
  445.   print "Checking: $filename\n";
  446. }
  447.  
  448. # Is it a reference to a specific section? (a file#section reference)
  449. if ($filename =~ m/(.+)#(.+)/) {
  450.   $filename = "$1#$2";
  451.   if (&CheckAnchor($1, $2) ) {
  452.     #print "** Anchor $2 is present in file $1\n"; 
  453.  
  454.     # Add to the list of anchors
  455.     if (!defined($AnchorList{$filename})) {
  456.       $AnchorList{$filename} = $_[1]; 
  457.       }
  458.     else {
  459.       $AnchorList{$filename} = "$AnchorList{$filename} $_[1]";
  460.     }
  461.   }
  462.   else {
  463.     print "xx Anchor $2 is NOT present in file $1\n"; 
  464.     print "xx Referenced by: $_[1]\n";
  465.     #print "Anchor filename: $filename\n";
  466.  
  467.     # Add to the list of lost anchors
  468.     if (!defined($LostAnchorList{$filename})) {
  469.       $LostAnchorList{$filename} = $_[1]; 
  470.       }
  471.     else {
  472.       $LostAnchorList{$filename} = "$LostAnchorList{$filename} $_[1]";
  473.     }
  474.     
  475.   }
  476.   return;
  477. }
  478.  
  479. #
  480. # Add to the list of already tested files
  481. #
  482.  
  483. # If the "file" is a directory try Welcome/welcome/index.html
  484. if (-d $filename) {
  485.   #print "xx $filename is a directory, trying Welcome/welcome/index.html.\n";
  486.  
  487.   $found = 0;
  488.   foreach $default_file (@default_files) {
  489.     #print "Trying $default_file\n";
  490.     if (-f ($file . '/' . $default_file)) {
  491.       $dirname=$filename;
  492.       $file= $default_file;
  493.       $found = 1;
  494.       last;
  495.     }
  496.   }
  497.  
  498.   if (! $found) {
  499.     print "xx No Welcome/welcome/index.html can be found in $filename\n";
  500.     print "xx Referenced by: $_[1]\n";
  501.   
  502.     # Add to list of lost files
  503.     if (!defined($LostFileList{$filename})) {
  504.       $LostFileList{$filename} = $_[1]; 
  505.       }
  506.     else {
  507.       $LostFileList{$filename} = "$LostFileList{$filename} $_[1]";
  508.     }
  509.     return;
  510.   }
  511.  
  512.   # Move to the specified directory
  513.   if ($debug) {
  514.     print "Chdir to $dirname\n";
  515.   }
  516.   chdir($dirname);
  517.   $dir=&Get_PWD;
  518.   if ($debug) {
  519.     print "Now in $dir\n";
  520.   }
  521.   $filename = $dir . $file;
  522.   if ($debug) {
  523.     print "** Filename is now: $filename\n";
  524.     print "** Dirname is now: $dir\n";
  525.   }
  526. }
  527.  
  528. if (! -f $filename) {
  529.   print "xx $filename cannot be found\n";
  530.   print "xx Referenced by: $_[1]\n";
  531.  
  532.   # Add to list of lost files
  533.   if (!defined($LostFileList{$filename})) {
  534.     $LostFileList{$filename} = $_[1]; 
  535.     }
  536.   else {
  537.     $LostFileList{$filename} = "$LostFileList{$filename} $_[1]";
  538.   }
  539.  
  540.   return;
  541. }
  542.  
  543. # Binary file? (pictures,...)
  544. if (-B $filename) {
  545.   if ($debug) {
  546.     print "** Binary file added to images";
  547.   }
  548.   if (defined($ImageFileList{$filename})) {
  549.     return;
  550.   }
  551.   if (!defined($ImageFileList{$filename})) {
  552.     $ImageFileList{$filename} = $_[1];  # Define!
  553.     }
  554.   else {
  555.     $ImageFileList{$filename} = "$ImageFileList{$filename} $_[1]";
  556.   }
  557.   if ($debug) {
  558.     print "\n\nAdded: $filename to list of images\n";
  559.   }
  560.   
  561.   return;
  562. }
  563.  
  564. # else it's a text (html)file
  565. if (!defined($FileList{$filename})) {
  566.   $FileList{$filename} = $_[1];  # Define!
  567.   }
  568. else {
  569.   $FileList{$filename} = "$FileList{$filename} $_[1]";
  570.   
  571.   return;  # Already did this file
  572. }
  573. if ($debug) {
  574.   print "** Added: $filename \n";
  575. }
  576.  
  577.  
  578. # World readable?
  579. ($_,$_,$mode) = stat($filename);
  580. $readmode = ($mode & 4);
  581. if ($readmode == 0) {
  582.   # Not world readable, add to list
  583.   #print "xx Warning: $filename is not world readable\n";
  584.   if (!defined($UnreadableList{$filename})) {
  585.     $UnreadableList{$filename} = $_[1];
  586.     }
  587.   else {
  588.     $UnreadableList{$filename} = "$UnreadableList{$filename} $_[1]";
  589.   }
  590. }
  591.  
  592. if ($HTML_only) {
  593.   # Filename *must* have extension .html, else we don't inspect it.
  594.   if ($filename !~ /.*\.html$/i) {return;}
  595. }
  596.  
  597. # Apply the regexp to avoid certain files
  598. if ($Avoid ne "") {
  599.   if ($filename =~ m/$Avoid/) { 
  600.     print "** The above file is avoided.\n"; 
  601.     return;
  602.   }
  603. }
  604.  
  605.  
  606. $err = 0;
  607. open(HTML, $filename) || ($err = 1);
  608. if ($err) {
  609.   print "xx Could not open file $filename\n";
  610.   return; 
  611. }
  612.  
  613. # Make sure all <somethings start on a new line in temp file,
  614. # resulting in one thingie per line
  615.  
  616. #Old:
  617. #open(TEMP,">$temp_file") || die "Could not create $temp_file\n";
  618. #while (<HTML>) {
  619. #  s/</\n</g;
  620. #  print TEMP;
  621. #}
  622. #close(TEMP);
  623.  
  624. # Read the file into a big string and remove crud in between tags.
  625. # Code thanks to Hans Hoppe (hopha@sci.kun.nl) 04-OCT-95
  626. open(TEMP,">$temp_file") || die "Could not create $temp_file\n";
  627. $offset=0;
  628. do {
  629.   $size=read(HTML,$html_text,32768,$offset);
  630.   $offset=$offset+$size;
  631. } until $size != 32768;
  632. close(HTML);
  633. #$html_text =~ s/\n/ /gs;
  634. $html_text =~ s/\n/ /g;
  635. $html_text =~ s/[^<]*//;
  636. $html_text =~ s/(<[^>]*>)[^<]*/\1\n/g;
  637. print TEMP "$html_text";
  638. $html_text="";
  639. close(TEMP);
  640.  
  641. open(HTML, $temp_file) || die "Could not open $temp_file\n";
  642. while (<HTML>) {
  643.   chop;
  644.  
  645.   # <a href=...
  646.   if (/<a\s+.*href\s*=/i) {
  647.     s/<a\s+.*href *=//i;   # <a href=  at start
  648.     s/\s+.*//;
  649.     s/\s+.*>.*//;          # trailing stuff
  650.     s/>.*$//i;             # remove >'s
  651.     s/"//g;                # Unquote file names
  652.     s/^\s*//;              # Remove spaces at start
  653.     s/\s*$//;              # Remove spaces at end
  654.  
  655.     # Link to section within current document?
  656.     if (m/^#.*/) {
  657.       $file_w_anchor = $filename;
  658.       $file_w_anchor =~ s#.*/##;
  659.       if ($debug) {
  660.         print "file_w_anchor: $file_w_anchor\n";
  661.         print "Added to newlist: $file_w_anchor$_\n";
  662.       }
  663.       $newlist{"$file_w_anchor$_"} = 1;  # Check this file plus anchor later
  664.       }
  665.     # Link to another document?
  666.     else {
  667.       if ($debug) {
  668.         print "added to newlist: $_\n";
  669.       }
  670.       $newlist{$_} = 1;
  671.     }
  672.  
  673.   }
  674.  
  675.   # <img src=...
  676.   # NB: <img and src= must be on same line
  677.   if (/<img\s+.*src\s*=/i) {
  678.     s/<img\s+.*src\s*=//i;
  679.     s/\s+.*//;
  680.     s/\s+.*>.*//;
  681.     s/>.*$//i;             # remove >'s
  682.     s/"//g;                # Unquote file names
  683.     s/^\s*//;              # Remove spaces at start
  684.     s/\s*$//;              # Remove spaces at end
  685.  
  686.     # Add file to the list
  687.     $newlist{$_} = 1;
  688.   }
  689.  
  690. }
  691.  
  692. close(HTML);
  693.  
  694. chdir($Old_Dir);
  695.  
  696. if ($debug) {
  697.   # List files
  698.   print "\nNewlist:\n";
  699.   foreach $file (keys(%newlist)) {
  700.     print "$file \n";
  701.   }
  702. }
  703.  
  704. # Walk the list
  705. foreach $file (keys(%newlist)) {
  706.   # if file is //something insert a http:
  707.   if ($file =~ m#^//.*#) {
  708.     $file = "http:" . $file;
  709.   }
  710.  
  711.   $Notlocal_file = $dir . $file;
  712.  
  713.   # If file is /something it's a reference from the root document.
  714.   # It can also be a cgi-bin reference!
  715.   if ($file =~ m#^/cgi-bin/.*#) {
  716.     $Notlocal_file = $file;
  717.     }
  718.   elsif ($file =~ m#^/.*#) {
  719.     $Notlocal_file = "$root$file";
  720.   }
  721.  
  722.   $Notlocal_ref_filename = $filename;
  723.   if ($debug) {
  724.     print "\nCalling GR with $Notlocal_file\n";
  725.     print "Referenced by: $Notlocal_ref_filename\n";
  726.   }
  727.   &Get_Refs($Notlocal_file, $Notlocal_ref_filename);
  728. }
  729.  
  730. unlink($temp_file);
  731.  
  732. } #sub Get_Refs
  733.  
  734. #---------------------------------------------
  735.  
  736. sub Base_Name {
  737.  
  738. # return basename,
  739. # e.g. /home/sscprick/.WWW/Welcome.html 
  740. # returns: Welcome.html
  741.  
  742. local($local_filename)=$_[0];
  743. $local_filename =~ s#.*/##;  # remove the directory name -> file name
  744.  
  745. $local_filename;
  746. }
  747.  
  748. sub Dir_Name {
  749.  
  750. # return dirname,
  751. # e.g. /home/sscprick/.WWW/Welcome.html 
  752. # returns: /home/sscprick/.WWW/
  753.  
  754. local($local_filename)=$_[0];
  755. $local_filename =~ s#.*/##;  # remove the directory name -> file name
  756. local($local_dirname) = $_[0];
  757. $local_filename =~ s/(\W)/\\$1/g;  # escape regexp chars
  758. $local_dirname =~ s/$local_filename$//; # wipe filename at end -> dir name
  759.  
  760. $local_dirname;
  761. }
  762.  
  763.  
  764. sub CheckAnchor {
  765.  
  766. # See if #section anchor is present in file
  767.  
  768. local($fn, $anchor) = @_;
  769. $anchor =~ s/(\W)/\\$1/g;  # quote rexep chars
  770.  
  771. open(CH_HTML, $fn) || die "xx Could not open $fn\n";
  772. while (<CH_HTML>) {
  773.   chop;
  774.   if (/<a +name *= *"*$anchor"*/i) {
  775.     close(CH_HTML);
  776.     return 1; 
  777.   }
  778. }
  779.  
  780. close(CH_HTML);
  781. return 0;
  782.  
  783. } # sub CheckAnchor
  784.  
  785.  
  786. #---------------------------------------------
  787.  
  788. sub Check_External_URLs {
  789.  
  790.  
  791. local(%list, $header) = @_;
  792. local($URL);
  793.  
  794. if (!$Silent) { print "\n\n----------------\n$header\n"; } 
  795. @TheList=keys(%list);
  796. @SortedList = sort @TheList;
  797.  
  798. foreach $URL (@SortedList) {
  799.   if (! $Silent) { print "$URL \n"; }
  800.  
  801.   if (defined($HTTPStatusList{$URL})) {
  802.     # Already checked on this one
  803.     next;
  804.   }
  805.   else {
  806.     $rcode = &Check_URL($URL);
  807.   }
  808.  
  809.   if (defined($OkStatusMsgs{$rcode})) {
  810.     # URL is ok, server responds and all.
  811.     if (! $Silent) { print "  Ok\n"; }
  812.     $HTTP_OK_List{$URL} = $HTTPList{$URL};  # The references
  813.   }
  814.   else {
  815.     # Something is wrong.
  816.     if (defined($FailStatusMsgs{$rcode})) {
  817.       if (! $Silent) { print "  xx Failed: $FailStatusMsgs{$rcode}\n"; }
  818.     }
  819.     else {
  820.       if (! $Silent) { print "  xx Failed with code $rcode\n"; }
  821.     }
  822.     $HTTP_Fail_List{$URL} = $rcode;
  823.   }
  824. }
  825.  
  826. if (! $Silent) { &Print_List(%HTTP_OK_List,"URLs checked ok:"); }
  827. &Print_Failed_URL_List(%HTTP_Fail_List, "Failed URLs:");
  828.  
  829. }
  830.  
  831.  
  832.  
  833. sub Print_Failed_URL_List {
  834.  
  835. local(%list, $header) = @_;
  836. local($URL);
  837.  
  838. # Don't list empty lists
  839. if (! %list) {return};
  840.  
  841. print "\n\n----------------\n$header\n";
  842. @TheList=keys(%list);
  843. @SortedList = sort @TheList;
  844.  
  845. foreach $URL (@SortedList) {
  846.   print "$URL \n";
  847.   $rcode = $HTTP_Fail_List{$URL};
  848.   print "  Status: $rcode ($FailStatusMsgs{$rcode})\n";
  849.  
  850.   @lost = split(/ /,$HTTPList{$URL});
  851.   @sortlost = sort @lost;
  852.   print "  Referenced by:\n";
  853.   foreach $lostURL (@sortlost) {
  854.     print "  $lostURL\n";
  855.   }
  856. }
  857.  
  858. }  # sub Print_Failed_URL_List
  859.  
  860.  
  861.  
  862.  
  863.  
  864. sub Check_URL {
  865.  
  866. # http://host:port/path
  867.  
  868. local($URL) = @_;
  869.  
  870. if ($URL !~ m#^http://.*#i) { 
  871.   print "wrong format http!\n";
  872.   return;
  873. }
  874. else {
  875.  
  876.   #if ($URL =~ m#^http://([\w-\.]+)(:|$|/)#) {
  877.  
  878.   # Get the host and port
  879.   if ($URL =~ m#^http://([\w-\.]+):?(\d*)($|/(.*))#) {
  880.     $host = $1;
  881.     $port = $2;
  882.     $path = $3;
  883.   }
  884.   if ($path eq "") { $path = '/'; }
  885.   if ($port eq "") { $port = 80; }
  886.  
  887.   # Delete name anchor. (check if the anchor is present in the doc?)
  888.   $path =~ s/#.*//;
  889.   # Delete parameters
  890.   #$path =~ s/\?.*//;
  891.  
  892.   #print "-->\n URL: $URL\n host: $host\n port: $port\n path: $path\n";
  893. }
  894.  
  895.  
  896. # The following is largely taken from the Camel book, chapter 6
  897.  
  898. $AF_INET = 2;
  899. $SOCK_STREAM = 1;
  900.  
  901. $sockaddr = 'S n a4 x8';
  902.  
  903. chop($hostname = `hostname`);
  904.  
  905. ($name,$aliases,$proto) = getprotobyname('tcp');
  906. ($name,$aliases,$port) = getservbyname($port,'tcp') unless $port =~ /^\d+$/;
  907. ($name,$aliases,$type,$len,$thisaddr) = gethostbyname($hostname);
  908. if (!(($name,$aliases,$type,$len,$thataddr) = gethostbyname($host))) {
  909.   return -1;
  910. }
  911.  
  912. $this = pack($sockaddr, $AF_INET, 0, $thisaddr);
  913. $that = pack($sockaddr, $AF_INET, $port, $thataddr);
  914.  
  915. # Make the socket filehandle.
  916. # ** Temporary fix, this is NOT The way to do it. 15-APR-96
  917. if (!(socket(S, $AF_INET, $SOCK_STREAM, $proto))) {
  918.   $SOCK_STREAM = 2;
  919.   if (!(socket(S, $AF_INET, $SOCK_STREAM, $proto))) { return -2; }
  920. }
  921.  
  922. # Give the socket an address
  923. if (!(bind(S, $this))) {
  924.   return -3;
  925. }
  926.  
  927. if (!(connect(S,$that))) {
  928.   return -4;
  929. }
  930.  
  931. select(S); $| = 1; select(STDOUT);
  932.  
  933. print S "HEAD $path HTTP/1.0\n\n";
  934.  
  935. $response = <S>;
  936. ($protocol, $status) = split(/ /, $response);
  937. while (<S>) {
  938.   #print;
  939. }
  940. close(S);
  941.  
  942. #print "Status: $status\n";
  943. return $status;
  944.  
  945. }
  946.  
  947.  
  948.  
  949.  
  950.  
  951.  
  952.  
  953. #---------------------------------------------
  954.  
  955. sub Print_List {
  956.  
  957. local(%list, $header) = @_;
  958. local($file);
  959.  
  960. # Don't list empty lists
  961. if (! %list) {return};
  962.  
  963. print "\n\n----------------\n$header\n";
  964. @TheList=keys(%list);
  965. @SortedList = sort @TheList;
  966.  
  967. foreach $file (@SortedList) {
  968.   print "$file \n";
  969.   @lost = split(/ /,$list{$file});
  970.   @sortlost = sort @lost;
  971.   print "  Referenced by:\n";
  972.   foreach $lostfile (@sortlost) {
  973.     print "  $lostfile\n";
  974.   }
  975. }
  976.  
  977. }  # sub Print_List
  978.  
  979.  
  980.  
  981.  
  982. sub Print_Lists {
  983.  
  984. # Print lists
  985.  
  986. # List all files found
  987. if (!$Silent) { &Print_List(%FileList,"Web documents found:");}
  988.  
  989. # List of directories referenced
  990. if (!$Silent) { &Print_List(%DirList,"Directories:");}
  991.  
  992. # List of images referenced
  993. if (!$Silent) { &Print_List(%ImageFileList,"Images:");}
  994.  
  995. # List of mailto's
  996. if (!$Silent) { &Print_List(%MailList,"Mailto:");}
  997.  
  998. # List of ftp's
  999. if (!$Silent) { &Print_List(%FTPList,"ftp:");}
  1000.  
  1001. # List of telnets
  1002. if (!$Silent) { &Print_List(%TelnetList,"telnet:");}
  1003.  
  1004. # List of gophers
  1005. if (!$Silent) { &Print_List(%GopherList,"gopher:");}
  1006.  
  1007. # List of news
  1008. if (!$Silent) { &Print_List(%NewsList,"News:");}
  1009.  
  1010. # List of http's
  1011. if (!$Silent) { &Print_List(%HTTPList,"External URLs:");}
  1012.  
  1013. # List of file:'s
  1014. if (!$Silent) { &Print_List(%ExtFileList,"External file:");}
  1015.  
  1016. # List of cgi-bin scripts/forms
  1017. if (!$Silent) { &Print_List(%CGIList,"cgi-bin scripts/forms:");}
  1018.  
  1019. # List of name anchors
  1020. if (!$Silent) { &Print_List(%AnchorList,"Name anchors found:");}
  1021.  
  1022. # List of files that can't be found
  1023. &Print_List(%LostFileList,"Files not found:");
  1024.  
  1025. # List of files that are not world readable
  1026. &Print_List(%UnreadableList,"Files not world readable:");
  1027.  
  1028. # List of directories that can't be found
  1029. &Print_List(%DirNotFoundList,"Directories not found:");
  1030.  
  1031. # List of name anchors not found
  1032. &Print_List(%LostAnchorList,"Name anchors not found:");
  1033.  
  1034. if ($HTML_only) { print "\nDone.\n"; }
  1035.  
  1036. } #sub Print_Lists
  1037.  
  1038.  
  1039.  
  1040. # This is the last line of the webxref script really.
  1041. # If this line is missi
  1042.  
  1043.