\ cgi.fs - Common Gateway Interface for Forth
\ +JMJ 2013 David Meyer <
[email protected]>
\ URI length limits:
\ Standards impose no maximum URI length, but MSIE
\ through version 10 can only handle URIs of 2083
\ characters or less (2048 characters is maximum
\ path length).
\ URI RFC recommends hostname part of URI not
\ exceed 255 characters.
\ Maximum number of key/value pairs in URI query string
\ Max. characters: 2083
\ Query string length: SUM( key-length-n + value-length-n + 2 ) - 1
\ = n * ( key-length-avg + value-length-avg + 2 ) - 1
\ Maximum number of keys achieved when key and values are minimum
\ length - 1 character.
\ 2083 = n * ( 1 + 1 + 2 ) - 1
\ = n * 4 - 1
\ 2084 = n * 4
\ n = 521 <-- Maximum possible number of key/value pairs in query string
variable decode-ptr
variable code-len
variable keystr-ptr
variable keystr-len
variable valstr-ptr
variable valstr-len
\ Is character c a '%'?
: c%? ( c -- f ) [char] % = ;
\ Return hexadecimal value (0-15) of character [0-9A-Fa-f]
\ Returns -1 for invalid character
: chex ( c -- n )
dup [char] 0 [char] 9 1+ within if
[char] 0 - exit
then
dup [char] A [char] F 1+ within if
[char] A - 10 + exit
then
dup [char] a [char] f 1+ within if
[char] a - 10 + exit
then
drop -1 ( Invalid character error )
;
\ Compute value (0-255) of 2-character hexadecimal number
: hexval ( chigh clow -- 16*chigh+clow ) swap 16 * + ;
\ Search string at c-addr1 for character c. If found, set f true and u2 to offset of 1st c in string.
: csearch ( c-addr1 u1 c -- u2 f )
0 2over ( c-addr1 u1 c ui c-addr1 u1 )
+do ( c-addr1 u1 c ui c-addr1 )
swap chars + c@ ( c-addr1 u1 c ci )
i rot rot ( c-addr1 u1 ui+1 c ci )
over = ( c-addr1 u1 ui+1 c fi )
>r swap 2over drop r> ( c-addr1 u1 c ui+1 c-addr1 fi )
\ Exit loop if current char. matches
if leave then ( c-addr1 u1 c ui+1 c-addr1 )
loop
drop 1- rot over ( c-addr1 c u2 u1 u2 )
- 1 > if ( c-addr1 c u2 )
\ Found char. before end of string
true 2swap 2drop ( u2 true )
else
\ Got to end of string
dup chars 2swap rot rot + c@ ( u2 c c2 )
= if
\ End of string matches char.
true ( u2 true )
else
\ No match
false ( u2 false )
then
then
;
\ Decode percent-encoded string
: %decode ( c-code u-code -- c-decode u-decode )
here decode-ptr !
dup chars allot
code-len ! ( c-code )
0 swap 0 ( decode-ofst c-code code-ofst )
begin
dup 1+ code-len @ <=
while
rot >r ( c-code code-ofst )
2dup + c@ c%? if
2dup 2dup + 1 chars + c@ chex
rot rot + 2 chars + c@ chex
2dup 0>= swap 0>= and if
hexval decode-ptr @ r@ + c!
r> 1 chars + rot rot
else
2drop
2dup + decode-ptr @ r@ + 3 cmove
r> 3 chars + rot rot
then
2 chars +
else
2dup + c@ decode-ptr @ r@ + c!
r> 1 chars + rot rot
\ cr ." debug:" decode-ptr @ code-len @ dump
then
1 chars +
repeat
2drop decode-ptr @ swap
;
\ Return value for CGI query string key.
\ Return 0 0 if key not found.
: qskeyval ( c-key u-key-len -- c-value u-value-len )
dup
s" QUERY_STRING" getenv
dup if
rot over swap - 2 < if
\ Query string not long enough for key=value
2drop 2drop 0 0
else
\ search for key string in query
2swap
( c-querystr u-querystr-len c-key u-key-len )
\ Set key search string
here keystr-ptr !
dup 2 + dup keystr-len !
chars dup allot
[char] = swap keystr-ptr @ + !
[char] & keystr-ptr !
keystr-ptr @ 1 chars + swap cmove
( c-querystr u-querystr-len )
\ Check for key at beginning of query string
2dup keystr-ptr @ 1 chars + keystr-len @ 1-
string-prefix? if
\ Extract 1st value string
here valstr-ptr !
else
\ Search query string for full key
then
then
else
\ QUERY_STRING not defined
2swap 2drop rot drop
then
;
