\ cgi.fs - Common Gateway Interface for Forth \ +JMJ 2013 David Meyer \ 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 ;