X-Git-Url: http://andersk.mit.edu/gitweb/scripts-static-cat.git/blobdiff_plain/374d09ff4081ea5bbbf70f412ea7c0b037b779e9..9b3cd5c2d8c20aa23725e791d828e07627ce062a:/StaticCat.hs diff --git a/StaticCat.hs b/StaticCat.hs index b5d03fc..ba9e0b7 100644 --- a/StaticCat.hs +++ b/StaticCat.hs @@ -8,6 +8,7 @@ import Control.Monad.CatchIO import qualified Data.ByteString.Lazy as B import Data.Char import Data.Dynamic +import Data.Int import qualified Data.Map as M import Data.Time.Clock.POSIX import Data.Time.Format @@ -16,6 +17,7 @@ import Numeric import System.FilePath import System.IO import System.IO.Error (isDoesNotExistError, isPermissionError) +import System.IO.Unsafe import System.Locale import System.Posix import System.Posix.Handle @@ -123,6 +125,8 @@ checkIfRange mTime = do return $ if parseHTTPDate ir == Just mTime then Just () else Nothing parseRange :: String -> FileOffset -> Maybe (FileOffset, FileOffset) +parseRange (splitAt 6 -> ("bytes=", '-':(readDec -> [(len, "")]))) size = + Just (max 0 (size - len), size - 1) parseRange (splitAt 6 -> ("bytes=", readDec -> [(a, "-")])) size = Just (a, size - 1) parseRange (splitAt 6 -> ("bytes=", readDec -> [(a, '-':(readDec -> [(b, "")]))])) size = @@ -136,13 +140,22 @@ checkRange mTime size = do (checkIfRange mTime >>=) $ maybe (return Nothing) $ \() -> do case parseRange range size of Just (a, b) | a <= b -> return $ Just (a, b) - _ -> throw BadRange + Just _ -> throw BadRange + Nothing -> return Nothing outputAll :: Handle -> FileOffset -> CGI CGIResult outputAll h size = do setHeader "Content-Length" $ show size outputFPS =<< liftIO (B.hGetContents h) +-- | Lazily read a given number of bytes from the handle into a +-- 'ByteString', then close the handle. +hGetClose :: Handle -> Int64 -> IO B.ByteString +hGetClose h len = do + contents <- B.hGetContents h + end <- unsafeInterleaveIO (hClose h >> return B.empty) + return (B.append (B.take len contents) end) + outputRange :: Handle -> FileOffset -> Maybe (FileOffset, FileOffset) -> CGI CGIResult outputRange h size Nothing = outputAll h size outputRange h size (Just (a, b)) = do @@ -153,7 +166,7 @@ outputRange h size (Just (a, b)) = do "bytes " ++ show a ++ "-" ++ show b ++ "/" ++ show size setHeader "Content-Length" $ show len liftIO $ hSeek h AbsoluteSeek (fromIntegral a) - outputFPS =<< liftIO (B.hGet h (fromIntegral len)) + outputFPS =<< liftIO (hGetClose h (fromIntegral len)) serveFile :: FilePath -> CGI CGIResult serveFile file = (`catch` outputMyError) $ do