home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 35 Internet / 35-Internet.zip / grabsite.zip / grabsite.cmd next >
OS/2 REXX Batch file  |  1999-08-18  |  39KB  |  1,365 lines

  1. /* This will take an html document and find all <a and <img links.
  2.   It will not find "FORM links.
  3. */
  4.  
  5.  
  6. /********** BEGIN USER changeable parameters ***********/
  7.  
  8. /* default "base url" -- only used if a file:// url is entered 
  9.    For example, to start at d:\www\guide.htm, you'ld enter
  10.    file://d:\www\guide.htm 
  11.    You'ld then need to enter the "default" address (for use with
  12.    relative URLS contained in this file)
  13. */
  14. defbaseurl='http://www/'
  15.  
  16. /* default root directory -- only used if a file:// url is entered 
  17. */
  18. defrootdir='/'
  19.  
  20. /* default name (for urls that end with / ). 
  21.   For example,
  22.     given a link of "<a href="/sports/scoreboard/">
  23.         and def_tofile='index.htm'
  24.     then the contents of this url would be written to:
  25.         destination_dir\sports\scoreboard\index.htm   */
  26. def_tofile='INDEX.HTM'
  27.  
  28.  
  29. /*If HTML Document mode is selected, then
  30.      only links ending with these extensions are downloaded, examined, and written.  
  31.   Notes:
  32.    * In all cases, if the content-type header is NOT text/html,
  33.      the contents will NOT be examined.
  34.    * If HTMLEXTS='', then this test is not performed  
  35.    * If NOT_HTMLEXTS='', then this test is not performed  */
  36. htmlexts='SHTML SHT HTM HTML HTML-SSI HTM-SSI'
  37.  
  38. /*  log file. If none desired, set=0. Otherwise, enter a 
  39.     filename. Note that old log files will be deleted/overwritten */
  40. logfile='GRABSITE.LOG'
  41.  
  42. /* nocgi=1 to skip CGI urls (that have a /CGI in their path */
  43. nocgi=1
  44.  
  45. /* nosearch=1 to skip urls that end with ?xxx 
  46.    (where xxx is a string of any length)*/
  47. nosearch=1              
  48.  
  49.  
  50. /*If HTML Document mode is selected, then
  51.       links ending with these extensions  are NOT downloaded.
  52.   Notes:
  53.    * If "retrieve all links" mode is specified, then
  54.         not_htmlexts is ignored    
  55.    * If HTMLEXTS<>'', then this test is not performed  
  56.    * If "retrieve all links" mode is specified, then
  57.         htmlexts is ignored    
  58.    * If HTMLEXTS='', then this test is not performed   */
  59. not_htmlexts='JPG GIF BMP ZIP GZ TIF TIFF MOV AU EXE COM WAV XBM PDF PS EPS  '
  60.  
  61.  
  62. /* overwrite=1 means "overwrite preexisting files.
  63.    Otherwise, don't overwrite 
  64. */
  65. overwrite=1
  66.  
  67.  
  68. /* optional request header(s) to send to servers
  69.    Note: use '0d0a'x to seperate multiple request headers  */
  70. reqheaders='User-agent: GrabSite'
  71.  
  72.  
  73. /* if URL's path starts with remove_prefix, then trim    
  74.    the beginning of the path (remove everything up to the first /) 
  75.    For example, 
  76.      if remove_prefix='!RANGE
  77.      and a link is /!RANGE:bytes=100-200/surplus/prices.lst
  78.      then /surplus/prices.lst is used   */
  79. remove_prefix='!RANGE'
  80.  
  81.  
  82. /* If robot_check=1, then check for a /ROBOTS.TXT file. This contains
  83.    instructions on what paths should not be visited by "web robots".
  84. */
  85. robot_check=1
  86.  
  87. /* if URL's path starts with skip_prefix, then skip it 
  88.    This is only needed when the "retrieve" test is /.   */
  89. skip_prefix='!'
  90.  
  91.  
  92. /* Status reports:
  93.     -2 for NO status output, -1 for minimal, 0 for average
  94.     1 for some, 2 for too much */
  95. verbose=1
  96.  
  97.  
  98. /********** END USER changeable parameters ***********/
  99.  
  100. parse arg afile destdir includer includer2 write_all  
  101. cmdline=0
  102. if afile<>'' then do 
  103.    afile=translate(afile,'/','\')
  104.    cmdline=1
  105. end /* do */
  106.  
  107. write_all0=write_all
  108.  
  109. if afile='?' then do
  110.   say "GrabSite -- GET a linked set of pages from the WWW"
  111.   say 
  112.   say "Calling syntax: GrabSite URL DestDir Test1 Test2 Get_all "
  113.   say "   where:"
  114.   say " URL = a fully qualified URL (the home page to start at)"
  115.   say " DestDir = destination directory (on local disk) to write results to"
  116.   say " Test1 = only parse documents in/under this prefix "
  117.   say " Test2 = only retrieve documents in/under this prefix "
  118.   say " Get_all = if 0, then do NOT get non-html documents "
  119.   say " "
  120.   say " Note: to avoid command line problems: use \ instead of /"
  121.   say " "
  122.   say "Example: "
  123.   say "   D:>grabsite http:\\fu.br.net\circ\index.htm d:\foob \circ\ \ 1 "
  124.   say
  125.   say "Or .. enter without arguments for user prompts"
  126.    exit
  127. end /* do */
  128.  
  129.  
  130. /* initialize some stuff */
  131. baseurl=''
  132. rootdir=''
  133. includer=translate(translate(includer,'/','\'))
  134. includer2=translate(translate(includer2,'/','\'))
  135. remove_prefix=translate(remove_prefix)
  136. skip_prefix=translate(skip_prefix)
  137. htmlexts=translate(htmlexts)
  138. not_htmlexts=translate(not_htmlexts)
  139. ndeleted=0
  140. nwritten=0 ; noconnects=0
  141. ngets=0; n400s=0
  142. nparsed=0
  143.  
  144. crlf='0d0a'x
  145. fileurls.0=0
  146. flist.0=0
  147.  
  148. call loaddll            /* load some dlls, set some parameters */
  149.  
  150.  
  151.  
  152. say
  153. say "         "cy_ye"GrabSite -- GET a set of linked documents from a WWW site"normal
  154. say
  155.  
  156.  
  157. if logfile=0 | logfile=' ' then do
  158.     logfile=0
  159. end /* do */
  160. else do
  161.   aa=stream(logfile,'c','query exists')
  162.   if aa<>'' then do
  163.      foo=sysfiledelete(logfile)
  164.      if verbose>0 then say "Old logfile deleted: "logfile
  165.      call lineout logfile,'GrabSite log file. Created '||time('n')||' '||date('n')
  166.   end /* do */
  167. end
  168.  
  169. /***** determine file/url to read, and other info */
  170. say 
  171. jump1: nop
  172. if afile='' then do
  173.    afile=getstring("Home page to grab, or enter ? for a brief description.",'?',reverse'  1)'normal)
  174.    if afile='?' then do
  175.         call helpme1
  176.         afile=''
  177.         signal jump1
  178.    end /* do */
  179. end
  180. afile=strip(afile)
  181. afileu=translate(strip(afile))
  182. if abbrev(afileu,'FILE://') then do
  183.    parse var afile . '://' afile
  184.    afileu=translate(afile)
  185.    afile_isurl=0
  186.    if stream(afile,'c','query exists')="" then do
  187.        call printsay "No such file: "afile
  188.        exit
  189.    end /* do */
  190.    call printsay "        ... reading "||cutstrg(afile,50) "...."
  191.    stuff=charin(afile,1,chars(afile))
  192.    afile_isurl=0
  193.    if baseurl='' then baseurl=getstring("Default site (the dotted ip address)",defbaseurl,reverse' 1a)'normal)
  194.    if rootdir='' then rootdir=getstring("Default 'root' directory ",defrootdir,reverse' 1b)'normal)
  195. end             /* local file as base */
  196. else do         /* it's a url */
  197.    if abbrev(afileu,'HTTP://')<>1 then do
  198.         afile='http://'afile
  199.         afileu=translate(afile)
  200.    end /* do */
  201.    afile_isurl=1
  202.    parse var afile . '://' bb1 '/' bb2
  203.    baseurl=bb1
  204.    ii=lastpos('/',bb2)
  205.    if ii=0 then 
  206.       rootdir='/'
  207.    else
  208.       rootdir=left(bb2,ii)
  209. end                   /* url entry */
  210.  
  211. if pos('://',baseurl)=0 then baseurl='http://'||baseurl
  212. rootdir=strip(rootdir)
  213. if rootdir<>'/' then rootdir='/'||strip(rootdir,,'/')||'/'
  214. baseurl=strip(strip(baseurl,'t','/'))
  215.  
  216.  
  217. /* destination directory */
  218. atdestdir: nop
  219. if destdir='' then do
  220.   destdir=getstring("Enter a destination directory ",directory(),reverse'  2)'normal)
  221.   if destdir="?" then do
  222.      call helpme1
  223.      destdir=''
  224.      signal atdestdir
  225.   end /* do */
  226.   didit=sysmkdir2(destdir,1)
  227.   if didit<>0 then do
  228.      say "Could not access, or create, "destdir
  229.      exit
  230.   end /* do */
  231. end
  232. else do
  233.    destdir=strip(strip(destdir),'t','\')'\'
  234.    didit=sysmkdir2(destdir,1)
  235.    if didit<>0 then do
  236.      say "Could not access, or create, "destdir
  237.      exit
  238.    end /* do */
  239. end
  240. destdir=strip(strip(destdir),'t','\')'\'
  241.  
  242. /* get and set includers variables */
  243. call get_includers
  244.  
  245. /* Quick/skeleton mode */
  246. getquick:nop
  247. if cmdline<>1 then do
  248.  do until write_all<>''
  249.    al=getstring(' HTML documents only (Yes, No, or ? for help)','N',reverse'  4)'normal)
  250.    al=strip(translate(al))
  251.    if al='?' then do
  252.      al=''
  253.      call help_writeall
  254.      iterate
  255.    end
  256.    if abbrev(al,'N')=1 then
  257.       write_all=1
  258.    else
  259.      write_all=0
  260.  end
  261.  if write_all=0 then
  262.   call printsay "Ignoring non-html documents"
  263.  else
  264.   call printsay "Retrieving all links "
  265.  say
  266.  
  267. /* modify other parameters */
  268. if write_all0='' then do
  269.   if yesno(" Would you like to modify configuration parameters?")=1 then do
  270.      call modify_config
  271.   end /* do */
  272. end
  273.  
  274. end
  275.  
  276.  
  277. /************** Done with user input **********/
  278.  
  279.  
  280.  
  281. /*******  copy file/url to destdir */
  282. /* if local file, copy directly to destidr
  283.    if url, then maybe copy relative to destdir 
  284. */
  285.  
  286. if afile_isurl=0 then do    /* local file  -- jump start*/
  287.   ff=translate(afile,' ','\/')
  288.   ff2=word(ff,words(ff))
  289.   ff2=destdir||ff2
  290.   say bold"Saving to "normal|| ff2
  291.   foo=translate(stream(ff2,'c','open write'))
  292.   if foo<>'READY:' then do
  293.      say "Could not open file for writing. Error was: " foo
  294.      exit
  295.   end /* do */
  296.   foo=charout(ff2,stuff,1)
  297.   if foo<>0 then do
  298.       say "Error. Problem writing file "
  299.       exit
  300.   end /* do */
  301.   foo=stream(ff2,'c','close')
  302.  
  303.   goo=time('e')                /* get stuff from file */
  304.   foo=urls_in(stuff,baseurl,rootdir,afile)
  305.   goo2=time('e')
  306.   if verbose>0 then do
  307.     if goo2-goo>5 then call printsay "  ... done parsing "||cutstrg(afile,50)
  308.     call printsay  ' '
  309.     call printsay "    " cy_ye " # links in "normal||bold||afile"="normal||"  "||fileurls.0
  310.   end
  311.   nparsed=1
  312.  
  313. end
  314. else do                 /* a url */
  315.    iurls=1
  316.    uaref=translate(strip(afile))
  317.    flist.uaref=1
  318.    flist.0=1
  319.    fileurls.iurls=afile
  320.    fileurls.iurls.!ref='user'
  321.    fileurls.0=iurls
  322. end /* do */
  323.  
  324. /**** get a robot.txt file first? */
  325. if robot_check=1 then do
  326.    aurl=baseurl'/robots.txt'
  327.    rlist=get_url(aurl)
  328.    exclist=add_robot(rlist)
  329.    if verbose>0 then do
  330.        call printsay "Excluding: "exclist ;  call printsay ' '
  331.    end 
  332.    exclist.0=0
  333.    if exclist<>'' then do
  334.        do ii=1 to words(exclist)
  335.           exclist.ii=translate(strip(word(exclist,ii)))
  336.        end /* do */
  337.        exclist.0=words(exclist) 
  338.    end /* do */
  339. end                     /* build exclist. */
  340.  
  341.  
  342. /************ Get urls in first file/url */
  343. call printsay ' '
  344. if write_all=0 then
  345.   call printsay ' Examining html links starting from:'||bold||afile||normal
  346. else
  347.   call printsay ' Examining links starting from:'||bold||afile||normal
  348. call printsay ' '
  349.  
  350.  
  351.  
  352. /********** now get the urls, parse, add to list.... */
  353. mm=0
  354. do forever
  355.    mm=mm+1
  356.    if mm>fileurls.0 then leave
  357.  
  358.    goob=fileurls.mm
  359.  
  360.    goob2=translate(goob)
  361.    parse var goob . '://' bb1 '/' asel
  362.    baseurl=bb1
  363.    ii=lastpos('/',asel)
  364.    if ii=0 then 
  365.       rootdir='/'
  366.    else
  367.       rootdir=left(asel,ii)
  368.    if pos('://',baseurl)=0 then baseurl='http://'||baseurl
  369.    rootdir=strip(rootdir)
  370.    if rootdir<>'/' then rootdir='/'||strip(rootdir,,'/')||'/'
  371.    baseurl=strip(strip(baseurl,'t','/'))
  372.  
  373.    if robot_no(asel)=1 then iterate   /* robot excluded */
  374.  
  375.    if includer2<>"" then do          /* only GET if in/under this directory */
  376.      if abbrev(goob2,includer2)=0 then iterate 
  377.    end
  378.  
  379.    if nocgi=1 then do           /* cgi? then skip */
  380.       if pos('/CGI',asel)=1 then iterate
  381.    end
  382.  
  383.    if nosearch=1 then do                /* skip "search string" calls (usually to scripts*/
  384.       if pos('?',asel)>0 then iterate
  385.    end /* do */
  386.  
  387.    if skip_prefix<>'' then do   /* ignore if starts with this? */
  388.       if abbrev(asel,skip_prefix)=1 then iterate
  389.    end /* do */
  390.  
  391.    ara=lastpos('.',asel);anext=''
  392.    if ara>0 then do                   /* check for html type of extentsion*/
  393.        anext=translate(strip(substr(asel,ara+1)))
  394.    end
  395.    if htmlexts<>'' & write_all<>1 then do   /* only get possible htmls */
  396.  
  397.        if pos(anext,htmlexts)=0 then iterate
  398.    end
  399.    if not_htmlexts<>"" & write_all<>1 then do  /* don't get almost certainly NOT htmls */
  400.        if pos(anext,not_htmlexts)>0 then iterate
  401.    end /* do */
  402.  
  403.    f1f=goob
  404.    if length(f1f)>40 then f1f='...'right(goob,36)
  405.    oof=''
  406.    if verbose>0 then oof=']--'||filespec('n',fileurls.mm.!ref)
  407.  
  408.    if verbose>-1 then call printsay "Checking "bold||mm||normal||" of "fileurls.0")"||f1f||oof
  409.  
  410. /* get the url */
  411.    goo=time('e')
  412.    stuff=get_url(goob,,verbose,reqheaders)
  413.    goo2=time('e')
  414.    if goo2-goo>5 & verbose>0 then call printsay "  .... done GETting "||cutstrg(goob,50)
  415.  
  416.    if stuff="" then do
  417.       noconnects=noconnects+1
  418.       iterate
  419.    end /* do */
  420.  
  421.    ngets=ngets+1
  422.    call extracts                /* extract body and head */
  423. /* look for return code */
  424.    parse var response_line . icode .
  425.    
  426.    r1=left(response_code,1)
  427.    if r1=4 | r1=5 | r1=1  then do              /* error response */
  428.       n400s=n400s+1
  429.       iterate
  430.    end /* do */
  431.  
  432.    
  433. /* get the content-type */
  434.    ss='!CONTENT-TYPE'
  435.    if translate(headers.ss)<>'TEXT/HTML' then do  /* not html -- don't parse */
  436.      if write_all=1 then call url_to_file goob  /* but possibly save to disk */
  437.      iterate /* don't bother parsing this */
  438.    end
  439.  
  440. /* does it satisfy the INCLUDER test? */
  441.    if includer<>"" then do          
  442.      if abbrev(goob2,includer)=0 then do
  443.         call url_to_file goob
  444.         iterate /* don't bother parsing this */
  445.      end /* do */
  446.    end
  447.  
  448. /* extract links, but first write it to disk */
  449.    call url_to_file goob
  450.    if result=0 then iterate
  451.  
  452. /* if here, extract urls and add to list */
  453.    eek=fileurls.0
  454.    goo=time('e')
  455.    if verbose>0 then call printsay "  .... parsing "||cutstrg(goob,50)
  456.  
  457.    if r1=3 then do      /* redirect -- extract location header */
  458.      ss='!LOCATION'
  459.      asd=strip(headers.ss)
  460.      if asd<>'' then do
  461.         stuff=stuff||'<a href="'asd'"> '   /* convert location header to link (a small hack */
  462.      end /* do */
  463.    end /* do */
  464.  
  465.    foo=urls_in(stuff,baseurl,rootdir,goob)
  466.    goo2=time('e')
  467.    if goo2-goo>5 & verbose>0 then call printsay "   ... done parsing "||cutstrg(goob,50)
  468.  
  469.    nparsed=nparsed+1
  470.    if verbose>1 then do
  471.       if eek<fileurls.0 & verbose>0 then call printsay "  new links to check: "bold||(fileurls.0-eek)||normal
  472.    end
  473.  
  474. end  /* ******* Read a url */
  475.  
  476. /**** Status info */
  477. call printsay ' '
  478. call printsay ' ------- Status: '
  479. call printsay "Total number of unique URLs: "fileurls.0
  480. call printsay "Total number retrieval attempts: " ngets '(400s='n400s'. No Connect='noconnects')'
  481. call printsay "Total number of parsed pages: "nparsed
  482. call printsay "Total number of files written: " nwritten '(files deleted='ndeleted')'
  483. call printsay " "
  484. call printsay "Reminder: files are written to "bold||destdir||normal
  485. if logfile<>0 then do
  486.     say '                ** The log file is: ' logfile
  487.     call lineout logfile
  488. end
  489. exit
  490.  
  491.  
  492. /********/
  493. /* modify configuration parameters */
  494. modify_config:
  495.  
  496. params="def_tofile htmlexts logfile not_Htmlexts overwrite robot_check reqheaders "
  497. params=params||"reqheaders verbose nocgi nosearch remove_prefix skip_prefix"
  498.  
  499. params=translate(params)
  500. say
  501.  
  502. do forever
  503. aa=getstring("Select a parameter to modify (?=list,??=current values, X=done)","?",reverse" -->"normal)
  504. if aa="?" then do
  505.    say
  506.    say "       "reverse"Configuration Parameters: "normal
  507.    say bold"  DEF_TOFILE"normal"= default filename, used when a URL does not contain a filename"
  508.    say bold"    HTMLEXTS"normal"= HTML extensions (if quick mode selected, only files with these "
  509.    say "              extensions are retrieved)"
  510.    say bold"     LOGFILE"normal"= Name of logfile (results are recorded here)"
  511.    say bold"       NOCGI"normal"= If 1, do NOT retrieve URLs containing /CGI (cgi-bin scripts)"
  512.    say bold"    NOSEARCH"normal"= If 1, do NOT retrieve URLs that end with a ?xxxx "
  513.    say bold"NOT_HTMLEXTS"normal"= non-HTML extensions (if quick mode selected, files with these "
  514.    say "              extensions are ignored)"
  515.    say bold"   OVERWRITE"normal"= If 1, then overwrite preexisting files "
  516.    say bold"REMOVE_PREFIX"normal"= If the URL's path starts with this, then trim the   "
  517.    say     "              beginning of the path (remove everything up to the first /) "
  518.    say bold" SKIP_PREFIX"normal"= If the URL's path starts with this, then skip it "
  519.    say bold"     VERBOSE"normal"= If 1, verbose mode "
  520.    say
  521.  
  522.    iterate
  523. end /* do */
  524. if aa="??" then do
  525.    say
  526.    say "       "reverse"Current values of configuration Parameters: "normal
  527.    say bold"  DEF_TOFILE"normal"= "def_tofile
  528.    say bold"    HTMLEXTS"normal"= "htmlexts
  529.    say bold"     LOGFILE"normal"= "logfile
  530.    say bold"       NOCGI"normal"= "nocgi
  531.    say bold"    NOSEARCH"normal"= "nosearch
  532.    say bold"NOT_HTMLEXTS"normal"= "not_htmlexts
  533.    say bold"   OVERWRITE"normal"= "overwrite
  534.    say bold"REMOVE_PREFIX"normal"= "remove_Prefix
  535.    say bold"   REQHEADERS"normal"= "reqheaders
  536.    say bold"  ROBOT_CHECK"normal"= "robot_check
  537.    say bold" SKIP_PREFIX"normal"= "skip_prefix
  538.    say bold"     VERBOSE"normal"= "verbose
  539.    say
  540.    say "Note: you can permanently change these values by editing GRABSITE.CMD"
  541.    say
  542.    iterate
  543. end /* do */
  544. aa=translate(strip(aa))
  545. if aa='X' then leave
  546. if wordpos(aa,params)=0 then do
  547.    say "No such parameter: " aa
  548. end /* do */
  549. else do
  550.    aaold=value(aa)
  551.    bb=getstring("Enter new value for "aa,aaold,bold"    --->"normal)
  552.    foo=value(aa,bb)
  553. end
  554.    
  555.  
  556. end
  557.  
  558. return 0
  559.  
  560.  
  561.  
  562. /********/
  563. /* get and set includer and includers2 */
  564. get_includers:
  565.  
  566. include1: nop
  567. if includer='' then do
  568.   includer=getstring(" Only GET & examine & save urls in or under (? for help) ",rootdir,reverse' 3)'normal)
  569. end
  570. if includer="?" then do
  571.      call help_includer
  572.      includer=''
  573.      signal include1
  574. end /* do */
  575. includer=translate(includer)
  576.  
  577. include2: nop
  578. if includer2='' then do
  579.     includer2=getstring(" Only GET & save urls that being with ",includer,reverse' 3b)'normal)
  580. end
  581. if includer2="?" then do
  582.      call help_includer
  583.      includer2=''
  584.      signal include2
  585. end /* do */
  586. includer2=translate(includer2)
  587.  
  588. if includer='' then
  589.    includer=baseurl||rootdir
  590. else
  591.    includer=baseurl||'/'strip(includer,'l','/')
  592. say 
  593. call printsay "Only examining URLs in/under: "includer
  594.  
  595. if includer2='' then
  596.       includer2=baseurl||'/'
  597. else
  598.      includer2=baseurl||'/'strip(includer2,'l','/')
  599. call printsay "Only retrieving URLs in/under: "includer2
  600.  
  601. includer=translate(includer)
  602. includer2=translate(includer2)
  603. len_includer2=length(includer2)
  604. say 
  605. return 0
  606.  
  607.  
  608. /**************************************************/
  609. /* copy a url to a file */
  610. url_to_file:
  611.  
  612. parse arg afil
  613.  
  614. goob2=translate(afil)
  615. if includer2<>"" then do          /*relative to includer2 directory */
  616.      tofile=substr(goob2,len_includer2)
  617. end
  618. else do
  619.    parse var afil . '://' . '/' tofile
  620. end /* do */
  621. if tofile='' | right(tofile,1)='/' then tofile=tofile||def_tofile
  622.  
  623. /* save  to destidr */
  624. tofile=translate(tofile,'\','/')
  625. tofile=strip(strip(tofile),'l','\')
  626.  
  627. tofile2=destdir||tofile
  628. todir=filespec('d',tofile2)||filespec('p',tofile2)
  629. mkit=sysmkdir2(todir)
  630.    
  631. yow=stream(tofile2,'c','query exists')
  632. if yow<>'' then do
  633.    if overwrite=2 then do
  634.       if verbose>-1 then call printsay "  "||cy_ye||tofile2||normal " old version used."
  635.       return 1 /* use old copy */
  636.    end
  637.    if overwrite=1 then do
  638.             if verbose>0 then call printsay "  .... deleting "tofile2
  639.             foo=sysfiledelete(tofile2)
  640.             ndeleted=ndeleted+1
  641.    end /* do */
  642.    else do      
  643.          call printsay "  > "tofile2 " exists; "bold"skipping "normal
  644.          return 0
  645.    end /* do */
  646. end /* do */
  647.  
  648. foo=stream(tofile2,'c','open write')
  649. wow=charout(tofile2,stuff,1)
  650. if wow<>0 then do
  651.       call printsay "ERROR: could not write "tofile2
  652.       return 0
  653. end /* do */
  654. foo=stream(tofile2,'c','close')
  655. if foo="READY:" then do
  656.       if verbose>-2 then call printsay "  "||cy_ye||tofile2||normal " written."
  657. end /* do */
  658.  
  659.  
  660. nwritten=nwritten+1
  661. return 1                /* sets globals */
  662.  
  663.  
  664. /********************/
  665. /* search a file, find IMG SRC= and A HREF= urls. Add BASEURL if
  666.    no / or http://.../ at beginning of URL */
  667.  
  668. urls_in:procedure expose  fileurls. flist. remove_prefix bold normal logfile reverse cy_ye
  669.  
  670. parse arg stuff, baseurl,rootdir,stuffname
  671.  
  672. /* remove comments */
  673. body=""
  674. do forever              /*no comments within comments are allowed */
  675.    if stuff="" then leave
  676.    parse var stuff t1 '<!-- ' t2 '-->' stuff
  677.    body=body||t1
  678. end /* do */
  679. stuff=body
  680. body=''
  681.  
  682. if verbose=1 then call printsay "Parsing "||length(stuff)||' characters'
  683. /* find all IMG SRC= and A HREF=, FRAME= throw away internal links */
  684. do until stuff=""
  685.     parse var stuff . '<' anarg '>' stuff
  686.     aref=afindsrc(anarg)
  687.  
  688.     if aref='' then iterate
  689.     uaref=translate(aref)
  690.     if abbrev(uaref,'MAILTO:')=1  then iterate  /* only keep https */
  691.     if abbrev(uaref,'FTP:')=1  then iterate
  692.     if abbrev(uaref,'GOPHER:')=1  then iterate
  693.  
  694. /* fix up name to be fully qualified url */
  695.      select
  696.           when  abbrev(translate(aref),'HTTP://')=1 then nop
  697.           when abbrev(aref,'/')=1  then aref=baseurl||aref
  698.           otherwise aref=baseurl||rootdir||aref
  699.      end
  700.  
  701. /* check for remove_prefix entries */
  702.      if remove_prefix<>'' then do
  703.               parse var aref a1 '://' a2 '/' aaurl
  704.               if abbrev(translate(aaurl),translate(remove_prefix))=1 then do
  705.                     parse var aaurl  . '/' aaurl
  706.                     aref=a1'://'a2'/'aaurl
  707.                     if verbose=1 then call printsay "   > " remove_prefix "removal yields: "aref
  708.               end /* do */
  709.      end /* do */
  710.  
  711. /* record this entry only if not yet recorded -- else, just increment counter */
  712.      uaref=translate(aref)
  713.      if datatype(flist.uaref)<>'NUM' then flist.uaref=0
  714.      flist.uaref=1+flist.uaref
  715.      flist.0=flist.0+1
  716.      if flist.uaref=1 then do
  717.         iurls=fileurls.0+1
  718.         fileurls.iurls=aref
  719.         fileurls.iurls.!ref=stuffname
  720.         fileurls.0=iurls
  721.      end
  722. end /* do */
  723.  
  724. return iurls
  725.  
  726.  
  727. /*****************/
  728. /* get a string from user */
  729. getstring:procedure expose normal bold reverse logfile cy_ye
  730. parse arg prompt,def,prompt0
  731. abold=bold
  732. if bold="BOLD" then abold=''
  733. anormal=normal
  734. if normal='NORMAL' then anormal=''
  735.  
  736. l1=length(prompt)
  737. l2=length(def)
  738. if l1+l2>38 then do
  739.    say prompt0' 'abold||prompt||anormal
  740.    if l2>22 then do
  741.      say '      (ENTER='abold||def||normal')'
  742.      call charout, bold"     ? "normal
  743.      parse pull ans
  744.    end /* do */
  745.    else do
  746.      call charout,'      (ENTER='abold||def||anormal')? '
  747.      parse pull ans
  748.    end
  749. end
  750. else do
  751.   call charout,prompt0' 'bold||prompt||normal' (ENTER='abold||def||anormal')? '
  752.   parse pull ans
  753. end
  754. if ans='' then ans=def
  755. return ans
  756.  
  757.  
  758.  
  759. /* ---------------------------------------------*/
  760. /* get a url from some site, return first
  761. maxchar characters (if maxchar missing, get 10million (the whole thing?)
  762.   call as:   stuff=get_url(aurl,maxchar,verbose,headers)
  763. where:
  764.   aurl: the url to GET (required)
  765. the other 3 are optional:
  766.   maxchar: max chars to get (default=10,000,000)
  767.   verbose: verbose mode (default=OFF)
  768.   headers: list of extra request headers, CRLF delimited 
  769. */
  770. /* ---------------------------------------------*/
  771.  
  772.  
  773.  
  774. get_url:procedure expose logfile bold normal reverse cy_ye
  775. parse arg aurl,maxchar,verbose,headers
  776.  
  777. if maxchar="" then maxchar=10000000
  778.  
  779. got=""
  780. if abbrev(translate(aurl),'HTTP://')=0 then do
  781.   if verbose>0 then call printsay "Error: URL not properly specified (it must begin with HTTP://)"
  782.   return ''
  783. end
  784.  
  785. parse var aurl . '://' server '/' request
  786.  
  787. if VERBOSE>1 then call printsay "  GETting http url : " server ", " request
  788.  
  789. /* now get the url.  This requires the RxSock.DLL be in your LIBPATH. */
  790.  
  791. /* Load RxSock */
  792.     if \RxFuncQuery("SockLoadFuncs") then nop
  793.     else do
  794.        call RxFuncAdd "SockLoadFuncs","rxSock","SockLoadFuncs"
  795.        call SockLoadFuncs
  796.     end
  797.  
  798.     crlf    ='0d0a'x                        /* constants */
  799.     family  ='AF_INET'
  800.     httpport=80
  801.  
  802.     rc=sockgethostbyname(server, "serv.0")  /* get dotaddress of server */
  803.     if rc=0 then do
  804.         call printsay '    Unable to resolve "'server'"'
  805.         return 0
  806.     end
  807.     dotserver=serv.0addr                    /* .. */
  808.     gosaddr.0family=family                  /* set up address */
  809.     gosaddr.0port  =httpport
  810.     gosaddr.0addr  =dotserver
  811.  
  812.     gosock = SockSocket(family, "SOCK_STREAM", "IPPROTO_TCP")
  813.  
  814.     /* Set up request  */
  815.     message="GET /"request' HTTP/1.0 'crlf||'Host: 'server||crlf
  816.     if length(headers)>2 then do
  817.        if right(headers,2)=crlf then headers=left(headers,length(headers)-2)
  818.     end
  819.     if headers<>'' then message=message||headers||crlf
  820.     message=message||crlf
  821.  
  822.     got=''
  823.     rc = SockConnect(gosock,"gosaddr.0")
  824.     if rc<0 then do
  825.         call printsay '     Unable to connect to "'server'"'
  826.         return 0
  827.     end
  828.     rc = SockSend(gosock, message)
  829.  
  830.  /* Now wait for the response */
  831.  
  832.    do r=1 by 1
  833.      rc = SockRecv(gosock, "response", 1000)
  834.      got=got||response
  835.      if rc<=0 then leave
  836.      tmplen=length(got)
  837.      if tmplen> maxchar then leave
  838.   end r
  839.  
  840.   rc = SockClose(gosock)
  841.  
  842. return got
  843.  
  844.  
  845.  
  846.  
  847. /* --- Load the function library, if necessary --- */
  848. loaddll:
  849.  
  850. if RxFuncQuery("SockLoadFuncs")=1 then do      /* already there */
  851.   call RxFuncAdd "SockLoadFuncs","rxSock","SockLoadFuncs"
  852.   call SockLoadFuncs
  853. end
  854.  
  855. foo=rxfuncquery('sysloadfuncs')
  856. if foo=1 then do
  857.   call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
  858.   call SysLoadFuncs
  859. end
  860.  
  861. /****
  862. foo=rxfuncquery('rexxlibregister')
  863. if foo=1 then do
  864.  call rxfuncadd 'rexxlibregister','rexxlib', 'rexxlibregister'
  865.  call rexxlibregister
  866. end
  867. foo=rxfuncquery('rexxlibregister')
  868. if foo=1 then do
  869.     say " Could not find REXXLIB "
  870.     exit
  871. end 
  872. ***/
  873.  
  874. ansion=checkansi()
  875. if ansion=1 then do
  876.   aesc='1B'x
  877.   cy_ye=aesc||'[37;46;m'
  878.   normal=aesc||'[0;m'
  879.   bold=aesc||'[1;m'
  880.   re_wh=aesc||'[31;47;m'
  881.   reverse=aesc||'[7;m'
  882. end
  883. else do
  884.   say " Warning: Could not detect ANSI....  output will look ugly ! "
  885.   cy_ye="" ; normal="" ; bold="" ;re_wh="" ;
  886.   reverse=""
  887. end  /* Do */
  888.  
  889. return 1
  890.  
  891. /* -------------------- */
  892. /* get a yes or no , return 1 if yes */
  893. yesno:procedure expose normal reverse bold logfile cy_ye
  894. parse arg fooa , allopt,altans
  895. if altans<>" " & words(altans)>1 then do
  896.    w1=strip(word(altans,1))
  897.    w2=strip(word(altans,2))
  898.    a1=left(w1,1) ; a2=left(w2,1)
  899.    a1a=substr(w1,2) ; a2a=substr(w2,2)
  900. end
  901. else do
  902.     a1='Y' ; a1a='es'
  903.     a2='N' ; a2a='o'
  904. end  /* Do */
  905. ayn='  '||bold||a1||normal||a1a||'\'||bold||a2||normal||a2a
  906. if allopt=1 then  ayn=ayn||'\'||bold||'A'||normal||'ll'
  907.  
  908. do forever
  909.  foo1=normal||reverse||fooa||normal||ayn
  910.  call charout,  foo1 normal ':'
  911.  pull anans
  912.  if abbrev(anans,a1)=1 then return 1
  913.  if abbrev(anans,a2)=1 then return 0
  914.  if allopt=1 & abbrev(anans,'A')=1 then return 2
  915. end
  916.  
  917. nocon:
  918. if rc=-7 then return 0
  919. exit 0
  920.  
  921.  
  922.  /* ------------------------------------------------------------------ */
  923.  /* function: Check if ANSI is activated                               */
  924.  CheckAnsi: PROCEDURE
  925.    thisRC = -1
  926.  
  927.    trace off
  928.                          /* install a local error handler              */
  929.    SIGNAL ON ERROR Name InitAnsiEnd
  930.  
  931.    "@ANSI 2>NUL | rxqueue 2>NUL"
  932.  
  933.    thisRC = 0
  934.  
  935.    do while queued() <> 0
  936.      queueLine = lineIN( "QUEUE:" )
  937.      if pos( " on.", queueLine ) <> 0 | ,                       /* USA */
  938.         pos( " (ON).", queueLine ) <> 0 then                    /* GER */
  939.        thisRC = 1
  940.    end /* do while queued() <> 0 */
  941.  
  942.  InitAnsiEnd:
  943.  signal off error
  944.  RETURN thisRC
  945.  
  946. /*************************/
  947. /* return 1 if adir is an existing (possibly empty) directory , 0 if not */
  948. dosisdir2:procedure 
  949. parse arg adir
  950.  
  951. adir=strip(adir)
  952. adir=strip(adir,'t','\')
  953. nowdir=directory()
  954. nowdrive=filespec('d',nowdir'\')
  955. nowpath=filespec('p',nowdir'\')
  956. adr=filespec('d',adir)
  957. if adr='' then do
  958.    if abbrev(adir,'\')=0 then 
  959.        adir=nowdrive||nowpath||adir
  960.    else
  961.        adir=nowdrive||adir
  962. end /* do */
  963.  
  964. foo=sysfiletree(adir,goo,'D')
  965. if  goo.0>0  then return 1
  966. return 0
  967.  
  968.  
  969.  
  970. /*************************************/
  971. /* parse GETten stuff to globals
  972.   response_line = the response line  */
  973.   response_code = the 200, 401, etc. code
  974.   headers. = list of response headers
  975.   stuff = the contents (the file)
  976. */
  977. extracts:
  978. cr='0a'x
  979. parse var stuff response_line (cr) stuff
  980. parse var response_line . response_code .
  981. response_line=strip(response_line,,'0d'x)
  982.   headers.0=''
  983.   do forever
  984.     parse var stuff  ahead  (cr) stuff
  985.     ahead=strip(ahead,,'0d'x)
  986.     if ahead='' then leave
  987.     parse var ahead name ':' aval
  988.     nn=translate('!'||name)
  989.     headers.0=headers.0' 'nn
  990.     headers.nn=aval
  991.   end /* do */
  992.  
  993. /* remove html comments */
  994. return 1
  995.  
  996.  
  997. /* ------------- */
  998. /* create a directory, arbitrarily deep.
  999. Returns 0 if succes, otherwise returns an error code 
  1000. adir: directory to create -- must be fully qualified.
  1001. verbose: if 1, will write some status stuff to screen
  1002. */
  1003.  
  1004. sysmkdir2:procedure
  1005. parse arg adir,verbose
  1006.  
  1007. adir=strip(adir,'t','\')
  1008.  
  1009. if dosisdir2(adir)=1 then do  /* already exists */
  1010.    if verbose=1 then say "       Using pre-existing directory: "adir
  1011.    return 0
  1012. end /* do */
  1013.  
  1014. ff=sysmkdir(adir)
  1015. if ff=0 then return ff
  1016.  
  1017. /* make the tree */
  1018. f2=adir'\'
  1019. dd=filespec('d',f2)
  1020. pp=filespec('p',f2)
  1021. if pp='\' | pp='' then return -1
  1022.  
  1023. pp2=strip(translate(pp,' ','\'))
  1024.  
  1025. do mm=1 to words(pp2)
  1026.    a1=subword(pp2,1,mm)
  1027.    a1=translate(a1,'\',' ')
  1028.    dd2=dd'\'a1
  1029.    hoo=sysmkdir(dd2)
  1030.    if hoo=0 & verbose=1 then call printsay '     ... creating: 'dd2  
  1031. end /* do */
  1032.  
  1033. return hoo
  1034.  
  1035.  
  1036. /****************/
  1037. /* URL and DESTDIR help info */
  1038. helpme1:
  1039.  
  1040. say
  1041. say bold"GrabSite"normal" is designed to copy a WWW site to your local hard disk. "
  1042. say 
  1043. say "It's easy to use: just specify a URL, and then specify a directory"
  1044. say "on your hard drive to copy the web pages (and other files) retrieved"
  1045. say "from this WWW site."
  1046. say
  1047. say "For example: suppose the 'home page' is"
  1048. say "     http://www.coolstuff.org/games/expert.htm"
  1049. say "and the 'destination directory' is:"
  1050. say "     d:\localweb\game10 "
  1051. say "Then..."
  1052. say "  a) GrabSite will GET (using socket calls) the /games/expert.htm HTML "
  1053. say "     document at www.coolstuff.org."
  1054. say "  b) A copy of /games/expert.htm will be written to d:\localweb\games10 "
  1055. say "  c) /games/expert.htm  will be scanned for links "
  1056. say "  d) For each link found, repeat step a (changing names appropriately)"
  1057. say 
  1058. say "Note: For hints on running from command line, run GrabSite with a ? argument."
  1059. say"       Example: D:>GrabSite ? "
  1060. say 
  1061. call charout,reverse"Hit any key to continue "normal
  1062. foo=sysgetkey('noecho')
  1063. say
  1064. return 1
  1065.  
  1066. /****************/
  1067. /* INCLUDER help info */
  1068. help_Includer:
  1069. say 
  1070. say "You can, and should, limit the scope of "bold"GrabSite"normal"'s WWW downloads"
  1071. say "(If you don't, you could end up downloading a significant chunk of the WWW!)"
  1072. say
  1073. say "There are two tests used to limit scope: "
  1074. say
  1075. say " a) Limiting what URLS are "bold"downloaded"normal" and "bold"examined"normal"."
  1076. say "    URLS that pass this test are retrieved (and saved to disk). "
  1077. say "    If they are text/html documents they will also be 'parsed' --"
  1078. say "    the links found in these text/html documents may also be retrieved."
  1079. say
  1080. say " b) Limiting what URLS are "bold"downloaded"normal", but "bold"not"normal" examined."
  1081. say "    URLS that pass this less stringent test are downloaded (and saved to disk)."
  1082. say "    They are "bold"not"normal" parsed -- links they may contain are ignored."
  1083. say
  1084. say " By using two tests, one can:"
  1085. say "  i) 'Recursively GET'  URLS thar are in (or under) the directory "
  1086. say "     of the 'home page' you selected. "
  1087. say " ii) Download & save (but not examine) files pointed to by these pages. "
  1088. say "     For example, .GIF files stored on a different part of the site."
  1089. say
  1090. call charout,reverse"Hit any key to continue "normal
  1091. foo=sysgetkey('noecho')
  1092. say
  1093. return 1
  1094.  
  1095. /****************/
  1096. /* writeall help info */
  1097. help_writeall:
  1098. say 
  1099. say "You can either: "
  1100. say " a) Download all documents, images, etc. from the site (more precisely,"
  1101. say "     documents, etc. that satisfy the 'scope tests')"
  1102. say " b) Only download HTML documents "
  1103. say
  1104. say "The latter option is useful if you want a quick snapshot of the navigable"
  1105. say "portion of the site -- if you do not care about images, text files, and "
  1106. say "other such 'non-html' contents."
  1107. say
  1108. say "If you select this latter option, the following rule is used: "
  1109. if htmlexts<>'' then
  1110.   say "Only retrieve links ending with: "htmlexts
  1111. else
  1112.  say "Retrieve links that do NOT end with: "not_htmlexts
  1113. say
  1114. say cy_ye" Note: Configuration hint:"normal
  1115. say "  You can modify this rule by changing the HTMLEXTS and NOT_HTMLEXTS parameters"
  1116. say
  1117. call charout,reverse"Hit any key to continue "normal
  1118. foo=sysgetkey('noecho')
  1119. say
  1120. return 1
  1121.   
  1122.  
  1123. /***************/
  1124. /* cut length of string to nn characters, if necessary */
  1125. cutstrg:procedure
  1126. parse arg astr,ilen
  1127. if ilen='' then return astr
  1128.  
  1129. if length(astr)<ilen then return astr
  1130. aa=left(astr,14)'...'||right(astr,33)
  1131. return aa
  1132.  
  1133.  
  1134. /***************/
  1135. /* say, and possible lineout, output */
  1136. printsay:procedure expose logfile bold normal reverse cy_ye
  1137. parse arg aval
  1138.  
  1139. say aval
  1140.  
  1141. aval=removestrg(aval,bold)
  1142. aval=removestrg(aval,normal)
  1143. aval=removestrg(aval,reverse)
  1144. aval=removestrg(aval,cy_ye)
  1145. if logfile<>0 then call lineout logfile,aval
  1146. return 0
  1147.  
  1148. /***********************************/
  1149. /* search a file, find IMG SRC=, FRAME SRC=, and A HREF= urls. Add BASEURL if
  1150.    no / or http://.../ at beginning of URL 
  1151.    Return results in hrefs. and imgs. */
  1152.  
  1153. afindsrc:procedure
  1154.  
  1155. parse arg anarg
  1156. parse var anarg htype stuff
  1157.  
  1158. htype=translate(strip(htype))
  1159.  
  1160.  
  1161. /* find all  FRAME SRC=, IMG SRC= and A HREF=, throw away internal links */
  1162.  
  1163. chklist='BODY IMG A FRAME AREA EMBED LINK APPLET '
  1164. anctype=wordpos(htype,chklist)
  1165.  
  1166. if anctype=0 then return ''      /* not a url containing element */
  1167.  
  1168. /* depending on anctye, look for different things */
  1169. select 
  1170.    when anctype=1 then do           /* body background */
  1171.       do forever
  1172.          if anarg=''  then return ''            /* nothing found */
  1173.          parse var anarg a1 anarg ; a1=strip(a1)
  1174.          if abbrev(translate(a1),'BACKGROUND=')=0 then iterate
  1175.          parse var a1 . '=' gotimg . ; gotimg=strip(strip(gotimg),,'"')
  1176.          return gotimg
  1177.       end /* do */
  1178.    end                              /* i3>0 */
  1179.  
  1180.    when anctype=2 then do                /* img */
  1181.          do forever
  1182.             if anarg=''  then return ''
  1183.             parse var anarg a1 anarg ; a1=strip(a1)
  1184.             if abbrev(translate(a1),'SRC=')=0 then iterate
  1185.             parse var a1 . '=' gotimg . ; gotimg=strip(strip(gotimg),,'"')
  1186.             return gotimg
  1187.          end /* do */
  1188.    end
  1189.  
  1190.    when anctype=3 | anctype=5  | anctype=7 then do /* A AREA LINK */
  1191.          do forever
  1192.             if anarg=''  then leave
  1193.             parse var anarg a1 anarg ; a1=strip(a1)
  1194.             if abbrev(translate(a1),'HREF=')=0 then iterate
  1195.             parse var a1 . '=' gothref . ; gothref=strip(strip(gothref),,'"')
  1196.  
  1197.             parse var gothref gothref '#' .     /* toss out internal jumps */
  1198.             if gothref="" then return ""
  1199.             if abbrev(translate(gothref),'JAVASCRIPT:') then  return "" /* don't do "javascript:" entries */
  1200.  
  1201.             return gothref
  1202.  
  1203.          end /* do */
  1204.     end
  1205.  
  1206.     when anctype=4 | anctype=6 then do   /* FRAME EMBED */
  1207.          do forever
  1208.             if anarg=''  then leave
  1209.             parse var anarg a1 anarg ; a1=strip(a1)
  1210.             if abbrev(translate(a1),'SRC=')=0 then iterate
  1211.             parse var a1 . '=' gothref . ; gothref=strip(strip(gothref),,'"')
  1212.  
  1213.             parse var gothref gothref '#' .     /* toss out internal jumps */
  1214.             if gothref="" then return ""
  1215.             return gothref
  1216.          end /* do */
  1217.     end
  1218.  
  1219.    when anctype=8 then do   /* APPLET */
  1220.          abase=''; aref=''
  1221.          do forever
  1222.             if anarg=''  then leave
  1223.             parse var anarg a1 anarg ; a1=strip(a1)
  1224.             if abbrev(translate(a1),'CODE=') + ,
  1225.                abbrev(translate(a1),'CODEBASE=')=0 then iterate
  1226.                 
  1227.             if abbrev(translate(a1),'CODEBASE=')=1 then do
  1228.                     parse var a1 '"' abase '"' .
  1229.              end /* do */
  1230.              else do                  /* CODE */
  1231.                    parse var a1 '"' aref '"'
  1232.              end /* do */
  1233.              if aref<>'' & abase<>'' then leave
  1234.           end
  1235.           
  1236.           if aref='' then return ''      /* no CODE= found */
  1237.  
  1238.           if abase<>'' then   aref=strip(abase,'t','/')||'/'||strip(aref,'l','/')
  1239.           return aref
  1240.  
  1241.    end
  1242.  
  1243.         
  1244.    otherwise return ''
  1245. end                  /* select */
  1246. return ''
  1247.  
  1248.  
  1249. /***********/
  1250. /* remove substring */
  1251. removestrg:procedure
  1252. parse arg aval,astr
  1253.  
  1254. if pos(astr,aval)=0 then return aval
  1255.  
  1256. aa=''
  1257. do forever
  1258.    if aval='' then leave
  1259.    parse var aval a1 (astr) aval
  1260.    aa=aa||a1
  1261. end
  1262. return aa
  1263.  
  1264. /**************/
  1265.  
  1266. /******************************/
  1267. /* parse a robots.txt file, 
  1268. The algorithim:
  1269. 1 ignore # lines (comments)
  1270. 2a look for user-agent: grabsite lines
  1271. 2b if none, look for user-agent:*  lines
  1272. 3 if 2a or 2b don't match, then no robot disallows exist
  1273. 4 otherwise, from the look for disallow lines going starting from 
  1274.   the user-agent line, until the first empty line (use 0a as line delimiter,
  1275.   and throw away the 0d)
  1276. 5 add from each disallow: asel to exclusion_list
  1277.  
  1278. ---------------
  1279. # samples robots.txt -- will add cgi-* to exclusion_list
  1280.  
  1281. user-agent: mozilla
  1282. Disallow: /samples
  1283. Disallow: /stuff/
  1284.  
  1285. #user-agent: checklink
  1286. user-agent:gizmo
  1287. disallow:fes/
  1288.  
  1289. user-agent:*
  1290. disallow:cgi-
  1291.  
  1292. ---------------
  1293.  
  1294. */
  1295.  
  1296. add_robot:procedure expose verbose 
  1297. parse arg abody
  1298.  
  1299. parse var abody . icode .
  1300. if left(strip(icode),1)<>2 then return ''       /* not 200 code, so no disallows */
  1301.  
  1302. cr='0a'x
  1303.  
  1304. do forever              /* get rid of response header */
  1305.   if abody='' then return ''    /* nothing in body */
  1306.   parse var abody al1 (cr) abody
  1307.   al1=strip(al1,,'0d'x)
  1308.   if al1='' then leave  /* found empty line*/
  1309. end
  1310.  
  1311. nn=0
  1312. do forever
  1313.   if abody='' then leave
  1314.   parse var abody al1 (cr) abody
  1315.   al1=strip(al1,,'0d'x)
  1316.   if al1='#' then iterate
  1317.   parse var al1 al1a '#' .
  1318.   nn=nn+1
  1319.   lins.nn=al1a
  1320. end
  1321. if nn=0 then return '' /* no entries, return */
  1322.  
  1323. lins.0=nn
  1324.  
  1325. /* look for GRABSITE, or *,  user-agent */
  1326. iat=0
  1327. do mm=1 to lins.0
  1328.    al=strip(lins.mm)
  1329.    if abbrev(translate(al),'USER-AGENT')=0 then iterate
  1330.    parse var al . ':' dagent ; dagent=translate(strip(dagent))
  1331.    if abbrev(dagent,'CHECKLINK')=1 then do
  1332.        iat=mm
  1333.        leave
  1334.    end
  1335.    if dagent='*' then do
  1336.        iat=mm
  1337.    end /* do */
  1338. end /* do */
  1339.  
  1340. exlist2=''
  1341. if iat=0 then return ' ' /* no matching user-agent */
  1342. do mm=iat+1 to lins.0
  1343.   al=translate(strip(lins.mm))
  1344.   if al='' then leave   /* blank line signals end of "record" */
  1345.   if abbrev(al,'DISALLOW')<>1 then iterate
  1346.   parse var al  . ':' dasel ; dasel=strip(dasel)
  1347.   exlist2=exlist2||' '||strip(dasel,'l','/')
  1348. end /* do */
  1349.  
  1350. return exlist2
  1351.  
  1352.  
  1353.  
  1354. /*******************/
  1355. / compare arg against "robot" exclist. -- return 1 if a match */
  1356. robot_No:procedure expose exclist.
  1357. parse upper arg asel
  1358. asel=strip(asel,'l','/')
  1359.  
  1360. do mm=1 to exclist.0
  1361.    tt=exclist.mm
  1362.    if abbrev(asel,tt)=1 then return 1
  1363. end /* do */
  1364. return 0
  1365.