diff options
| -rw-r--r-- | src/compiler/GFServer.hs | 20 | ||||
| -rw-r--r-- | src/server/FastCGIUtils.hs | 26 |
2 files changed, 24 insertions, 22 deletions
diff --git a/src/compiler/GFServer.hs b/src/compiler/GFServer.hs index b45862aca..2ba645268 100644 --- a/src/compiler/GFServer.hs +++ b/src/compiler/GFServer.hs @@ -324,7 +324,7 @@ serveStaticFile' path = if ext `elem` [".cgi",".fcgi",".sh",".php"] then return $ resp400 $ "Unsupported file type: "++ext else do b <- doesFileExist path - if b then fmap (ok200' (ct t)) $ rdFile path + if b then fmap (ok200' (ct t "")) $ rdFile path else do cwd <- getCurrentDirectory logPutStrLn $ "Not found: "++path++" cwd="++cwd return (resp404 path) @@ -334,15 +334,16 @@ logPutStrLn s = liftIO . hPutStrLn stderr $ s -- * JSONP output -jsonp qs = json200' $ maybe id apply (lookup "jsonp" qs) +jsonp qs = maybe json200 apply (lookup "jsonp" qs) where - apply f json = f++"("++json++")" + apply f = jsonp200' $ \ json -> f++"("++json++")" -- * Standard HTTP responses ok200 = Response 200 [plainUTF8,noCache,xo] . encodeString ok200' t = Response 200 [t,xo] json200 x = json200' id x json200' f = ok200' jsonUTF8 . encodeString . f . encode +jsonp200' f = ok200' jsonpUTF8 . encodeString . f . encode html200 = ok200' htmlUTF8 . encodeString resp204 = Response 204 [xo] "" -- no content resp400 msg = Response 400 [plain,xo] $ "Bad request: "++msg++"\n" @@ -355,11 +356,14 @@ instance Error Response where strMsg = resp500 -- * Content types -plain = ct "text/plain" -plainUTF8 = ct "text/plain; charset=UTF-8" -jsonUTF8 = ct "text/javascript; charset=UTF-8" -htmlUTF8 = ct "text/html; charset=UTF-8" -ct t = ("Content-Type",t) +plain = ct "text/plain" "" +plainUTF8 = ct "text/plain" csutf8 +jsonUTF8 = ct "application/json" csutf8 -- http://www.ietf.org/rfc/rfc4627.txt +jsonpUTF8 = ct "application/javascript" csutf8 +htmlUTF8 = ct "text/html" csutf8 + +ct t cs = ("Content-Type",t++cs) +csutf8 = "; charset=UTF-8" xo = ("Access-Control-Allow-Origin","*") -- Allow cross origin requests -- https://developer.mozilla.org/en-US/docs/HTTP/Access_control_CORS diff --git a/src/server/FastCGIUtils.hs b/src/server/FastCGIUtils.hs index 6c93b2801..e65987b6d 100644 --- a/src/server/FastCGIUtils.hs +++ b/src/server/FastCGIUtils.hs @@ -167,11 +167,11 @@ outputJSONP = outputEncodedJSONP . encode outputEncodedJSONP :: String -> CGI CGIResult outputEncodedJSONP json = do mc <- getInput "jsonp" - let str = case mc of - Nothing -> json - Just c -> c ++ "(" ++ json ++ ")" - setHeader "Content-Type" "text/javascript; charset=utf-8" - outputStrict $ UTF8.encodeString str + let (ty,str) = case mc of + Nothing -> ("json",json) + Just c -> ("javascript",c ++ "(" ++ json ++ ")") + ct = "application/"++ty++"; charset=utf-8" + outputStrict ct $ UTF8.encodeString str outputPNG :: BS.ByteString -> CGI CGIResult outputPNG x = do @@ -186,18 +186,16 @@ outputBinary x = do outputFPS x outputHTML :: String -> CGI CGIResult -outputHTML x = do - setHeader "Content-Type" "text/html; charset=utf-8" - outputStrict $ UTF8.encodeString x +outputHTML = outputStrict "text/html; charset=utf-8" . UTF8.encodeString outputPlain :: String -> CGI CGIResult -outputPlain x = do - setHeader "Content-Type" "text/plain; charset=utf-8" - outputStrict $ UTF8.encodeString x +outputPlain = outputStrict "text/plain; charset=utf-8" . UTF8.encodeString -outputStrict :: String -> CGI CGIResult -outputStrict x | x == x = do setXO ; output x - | otherwise = fail "I am the pope." +outputStrict :: String -> String -> CGI CGIResult +outputStrict ct x | x == x = do setHeader "Content-Type" ct + setXO + output x + | otherwise = fail "I am the pope." setXO = setHeader "Access-Control-Allow-Origin" "*" -- https://developer.mozilla.org/en-US/docs/HTTP/Access_control_CORS |