From e07a74df01fdb5fc67513207b587f074f577e7d8 Mon Sep 17 00:00:00 2001
From: hallgren <hallgren@chalmers.se>
Date: Thu, 25 Jul 2013 16:04:43 +0000
Subject: Allow cross origin requests to GF cloud & PGF services

By adding a header

	Access-Control-Allow-Origin: *

to the HTTP responses, web browsers are informed that it is OK to call the
services from web pages hosted on other sites.

This is apparently supported in most modern browsers, so it should no longer
be necessary to resort to JSONP.

See https://developer.mozilla.org/en-US/docs/HTTP/Access_control_CORS
---
 src/server/FastCGIUtils.hs | 17 ++++++++++++-----
 1 file changed, 12 insertions(+), 5 deletions(-)

(limited to 'src/server')

diff --git a/src/server/FastCGIUtils.hs b/src/server/FastCGIUtils.hs
index 05aa29eac..6c93b2801 100644
--- a/src/server/FastCGIUtils.hs
+++ b/src/server/FastCGIUtils.hs
@@ -22,7 +22,8 @@ import System.Posix
 #endif
 
 --import Network.FastCGI
-import Network.CGI
+import Network.CGI(CGI,CGIResult,setHeader,output,outputFPS,outputError,
+                   getInput,catchCGI,throwCGI)
 
 import Text.JSON
 import qualified Codec.Binary.UTF8.String as UTF8 (encodeString)
@@ -153,9 +154,10 @@ throwCGIError :: Int -> String -> [String] -> CGI a
 throwCGIError c m t = throwCGI $ toException $ CGIError c m t
 
 handleCGIErrors :: CGI CGIResult -> CGI CGIResult
-handleCGIErrors x = x `catchCGI` \e -> case fromException e of
-                                         Nothing -> throw e
-                                         Just (CGIError c m t) -> outputError c m t
+handleCGIErrors x =
+    x `catchCGI` \e -> case fromException e of
+                         Nothing -> throw e
+                         Just (CGIError c m t) -> do setXO; outputError c m t
 
 -- * General CGI and JSON stuff
 
@@ -174,11 +176,13 @@ outputEncodedJSONP json =
 outputPNG :: BS.ByteString -> CGI CGIResult
 outputPNG x = do
        setHeader "Content-Type" "image/png"
+       setXO
        outputFPS x
 
 outputBinary :: BS.ByteString -> CGI CGIResult
 outputBinary x = do
        setHeader "Content-Type" "application/binary"
+       setXO
        outputFPS x
 
 outputHTML :: String -> CGI CGIResult
@@ -192,9 +196,12 @@ outputPlain x = do
        outputStrict $ UTF8.encodeString x
 
 outputStrict :: String -> CGI CGIResult
-outputStrict x | x == x = output x
+outputStrict x | x == x = do 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
+
 -- * General utilities
 
 splitBy :: (a -> Bool) -> [a] -> [[a]]
-- 
cgit v1.2.3