Fix Internet.HTTP.CGI (fixes #3)

src/libraries/OS-Independent/Internet/HTTP.dcl

@@ -98,5 +98,4 @@ badRequestResponse 	:: !String -> HTTPResponse
 staticResponse		:: !HTTPRequest !*World																				-> (!HTTPResponse, !*World)
 customResponse		:: ![((String -> Bool),(HTTPRequest *World -> (HTTPResponse, *World)))] !Bool !HTTPRequest !*World	-> (!HTTPResponse, !*World)
 
-
-
+encodeResponse :: !Bool !HTTPResponse !*World -> (!String,!*World)

src/libraries/OS-Independent/Internet/HTTP.icl

@@ -283,3 +283,21 @@ customResponse [(pred,handler):rest] fallback request world
 									= handler request world							//Apply handler function
 									= customResponse rest fallback request world	//Search the rest of the list
 
+//Response utilities
+encodeResponse :: !Bool !HTTPResponse !*World -> (!String,!*World)
+encodeResponse withreply {rsp_headers = headers, rsp_data = data} world
+	# reply = if withreply
+		("HTTP/1.0 " +++ (default "200 OK" (lookup "Status" headers)) +++ "\r\n")
+		("Status: " +++ (default "200 OK" (lookup "Status" headers)) +++ "\r\n")
+	# reply = reply +++ ("Server: " +++ (default "Clean HTTP tools" (lookup "Server" headers)) +++ "\r\n") //Server identifier
+	# reply = reply +++ ("Content-Type: " +++ (default "text/html" (lookup "Content-Type" headers)) +++ "\r\n") //Content type header
+	# reply = reply +++ ("Content-Length: " +++ (toString (size data)) +++ "\r\n") //Content length header
+	# reply = reply +++ (foldr (+++) "" [(n +++ ": " +++ v +++ "\r\n") \\ (n,v) <- headers | not (skipHeader n)]) //Additional headers
+	# reply = reply +++ ("\r\n" +++ data) //Separator + data
+	= (reply, world)
+where
+	//Do not add these headers two times
+	default def mbval = case mbval of
+		Nothing = def
+		(Just val) = val
+	skipHeader s = isMember s ["Status","Date","Server","Content-Type","Content-Length","Last-Modified"]

src/libraries/OS-Independent/Internet/HTTP/CGI.icl

 implementation module Internet.HTTP.CGI
 
 import StdFile, StdInt, StdBool, StdArray
-import Data.Maybe, Internet.HTTP, Text, System.Environment, Data.Map
+import Data.Maybe, Data.Tuple, Internet.HTTP, Text, System.Environment, Data.Map
 
 //Http headers which should be polled in the environment
 CGI_HEADERS :== [ ("Content-Type","CONTENT_TYPE")
@@ -22,7 +22,7 @@ startCGI options handlers world
 	# (ok,console)			= freopen console FReadData
 	# (datalength, world)	= getDataLength world
 	# (data, console)		= getData datalength console											//Read post data
-	# (req_method, world)	= getFromEnv "REQUEST_METHOD" world										//Read environment data
+	# (req_method, world)	= appFst fromString (getFromEnv "REQUEST_METHOD" world) //Read environment data
 	# (req_path, world)		= getFromEnv "SCRIPT_NAME" world
 	# (req_query, world)	= getFromEnv "QUERY_STRING" world
 	# (req_version, world)	= getFromEnv "SERVER_PROTOCOL" world

tests/linux64/test.icl

@@ -92,6 +92,7 @@ import qualified Graphics.Layout
 import qualified Graphics.Scalable
 import qualified Graphics.Scalable.Internal
 import qualified Internet.HTTP
+import qualified Internet.HTTP.CGI
 import qualified Math.Geometry
 import qualified Math.Random
 import qualified Network.IP
@@ -138,7 +139,6 @@ import qualified Text.Unicode.UChar
 
 //Errors that need to be fixed
 import qualified Text.XML
-import qualified Internet.HTTP.CGI
 import qualified Database.SQL.RelationalMapping
 
 Start = "Hello World!"