REBOL [
Title: "Rebol CGI library"
File: %cgi.r
Author: "Cal Dixon"
Date: 2-Mar-2004
Purpose: "Provide everything needed to create a CGI script"
library: [
level: 'advanced
platform: 'all
type: 'module
domain: [cgi http web]
tested-under: none
support: none
license: 'MIT
see-also: none
]
]
comment {
This script provides 15 functions (for more information run this script from the Rebol console and use 'HELP):
; these are very CGI specific
process-cgi
cgi
all-cgi
cookie
set-cookies
redirect
; these are frequently needed in CGI scripts but are not CGI specific
cgi-escape
html-escape
onepx.gif
binary-prin
cgi-prin
cgi-print
; these are generally useful and used internally in the other functions here
rejoinif
time-to-zone
hex
}
use [buffer parts cgiobj cookieobj getobj postobj cookies cookies-buffer pc seg sep cdisp len][
cookies: copy [] postobj: copy [] parts: copy [] cgiobj: context []
process-cgi: func ["Processes HTTP Cookies, CGI GET and POST input - returns an object" /maxpostlength maxbytes][
getobj: construct decode-cgi any [ system/options/cgi/query-string "" ]
repeat cookie parse any [select system/options/cgi/other-headers "HTTP_COOKIE" ""] none [
pc: parse cookie "=" if all [ pc/1 pc/2 pc/1/1 pc/2/1 ] [ insert tail cookies reduce [ to-set-word pc/1 pc/2 ] ]
]
cookieobj: construct cookies
if system/options/cgi/request-method = "POST" [
buffer: make string! 20 + len: to-integer system/options/cgi/content-length
if all [maxbytes len > maxbytes][return context []]
set-modes system/ports/input [lines: false]
while [ all [ len > length? buffer read-io system/ports/input buffer len ] ] [
if all [ not empty? buffer len <> length? buffer not wait reduce [system/ports/input 30] ][quit]
]
postobj: construct either all [
sep: find/tail system/options/cgi/content-type "multipart/form-data;"
sep: find/tail sep "boundary="
][
sep: rejoin [crlf "--" sep]
model: context [ content-disposition: name: filename: none content-type: "text/plain" ]
parse join crlf buffer [any [copy seg to sep (if seg [
seg: parse-header model find seg complement charset crlf
if all [seg/content-disposition cdisp: find/tail seg/content-disposition "form-data;"][
seg: make seg [
name: copy/part name: find/tail cdisp {name="} find name {"}
filename: if filename: find/tail cdisp {filename="} [
filename: copy/part filename find filename {"}
]
]
if not find seg/content-type "text/" [seg/content: to-binary seg/content]
either all [seg/filename not empty? seg/filename] [
seg/content: context [filename: seg/filename content-type: seg/content-type content: seg/content]
][
if seg/content-type = "text/plain" [trim/head/tail seg/content]
]
insert tail parts reduce [ to-set-word seg/name seg/content ]
]
]) sep]]
parts
][
decode-cgi buffer
]
]
return cgiobj: make cookieobj make getobj postobj
]
cgi: func ["Get a CGI variable that was read by process-cgi" var [any-string! any-word!] /cookie /get /post /local o][
o: any [
if get [ getobj ]
if post [ postobj ]
if cookie [ cookieobj ]
cgiobj
]
if var: in o to-word form var [ system/words/get :var ]
]
allcgi: func ["Returns a block of all CGI variables from process-cgi"][bind difference first cgiobj [self] in cgiobj 'self]
rejoinif: func [ "either :condition [ rejoin block ][ :default ]" condition [logic! none!] block [block!] default ][ either :condition [ rejoin block ][ :default ] ]
hex: func ["Returns a two character hexadecimal version of a number or character" c [char! string! integer!]][copy/part next next form to-binary to-char c 2]
cgi-escape: func ["Full URL escaping of a string" x [string!] /local echar nonechar s c][
echar: complement nonechar: charset "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789$-_.!*(),"
parse/all x: to-string x [ any [ s: echar (c: s/1 remove s insert s join "%" hex c s: skip s 2) :s | nonechar ] ]
x
]
html-escape: func ["Prepares a string for use in HTML forms" x [string!] /local echar nonechar s c t][
nonechar: complement echar: charset {"<>^M^J}
parse/all x: to-string x [ any [ s: echar (c: s/1 remove s insert s t: rejoin ["&#" to-integer c ";"] s: skip s length? t) :s | nonechar ] ]
x
]
onepx.gif: func ["Returns a 1x1 transparent GIF file as a binary!"][#{4749463839610100010080000000000000000021F90401000000002C00000000010001004002024401003B}]
time-to-zone: func [ "Adjusts a time! to a different time zone" time [date! time!] zone [time!] /local a][a: (time - time/zone) + zone a/zone: zone a]
cookies-buffer: []
cookie: func [ "Sets or Unsets a Cookie - use set-cookies after all cookies have been set" name val /expires exp /path pth /kill ][
if kill [ exp: now - 2 val: "." ]
insert tail cookies-buffer rejoin [
"Set-Cookie: " form :name "=" form :val
rejoinif expires ["; expires=" to-idate time-to-zone exp 0:00 ] ""
rejoinif ["; path=" pth ] ""
newline
]
]
set-cookies: func ["Ouputs all cookie changes at once"][ if cookies-buffer/1 [cgi-print rejoin cookies-out] ]
redirect: func ["Does an HTTP redirect" url [url! string!] /quit ][ print [ "Location:" url ] if quit [system/words/quit]]
binary-prin: func [ "Outputs a value with no processing" data ] [ write-io system/ports/output data length? data ]
cgi-prin: func [ "Replacement for 'PRIN that always translates ^^/ to CRLF" out /local data ] [
data: replace/all (reform out) newline "^M^J"
write-io system/ports/output data length? data
return
]
cgi-print: func ["Replacement for 'PRINT that always translates ^^/ to CRLF" out][
data: head insert tail replace/all (reform out) newline "^M^J" "^M^J"
write-io system/ports/output data length? data
return
]
]
; The following is an example CGI script using this library
comment {
#!/usr/local/rebol/rebol -cs
REBOL [ file: %cgidemo.cgi ]
if error? e: try [
do %cgi.r
process-cgi
print "Content-type: text/html^/"
file: any [cgi 'filetest context [filename: none content-type: none content: ""]]
print rejoin [
{CGI Demo}
"CGI Demo Script"
mold cgi 'gettest
file/filename newline file/content-type newline length? file/content
mold cgi 'posttest
mold cgi 'posttest2
{}
]
none
][
print "Content-type: text/plain^/"
probe mold disarm e
]
quit
}