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