home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 35 Internet / 35-Internet.zip / gostats.zip / gofilter.80 next >
Text File  |  1999-03-09  |  16KB  |  328 lines
  1. /* Sample GoServe filter program for an HTTP server--see GOHTTP.DOC */
  2. /* Be sure to start GoServe with the HTTP option to use this filter */
  3.  
  4. dir = datadir()          /* Data directory (root of all data directories) */
  5.                          /* [must include drive and end in '/'] */
  6.  
  7. parse arg source, request, sel                         /* Get arguments */
  8. parse var source myaddr port transaction who whoport . /* Often useful */
  9. tempfile=dir'$'transaction'.'port                      /* Often used */
  10. statfile=dir'$_'transaction'.'port                     /* stats file name */
  11.  
  12. default = 'index.html'    /* Default document (sent if none specified) */
  13. owner   = '142.72.67.160'          /* Owner IP address (may send special requests) */
  14.                          /* [e.g. '9.11.22.33', or 'ANY' for no checking] */
  15.  
  16. /* say time() transaction who':' request */  /* sample debug aid */
  17.  
  18. parse var request verb uri protocol .        /* split up the request line */
  19.  
  20. /* Check request */
  21. if left(protocol,4)\='HTTP' & protocol\='' then
  22.   return response('badreq', 'specified a protocol that was not HTTP')
  23.  
  24. /* Provide access to the remote control forms.  Authorization can */
  25. /* be applied to seeing the forms, or only if Apply is pressed.   */
  26. /* This assumes the pages are in the DataDir directory.           */
  27. /* You might want to change the 'keyword' in the next line, too.  */
  28. if left(translate(sel),8)='GOREMOTE' then do
  29.   if pos('/',sel)=0 then return moved(sel'/')
  30.   /* [remove next line (only) to protect both forms and Apply] */
  31.   if verb='POST' then
  32.     call authorize 'GoRemote'         /* direct exit if fails */
  33.   parse var sel '/' action            /* action follows the '/' */
  34.   if action='' then action='goremote' /* add top form name */
  35.   return goremote(verb, action)       /* invoke forms handler */
  36.   end /* remote control request */
  37.  
  38. /* Convert empty selector to default [or use more sophisticated */
  39. /* defaulting, here].                                           */
  40. if sel='' then sel=default
  41.  
  42. /* Allow some special 'control' requests.  For these, the verb is */
  43. /* ignored (though would usually be GET) */
  44. if left(sel,1)='!' then do
  45.  
  46.   if left(sel,6)='!stats' then do    /* * stats * */
  47.     'extract clientaddr'
  48.     st_type = substr(sel,8,50)        /* could be !stats-this-month */
  49.  
  50.     address cmd
  51.     'call c:\GoStats\GoStats.exe parse 'clientaddr' 'statfile' 'st_type
  52.     return 'FILE ERASE TYPE text/html NAME ' statfile
  53.   end
  54.  
  55.   /* Special request -- only accept from allowed places. */
  56.   if who\=owner & owner\='ANY' then
  57.     return response('forbid', 'tried to use a special control')
  58.   select
  59.     when sel='!ping'       then return 'STRING Ping!'
  60.     when sel='!statistics' then return 'CONTROL STATISTICS'
  61.     when sel='!save'       then return 'CONTROL MOVEAUDIT'
  62.     when sel='!reset'      then return 'CONTROL RESET ALL'
  63.     when sel='!dopush'     then return dopush()   /* server push example */
  64.     when sel='!special'    then do                /* protected command */
  65.       call authorize 'Demo'             /* will Exit if not authorized */
  66.       return 'STRING You got the right password'
  67.       end
  68.     otherwise return response('badreq', 'asked for unknown control "'sel'"')
  69.     end
  70.   end
  71.  
  72. /* Now carry out whichever verbs we support */
  73. file=dir||sel       /* full filename */
  74. select
  75.   when verb='GET' | verb='HEAD' then do
  76.     /* First see if it's a query or image click */
  77.     parse var sel type '?' words
  78.     if words='' then /* common case: do not have a search */ do
  79.       if stream(file, 'c', 'query exists')='' then return response('notfound',,
  80.         'asked for "'sel'", which could not be found')
  81.       return 'FILE TYPE' mediatype(file) 'NAME' file
  82.       end
  83.     /* If something after the '?' it's the result from Image or Form */
  84.     if type='globe' then return globemap(words)
  85.     /* Here if a search from GET; call function to do it */
  86.     return search(tempfile, type, words)
  87.     end /* get */
  88.  
  89.   when verb='POST' then do
  90.     /* This filter only uses POSTs for queries (forms) */
  91.     'read body var words'                    /* get the incoming data */
  92.     if rc=-4 then                            /* body too large */
  93.       return response('badreq', 'sent too much data')
  94.     if rc<>0 then                            /* e.g., invalid HTTP header */
  95.       return response('badreq', 'sent data that could not be read')
  96.     return search(tempfile, sel, words)      /* this does the search */
  97.     end /* post */
  98.  
  99.   otherwise return response('badreq', 'sent an unknown verb "'verb'"')
  100.   end /* select verb */
  101. /* [cannot reach here] */
  102.  
  103. /* ----------------------------------------------------------------------- */
  104. /* RESPONSE: Standard [mostly error] responses.                            */
  105. /* ----------------------------------------------------------------------- */
  106. /* This routine should stay in the main filter program.                    */
  107. /* Arguments are: response type and extended message information.          */
  108. /* It returns the GoServe command to handle the result file.               */
  109. response: procedure expose tempfile
  110.   parse arg request, message
  111.   select
  112.     when request='badreq'   then use='400 Bad request syntax'
  113.     when request='notfound' then use='404 Not found'
  114.     when request='forbid'   then use='403 Forbidden'
  115.     when request='unauth'   then use='401 Unauthorized'
  116.     end  /* Add others to this list as needed */
  117.   /* Now set the response and build the response file */
  118.   'RESPONSE HTTP/1.0' use     /* Set HTTP response line */
  119.  
  120.   'extract clientaddr'
  121.  
  122.   parse var use code text
  123.   call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
  124.   call lineout tempfile, "<html><head><title>"text"</title></head>"
  125.   call lineout tempfile, "<body><h2>Oh Oh! Sorry...</h2>"
  126.   call lineout tempfile, "<p>The request from your Web client" message"."
  127.   call lineout tempfile, "<hr><em>HTTP response code:</em>" code '['text']'
  128.   call lineout tempfile, "<br><em>From server at:</em>" servername()
  129.   call lineout tempfile, "<br><em>Running:</em>" server()
  130.   call lineout tempfile, "<br><em>Your IP:</em>" clientaddr
  131.   call lineout tempfile, "</body></html>"
  132.   call lineout tempfile  /* close */
  133.   return 'FILE ERASE TYPE text/html NAME' tempfile
  134.  
  135. /* ----------------------------------------------------------------------- */
  136. /* MOVED: Return a 'moved' response                                        */
  137. /* ----------------------------------------------------------------------- */
  138. /* This must be in the main filter program (uses PORT and TEMPFILE).       */
  139. /* Argument is new URL or partial URI                                      */
  140. /* It returns the GoServe command to handle the result file.               */
  141. moved: procedure expose port tempfile
  142.   parse arg uri
  143.   if left(uri,5)=='http:' then /* got full URI */ url=uri
  144.    else /* got partial URI */ do
  145.     if port=80 then pp=''; else pp=':'port
  146.     url='http://'servername()pp'/'uri        /* relocation */
  147.     end
  148.   /* Now set the response and build the response file */
  149.   'RESPONSE HTTP/1.0 302 Moved Temporarily'  /* Set HTTP response line */
  150.   'HEADER ADD Location:' url
  151.   call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
  152.   call lineout tempfile, "<html><head><title>Moved</title></head>"
  153.   call lineout tempfile, "<body><h2>Document moved...</h2>"
  154.   call lineout tempfile, "<p>This document has moved"
  155.   call lineout tempfile, "<a href="""url""">here<a>."
  156.   call lineout tempfile, "</body></html>"
  157.   call lineout tempfile  /* close */
  158.   return 'FILE ERASE TYPE text/html NAME' tempfile
  159.  
  160. /* ----------------------------------------------------------------------- */
  161. /* AUTHORIZE -- check access to data is authorized                         */
  162. /* ----------------------------------------------------------------------- */
  163. /* This routine exits directly if it needs to challenge the client, so it  */
  164. /* must be internal.  If authorization is valid, it returns to caller.     */
  165. /* Argument is the Realm to which the data belongs (this tells the user    */
  166. /* which userid/password pair to use).                                     */
  167. /* In this sample filter, the password for the 'Demo' realm is simply the  */
  168. /* userid; in a real application, it would probably be held in a file      */
  169. /* (such as a .INI file), or possibly hard-coded here.                     */
  170. authorize: procedure expose tempfile
  171.   parse arg realm .                     /* get the realm word */
  172.   afield=reqfield('Authorization')      /* see if incoming authorization */
  173.   parse var afield . m64 .              /* get the encoded cookie */
  174.   dec=pack64(m64)                       /* and decode it */
  175.   parse var dec user ':' pw             /* split to userid and password */
  176.   /* These checks can use the USER, PW, and REALM variables. */
  177.   /* Note: a RETURN indicates success (client is authorized). */
  178.   /* [Start of password checking code here] */
  179.     if realm='Demo'     & pw<>'' & pw==user     then return
  180.     /* To enable remote control Applys, change the password (??????) in the */
  181.     /* next line and then remove the comment delimiters from that line. */
  182.     /* if realm='GoRemote' & pw=='??????' then return */
  183.   /* [End of password checking code] */
  184.   'header add WWW-Authenticate: Basic Realm=<'realm'>'  /* challenge */
  185.   exit response('unauth', "for realm '"realm"'was not authorized")
  186.  
  187. /* ----------------------------------------------------------------------- */
  188. /* SEARCH: Sample search function that builds a response file dynamically. */
  189. /* ----------------------------------------------------------------------- */
  190. /* We'd probably make it a separate Rexx program normally, for ease of     */
  191. /* maintenance.                                                            */
  192. /* Arguments are: the unique file name, search to do, and words [UR form]. */
  193. /* It returns the GoServe command to handle the result file.               */
  194. search: procedure
  195.   parse arg file, type, list       /* could easily be uppercased */
  196.   parse var list list '&' checks   /* split off all checkboxes etc. */
  197.   /* If this came with our name, use the value                           */
  198.   /* If came from an old form, with an ISINDEX tag, can handle that, too */
  199.   /* If this came from an old form and old client, use list as-is        */
  200.   /* But if the name isn't the one we put in the form, use empty list.   */
  201.   parse var list name '=' value
  202.   select
  203.     when name='searchText' then list=value   /* usual case */
  204.     when name='isindex'    then list=value   /* for very simple forms */
  205.     when pos('=', list)=0  then nop          /* as-is case */
  206.     otherwise list=''                        /* invalid name */
  207.     end
  208.   list=packur(list)                /* pack escape sequences in list */
  209.  
  210.   /* This sample function ignores TYPE except as information */
  211.   call lineout file, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
  212.   call lineout file, "<html><head><title>Response</title></head>"
  213.   call lineout file, "<body>"
  214.   call lineout file, "<h2>Response to '"type"' request</h2>"
  215.  
  216.   /* Here would be a customized search.  We just build a simple list. */
  217.   list=translate(list, ' ', '+'||'090a0d'x)  /* Whitespace, etc. */
  218.   if list='' then call lineout file, "<p>You chose no words."
  219.    else do
  220.     call lineout file, "<p>The words you chose were:<ol>"
  221.     do while list<>''
  222.       parse var list word list               /* get first */
  223.       call lineout file, "<li>"word
  224.       end
  225.     call lineout file, "</ol>"
  226.     end /* have words */
  227.   if checks<>'' then
  228.     call lineout file, "<p>Checkbox data was:" checks
  229.   call lineout file, "<hr></body></html>"
  230.   call lineout file                          /* close */
  231.   return 'FILE ERASE TYPE text/html NAME' file
  232.  
  233. /* ----------------------------------------------------------------------- */
  234. /* GLOBEMAP: Sample handling of a selectable image [image map].            */
  235. /* ----------------------------------------------------------------------- */
  236. globemap: procedure
  237.   /* Use 'trace i' here, with PMprintf, to see the calculations */
  238.   parse arg x ',' y           /* get coordinates */
  239.   radius=69/2                 /* need the .GIF size for this */
  240.                               /* note some browsers seem to include frame */
  241.   y=radius*2-y                /* convert Y to map direction [up is plus] */
  242.   xrel=(x-radius)/radius      /* both in range +/- 1.0 */
  243.   yrel=(y-radius)/radius      /* .. */
  244.   if (xrel**2 + yrel**2)<=1 then onglobe=1; else onglobe=0
  245.  
  246.   if \onglobe then return 'String You clicked off the globe'
  247.   crlf='0d0a'x
  248.   return 'String You clicked on the globe image at map coordinates'crlf,
  249.     crlf'  ['format(xrel*100,,0)'%,' format(yrel*100,,0)'%]'crlf,
  250.     crlf'from the middle.'
  251.  
  252. /* ----------------------------------------------------------------------- */
  253. /* DOPUSH: Sample 'server push' routine                                    */
  254. /* ----------------------------------------------------------------------- */
  255. /* This sends a (very simple) "Server push" data stream.  It requires a    */
  256. /* browser that accepts the internet type  'multipart/x-mixed-replace'     */
  257. dopush: procedure
  258.   /* This simple example does a full-document countdown */
  259.   crlf='0d0a'x                /* useful */
  260.   bound=copies("x",11)        /* boundary data for part [could be random] */
  261.   mimestart='--'bound''crlf   /* starts a MIME multipart section */
  262.   mimeend  ='--'bound'--'crlf /* ends a MIME multipart section */
  263.  
  264.   /* Send the header and first boundary */
  265.   'set netbuffer off'         /* turn off buffering */
  266.   'send type multipart/x-mixed-replace;boundary="'bound'" as Countdown'
  267.   'string' mimestart          /* Or could be: 'var name mimestart' */
  268.  
  269.   do num=10 to 0 by -1
  270.     /* Build document to send, with leading (mixed) Type header and    */
  271.     /* terminating MIME boundary.  It could be sent in smaller pieces. */
  272.     out=''
  273.     out=out||'Content-type: text/html'crlf
  274.     out=out||crlf
  275.     out=out||'<!doctype html public "-//IETF//DTD HTML 2.0//EN">'crlf
  276.     out=out||"<html><head><title>Counting...</title></head>"crlf
  277.     out=out||"<body><h2>"
  278.     if num>0 then out=out||num||'...'
  279.              else out=out||'<hr>Zero!!<hr>'
  280.     out=out||"</h2>"crlf
  281.     out=out||"</body></html>"crlf
  282.     if num=0 then out=out||mimeend           /* Mime 'last data' indicator */
  283.              else out=out||mimestart         /* Mime 'start data' indicator */
  284.     'VAR NAME out'                           /* send it */
  285.     if num>0 then 'wait seconds 0.7'         /* pause */
  286.     end
  287.  
  288.   'SEND Complete'                            /* and complete the send */
  289.   return ''                                  /* [called as function] */
  290.  
  291. /* ----------------------------------------------------------------------- */
  292. /* MEDIATYPE: Return the media type of a file, based on its extension.     */
  293. /* ----------------------------------------------------------------------- */
  294. mediatype: procedure
  295.   /* First get the extension; this assumes filenames have at least one '.' */
  296.   ???=translate(substr(arg(1), lastpos('.',arg(1))+1))
  297.  
  298.   /* Fastpath very common types [add your own favourites] */
  299.   if ???='GIF'  then return 'image/gif'
  300.   if ???='HTM'  then return 'text/html'
  301.   if ???='HTML' then return 'text/html'
  302.  
  303.   /* Set up the table of all types that we are interested in */
  304.   known.   ='application/octet-stream'  /* default type */
  305.   known.ps ='application/postscript'
  306.   known.zip='application/zip'
  307.   known.pdf='application/pdf'
  308.   known.au ='audio/basic'
  309.   known.snd='audio/basic'
  310.   known.wav='audio/x-wav'
  311.   known.mid='audio/x-midi'
  312.   known.gif='image/gif'
  313.   known.bmp='image/bmp'
  314.   known.jpg='image/jpeg';  known.jpeg='image/jpeg'
  315.   known.tif='image/tiff';  known.tiff='image/tiff'
  316.   known.htm='text/html' ;  known.html='text/html'
  317.   known.txt='text/plain'
  318.   known.rex='text/plain';  known.rexx='text/plain'
  319.   known.nrx='text/plain'
  320.   known.c  ='text/plain';  known.cpp ='text/plain'
  321.   known.jav='text/plain';  known.java='text/plain'
  322.   known.cmd='text/plain';  known.txt ='text/plain'
  323.   known.doc='text/plain';  known.faq ='text/plain'
  324.   known.mpg='video/mpeg';  known.mpeg='video/mpeg'
  325.   known.avi='video/x-msvideo'
  326.   /* Now it's trivial... */
  327.   return known.???
  328.