Ignore unparsable byte ranges.

[scripts-static-cat.git] / StaticCat.hs

diff --git a/StaticCat.hs b/StaticCat.hs
index 9f8881c0e28f1c786a85890c1be6c35860a3734b..ba9e0b76137e3db0c1da5d6560e89a842ce13b0d 100644 (file)
--- 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,10 +125,12 @@ 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, "")]))])) _ =
-    Just (a, b)
+parseRange (splitAt 6 -> ("bytes=", readDec -> [(a, '-':(readDec -> [(b, "")]))])) size =
+    Just (a, min (size - 1) b)
 parseRange _ _ = Nothing
 
 checkRange :: EpochTime -> FileOffset -> CGI (Maybe (FileOffset, FileOffset))
@@ -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