home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 35 Internet / 35-Internet.zip / chkurl16.zip / checkurl.cmd < prev    next >
OS/2 REXX Batch file  |  2000-03-20  |  33KB  |  1,145 lines
  1. /*
  2.  
  3.   CheckUrl, written by Francesco Cipriani
  4.   version 1.6 - March 20, 2000
  5.  
  6.   Parses a HTML page and checks if the urls it contains
  7.   are correct. More infos in the docs.
  8.  
  9.   You need to have two dll installed: RxSock and RxFtp.
  10.   (see http://village.flashnet.it/~rm03703/programs if
  11.    you don't have them)
  12.  
  13.   Syntax: CheckUrl <parameters>
  14.   parameters:
  15.    - "/html" : the page we are going to check is an html file
  16.    - "/mconn": we want to use multiple connections.
  17.    - "/source <html_page>": the page to analyze
  18.  
  19. */
  20.  
  21. /*signal on SYNTAX name SYNTAX */
  22. signal on halt
  23.  
  24. call RxfuncAdd "SysLoadFuncs","RexxUtil","SysLoadFuncs"
  25. call SysLoadFuncs
  26. loadattempt='FTP'
  27. call RxFuncAdd "FtpLoadFuncs","RxFtp","FtpLoadFuncs"
  28. call FtpLoadFuncs "skip"
  29. loadattempt='SOCK'
  30. call RxFuncAdd "SockLoadFuncs", "RxSock", "SockLoadFuncs"
  31. call SockLoadFuncs "skip"
  32. loadattempt=''
  33.  
  34. vars.!debug=0
  35. say 'CheckUrl 1.6'
  36. say
  37.  
  38. parse arg parms
  39. if parms='' then do
  40.     say "Syntax: CheckUrl <parameters>"
  41.     say
  42.     say "parameters:"
  43.     say "- /html : the page we are going to check contains html code"
  44.     say "- /mconn: we want to use multiple connections."
  45.     say "- /source <html_page>: the page to analyze (use \ instead of"
  46.     say "                       / when the page is and url)"
  47.     say "examples:"
  48.     say "checkurl /html /mconn /source http:\\www.netscape.com"
  49.     say "checkurl /html /mconn /source x:\mypath\my_file.html"
  50.     say "checkurl /mconn /source text_file.txt"
  51.     exit
  52. end
  53.  
  54. call read_cfg 'checkurl.cfg'
  55.  
  56. vars.!opt.!ishtml=0;
  57. vars.!opt.!testbug=0;
  58. vars.!opt.!imchild=0;
  59. vars.!opt.!imserver=0;
  60. wordnum = words(parms); i=1;
  61. do while (i < wordnum) 
  62.     thisword = word(parms, i);
  63.     thisUpperWord = translate(thisword);
  64.     select
  65.         when thisUpperWord = "/HTML" then
  66.             vars.!opt.!ishtml = 1
  67.         when thisUpperWord = "/TESTBUG" then
  68.             vars.!opt.!testbug = 1
  69.         when thisUpperWord = "/CHILD" then do
  70.             vars.!opt.!imchild = 1
  71.             vars.!conn.!name = word(parms, i + 1)
  72.             i = i + 1;
  73.         end
  74.         when thisUpperWord = "/SOURCE" then do
  75.             source = word(parms, i+1)
  76.             i = i + 1;
  77.         end
  78.         when thisUpperWord = "/MCONN" then
  79.             vars.!opt.!imserver=1
  80.         otherwise nop
  81.     end
  82.     i = i + 1;
  83. end
  84.  
  85. vars.!url.0=0
  86. crlf='0d0a'x
  87.  
  88.  
  89. if vars.!opt.!imchild = 1 then signal skip
  90. if pos("HTTP:", translate(source))<>0 then do
  91.     mode = "fetch";
  92.     url = normalize(source);
  93.     
  94.     res = "";
  95.     do while res <> "ok"
  96.         say "Fetching "url
  97.         res = checkHttp(url)
  98.         if res <> "ok" then do
  99.             if session.!errorCode = "301" | session.!errorCode = "302" then do
  100.                 url = session.!redirect;
  101.                 say "Page redirected to "session.!redirect" - Retrying"
  102.             end
  103.             else do
  104.                 say "Error while retrieving source page ("res")"
  105.                 exit 2
  106.             end
  107.         end
  108.     end
  109.     say "...done"
  110.     /* we have session.!content set with the content of the url passed */
  111.     call retrieve_html_urls session.!content, 'HREF=', url
  112. end
  113. else do
  114.     call apri_lettura source
  115.     if (vars.!opt.!ishtml) then do
  116.         text=charin(source,1,chars(source))
  117.         call retrieve_html_urls text, 'HREF=', ""
  118.     end
  119.     else do while lines(source)=1
  120.         line=linein(source)
  121.         if line<>"" & left(line,1)<>";" then call insert_url unescape(line)
  122.     end
  123.     call chiudi source
  124. end
  125.  
  126.  
  127. skip:
  128.     
  129. if vars.!opt.!imchild then call child_proc
  130. else do
  131.     say "0d0a"x||"Checking urls..."
  132.     call apri_scrittura vars.!files.!log
  133.  
  134.     /* if conn number > url to check then conn number=url to check */
  135.     if vars.!conn.!num>vars.!url.0 then vars.!conn.!num=vars.!url.0
  136.  
  137.     call time('R')
  138.     call time('E')
  139.  
  140.     if vars.!opt.!imserver then call server_proc
  141.     else
  142.     do i=1 to vars.!url.0
  143.         say 'Checking 'vars.!url.i" ("i" of "vars.!url.0")"
  144.  
  145.         ret=checkurl(vars.!url.i);try=1
  146.         do while try<vars.!maxtries & left(ret,5)='Error'
  147.             ret=checkurl(vars.!url.i);try=try+1
  148.         end
  149.         say ret||crlf
  150.         call list_insert vars.!url.i' 'ret, '!result'
  151.     end
  152.  
  153.     call makereport
  154.     call chiudi vars.!files.!log
  155. end
  156.  
  157. /* uncomment if no other program uses rxsock or rxftp
  158.  * call SockDropFuncs
  159.  * call FtpDropFuncs  
  160.  */
  161. exit
  162.  
  163.  
  164. /*
  165.  * Given a url passed from command line with \ substituting /
  166.  * translate \ into / and return the correct url
  167.  */
  168. normalize:
  169. procedure 
  170.     parse arg cmdlineUrl
  171.     url = translate(cmdlineUrl, "/", "\");
  172. return url
  173.     
  174.     
  175. read_cfg:
  176. procedure expose vars.
  177.     parse arg cfgfile
  178.  
  179.     vars.!files.!badurl=''                               /* defaults */
  180.     vars.!maxtries=1
  181.     vars.!email=''
  182.     vars.!opt.!logwarnings=0
  183.     vars.!opt.!logerrors=0
  184.     vars.!logfile='checkurl.log'
  185.     vars.!files.!htmllog='report.html'
  186.     vars.!internalport=1932
  187.     vars.!socket.!timeout=60
  188.     vars.!conn.!num=5
  189.  
  190.     call apri_lettura cfgfile
  191.     do while lines(cfgfile)=1
  192.         line=linein(cfgfile)
  193.     if left(line,1)=';' | line='' then iterate
  194.     else do
  195.         parse var line keyword'='val
  196.         keyword=translate(keyword)
  197.         val=strip(val)
  198.         select
  199.         when keyword='EMAIL' then vars.!email=val
  200.                 when keyword='LOGERRORS' then do
  201.                     if val='yes' then vars.!opt.!logerrors=1
  202.                     else vars.!opt.!logerrors=0
  203.                 end
  204.                 when keyword='LOGWARNINGS' then do
  205.                     if val='yes' then vars.!opt.!logwarnings=1
  206.                     else vars.!opt.!logwarnings=0
  207.                 end
  208.                 when keyword='LOGFILE' then vars.!files.!log=val
  209.                 when keyword='HTMLLOGFILE' then vars.!files.!htmllog=val
  210.                 when keyword='CONNECTIONS' then vars.!conn.!num=val
  211.                 when keyword='TIMEOUT' then vars.!socket.!timeout=val
  212.                 when keyword='INTERNALPORT' then vars.!internalport=val
  213.                 when keyword='BADURLFILE' then vars.!files.!badurl=val
  214.                 when keyword='MAXTRIES' then vars.!maxtries=val
  215.                 otherwise nop
  216.             end
  217.         end
  218.     end
  219.     call chiudi cfgfile
  220. return
  221.     
  222.     
  223. makereport:
  224. procedure expose vars.
  225.  
  226.  /* do nothing if no result available */
  227.     if datatype(vars.!result.0)='NUM' then do
  228.         if vars.!result.0=0 then return
  229.     end
  230.     else return
  231.  
  232.     crlf='0d0a'x
  233.     htmlfile=vars.!files.!htmllog
  234.  
  235.     writebadurl=vars.!files.!badurl<>''                       /* write bad urls? */
  236.     if writebadurl then do
  237.         call sysfiledelete vars.!files.!badurl
  238.         call apri_scrittura vars.!files.!badurl
  239.     end
  240.     call sysfiledelete htmlfile;call apri_scrittura htmlfile
  241.  
  242.     call lineout htmlfile, '<HTML><BODY><TABLE>'
  243.  
  244.     do i=1 to vars.!result.0
  245.         parse var vars.!result.i url status
  246.         logmessage=url' 'status||crlf
  247.         select
  248.             when left(status, 7)='Warning' then do
  249.                 if vars.!opt.!logwarnings=1 then do
  250.                     parse var status . err
  251.                     call lineout htmlfile, '<TR><TD WIDTH=3% BGCOLOR="Orange">Warning</TD><TD>'
  252.                     call lineout htmlfile, '<A HREF='url'>'url'</A><BR>'err
  253.                     call lineout htmlfile, '</TD></TR>'
  254.                     call logga logmessage
  255.                 end
  256.             end
  257.             when left(status,5)='Error' then do
  258.                 if writebadurl then call lineout vars.!files.!badurl, url
  259.                 if vars.!opt.!logerrors=1 then do
  260.                     parse var status . err
  261.                     call lineout htmlfile, '<TR><TD WIDTH=3% BGCOLOR="Red">Error</TD><TD>'
  262.                     call lineout htmlfile, '<A HREF='url'>'url'</A><BR>'err
  263.                     call lineout htmlfile, '</TD></TR>'
  264.                     call logga logmessage
  265.                 end
  266.             end
  267.             otherwise nop
  268.         end
  269.     end
  270.  
  271.     if vars.!debug then
  272.         call logga 'Checked 'vars.!url.0 'urls in 'time('E') 'seconds'
  273.  
  274.     call lineout htmlfile, '</TABLE></BODY></HTML>'
  275.     call chiudi htmlfile
  276.     if writebadurl then
  277.         call chiudi vars.!files.!badurl
  278. return
  279.  
  280.     
  281.     
  282.     
  283. /* Read urls from html file - called with HREF string to be looked for */
  284. retrieve_html_urls:
  285. procedure expose vars.
  286.     parse arg text, what, currentUrl
  287.     
  288.     baseUrl = baseUrl(currentUrl)
  289.     
  290.     /* slash to be added when subdirs found */
  291.     if right(currentUrl, 1) = '/'
  292.     then slash = ""
  293.     else slash = "/"
  294.  
  295.     text=stripchar('0d'x,text)
  296.     text=stripchar('0a'x,text)
  297.     utext=translate(text)
  298.     spos=1;
  299.     do while pos(what,utext,spos)>0
  300.         str='';wtl=length(what)
  301.         x=pos(what,utext,spos)
  302.         if x>1 then prev=substr(text,x-1,1)
  303.         else prev=' '
  304.         if prev=' ' | prev='0a'x | prev='0d'x then do
  305.             nextch = substr(text, x+wtl, 1)
  306.             if nextch = '"' | nextch = "'" then x=x+1
  307.             
  308.             fine = 0;
  309.             
  310.             fine1 = pos('>', text, x+wtl);
  311.             if fine1 <> 0 then fine = fine1
  312.             
  313.             fine2 = pos('"', text, x+wtl);
  314.             if fine2 <> 0 & fine2 < fine then fine = fine2
  315.  
  316.             fine3 = pos("'", text, x+wtl);
  317.             if fine3 <> 0 & fine3 < fine then fine = fine3
  318.             
  319.             if fine = 0 then str=substr(text, x+wtl)
  320.             else str = substr(text, x+wtl, fine-x-wtl)
  321.             
  322.             str=strip(str,,'=')
  323.             str=strip(str,,')')
  324.             str=strip(str,,'(')
  325.             str=strip(str,,',')
  326.             str=strip(str,,'"')
  327.             str=strip(str,,' ')
  328.             str=strip(str,,"'")
  329.             str=strip(str,,'0a'x)
  330.             str=strip(str,,'0d'x)
  331.             
  332.             /* Check url not empty and 
  333.              * Support relative url only for online urls 
  334.              */
  335.             ustr=translate(str);
  336.             if str <> "" then do
  337.  
  338.                 okflag = 0;
  339.                 if currentUrl = "" then do
  340.                     if pos("HTTP://", ustr) = 1 then 
  341.                         okflag =1;
  342.                 end
  343.                 else do
  344.                     okflag = 1
  345.                 end
  346.                 
  347.                 if okflag then do
  348.                     upper_levels = count_occurrences('../', str)
  349.                     if upper_levels > 0 then do
  350.  
  351.                         tstring = currentUrl
  352.                         do i = 1 to upper_levels + 1
  353.                             tstring = url_up(tstring)
  354.                         end
  355.  
  356.                         /* Strip leading ../ */
  357.                         found = false; i= 1; len = length(str)
  358.                         do while found = false & i < len
  359.                             c = substr(str, i, 1)
  360.                             if c <> "." &  c <> "/" then
  361.                                 found = true
  362.                             else
  363.                                 i = i + 1;
  364.                         end
  365.  
  366.                         str = tstring'/'||right(str, len - i + 1);
  367.                     end
  368.  
  369.                     if pos('/', str) = 1 then
  370.                         str = baseUrl||str
  371.  
  372.                     ustr=translate(str);
  373.                     ok = 1;
  374.  
  375.                     if pos('JAVASCRIPT:', ustr) = 1,
  376.                     |  pos('GOPHER:',ustr) = 1,
  377.                     |  pos('MAILTO:',ustr) = 1,
  378.                     |  pos('NEWS:',ustr) = 1,
  379.                     |  pos('FTP:',ustr) = 1,
  380.                     |  pos('FILE://',ustr) = 1,
  381.                     |  pos('#',str)=1,
  382.                     then ok=0;
  383.  
  384.                     if ok then do
  385.                         if left(ustr, 4)='HTTP' then do
  386.                             str=filter_url(str)
  387.                             call insert_url unescape(str)
  388.                         end
  389.                         else do
  390.                             str = currentUrl||slash||str   /* subdirectory */
  391.                             str=filter_url(str)
  392.                             call insert_url unescape(str)
  393.                         end
  394.                     end
  395.  
  396.                     spos = x + length(str)
  397.  
  398.                 end /* if okflag */
  399.                 else do
  400.                     spos = spos + length(str)
  401.                 end
  402.  
  403.             end /* if str <> "" */
  404.             else do
  405.                 spos = spos + 1;
  406.             end
  407.  
  408.         end /* if .. */
  409.         else spos = spos+1;
  410.  
  411.     end /* do while */
  412. return
  413.  
  414.  
  415. insert_url:
  416. procedure expose vars.
  417.     parse arg url
  418.     if list_isinlist(url, '!url')=0 then do
  419.     call list_insert url, '!url'
  420.     end
  421.     else do
  422.     str='! Dupe: 'url
  423.     say str
  424.     call logga str
  425.     end
  426. return
  427.  
  428.  
  429. /* ------- LIST ROUTINES ---------- */
  430.  
  431. list_insert:
  432. procedure expose vars.
  433.     parse arg elem, stem
  434.     stem=value(stem)
  435.     if symbol('vars.'stem'.0')<>'VAR' then vars.stem.0=0
  436.     x=list_isinlist(elem,stem)
  437.     if x=0 then do
  438.     a=vars.stem.0+1
  439.     vars.stem.a=elem
  440.     vars.stem.0=a
  441.     end
  442. return
  443.  
  444. /* 0 -> not in list
  445.    n -> elem position */
  446. list_isinlist:
  447. procedure expose vars.
  448.     parse arg elem, stem
  449.     stem = value(stem)
  450.     do i = 1 to vars.stem.0
  451.         if elem = vars.stem.i then return i
  452.     end
  453. return 0
  454.  
  455. /* ------------ CHECK ROUTINES ----------------- */
  456.  
  457. /* Returns "ok" if all ok, or an error message ("Error:..")*/
  458. checkurl:
  459. procedure expose vars.
  460.     parse arg url
  461.     uurl=translate(url)
  462.     mode = "check" /* for checkhttp */
  463.     if pos('HTTP://',uurl)<>0 then do
  464.         err=checkhttp(url)
  465.     end
  466.     else if pos('FTP://',uurl)<>0 then err=checkftp(url)
  467.     else err='Bad Url - Only FTP and HTTP supported'
  468. return err
  469.  
  470. /* Check an FTP url */
  471. checkftp:
  472. procedure expose vars.
  473.     parse arg url
  474.     uurl=translate(url);err=''
  475.     parse var url .'://'site'/'rest
  476.     x=lastpos('/',rest)
  477.     dir=left(rest,x)
  478.     file=right(rest,length(rest)-x)
  479.     
  480.     rc = FtpSetUser(site, 'anonymous', vars.!email)
  481.     if rc=1 then do
  482.         rc = ftpchdir('/'dir)
  483.         err = 'Error: Url not found';
  484.         ufile = translate(file)
  485.         call FTPLs "-la "file, "files."
  486.  
  487.         do i = 1 to files.0
  488.             if pos(ufile, translate(files.i))<>0 then do
  489.                 err='Ok'
  490.                 leave;
  491.             end
  492.         end
  493.  
  494.         rc = ftpLogoff()
  495.     end
  496. return err
  497.  
  498.     
  499.     
  500. baseUrl:
  501. procedure
  502.     parse arg currentUrl
  503.     /* find the site domain */
  504.     x1 = pos("://", currentUrl);
  505.     if x1 <> 0 then x2 = pos("/", currentUrl, x1 + 3)
  506.     else x2 = 0;
  507.  
  508.     if x2 <> 0 then do
  509.         baseUrl = left(currentUrl, x2)
  510.     end
  511.     else baseUrl = currentUrl
  512.     /* strip trailing / */
  513.     if right(baseUrl, 1) = "/"  then 
  514.         baseUrl = left(baseUrl, length(baseUrl) - 1)
  515.  
  516. return baseUrl
  517.     
  518.     
  519. /*
  520.  * Check a HTTP url  
  521.  */
  522. checkhttp:
  523. procedure expose vars. mode session.
  524.     parse arg url
  525.     
  526.     /*
  527.      * initialization for "fetch" mode 
  528.      * In fetch mode this function fills the session. stem
  529.      * session.!content - the content of the url requested 
  530.      * session.!errorCode - the error code returned by the http server 
  531.      * session.!redirect - url we've been redirected to (available only
  532.      *                     if the server reported a redirection err code 
  533.      */
  534.     session.!content = ""
  535.     session.!errorCode = 0;
  536.     session.!redirect = ""
  537.         
  538.     url=filter_url(url)
  539.     parse value url with type'://'server'/'suburl
  540.     suburl=transl(suburl)
  541.     
  542.     baseUrl = "http://"server
  543.  
  544.     host.!dotted=get_dotted(server)
  545.     if host.!dotted='' then return "Error: Domain doesn't exist"
  546.  
  547.     sock = SockSocket('AF_INET', 'SOCK_STREAM', 'IPPROTO_TCP')
  548.     if (sock=-1) then do
  549.         return 'Error: cannot get a socket (fun SockSocket)'
  550.     end
  551.  
  552.     addr.!family='AF_INET'           
  553.     addr.!port = strip(host.!port)              /* retrieved by get_dotted */
  554.     addr.!addr = host.!dotted       
  555.  
  556.     rc = _SockConnect(sock, vars.!socket.!timeout)
  557.     if rc<>'ok' then do
  558.     call SockSoClose sock
  559.     return rc
  560.     end
  561.  
  562.     ret='';crlf='0d0a'x
  563.  
  564.     message = 'GET /'suburl' HTTP/1.0'crlf,
  565.     || 'User-Agent: CheckUrl/1.6'crlf,
  566.     || 'Host: 'server':'host.!port||crlf,
  567.     || 'Accept: */*'||crlf,
  568.     || crlf
  569.  
  570.     /* modes: fetch | check
  571.      * the mode variable is set from the calling function
  572.      * if mode = fetch session.!contente variable is filled with the 
  573.      * html page
  574.      */
  575.     if (mode = "check") then do
  576.         rc = SockSend(sock, message)
  577.         ret = sockin(sock, vars.!socket.!timeout, 1024, '##SockIn:')
  578.         if left(ret,9)='##SockIn:' then do
  579.             rc = SockSoClose(sock)
  580.             return 'Error: Timeout receiving data'
  581.         end
  582.     end
  583.     else do
  584.         rc = SockSend(sock, message)
  585.         ret = sockin(sock, vars.!socket.!timeout,, '##SockIn:')
  586.         session.!content = ret
  587.         if left(ret,9)='##SockIn:' then do
  588.             rc = SockSoClose(sock)
  589.             return 'Error: Timeout receiving data'
  590.         end
  591.     end
  592.  
  593.     rc = SockSoClose(sock)
  594.     sock=""
  595.  
  596.     ret=strip(ret)
  597.     
  598.     servercode=word(ret,2)
  599.     
  600.     parse var servercode servercode '0d'x .             /* further parsing */
  601.     parse var servercode servercode '0a'x .
  602.     session.!errorCode = servercode
  603.  
  604.     select
  605.     when ret='' then err='Error: Connection refused'
  606.         when translate(left(ret,6))='<HTML>' then err='ok' /* special handling for some bad site */
  607.         when servercode='200' then err='ok'
  608.     when servercode='400' then err='Error: Bad request'
  609.     when servercode='401' then err='Warning: Unuathorized'
  610.     when servercode='403' then err='Error: Forbidden'
  611.     when servercode='404' then err='Error: Url not found'
  612.     when servercode='301' | servercode='302' then do
  613.         if servercode='301' then err='Warning: Moved Permanently -> '
  614.         if servercode='302' then err='Warning: Moved Temporarily -> '
  615.         x=pos('Location: ', ret);loc=''
  616.         if x<>0 then do
  617.         parse value ret with .'Location: 'loc'0a'x
  618.                 loc=strip(loc,'T','0d'x)
  619.                 /*                if loc=url'/'  then return 'ok'*/ /* Just a slash to be added .. */
  620.                 if pos("/", loc) = 1 then do
  621.                     loc = baseurl||loc                  /* loc is /location */
  622.                 end
  623.  
  624.                 err=err||loc
  625.  
  626.                 session.!redirect = loc
  627.         end
  628.     end
  629.     otherwise do
  630.         err='Error: Unknown server return code'
  631.     end
  632.     end
  633.     
  634.     
  635.     /* 
  636.      * if there was an error, the page is not valid 
  637.      * otherwise, clean it from the server information
  638.      */
  639.     if mode = "fetch" & err = "ok" then do
  640.         session.!content = stripHeader(session.!content);
  641.     end
  642.  
  643. return err
  644.  
  645. /* Given a site name return its dotted rappresentation or the name itself
  646.    if it's already a dotted ip */
  647. get_dotted:
  648. procedure expose host. server.
  649.     parse arg servname
  650.     parse var servname hostname ':' host.!port
  651.     if host.!port='' then host.!port='80'
  652.     parse var hostname o1 '.' o2 '.' o3 '.' o4
  653.     if datatype(o1)='NUM' & datatype(o2)='NUM' & datatype(o3)='NUM' & datatype(o4)='NUM' then
  654.         if datatype(o1,'w')=1 & datatype(o2,'w')=1 & datatype(o3,'w')=1 & datatype(o4,'w')=1 then
  655.             if (o1>=0 & o1<=255) & (o2>=0 & o2<=255) & (o3>=0 & o3<=255) & (o4>=0 & o4<=255) then
  656.                 return hostname
  657.  
  658.     server.!family = 'AF_INET'
  659.     server.!port   = host.!port
  660.     server.!addr   = hostname
  661.     rc=sockgethostbyname(hostname,serv.!)
  662.     if rc=0 then return ''
  663. return serv.!addr
  664.  
  665. /* "Clean" url */
  666. filter_url:
  667. procedure
  668.     parse arg url
  669.     if pos('#',url)<>0 then parse var url url'#'.
  670. return url
  671.  
  672. transl:
  673. procedure
  674.     parse arg s
  675.     result='';
  676.     unsafe=' "<>#%{}~|\^[]`'
  677.     do i=1 to length(s)
  678.         car=substr(s,i,1)
  679.         code=c2d(car)
  680.         select
  681.             when code>=127 | code<=31 then result=result||'%'d2x(code)
  682.             when pos(car, unsafe)<>0 then result=result||'%'d2x(code)
  683.             otherwise result=result||car
  684.         end
  685.     end
  686. return result
  687.  
  688. /* ------------------------ */
  689.  
  690. logga:
  691. procedure expose vars.
  692.     parse arg str
  693.     rc=lineout(vars.!files.!log,str)
  694. return
  695.  
  696. child_proc:
  697. procedure expose vars.
  698.     url=''; try=1;
  699.     do while url<>'FINE'
  700.         if url='' then url=child_talkserver('GETURL 'vars.!conn.!name)
  701.  
  702.         if url<>'FINE' then do
  703.             result=checkurl(url);lasturl=url
  704.             stringa='RESULT 'vars.!conn.!name' 'try' 'url' 'result
  705.  
  706.             url=child_talkserver(stringa)
  707.             select
  708.                 when url=lasturl then try=try+1       /* times the url has been checked */
  709.                 when url='OK' then do; try=1; url=''; end;
  710.                 otherwise nop
  711.             end
  712.         end
  713.     end
  714. return
  715.  
  716. /* send a string and get another */
  717. child_talkserver:
  718. procedure expose vars.
  719.     parse arg stringtosend
  720.  
  721.     host.!dotted=get_dotted('localhost')
  722.     addr.!family='AF_INET'
  723.     addr.!port = vars.!internalport
  724.     addr.!addr = host.!dotted
  725.  
  726.     sock = SockSocket('AF_INET','SOCK_STREAM',0)
  727.     if (sock=-1) then do
  728.         say 'Error on SockSocket'
  729.         signal halt
  730.     end
  731.  
  732.     rc = SockConnect(sock, "addr.!")
  733.     if (rc=-1) then do
  734.         say 'Error on SockConnect'
  735.         signal halt
  736.     end
  737.  
  738.     rc = SockSend(sock, stringtosend)
  739.     if (rc=-1) then do
  740.         say 'Error on SockSend' errno
  741.         signal halt
  742.     end
  743.  
  744.     ret = sockin(sock, vars.!socket.!timeout, 1024, '##SockIn:')
  745.     if left(ret,9)='##SockIn:' then do
  746.         rc = SockSoClose(sock)
  747.         signal halt
  748.     end
  749.  
  750.     rc = SockSoClose(sock)
  751.     sock=""
  752.     if (rc=-1) then do
  753.         say 'Error on SockClose' errno
  754.         signal halt
  755.     end
  756. return ret
  757.  
  758.  
  759. server_proc:
  760.  procedure expose vars.
  761.  
  762.     s = SockSocket("AF_INET","SOCK_STREAM",0)
  763.     if s = -1 then do
  764.     say 'Error on SockSocket:' errno
  765.     signal halt
  766.     end
  767.  
  768.     server.!family = "AF_INET"
  769.     server.!port   = vars.!internalport
  770.     server.!addr   = "INADDR_ANY"
  771.  
  772.     if vars.!opt.!testbug=0 then
  773.     rc=SockSetSockOpt(s, "SOL_SOCKET", "SO_REUSEADDR", 1)
  774.  
  775.     rc = SockBind(s,"server.!")
  776.     if (rc = -1) then do
  777.     say 'Error on SockBind' errno
  778.     signal halt
  779.     end
  780.  
  781.     do i=1 to vars.!conn.!num
  782.     temp.!conn.!url.i = ''
  783.     temp.!conn.!try.i = 0
  784.     temp.!conn.!secs.i = 0
  785.     '@detach /c checkurl /child 'i
  786.     end
  787.  
  788.     i=1;threadfinished=0;
  789.     temp.!checkedurl=0                                    /* analyzed urls */
  790.  
  791.     do while threadfinished<vars.!conn.!num
  792.     rc = SockListen(s, vars.!conn.!num)
  793.     if (rc = -1) then do
  794.         say "Error on SockListen:" errno
  795.         signal halt
  796.     end
  797.  
  798.     ns = SockAccept(s, "client.!")
  799.     if (ns = -1) then do
  800.         say "Error on SockAccept:" errno
  801.         signal halt
  802.     end
  803.  
  804.     if vars.!debug then say "Accepted client:" client.!addr
  805.  
  806.     data=''
  807.     rc = sockrecv(ns, 'data', 1024)
  808.     if rc=-1 then do
  809.         rc = SockSoClose(s)
  810.         rc = SockSoClose(ns)
  811.         iterate
  812.     end
  813.  
  814.     select
  815.  
  816.         when left(data,6)='RESULT' then do
  817.         parse var data . threadname try url res
  818.         if (left(res,5)='Error') & (try<vars.!maxtries) then do
  819.             call _socksend ns, url
  820.             try=try+1                         /* child is tryingfor try+1 times now */
  821.         end
  822.         else do
  823.             call _socksend ns, 'OK'
  824.             call list_insert url' 'res, '!result'
  825.             call logga url' 'res
  826.             temp.!conn.!url.threadname=''
  827.             temp.!checkedurl=temp.!checkedurl+1
  828.             try=0
  829.         end
  830.         temp.!conn.!secs.threadname=trunc(time('E'))
  831.         temp.!conn.!try.threadname=try
  832.         call showthreads
  833.         end
  834.  
  835.         when left(data,6)='GETURL' then do
  836.         parse var data . threadname
  837.         if i>vars.!url.0 then do
  838.             call _socksend ns, 'FINE'
  839.             threadfinished=threadfinished+1
  840.             temp.!conn.!url.threadname='FINE'
  841.             call showthreads
  842.         end
  843.         else do
  844.             newdata=vars.!url.i;i=i+1
  845.             call _socksend ns, newdata
  846.             temp.!conn.!url.threadname=newdata
  847.             temp.!conn.!secs.threadname=trunc(time('E'))
  848.             temp.!conn.!try.threadname=1
  849.             call showthreads
  850.         end
  851.         end
  852.  
  853.         otherwise nop
  854.     end
  855.  
  856.     rc = SockSoClose(ns)
  857.     ns=""
  858.     if (rc = -1) then do
  859.         say "Error on SockSoClose:" errno
  860.         signal halt
  861.     end
  862.  
  863.     end /* do while */
  864.  
  865.     rc = SockSoClose(s)
  866.     s=""
  867.     if (rc=-1) then do
  868.     say "Error on SockSoClose:" errno
  869.     signal halt
  870.     end
  871. return
  872.     
  873.  
  874. showthreads:
  875.  procedure expose temp. vars.
  876.  curtime=trunc(time('E'))
  877.  call syscls
  878.  do i=1 to vars.!conn.!num
  879.   call syscurpos 2+(i-1)*2, 0
  880.   if temp.!conn.!url.i='FINE' then say 'Conn 'right(i,2) ': Finished'
  881.    else say 'C'right(i,2) '['temp.!conn.!try.i']' '('right(curtime-temp.!conn.!secs.i,2)')' temp.!conn.!url.i
  882.  end
  883.  parse value systextscreensize() with row col
  884.  bar=copies('■',col)
  885.  percent=(temp.!checkedurl/vars.!url.0)*100
  886.  call syscurpos 0, 0;say left(bar,trunc( length(bar)*(percent/100) ))
  887.  call syscurpos 1, 0;say 'C # Try Secs Url'
  888.  mex=temp.!checkedurl 'of' vars.!url.0
  889.  call syscurpos 0, trunc((col/2)-length(mex)/2); say mex
  890. return
  891.  
  892. _socksend:
  893.  procedure
  894.  parse arg socket, data
  895.  rc = SockSend(socket,data)
  896.  if (rc = -1) then do
  897.  say "Error on SockSend:" errno
  898.   signal halt
  899.  end
  900. return
  901.  
  902. /* Extended SockConnect - timeout support */
  903. _sockconnect:
  904.  procedure expose addr. vars. sock
  905.  parse arg socket, timeout
  906.  
  907.  call SockIoctl sock, 'FIONBIO', 1                    /* Non blocking mode */
  908.  
  909.  c=0;rc=-1;rcode=''
  910.  do while c<=timeout & rc=-1 & rcode=''
  911.   rc=SockConnect(sock, "addr.!")
  912.   if rc=-1 then
  913.    select
  914.     when errno = 'EINPROGRESS' |,
  915.          errno = 'EALREADY'      then do; call syssleep(1);c=c+1;iterate;end;
  916.     when errno = 'EADDRNOTAVAIL' then rcode='Error: No route to host'
  917.     when errno = 'EISCONN'       then rcode='ok'
  918.     when errno = 'ENOTSOCK'      then rcode='Error: Incorrect socket parameter'
  919.     when errno = 'ECONNREFUSED'  then rcode='Error: Connection refused'
  920.     when errno = 'EINTR'         then rcode='Error: Interrupted system call'
  921.     when errno = 'ENETUNREACH'   then rcode='Error: Network unreachable'
  922.     when errno = 'ETIMEDOUT'     then rcode='Error: Connection timed out'
  923.     when errno = 'ENOBUFS'       then rcode='Error: No buffer space available'
  924.     otherwise rcode="Error: couldn't connect" /* ? */
  925.    end
  926.  end
  927.  if rcode='' then do
  928.   if c>timeout then rcode='Error: Timeout connecting'
  929.    else rcode='Error: 'errno
  930.   end
  931.  
  932.  call SockIoctl sock, 'FIONBIO', 0
  933. return rcode
  934.     
  935.     
  936. apri_lettura:
  937. procedure
  938.     parse arg file
  939.     rc=stream(file,'c','open read')
  940.     if rc<>'READY: ' then do
  941.         say 'Error opening file "'file'" for reading'
  942.         exit
  943.     end
  944. return
  945.  
  946. apri_scrittura:
  947. procedure
  948.     parse arg file
  949.     rc=stream(file,'c','open write')
  950.     if rc<>'READY: ' then do
  951.         say 'Error opening file "'file'" for writing'
  952.         exit
  953.     end
  954. return
  955.  
  956. chiudi:
  957. procedure
  958.     parse arg file
  959.     rc=stream(file,'c','close')
  960.     if rc<>'READY: ' then do
  961.         say 'Error closing file "'file'"'
  962.         exit
  963.     end
  964. return
  965.  
  966. halt:
  967.     call makereport
  968.     rc=stream(vars.!files.!log,'c',close)
  969.     if datatype(sock,"W") then call SockSoClose(sock)
  970.     if datatype(socket,"W") then call SockSoClose(socket)
  971.     if datatype(ns,"W") then call SockSoClose(ns)
  972.     if datatype(s,"W") then call SockSoClose(s)
  973.     say 'Exiting'
  974.     exit
  975. return
  976.  
  977. SYNTAX:
  978.     select
  979.         when loadattempt='FTP' then do
  980.             say ''
  981.             say 'RxFTP library not present.'
  982.             say 'See documentation for download instructions.'
  983.             exit
  984.         end
  985.         when loadattempt='SOCK' then do
  986.             say ''
  987.             say 'RxSock library not present.'
  988.             say 'See documentation for download instructions.'
  989.             exit
  990.         end
  991.         otherwise do
  992.             nop
  993.             exit
  994.         end
  995.     end
  996. return
  997.  
  998. /**************************/
  999.  
  1000. /* SOCKIN: a replacement for sockrecv.
  1001.  call as
  1002.  stuff=sockin(socket,timeout,maxlen,timeoutmess)
  1003.  where:
  1004.  socket == a socket that's been established using sockconnect
  1005.  timeout == a timeout value in seconds
  1006.  maxlen == maximum length of message to recieve
  1007.  
  1008.  If not specified, then no maximum is imposed
  1009.  timeoutmess == Prefix for "error" and "timeout" message.
  1010.  If not specified, "#SOCKIN: " is used as a prefix
  1011.  For example: #SOCKIN: timeout " will be returned if no response
  1012.  was recieved in timeout seconds.
  1013.  
  1014.  and
  1015.    stuff = the contents returned from the server (up to maxlen characters)
  1016.            or an error message (starting with the timeoutmess)
  1017.  
  1018. Note: timeout refers to maximum seconds between "sockrecv" requests. 
  1019.       It does NOT refer to total length of time required to recieve a message.
  1020.       Thus, a number of medium length delays (say, a few seconds required
  1021.       to complete each of several sockrecv requests) will NOT cause a timeout 
  1022.       (in other words, the timeout counter is reset upon each successful 
  1023.       completion of a 256 byte sockrecv request).
  1024.  
  1025. */
  1026.  
  1027. /* Adpapted from Sockin by Daniel Hellerstein, danielh@econ.ag.gov */
  1028. sockin:
  1029. procedure
  1030.     parse arg socket, timeout, maxlen, timeoutmess
  1031.  
  1032.     if maxlen=0 | maxlen='' then maxlen=100000000
  1033.     if timeoutmess='' then timeoutmess='#SOCKIN:'
  1034.     if timeout='' then timeout=10
  1035.  
  1036.     if sockioctl(socket, 'FIONBIO', 1)=-1 then 
  1037.         return timeoutmess||'crashed in ioctl 'errno
  1038.     
  1039.     maxPkt = 10000;
  1040.     if (maxlen < maxPkt) then maxPkt = maxlen;
  1041.  
  1042.     ok=0; incoming=''
  1043.  
  1044.     Do While TimeOut > 0
  1045.         res = sockrecv(socket, 'data', maxPkt)
  1046.         if res = -1 then do                            /* error condition ? */
  1047.         /* severe error */
  1048.             If errno <> 'EWOULDBLOCK' then
  1049.                 return timeoutmess||'crashed in sockrecv 'errno
  1050.                 /* not-fatal,no-data-available-condition:  
  1051.                  * errno = EWOULDBLOCK & sockrecv returned -1 
  1052.                  */
  1053.             
  1054.         /*    if incoming<>'' then do; ok=1; leave; end*/
  1055.             call syssleep(1)                                /* release cpu? */
  1056.  
  1057.             TimeOut = TimeOut - 1;                   /* count down my timer */
  1058.             Iterate;
  1059.         end;
  1060.         if res=0 then do
  1061.             ok=1 ; leave         /* got end of message, so exit this do loop*/
  1062.         end
  1063.         if res<0 & incoming='' then do
  1064.             return timeoutmess||" Error in sockrecv " rc
  1065.         end
  1066.         incoming = incoming||data; data=''
  1067.         call syssleep(0);
  1068.         if length(incoming) > maxlen then do
  1069.             ok=2
  1070.             leave
  1071.         end
  1072.     end /* do while timeout > 0 */
  1073.     /* here we are timed out, or got entire message */
  1074.     if ok=1  then do
  1075.         rc=sockioctl(socket,'FIONBIO',0)          /* switch to blocking mode */
  1076.         return incoming                                          /* success! */
  1077.     end
  1078.     if ok=2  then do
  1079.         rc=sockioctl(socket,'FIONBIO',0)
  1080.         return left(incoming, maxlen)
  1081.     end
  1082.     
  1083. return timeoutmess||' Timeout ';
  1084.     
  1085.     
  1086.     
  1087. /*
  1088.  * Given a page with its header,
  1089.  * strips the header and returns the content
  1090.  */
  1091. stripHeader:
  1092. procedure
  1093.     parse arg page
  1094.     parse var page . '0d0a0d0a'x page
  1095. return page
  1096.     
  1097.     
  1098. count_occurrences:
  1099. procedure
  1100.     parse arg word, string
  1101.     num = 0; start = 1; len = length(word)
  1102.     do forever
  1103.         x=pos(word, string, start)
  1104.         if x = 0 then leave
  1105.         num = num + 1
  1106.         start = x + len
  1107.     end
  1108. return num
  1109.     
  1110.     
  1111. stripchar:
  1112. procedure
  1113.     parse arg char, text
  1114.     fine=false; spos=1
  1115.     do while fine=false
  1116.         x = pos(char, text, spos)
  1117.         if x = 0 then fine=true
  1118.         else text = delstr(text, x, 1)
  1119.         spos = x
  1120.     end
  1121. return text
  1122.     
  1123.     
  1124. unescape:
  1125. procedure
  1126.     parse arg string
  1127.     do forever
  1128.         x = pos('%',string)
  1129.         if x = 0 then return string
  1130.         es = substr(string, x + 1, 2)
  1131.         
  1132.         string= left(String, x - 1),
  1133.         ||x2c(es),
  1134.         ||right(string, length(string) - (x + 2))
  1135.     end
  1136. return string
  1137.  
  1138. url_up:
  1139. procedure
  1140.     parse arg url
  1141.     x = lastpos('/',url)
  1142.     url = left(url, x-1)
  1143. return url
  1144.     
  1145.