148 lines
4.2 KiB
Forth
Executable File
148 lines
4.2 KiB
Forth
Executable File
\ cgi.fs - Common Gateway Interface for Forth
|
|
\ +JMJ 2013 David Meyer <papa@sdf.org>
|
|
|
|
\ 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
|
|
; |