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