Index: trunk/server/common/oursrc/scripts-static-cat/StaticCat.hs
===================================================================
--- trunk/server/common/oursrc/scripts-static-cat/StaticCat.hs	(revision 1877)
+++ trunk/server/common/oursrc/scripts-static-cat/StaticCat.hs	(revision 1900)
@@ -7,11 +7,15 @@
 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
+import Network.CGI hiding (ContentType)
 import Numeric
 import System.FilePath
@@ -22,6 +26,10 @@
 import System.Posix
 import System.Posix.Handle
-
-encodings :: M.Map String String
+import System.Random
+
+type Encoding = String
+type ContentType = String
+
+encodings :: M.Map String Encoding
 encodings = M.fromList [
              (".bz2", "bzip2"),
@@ -30,5 +38,5 @@
             ]
 
-types :: M.Map String String
+types :: M.Map String ContentType
 types = M.fromList [
          (".avi", "video/x-msvideo"),
@@ -122,16 +130,15 @@
 outputMyError BadRange = outputError 416 "Requested Range Not Satisfiable" []
 
-checkExtension :: FilePath -> CGI ()
-checkExtension file = do
+-- | Nothing if type is not whitelisted.
+checkExtension :: FilePath -> Maybe (Maybe Encoding, ContentType)
+checkExtension file =
   let (base, ext) = splitExtension file
-  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
+      (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)
 
 checkMethod :: CGI CGIResult -> CGI CGIResult
@@ -164,25 +171,30 @@
       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 =
-    Just (a, min (size - 1) b)
-parseRange _ _ = Nothing
-
-checkRange :: EpochTime -> FileOffset -> CGI (Maybe (FileOffset, FileOffset))
-checkRange mTime size = do
+-- | 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
   setHeader "Accept-Ranges" "bytes"
   (requestHeader "Range" >>=) $ maybe (return Nothing) $ \range -> do
   (checkIfRange mTime >>=) $ maybe (return Nothing) $ \() -> do
-    case parseRange range size of
-      Just (a, b) | a <= b -> return $ Just (a, b)
+    case parseRanges range size of
+      Just rs | all (\(a, b) -> a <= b) rs -> return $ Just rs
       Just _ -> throw BadRange
       Nothing -> return Nothing
 
-outputAll :: Handle -> FileOffset -> CGI CGIResult
-outputAll h size = do
+outputAll :: Handle -> FileOffset -> ContentType -> CGI CGIResult
+outputAll h size ctype = do
+  setHeader "Content-Type" ctype
   setHeader "Content-Length" $ show size
   outputFPS =<< liftIO (B.hGetContents h)
@@ -196,10 +208,11 @@
   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
+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
   let len = b - a + 1
 
   setStatus 206 "Partial Content"
+  setHeader "Content-Type" ctype
   setHeader "Content-Range" $
    "bytes " ++ show a ++ "-" ++ show b ++ "/" ++ show size
@@ -207,8 +220,44 @@
   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
-  checkExtension file
+  let menctype = checkExtension file
+  when (isNothing menctype) $ throw Forbidden
+  let (menc, ctype) = fromJust menctype
+  when (isJust menc) $ setHeader "Content-Encoding" (fromJust menc)
 
   checkMethod $ do
@@ -226,6 +275,6 @@
   checkModified mTime
 
-  range <- checkRange mTime size
-  outputRange h size range
+  ranges <- checkRanges mTime size
+  outputRange h size ctype ranges
 
 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 1877)
+++ trunk/server/common/oursrc/scripts-static-cat/scripts-static-cat.cabal	(revision 1900)
@@ -19,4 +19,6 @@
     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 1900)
@@ -0,0 +1,1 @@
+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 1900)
@@ -0,0 +1,123 @@
+#!/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."