diff options
| author | hallgren <hallgren@chalmers.se> | 2013-06-13 08:23:48 +0000 |
|---|---|---|
| committer | hallgren <hallgren@chalmers.se> | 2013-06-13 08:23:48 +0000 |
| commit | bdfd663e917b0d5ed1a2d987f2f470c682969dd3 (patch) | |
| tree | ceb77c63bc99dbcb0a1a38322d5ef8a9fbc94486 /src/server/RunHTTP.hs | |
| parent | 51ece66688cbbb9295126bdc99303b631ef0dacb (diff) | |
Fix UTF-8 decoding problem in gf -server
The package network-2.4.1.1 thoughlessly introduced a backward incompatible
change to the function Network.URI.unEscapeString, see
https://github.com/haskell/network/commit/f2168b1f8978b4ad9c504e545755f0795ac869ce
This also affects the function Network.Shed.Httpd.queryToArguments, which is
used in GFServer.hs.
To remain compatible with older and newer versions of the network package,
we need to stay clear of queryToArguments and unEscapeString. A replacement
function has been added to server/URLEncoding.hs.
Diffstat (limited to 'src/server/RunHTTP.hs')
| -rw-r--r-- | src/server/RunHTTP.hs | 9 |
1 files changed, 6 insertions, 3 deletions
diff --git a/src/server/RunHTTP.hs b/src/server/RunHTTP.hs index 2afc92afc..2b4627add 100644 --- a/src/server/RunHTTP.hs +++ b/src/server/RunHTTP.hs @@ -4,9 +4,10 @@ import Network.CGI(ContentType(..)) import Network.CGI.Protocol(CGIResult(..),CGIRequest(..),Input(..), Headers,HeaderName(..)) import Network.CGI.Monad(runCGIT) -import Network.Shed.Httpd(initServer,Request(..),Response(..),queryToArguments) +import Network.Shed.Httpd(initServer,Request(..),Response(..)) import qualified Data.ByteString.Lazy.Char8 as BS(pack,unpack) import qualified Data.Map as M(fromList) +import URLEncoding(decodeQuery) data Options = Options { documentRoot :: String, port :: Int } deriving Show @@ -36,13 +37,15 @@ cgiReq root (Request method uri hdrs body) = CGIRequest vars inputs body' '?':s -> s s -> s al = maybe "" id $ lookup "Accept-Language" hdrs - inputs = map input $ queryToArguments $ fixplus qs -- assumes method=="GET" +-- inputs = map input $ queryToArguments $ fixplus qs -- assumes method=="GET" + inputs = map input $ decodeQuery qs -- assumes method=="GET" body' = BS.pack body input (name,val) = (name,Input (BS.pack val) Nothing plaintext) plaintext = ContentType "text" "plain" [] - +{- fixplus = concatMap decode where decode '+' = "%20" -- httpd-shed bug workaround decode c = [c] +-}
\ No newline at end of file |