\ 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

require array.fs

variable CGIQUERYSTR  \ QUERY_STRING address
variable CGIQUERYLEN  \ QUERY_STRING length

521 4 table CGIFIELD

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
;

\ 2013/10/21 New start: Following may be useful even if above
\ is discarded ...

create cgiKey 521 allot
create cgiKeyLen 521 allot
create cgiValue 521 allot
create cgiValueLen 521 allot
-1 variable cgiLastField

: cgiParseQuery { a-query u -- }
    2dup [char] & scan

;