Index: trunk/server/common/oursrc/scripts-static-cat/StaticCat.hs
===================================================================
--- trunk/server/common/oursrc/scripts-static-cat/StaticCat.hs	(revision 1900)
+++ trunk/server/common/oursrc/scripts-static-cat/StaticCat.hs	(revision 1931)
@@ -7,15 +7,11 @@
 import Control.Monad.CatchIO
 import qualified Data.ByteString.Lazy as B
-import Data.ByteString.Lazy.Char8 (pack)
 import Data.Char
 import Data.Dynamic
 import Data.Int
-import Data.List (unfoldr)
-import Data.List.Split (splitOn)
-import Data.Maybe (fromJust, isNothing, isJust)
 import qualified Data.Map as M
 import Data.Time.Clock.POSIX
 import Data.Time.Format
-import Network.CGI hiding (ContentType)
+import Network.CGI
 import Numeric
 import System.FilePath
@@ -26,10 +22,6 @@
 import System.Posix
 import System.Posix.Handle
-import System.Random
-
-type Encoding = String
-type ContentType = String
-
-encodings :: M.Map String Encoding
+
+encodings :: M.Map String String
 encodings = M.fromList [
              (".bz2", "bzip2"),
@@ -38,5 +30,5 @@
             ]
 
-types :: M.Map String ContentType
+types :: M.Map String String
 types = M.fromList [
          (".avi", "video/x-msvideo"),
@@ -130,15 +122,16 @@
 outputMyError BadRange = outputError 416 "Requested Range Not Satisfiable" []
 
--- | Nothing if type is not whitelisted.
-checkExtension :: FilePath -> Maybe (Maybe Encoding, ContentType)
-checkExtension file =
+checkExtension :: FilePath -> CGI ()
+checkExtension file = do
   let (base, ext) = splitExtension file
-      (file', enc) = case M.lookup (map toLower ext) encodings of
-                        Nothing -> (file, Nothing)
-                        Just e -> (base, Just e)
-      (_, ext') = splitExtension file'
-   in case M.lookup (map toLower ext') types of
-            Nothing -> Nothing
-            Just e -> Just (enc, e)
+  ext' <- case M.lookup (map toLower ext) encodings of
+            Nothing -> return ext
+            Just e -> do
+              setHeader "Content-Encoding" e
+              return $ takeExtension base
+
+  case M.lookup (map toLower ext') types of
+    Nothing -> throw Forbidden
+    Just t -> setHeader "Content-Type" t
 
 checkMethod :: CGI CGIResult -> CGI CGIResult
@@ -171,30 +164,25 @@
       return $ if parseHTTPDate ir == Just mTime then Just () else Nothing
 
--- | parseRanges string size returns a list of ranges, or Nothing if parse fails.
-parseRanges :: String -> FileOffset -> Maybe [(FileOffset, FileOffset)]
-parseRanges (splitAt 6 -> ("bytes=", ranges)) size =
-    mapM parseOneRange $ splitOn "," ranges
-    where parseOneRange ('-':(readDec -> [(len, "")])) =
-            Just (max 0 (size - len), size - 1)
-          parseOneRange (readDec -> [(a, "-")]) =
-            Just (a, size - 1)
-          parseOneRange (readDec -> [(a, '-':(readDec -> [(b, "")]))]) =
-            Just (a, min (size - 1) b)
-          parseOneRange _ = Nothing
-parseRanges _ _ = Nothing
-
-checkRanges :: EpochTime -> FileOffset -> CGI (Maybe [(FileOffset, FileOffset)])
-checkRanges mTime size = do
+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 =
+    Just (a, min (size - 1) b)
+parseRange _ _ = Nothing
+
+checkRange :: EpochTime -> FileOffset -> CGI (Maybe (FileOffset, FileOffset))
+checkRange mTime size = do
   setHeader "Accept-Ranges" "bytes"
   (requestHeader "Range" >>=) $ maybe (return Nothing) $ \range -> do
   (checkIfRange mTime >>=) $ maybe (return Nothing) $ \() -> do
-    case parseRanges range size of
-      Just rs | all (\(a, b) -> a <= b) rs -> return $ Just rs
+    case parseRange range size of
+      Just (a, b) | a <= b -> return $ Just (a, b)
       Just _ -> throw BadRange
       Nothing -> return Nothing
 
-outputAll :: Handle -> FileOffset -> ContentType -> CGI CGIResult
-outputAll h size ctype = do
-  setHeader "Content-Type" ctype
+outputAll :: Handle -> FileOffset -> CGI CGIResult
+outputAll h size = do
   setHeader "Content-Length" $ show size
   outputFPS =<< liftIO (B.hGetContents h)
@@ -208,11 +196,10 @@
   return (B.append (B.take len contents) end)
 
-outputRange :: Handle -> FileOffset -> ContentType -> Maybe [(FileOffset, FileOffset)] -> CGI CGIResult
-outputRange h size ctype Nothing = outputAll h size ctype
-outputRange h size ctype (Just [(a, b)]) = do
+outputRange :: Handle -> FileOffset -> Maybe (FileOffset, FileOffset) -> CGI CGIResult
+outputRange h size Nothing = outputAll h size
+outputRange h size (Just (a, b)) = do
   let len = b - a + 1
 
   setStatus 206 "Partial Content"
-  setHeader "Content-Type" ctype
   setHeader "Content-Range" $
    "bytes " ++ show a ++ "-" ++ show b ++ "/" ++ show size
@@ -220,44 +207,8 @@
   liftIO $ hSeek h AbsoluteSeek (fromIntegral a)
   outputFPS =<< liftIO (hGetClose h (fromIntegral len))
-outputRange h size ctype (Just rs) = do
-  seed <- liftIO getStdGen
-  let ints = take 16 $ unfoldr (Just . random) seed :: [Int]
-      sep  = concat $ map (flip showHex "" . (`mod` 16)) ints
-  setStatus 206 "Partial Content"
-
-  setHeader "Content-Type" $ "multipart/byteranges; boundary=" ++ sep
-  -- Need Content-Length? RFC doesn't seem to mandate it...
-  chunks <- liftIO $ sequence $ map readChunk rs
-  let parts = map (uncurry $ mkPartHeader sep) (zip rs chunks)
-      body = B.concat [ pack "\r\n"
-                      , B.concat parts
-                      , pack "--", pack sep, pack "--\r\n"
-                      ]
-  end <- liftIO $ unsafeInterleaveIO (hClose h >> return B.empty)
-  -- TODO figure out how to guarantee handle is ALWAYS closed, and NEVER before
-  -- reading is finished...
-  outputFPS (B.append body end)
-   where readChunk :: (FileOffset, FileOffset) -> IO B.ByteString
-         readChunk (a, b) = do
-            hSeek h AbsoluteSeek (fromIntegral a)
-            -- Carful here, hGetContents makes the handle unusable afterwards.
-            -- TODO Anders says use hGetSome or some other way lazy way
-            B.hGet h (fromIntegral $ b - a + 1)
-         mkPartHeader :: String -> (FileOffset, FileOffset) -> B.ByteString -> B.ByteString
-         mkPartHeader sep (a, b) chunk = B.concat [ pack "--" , pack sep
-                                                  , pack "\r\nContent-Type: ", pack ctype
-                                                  , pack "\r\nContent-Range: bytes "
-                                                  , pack $ show a, pack "-", pack $ show b
-                                                  , pack "/", pack $ show size
-                                                  , pack "\r\n\r\n", chunk, pack "\r\n"
-                                                  ]
-
 
 serveFile :: FilePath -> CGI CGIResult
 serveFile file = (`catch` outputMyError) $ do
-  let menctype = checkExtension file
-  when (isNothing menctype) $ throw Forbidden
-  let (menc, ctype) = fromJust menctype
-  when (isJust menc) $ setHeader "Content-Encoding" (fromJust menc)
+  checkExtension file
 
   checkMethod $ do
@@ -275,6 +226,6 @@
   checkModified mTime
 
-  ranges <- checkRanges mTime size
-  outputRange h size ctype ranges
+  range <- checkRange mTime size
+  outputRange h size range
 
 main :: IO ()
Index: trunk/server/common/oursrc/scripts-static-cat/scripts-static-cat.cabal
===================================================================
--- trunk/server/common/oursrc/scripts-static-cat/scripts-static-cat.cabal	(revision 1900)
+++ trunk/server/common/oursrc/scripts-static-cat/scripts-static-cat.cabal	(revision 1931)
@@ -19,6 +19,4 @@
     MonadCatchIO-mtl,
     old-locale,
-    random,
-    split,
     time,
     unix,
Index: trunk/server/common/oursrc/scripts-static-cat/test.html
===================================================================
--- trunk/server/common/oursrc/scripts-static-cat/test.html	(revision 1900)
+++ trunk/server/common/oursrc/scripts-static-cat/test.html	(revision 1931)
@@ -1,1 +1,0 @@
-Sunt autem quidam e nostris, qui haec subtilius velint tradere et negent satis esse, quid bonum sit aut quid malum, sensu iudicari, sed animo etiam ac ratione intellegi posse et voluptatem ipsam per se esse expetendam et dolorem ipsum per se esse fugiendum. itaque aiunt hanc quasi naturalem atque insitam in animis nostris inesse notionem, ut alterum esse appetendum, alterum aspernandum sentiamus. Alii autem, quibus ego assentior, cum a philosophis compluribus permulta dicantur, cur nec voluptas in bonis sit numeranda nec in malis dolor, non existimant oportere nimium nos causae confidere, sed et argumentandum et accurate disserendum et rationibus conquisitis de voluptate et dolore disputandum putant.
Index: trunk/server/common/oursrc/scripts-static-cat/test.py
===================================================================
--- trunk/server/common/oursrc/scripts-static-cat/test.py	(revision 1900)
+++ trunk/server/common/oursrc/scripts-static-cat/test.py	(revision 1931)
@@ -1,123 +1,0 @@
-#!/usr/bin/python
-
-from subprocess import Popen, PIPE
-
-
-# Make test.html in this directory available at this url:
-URL = "http://cberzan.scripts.mit.edu/static-cat.cgi/test.html"
-
-
-def test_all():
-    truth =\
-r"""HTTP/1.1 200 OK
-Date: Sun, 12 Jun 2011 02:59:36 GMT
-Server: Apache
-Last-Modified: Sat, 11 Jun 2011 21:55:23 GMT
-ETag: "823818c-2c6-4a576be3968c0"
-Accept-Ranges: bytes
-Content-Length: 710
-Vary: Accept-Encoding
-Content-Type: text/html
-
-Sunt autem quidam e nostris, qui haec subtilius velint tradere et negent satis esse, quid bonum sit aut quid malum, sensu iudicari, sed animo etiam ac ratione intellegi posse et voluptatem ipsam per se esse expetendam et dolorem ipsum per se esse fugiendum. itaque aiunt hanc quasi naturalem atque insitam in animis nostris inesse notionem, ut alterum esse appetendum, alterum aspernandum sentiamus. Alii autem, quibus ego assentior, cum a philosophis compluribus permulta dicantur, cur nec voluptas in bonis sit numeranda nec in malis dolor, non existimant oportere nimium nos causae confidere, sed et argumentandum et accurate disserendum et rationibus conquisitis de voluptate et dolore disputandum putant."""
-    p = Popen(["curl", URL, "-s", "-D", "-"], stdout=PIPE)
-    result = p.communicate()[0]
-    print "TODO finish test..."
-    # LEFT TODO: use mimeheaders or something (http://stackoverflow.com/questions/4685217/parse-raw-http-headers)
-    # to parse headers and make sure they're OK; compare content and make sure it matches byte-for-byte.
-
-
-def test_one_range():
-    truth =\
-r"""HTTP/1.1 206 Partial Content
-Date: Sun, 12 Jun 2011 03:05:41 GMT
-Server: Apache
-Last-Modified: Sat, 11 Jun 2011 21:55:23 GMT
-ETag: "823818c-2c6-4a576be3968c0"
-Accept-Ranges: bytes
-Content-Length: 101
-Vary: Accept-Encoding
-Content-Range: bytes 100-200/710
-Content-Type: text/html
-
-aut quid malum, sensu iudicari, sed animo etiam ac ratione intellegi posse et voluptatem ipsam per se"""
-    p = Popen(["curl", "-r", "100-200", URL, "-s", "-D", "-"], stdout=PIPE)
-    result = p.communicate()[0]
-    print "TODO finish test..."
-    # LEFT TODO: see above
-
-
-def test_overlapping_ranges():
-    truth =\
-r"""HTTP/1.1 206 Partial Content
-Date: Sun, 12 Jun 2011 03:07:02 GMT
-Server: Apache
-Last-Modified: Sat, 11 Jun 2011 21:55:23 GMT
-ETag: "823818c-2c6-4a576be3968c0"
-Accept-Ranges: bytes
-Content-Length: 395
-Vary: Accept-Encoding
-Content-Type: multipart/byteranges; boundary=4a57b18cf808c49ff
-
-
---4a57b18cf808c49ff
-Content-type: text/html
-Content-range: bytes 100-200/710
-
-aut quid malum, sensu iudicari, sed animo etiam ac ratione intellegi posse et voluptatem ipsam per se
---4a57b18cf808c49ff
-Content-type: text/html
-Content-range: bytes 150-250/710
-
- ratione intellegi posse et voluptatem ipsam per se esse expetendam et dolorem ipsum per se esse fugi
- --4a57b18cf808c49ff--
-"""
-    p = Popen(["curl", "-r", "100-200,150-250", URL, "-s", "-D", "-"], stdout=PIPE)
-    result = p.communicate()[0]
-    print "TODO finish test..."
-    # LEFT TODO: see above, with the additional complication that the separating string varies.
-
-
-def test_nonoverlapping_ranges():
-    truth =\
-r"""HTTP/1.1 206 Partial Content
-Date: Sun, 12 Jun 2011 03:08:19 GMT
-Server: Apache
-Last-Modified: Sat, 11 Jun 2011 21:55:23 GMT
-ETag: "823818c-2c6-4a576be3968c0"
-Accept-Ranges: bytes
-Content-Length: 429
-Vary: Accept-Encoding
-Content-Type: multipart/byteranges; boundary=4a57b1d5f1d8949fd
-
-
---4a57b1d5f1d8949fd
-Content-type: text/html
-Content-range: bytes 50-100/710
-
-lint tradere et negent satis esse, quid bonum sit a
---4a57b1d5f1d8949fd
-Content-type: text/html
-Content-range: bytes 150-200/710
-
- ratione intellegi posse et voluptatem ipsam per se
- --4a57b1d5f1d8949fd
- Content-type: text/html
- Content-range: bytes 250-300/710
-
- iendum. itaque aiunt hanc quasi naturalem atque ins
- --4a57b1d5f1d8949fd--
-"""
-    p = Popen(["curl", "-r", "50-100,150-200,250-300", URL, "-s", "-D", "-"], stdout=PIPE)
-    result = p.communicate()[0]
-    print "TODO finish test..."
-    # LEFT TODO: see above, with the additional complication that the separating string varies.
-
-
-if __name__ == "__main__":
-    print "Unfinished tests! Read the source."
-    test_all()
-    test_one_range()
-    test_overlapping_ranges()
-    test_nonoverlapping_ranges()
-    print "Test passed."