Changeset 1931 for trunk/server/common


Ignore:
Timestamp:
Jul 16, 2011, 8:10:46 PM (13 years ago)
Author:
geofft
Message:
Revert r1900

This commit isn't usable as-is. We will probably be applying / working
on parts of it after our Fedora 15 release.
Location:
trunk/server/common/oursrc/scripts-static-cat
Files:
4 edited

Legend:

Unmodified
Added
Removed

  • trunk/server/common/oursrc/scripts-static-cat/StaticCat.hs

    r1900 r1931  
    77import Control.Monad.CatchIO
    88import qualified Data.ByteString.Lazy as B
    9 import Data.ByteString.Lazy.Char8 (pack)
    109import Data.Char
    1110import Data.Dynamic
    1211import Data.Int
    13 import Data.List (unfoldr)
    14 import Data.List.Split (splitOn)
    15 import Data.Maybe (fromJust, isNothing, isJust)
    1612import qualified Data.Map as M
    1713import Data.Time.Clock.POSIX
    1814import Data.Time.Format
    19 import Network.CGI hiding (ContentType)
     15import Network.CGI
    2016import Numeric
    2117import System.FilePath
    … …  
    2622import System.Posix
    2723import System.Posix.Handle
    28 import System.Random
    29 
    30 type Encoding = String
    31 type ContentType = String
    32 
    33 encodings :: M.Map String Encoding
     24
     25encodings :: M.Map String String
    3426encodings = M.fromList [
    3527             (".bz2", "bzip2"),
    … …  
    3830            ]
    3931
    40 types :: M.Map String ContentType
     32types :: M.Map String String
    4133types = M.fromList [
    4234         (".avi", "video/x-msvideo"),
    … …  
    130122outputMyError BadRange = outputError 416 "Requested Range Not Satisfiable" []
    131123
    132 -- | Nothing if type is not whitelisted.
    133 checkExtension :: FilePath -> Maybe (Maybe Encoding, ContentType)
    134 checkExtension file =
     124checkExtension :: FilePath -> CGI ()
     125checkExtension file = do
    135126  let (base, ext) = splitExtension file
    136       (file', enc) = case M.lookup (map toLower ext) encodings of
    137                         Nothing -> (file, Nothing)
    138                         Just e -> (base, Just e)
    139       (_, ext') = splitExtension file'
    140    in case M.lookup (map toLower ext') types of
    141             Nothing -> Nothing
    142             Just e -> Just (enc, e)
     127  ext' <- case M.lookup (map toLower ext) encodings of
     128            Nothing -> return ext
     129            Just e -> do
     130              setHeader "Content-Encoding" e
     131              return $ takeExtension base
     132
     133  case M.lookup (map toLower ext') types of
     134    Nothing -> throw Forbidden
     135    Just t -> setHeader "Content-Type" t
    143136
    144137checkMethod :: CGI CGIResult -> CGI CGIResult
    … …  
    171164      return $ if parseHTTPDate ir == Just mTime then Just () else Nothing
    172165
    173 -- | parseRanges string size returns a list of ranges, or Nothing if parse fails.
    174 parseRanges :: String -> FileOffset -> Maybe [(FileOffset, FileOffset)]
    175 parseRanges (splitAt 6 -> ("bytes=", ranges)) size =
    176     mapM parseOneRange $ splitOn "," ranges
    177     where parseOneRange ('-':(readDec -> [(len, "")])) =
    178             Just (max 0 (size - len), size - 1)
    179           parseOneRange (readDec -> [(a, "-")]) =
    180             Just (a, size - 1)
    181           parseOneRange (readDec -> [(a, '-':(readDec -> [(b, "")]))]) =
    182             Just (a, min (size - 1) b)
    183           parseOneRange _ = Nothing
    184 parseRanges _ _ = Nothing
    185 
    186 checkRanges :: EpochTime -> FileOffset -> CGI (Maybe [(FileOffset, FileOffset)])
    187 checkRanges mTime size = do
     166parseRange :: String -> FileOffset -> Maybe (FileOffset, FileOffset)
     167parseRange (splitAt 6 -> ("bytes=", '-':(readDec -> [(len, "")]))) size =
     168    Just (max 0 (size - len), size - 1)
     169parseRange (splitAt 6 -> ("bytes=", readDec -> [(a, "-")])) size =
     170    Just (a, size - 1)
     171parseRange (splitAt 6 -> ("bytes=", readDec -> [(a, '-':(readDec -> [(b, "")]))])) size =
     172    Just (a, min (size - 1) b)
     173parseRange _ _ = Nothing
     174
     175checkRange :: EpochTime -> FileOffset -> CGI (Maybe (FileOffset, FileOffset))
     176checkRange mTime size = do
    188177  setHeader "Accept-Ranges" "bytes"
    189178  (requestHeader "Range" >>=) $ maybe (return Nothing) $ \range -> do
    190179  (checkIfRange mTime >>=) $ maybe (return Nothing) $ \() -> do
    191     case parseRanges range size of
    192       Just rs | all (\(a, b) -> a <= b) rs -> return $ Just rs
     180    case parseRange range size of
     181      Just (a, b) | a <= b -> return $ Just (a, b)
    193182      Just _ -> throw BadRange
    194183      Nothing -> return Nothing
    195184
    196 outputAll :: Handle -> FileOffset -> ContentType -> CGI CGIResult
    197 outputAll h size ctype = do
    198   setHeader "Content-Type" ctype
     185outputAll :: Handle -> FileOffset -> CGI CGIResult
     186outputAll h size = do
    199187  setHeader "Content-Length" $ show size
    200188  outputFPS =<< liftIO (B.hGetContents h)
    … …  
    208196  return (B.append (B.take len contents) end)
    209197
    210 outputRange :: Handle -> FileOffset -> ContentType -> Maybe [(FileOffset, FileOffset)] -> CGI CGIResult
    211 outputRange h size ctype Nothing = outputAll h size ctype
    212 outputRange h size ctype (Just [(a, b)]) = do
     198outputRange :: Handle -> FileOffset -> Maybe (FileOffset, FileOffset) -> CGI CGIResult
     199outputRange h size Nothing = outputAll h size
     200outputRange h size (Just (a, b)) = do
    213201  let len = b - a + 1
    214202
    215203  setStatus 206 "Partial Content"
    216   setHeader "Content-Type" ctype
    217204  setHeader "Content-Range" $
    218205   "bytes " ++ show a ++ "-" ++ show b ++ "/" ++ show size
    … …  
    220207  liftIO $ hSeek h AbsoluteSeek (fromIntegral a)
    221208  outputFPS =<< liftIO (hGetClose h (fromIntegral len))
    222 outputRange h size ctype (Just rs) = do
    223   seed <- liftIO getStdGen
    224   let ints = take 16 $ unfoldr (Just . random) seed :: [Int]
    225       sep  = concat $ map (flip showHex "" . (`mod` 16)) ints
    226   setStatus 206 "Partial Content"
    227 
    228   setHeader "Content-Type" $ "multipart/byteranges; boundary=" ++ sep
    229   -- Need Content-Length? RFC doesn't seem to mandate it...
    230   chunks <- liftIO $ sequence $ map readChunk rs
    231   let parts = map (uncurry $ mkPartHeader sep) (zip rs chunks)
    232       body = B.concat [ pack "\r\n"
    233                       , B.concat parts
    234                       , pack "--", pack sep, pack "--\r\n"
    235                       ]
    236   end <- liftIO $ unsafeInterleaveIO (hClose h >> return B.empty)
    237   -- TODO figure out how to guarantee handle is ALWAYS closed, and NEVER before
    238   -- reading is finished...
    239   outputFPS (B.append body end)
    240    where readChunk :: (FileOffset, FileOffset) -> IO B.ByteString
    241          readChunk (a, b) = do
    242             hSeek h AbsoluteSeek (fromIntegral a)
    243             -- Carful here, hGetContents makes the handle unusable afterwards.
    244             -- TODO Anders says use hGetSome or some other way lazy way
    245             B.hGet h (fromIntegral $ b - a + 1)
    246          mkPartHeader :: String -> (FileOffset, FileOffset) -> B.ByteString -> B.ByteString
    247          mkPartHeader sep (a, b) chunk = B.concat [ pack "--" , pack sep
    248                                                   , pack "\r\nContent-Type: ", pack ctype
    249                                                   , pack "\r\nContent-Range: bytes "
    250                                                   , pack $ show a, pack "-", pack $ show b
    251                                                   , pack "/", pack $ show size
    252                                                   , pack "\r\n\r\n", chunk, pack "\r\n"
    253                                                   ]
    254 
    255209
    256210serveFile :: FilePath -> CGI CGIResult
    257211serveFile file = (`catch` outputMyError) $ do
    258   let menctype = checkExtension file
    259   when (isNothing menctype) $ throw Forbidden
    260   let (menc, ctype) = fromJust menctype
    261   when (isJust menc) $ setHeader "Content-Encoding" (fromJust menc)
     212  checkExtension file
    262213
    263214  checkMethod $ do
    … …  
    275226  checkModified mTime
    276227
    277   ranges <- checkRanges mTime size
    278   outputRange h size ctype ranges
     228  range <- checkRange mTime size
     229  outputRange h size range
    279230
    280231main :: IO ()

  • trunk/server/common/oursrc/scripts-static-cat/scripts-static-cat.cabal

    r1900 r1931  
    1919    MonadCatchIO-mtl,
    2020    old-locale,
    21     random,
    22     split,
    2321    time,
    2422    unix,

  • trunk/server/common/oursrc/scripts-static-cat/test.html

    r1900 r1931  
    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.

  • trunk/server/common/oursrc/scripts-static-cat/test.py

    r1900 r1931  
    1 #!/usr/bin/python
    2 
    3 from subprocess import Popen, PIPE
    4 
    5 
    6 # Make test.html in this directory available at this url:
    7 URL = "http://cberzan.scripts.mit.edu/static-cat.cgi/test.html"
    8 
    9 
    10 def test_all():
    11     truth =\
    12 r"""HTTP/1.1 200 OK
    13 Date: Sun, 12 Jun 2011 02:59:36 GMT
    14 Server: Apache
    15 Last-Modified: Sat, 11 Jun 2011 21:55:23 GMT
    16 ETag: "823818c-2c6-4a576be3968c0"
    17 Accept-Ranges: bytes
    18 Content-Length: 710
    19 Vary: Accept-Encoding
    20 Content-Type: text/html
    21 
    22 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."""
    23     p = Popen(["curl", URL, "-s", "-D", "-"], stdout=PIPE)
    24     result = p.communicate()[0]
    25     print "TODO finish test..."
    26     # LEFT TODO: use mimeheaders or something (http://stackoverflow.com/questions/4685217/parse-raw-http-headers)
    27     # to parse headers and make sure they're OK; compare content and make sure it matches byte-for-byte.
    28 
    29 
    30 def test_one_range():
    31     truth =\
    32 r"""HTTP/1.1 206 Partial Content
    33 Date: Sun, 12 Jun 2011 03:05:41 GMT
    34 Server: Apache
    35 Last-Modified: Sat, 11 Jun 2011 21:55:23 GMT
    36 ETag: "823818c-2c6-4a576be3968c0"
    37 Accept-Ranges: bytes
    38 Content-Length: 101
    39 Vary: Accept-Encoding
    40 Content-Range: bytes 100-200/710
    41 Content-Type: text/html
    42 
    43 aut quid malum, sensu iudicari, sed animo etiam ac ratione intellegi posse et voluptatem ipsam per se"""
    44     p = Popen(["curl", "-r", "100-200", URL, "-s", "-D", "-"], stdout=PIPE)
    45     result = p.communicate()[0]
    46     print "TODO finish test..."
    47     # LEFT TODO: see above
    48 
    49 
    50 def test_overlapping_ranges():
    51     truth =\
    52 r"""HTTP/1.1 206 Partial Content
    53 Date: Sun, 12 Jun 2011 03:07:02 GMT
    54 Server: Apache
    55 Last-Modified: Sat, 11 Jun 2011 21:55:23 GMT
    56 ETag: "823818c-2c6-4a576be3968c0"
    57 Accept-Ranges: bytes
    58 Content-Length: 395
    59 Vary: Accept-Encoding
    60 Content-Type: multipart/byteranges; boundary=4a57b18cf808c49ff
    61 
    62 
    63 --4a57b18cf808c49ff
    64 Content-type: text/html
    65 Content-range: bytes 100-200/710
    66 
    67 aut quid malum, sensu iudicari, sed animo etiam ac ratione intellegi posse et voluptatem ipsam per se
    68 --4a57b18cf808c49ff
    69 Content-type: text/html
    70 Content-range: bytes 150-250/710
    71 
    72  ratione intellegi posse et voluptatem ipsam per se esse expetendam et dolorem ipsum per se esse fugi
    73  --4a57b18cf808c49ff--
    74 """
    75     p = Popen(["curl", "-r", "100-200,150-250", URL, "-s", "-D", "-"], stdout=PIPE)
    76     result = p.communicate()[0]
    77     print "TODO finish test..."
    78     # LEFT TODO: see above, with the additional complication that the separating string varies.
    79 
    80 
    81 def test_nonoverlapping_ranges():
    82     truth =\
    83 r"""HTTP/1.1 206 Partial Content
    84 Date: Sun, 12 Jun 2011 03:08:19 GMT
    85 Server: Apache
    86 Last-Modified: Sat, 11 Jun 2011 21:55:23 GMT
    87 ETag: "823818c-2c6-4a576be3968c0"
    88 Accept-Ranges: bytes
    89 Content-Length: 429
    90 Vary: Accept-Encoding
    91 Content-Type: multipart/byteranges; boundary=4a57b1d5f1d8949fd
    92 
    93 
    94 --4a57b1d5f1d8949fd
    95 Content-type: text/html
    96 Content-range: bytes 50-100/710
    97 
    98 lint tradere et negent satis esse, quid bonum sit a
    99 --4a57b1d5f1d8949fd
    100 Content-type: text/html
    101 Content-range: bytes 150-200/710
    102 
    103  ratione intellegi posse et voluptatem ipsam per se
    104  --4a57b1d5f1d8949fd
    105  Content-type: text/html
    106  Content-range: bytes 250-300/710
    107 
    108  iendum. itaque aiunt hanc quasi naturalem atque ins
    109  --4a57b1d5f1d8949fd--
    110 """
    111     p = Popen(["curl", "-r", "50-100,150-200,250-300", URL, "-s", "-D", "-"], stdout=PIPE)
    112     result = p.communicate()[0]
    113     print "TODO finish test..."
    114     # LEFT TODO: see above, with the additional complication that the separating string varies.
    115 
    116 
    117 if __name__ == "__main__":
    118     print "Unfinished tests! Read the source."
    119     test_all()
    120     test_one_range()
    121     test_overlapping_ranges()
    122     test_nonoverlapping_ranges()
    123     print "Test passed."
Note: See TracChangeset for help on using the changeset viewer.