diff --git a/Network/Wai/Middleware/CleanPath.hs b/Network/Wai/Middleware/CleanPath.hs --- a/Network/Wai/Middleware/CleanPath.hs +++ b/Network/Wai/Middleware/CleanPath.hs @@ -34,7 +34,7 @@ -- * There are any doubled slashes. splitPath :: B.ByteString -> Either B.ByteString [String] splitPath s = - let corrected = B.pack $ ats $ rds $ B.unpack s + let corrected = B.pack $ rts $ ats $ rds $ B.unpack s in if corrected == s then Right $ map (unEscapeString . B.unpack) $ filter (not . B.null) @@ -56,6 +56,14 @@ if last s == '/' || dbs (reverse s) then s else s ++ "/" + +-- | Remove a trailing slash if the last piece has a period. +rts :: String -> String +rts [] = [] +rts s = + if last s == '/' && dbs (tail $ reverse s) + then init s + else s -- | Is there a period before a slash here? dbs :: String -> Bool diff --git a/Network/Wai/Middleware/Gzip.hs b/Network/Wai/Middleware/Gzip.hs --- a/Network/Wai/Middleware/Gzip.hs +++ b/Network/Wai/Middleware/Gzip.hs @@ -16,8 +16,7 @@ module Network.Wai.Middleware.Gzip (gzip) where import Network.Wai -import Network.Wai.Enumerator (fromLBS', toLBS) -import Codec.Compression.GZip (compress) +import Network.Wai.Zlib import Data.Maybe (fromMaybe) import qualified Data.ByteString.Char8 as B @@ -54,7 +53,7 @@ compressE :: Either FilePath Enumerator -> Either FilePath Enumerator compressE (Left fp) = Left fp -compressE (Right e) = Right $ fromLBS' $ fmap compress $ toLBS e +compressE (Right e) = Right $ compress e splitCommas :: String -> [String] splitCommas [] = [] diff --git a/Network/Wai/Middleware/Jsonp.hs b/Network/Wai/Middleware/Jsonp.hs --- a/Network/Wai/Middleware/Jsonp.hs +++ b/Network/Wai/Middleware/Jsonp.hs @@ -27,6 +27,11 @@ then Just y' else takeCallback $ B8.drop 1 z +dropQM :: B8.ByteString -> B8.ByteString +dropQM bs + | B8.null bs = bs + | B8.head bs == '?' = B8.tail bs + | otherwise = bs -- | Wrap json responses in a jsonp callback. -- @@ -41,7 +46,7 @@ let callback :: Maybe B8.ByteString callback = if B8.pack "text/javascript" `B8.isInfixOf` accept - then takeCallback $ queryString env + then takeCallback $ dropQM $ queryString env else Nothing let env' = case callback of diff --git a/Network/Wai/Zlib.hs b/Network/Wai/Zlib.hs new file mode 100644 --- /dev/null +++ b/Network/Wai/Zlib.hs @@ -0,0 +1,106 @@ +{-# LANGUAGE CPP, ForeignFunctionInterface #-} +{-# LANGUAGE EmptyDataDecls #-} +module Network.Wai.Zlib (compress) where + +import Prelude hiding (length) +import Network.Wai hiding (status) + +import Data.ByteString.Unsafe +import Data.ByteString.Lazy.Internal (defaultChunkSize) + +import Foreign.C +import Foreign.Ptr +import Foreign.Marshal.Alloc +import Control.Exception +import Control.Monad + +import Data.ByteString.Char8 hiding (putStrLn) + +chunkSize :: Int +chunkSize = defaultChunkSize + +compress :: Enumerator -> Enumerator +compress enum = + Enumerator $ \iter acc -> + bracket + c_create_z_stream + c_free_z_stream + (compressInner iter acc enum) + +compressInner :: (acc -> ByteString -> IO (Either acc acc)) + -> acc + -> Enumerator + -> ZStream + -> IO (Either acc acc) +compressInner iter acc enum stream = allocaBytes chunkSize $ \outbuff -> do + when (stream == nullPtr) $ error "Error from zlib library" + c_set_avail_out stream outbuff $ fromIntegral chunkSize + eacc <- runEnumerator enum (compressIter iter stream outbuff) acc + case eacc of + Left acc' -> return $ Left acc' + Right acc' -> finishStream iter stream outbuff acc' + +drainOutput :: Bool -- ^ are we finishing? + -> ZStream + -> Ptr CChar -- ^ output buffer + -> (acc -> ByteString -> IO (Either acc acc)) + -> acc + -> IO (Either acc acc) +drainOutput isFinish stream outbuff iter acc = do + if isFinish + then c_call_deflate_finish stream >> return () + else c_call_deflate_noflush stream + newAvail <- fromIntegral `fmap` c_get_avail_out stream + if newAvail == 0 || (isFinish && newAvail /= chunkSize) + then do + bs <- unsafePackCStringLen (outbuff, chunkSize - newAvail) + eacc <- iter acc bs + case eacc of + Left acc' -> return $ Left acc' + Right acc' -> do + c_set_avail_out stream outbuff $ fromIntegral chunkSize + drainOutput isFinish stream outbuff iter acc' + else return $ Right acc + +finishStream :: (acc -> ByteString -> IO (Either acc acc)) + -> ZStream + -> Ptr CChar + -> acc + -> IO (Either acc acc) +finishStream iter stream outbuff acc = + drainOutput True stream outbuff iter acc + +compressIter :: (acc -> ByteString -> IO (Either acc acc)) + -> ZStream + -> Ptr CChar + -> acc + -> ByteString + -> IO (Either acc acc) +compressIter iter stream outbuff acc bsInput = do + unsafeUseAsCStringLen bsInput $ \(cstr, len) -> + c_set_avail_in stream cstr $ fromIntegral len + drainOutput False stream outbuff iter acc + +data ZStreamStruct +type ZStream = Ptr ZStreamStruct + +foreign import ccall unsafe "create_z_stream" + c_create_z_stream :: IO ZStream + +foreign import ccall unsafe "free_z_stream" + c_free_z_stream :: ZStream -> IO () + +foreign import ccall unsafe "set_avail_in" + c_set_avail_in :: ZStream -> Ptr CChar -> CUInt -> IO () + +foreign import ccall unsafe "set_avail_out" + c_set_avail_out :: ZStream -> Ptr CChar -> CUInt -> IO () + +foreign import ccall unsafe "call_deflate_noflush" + c_call_deflate_noflush :: ZStream -> IO () + +foreign import ccall unsafe "call_deflate_finish" + c_call_deflate_finish :: ZStream -> IO CInt + +foreign import ccall unsafe "get_avail_out" + c_get_avail_out :: ZStream -> IO CUInt diff --git a/c/helper.c b/c/helper.c new file mode 100644 --- /dev/null +++ b/c/helper.c @@ -0,0 +1,56 @@ +#include +#include +#include +#include + +z_stream * create_z_stream (void) +{ + z_stream *ret = malloc(sizeof(z_stream)); + ret->zalloc = Z_NULL; + ret->zfree = Z_NULL; + ret->opaque = Z_NULL; + ret->next_in = NULL; + ret->avail_in = 0; + + if (deflateInit2(ret, 7, Z_DEFLATED, 31, 8, Z_DEFAULT_STRATEGY) + != Z_OK) return NULL; + else return ret; +} + +void free_z_stream (z_stream *stream) +{ + deflateEnd(stream); + free(stream); +} + +void set_avail_in (z_stream *stream, char *buff, unsigned int avail) +{ + stream->next_in = buff; + stream->avail_in = avail; +} + +void set_avail_out (z_stream *stream, char *buff, unsigned int avail) +{ + stream->next_out = buff; + stream->avail_out = avail; +} + +void call_deflate_noflush (z_stream *stream) +{ + int ret; + ret = deflate(stream, Z_NO_FLUSH); + assert (ret == Z_OK); +} + +int call_deflate_finish (z_stream *stream) +{ + int ret; + ret = deflate(stream, Z_FINISH); + assert (ret == Z_OK || ret == Z_STREAM_END); + return ret; +} + +unsigned int get_avail_out (z_stream *stream) +{ + return stream->avail_out; +} diff --git a/wai-extra.cabal b/wai-extra.cabal --- a/wai-extra.cabal +++ b/wai-extra.cabal @@ -1,5 +1,5 @@ Name: wai-extra -Version: 0.1.0 +Version: 0.1.1 Synopsis: Provides some basic WAI handlers and middleware. Description: The goal here is to provide common features without many dependencies. License: BSD3 @@ -18,7 +18,6 @@ wai >= 0.0.0 && < 0.1, old-locale >= 1.0 && < 1.1, time >= 1.1.4 && < 1.2, - zlib >= 0.5.2.0 && < 0.6, sendfile >= 0.6.1 && < 0.7, network >= 2.2.1.5 && < 2.3 Exposed-modules: Network.Wai.Handler.CGI @@ -26,5 +25,9 @@ Network.Wai.Middleware.CleanPath Network.Wai.Middleware.Gzip Network.Wai.Middleware.Jsonp + Network.Wai.Zlib Other-modules: Network.Wai.Handler.Helper ghc-options: -Wall + c-sources: c/helper.c + include-dirs: c + extra-libraries: z