home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v941.tgz / icon.v941src.tar / icon.v941src / ipl / progs / weblinks.icn < prev    next >
Text File  |  2001-09-27  |  10KB  |  394 lines
  1. ############################################################################
  2. #
  3. #    File:     weblinks.icn
  4. #
  5. #    Subject:  Program to check links in HTML files
  6. #
  7. #    Author:   Gregg M. Townsend
  8. #
  9. #    Date:     September 27, 2001
  10. #
  11. ############################################################################
  12. #
  13. #    This file is in the public domain.
  14. #
  15. ############################################################################
  16. #
  17. #    Weblinks is a program for checking links in a collection of HTML
  18. #    files.  It is designed for use directly on the file structure
  19. #    containing the HTML files.
  20. #
  21. #    Given one or more starting points, weblinks parses each file and
  22. #    validates the HTTP: and FILE: links it finds.  Errors are reported
  23. #    on standard output.  FILE: links, including relative links, can be
  24. #    followed recursively.
  25. #
  26. ############################################################################
  27. #
  28. #    By design, only local files are scanned.  Only an existence check is
  29. #    performed for HTTP: links.  Validation of HTTP: links is aided by
  30. #    caching and subject to speed limits; see "vhttp.icn" for details.
  31. #
  32. #    Remote links are checked by sending an HTTP "HEAD" request. 
  33. #    Unfortunately, some sites respond with "Server Error" or even with
  34. #    snide remarks like "Because I felt like it".  These are reported
  35. #    as errors and must be inspected manually.
  36. #
  37. #    NOTE:  if the environment variable USER is set, as it usually is,
  38. #    then "From: $USER@hostname" is sent as part of each remote inquiry
  39. #    in order to identify the source.  This is standard etiquette for
  40. #    automated checkers.
  41. #
  42. #    Limitations:
  43. #       url(...) links within embedded stylesheets are not recognized.
  44. #       FTP:, MAILTO:, and other link types are not validated.
  45. #       Files are checked recursively only if named *.htm*.
  46. #       Proper file permission (for web export) is not checked.
  47. #
  48. #    The common error of failing to put a trailing slash on a directory
  49. #    specification results in a "453 Is A Directory" error message for a
  50. #    local file or, typically, a "301 Moved Permanently" message for a
  51. #    remote file.
  52. #
  53. ############################################################################
  54. #
  55. #    usage:   weblinks [options] file...
  56. #
  57. #    -R    follow file links recursively
  58. #        (http links are never followed recursively)
  59. #
  60. #    -t    trace files as visited
  61. #
  62. #    -s    report successes as well as problems
  63. #
  64. #    -v    report tracing and successes, if selected, more verbosely
  65. #
  66. #    -r root
  67. #        specify starting point for file names beginning with "/"
  68. #        (e.g. -r /cs/www).  This is needed if such references are
  69. #        to be followed or checked.  If a root is specified it
  70. #        affects all file specifications including those on the
  71. #        command line.
  72. #
  73. #    -h home
  74. #        specify starting point for file names beginning with "/~".
  75. #
  76. #    -p prefix[,prefix...]
  77. #        prune (don't check) files beginning with given prefix
  78. #
  79. #    -b prefix
  80. #        specify bounds for files scanned:  do not scan files
  81. #        that do not begin with prefix.  Default bounds are
  82. #        directory of last file name.  For example,
  83. #            weblinks /foo/bar /foo/baz  
  84. #        implies "-b /foo/".
  85. #
  86. #    If the environment variable WEBLINKS_INIT is set, its whitespace-
  87. #    separated words are prepended to the explicit command argument list.
  88. #
  89. ############################################################################
  90. #
  91. #    Examples (all assuming a web area rooted at /cs/www)
  92. #
  93. #        To check one new page:
  94. #        weblinks -r /cs/www  /icon/books.htm
  95. #
  96. #        To check a personal hierarchy, with tracing:
  97. #        setenv WEBLINKS_INIT "-r /cs/www -h /cs/www/people"
  98. #        weblinks -R -t /~gmt/
  99. #
  100. #        To check with pruning:
  101. #        weblinks -R -t -r /cs/www -p /icon/library /icon/index.htm
  102. #
  103. ############################################################################
  104. #
  105. #  Links:  options, strings, html, vhttp
  106. #
  107. ############################################################################
  108. #
  109. #  Requires:  Unix, dynamic loading
  110. #
  111. ############################################################################
  112.  
  113.  
  114. #  to do:
  115. #    add -u option (report unchecked URLs); -s should imply -u
  116. #    provide way to ask for warnings about (e.g.) /http/html paths
  117. #    provide way to specify translation from http:lww... into file: /...
  118. #    provide way to specify translation from ftp:... into file: /...
  119. #    provide depth limit control
  120. #    allow longer history persistence
  121. #    history is clumsy -- hard to recheck a connection that failed
  122. #      add option to retry failed entries (but believe cached successes)
  123. #    add option to sort report by referencing page
  124.  
  125.  
  126. $define URLCOLS 56    # number of columns allotted for tracing URLs
  127. $define STATCOLS 22    # number of columns allotted for status messages
  128.  
  129. link options
  130. link strings
  131. link html
  132. link vhttp
  133.  
  134.  
  135. global root
  136. global home
  137. global prune
  138. global bounds
  139.  
  140. global recurse
  141. global trace
  142. global verbose
  143. global successes
  144.  
  145. global todo, done, nscanned
  146. global refto, reffrom
  147.  
  148.  
  149. procedure main(args)
  150.    local opts, url, tmp
  151.  
  152.    # initialize data structures
  153.  
  154.    prune := list()
  155.    todo := list()
  156.    done := table()
  157.    refto := table()
  158.    reffrom := table()
  159.    nscanned := 0
  160.  
  161.    # add arguments from the environment to the command line
  162.  
  163.    tmp := list()
  164.    every put(tmp, words(getenv("WEBLINKS_INIT")))
  165.    while push(args, pull(tmp))
  166.  
  167.    # process command line
  168.  
  169.    opts := options(args, "b:p:r:h:Rstv")
  170.    recurse := opts["R"]
  171.    successes := opts["s"]
  172.    trace := opts["t"]
  173.    verbose := opts["v"]
  174.  
  175.    if *args = 0 then
  176.       stop("usage: ", &progname, " [options] file ...")
  177.  
  178.    setroot(\opts["r"] | "/")
  179.    sethome(\opts["h"] | "/usr/")
  180.    setbounds(\opts["b"] | urlmerge(args[-1], ""))
  181.    every setprune(words(\opts["p"], ' ,'))
  182.    setfrom()
  183.  
  184.    register("initial:")
  185.    register("implicit:")
  186.    every addref("initial:", urlmerge("file:", !args))
  187.  
  188.    wheader()
  189.  
  190.    while url := get(todo) do
  191.       try(url)
  192.  
  193.    if \trace then
  194.       write()
  195.  
  196.    report()
  197. end
  198.  
  199. procedure setroot(s)
  200.    if s[-1] ~== "/" then
  201.       s ||:= "/"
  202.    root := s
  203.    return
  204. end
  205.  
  206. procedure sethome(s)
  207.    if s[-1] ~== "/" then
  208.       s ||:= "/"
  209.    home := s
  210.    return
  211. end
  212.  
  213. procedure setprune(s)
  214.    put(prune, s)
  215.    return
  216. end
  217.  
  218. procedure setbounds(s)
  219.    bounds := s
  220.    return
  221. end
  222.  
  223. procedure setfrom()
  224.    local user, host, f
  225.  
  226.    user := getenv("USER")    | fail
  227.    *user > 0            | fail
  228.    f := open("uname -n", "rp")    | fail
  229.    host := read(f)
  230.    close(f)
  231.    *\host > 0            | fail
  232.    vhttp_from := user || "@" || host
  233.    return
  234. end
  235.  
  236.  
  237. procedure wheader()
  238.    write("From:\t", \vhttp_from | "[none]")
  239.    write("root:\t", root)
  240.    write("home:\t", home)
  241.    write("bounds:\t", bounds)
  242.    every write("start:\t", (!todo)[6:0])
  243.    every write("prune:\t", !prune)
  244.    write()
  245.    return
  246. end
  247.  
  248. procedure try(url)
  249.    local result
  250.  
  251.    (/done[url] := "[processing]") | return    # return if already checked
  252.  
  253.    if \trace then {
  254.       writes(pad(url, URLCOLS))
  255.       flush(&output)
  256.       }
  257.  
  258.    result := check(url)
  259.    done[url] := result
  260.  
  261.    if \trace then
  262.       write("  ", result)
  263.    return
  264. end
  265.  
  266.  
  267. procedure check(url)
  268.    local protocol, fspec, fname, f, s, ref, base
  269.  
  270.    url ? {
  271.       protocol := map(tab(upto(':'))) | ""
  272.       =":"
  273.       fspec := tab(0)
  274.    }
  275.  
  276.    if protocol == "http" then
  277.       return vhttp(url) | "451 Illegal URL"
  278.  
  279.    if protocol ~== "file" then
  280.       return "152 Not Checked"
  281.  
  282.    fspec ? {
  283.       if ="/~" then
  284.          fname := home || tab(0)
  285.       else if ="/" then
  286.          fname := root || tab(0)
  287.       else if pos(0) then
  288.          fname := "./"
  289.       else
  290.          fname := fspec
  291.       }
  292.  
  293.    if fname[-1] == "/" then {
  294.       if (close(open(fname || "index.html"))) then {
  295.          addref("implicit:", url || "index.html")
  296.          return "154 Found index.html"
  297.          }
  298.       if (close(open(fname || "index.htm"))) then {
  299.          addref("implicit:", url || "index.htm")
  300.          return "155 Found index.htm"
  301.          }
  302.       if (close(open(fname || "."))) then
  303.          return "153 Found Directory"
  304.       }
  305.  
  306.    if not (f := open(fname)) then
  307.       return "452 Cannot Open"
  308.  
  309.    if (/recurse & not member(reffrom["initial:"], url)) |
  310.    (fspec ? (not match(bounds)) | match(!prune)) | 
  311.    (not find(".htm", map(url))) then {
  312.       close(f)
  313.       if close(open(fname || "/.")) then
  314.          return "453 Is A Directory"
  315.       else
  316.          return "251 File Exists"
  317.       }
  318.  
  319.    base := url
  320.    every s := htrefs(f) do s ? {
  321.       if ="BASE HREF " then {
  322.          base := tab(0)
  323.          }
  324.       else {
  325.          tab(upto(' ') + 1)
  326.          tab(upto(' ') + 1)
  327.          ref := urlmerge(base, tab(0))
  328.          addref(url, ref)
  329.          }
  330.       if \verbose then
  331.          writes("\n   references: ", ref)
  332.       }
  333.    if \verbose then
  334.       writes("\n", repl(" ", URLCOLS))
  335.  
  336.    close(f)
  337.    nscanned +:= 1
  338.    return "252 File Scanned"
  339. end
  340.  
  341. procedure report()
  342.    local l, url, stat
  343.  
  344.    l := sort(done, 4)
  345.    while (url := get(l)) & (stat := get(l)) do {
  346.       if \successes | (any('3456789', stat) & stat ~== "302 Found") then {
  347.          write(pad(stat || ":", STATCOLS), "  ", url)
  348.          if \verbose | any('3456789', stat) then
  349.             every write("   referenced by:\t", !sort(refto[url]))
  350.          }
  351.       }
  352.  
  353.    write()
  354.  
  355.    if nscanned = 1 then
  356.       write("1 file scanned")
  357.    else
  358.       write(nscanned, " files scanned")
  359.  
  360.    if *done = 1 then
  361.       write("1 reference checked")
  362.    else
  363.       write(*done, " references checked")
  364.  
  365.    return
  366. end
  367.  
  368. procedure addref(src, dst)
  369.    dst := (dst ? tab(upto('#') | 0))
  370.    register(dst)
  371.    insert(refto[dst], src)
  372.    insert(reffrom[src], dst)
  373.    if /done[dst] then
  374.       put(todo, dst)
  375.    return
  376. end
  377.  
  378. procedure register(url)
  379.    /refto[url] := set()
  380.    /reffrom[url] := set()
  381.    return
  382. end
  383.  
  384.  
  385.  
  386. #  pad(s, n) -- pad string to length n, never truncating
  387.  
  388. procedure pad(s, n)
  389.    if *s < n then
  390.       return left(s, n)
  391.    else
  392.       return s
  393. end
  394.