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