Changeset 1931 for trunk/server
- Timestamp:
- Jul 16, 2011, 8:10:46 PM (13 years ago)
- 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 7 7 import Control.Monad.CatchIO 8 8 import qualified Data.ByteString.Lazy as B 9 import Data.ByteString.Lazy.Char8 (pack)10 9 import Data.Char 11 10 import Data.Dynamic 12 11 import Data.Int 13 import Data.List (unfoldr)14 import Data.List.Split (splitOn)15 import Data.Maybe (fromJust, isNothing, isJust)16 12 import qualified Data.Map as M 17 13 import Data.Time.Clock.POSIX 18 14 import Data.Time.Format 19 import Network.CGI hiding (ContentType)15 import Network.CGI 20 16 import Numeric 21 17 import System.FilePath … … 26 22 import System.Posix 27 23 import System.Posix.Handle 28 import System.Random 29 30 type Encoding = String 31 type ContentType = String 32 33 encodings :: M.Map String Encoding 24 25 encodings :: M.Map String String 34 26 encodings = M.fromList [ 35 27 (".bz2", "bzip2"), … … 38 30 ] 39 31 40 types :: M.Map String ContentType32 types :: M.Map String String 41 33 types = M.fromList [ 42 34 (".avi", "video/x-msvideo"), … … 130 122 outputMyError BadRange = outputError 416 "Requested Range Not Satisfiable" [] 131 123 132 -- | Nothing if type is not whitelisted. 133 checkExtension :: FilePath -> Maybe (Maybe Encoding, ContentType) 134 checkExtension file = 124 checkExtension :: FilePath -> CGI () 125 checkExtension file = do 135 126 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 143 136 144 137 checkMethod :: CGI CGIResult -> CGI CGIResult … … 171 164 return $ if parseHTTPDate ir == Just mTime then Just () else Nothing 172 165 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 166 parseRange :: String -> FileOffset -> Maybe (FileOffset, FileOffset) 167 parseRange (splitAt 6 -> ("bytes=", '-':(readDec -> [(len, "")]))) size = 168 Just (max 0 (size - len), size - 1) 169 parseRange (splitAt 6 -> ("bytes=", readDec -> [(a, "-")])) size = 170 Just (a, size - 1) 171 parseRange (splitAt 6 -> ("bytes=", readDec -> [(a, '-':(readDec -> [(b, "")]))])) size = 172 Just (a, min (size - 1) b) 173 parseRange _ _ = Nothing 174 175 checkRange :: EpochTime -> FileOffset -> CGI (Maybe (FileOffset, FileOffset)) 176 checkRange mTime size = do 188 177 setHeader "Accept-Ranges" "bytes" 189 178 (requestHeader "Range" >>=) $ maybe (return Nothing) $ \range -> do 190 179 (checkIfRange mTime >>=) $ maybe (return Nothing) $ \() -> do 191 case parseRange srange size of192 Just rs | all (\(a, b) -> a <= b) rs -> return $ Just rs180 case parseRange range size of 181 Just (a, b) | a <= b -> return $ Just (a, b) 193 182 Just _ -> throw BadRange 194 183 Nothing -> return Nothing 195 184 196 outputAll :: Handle -> FileOffset -> ContentType -> CGI CGIResult 197 outputAll h size ctype = do 198 setHeader "Content-Type" ctype 185 outputAll :: Handle -> FileOffset -> CGI CGIResult 186 outputAll h size = do 199 187 setHeader "Content-Length" $ show size 200 188 outputFPS =<< liftIO (B.hGetContents h) … … 208 196 return (B.append (B.take len contents) end) 209 197 210 outputRange :: Handle -> FileOffset -> ContentType -> Maybe [(FileOffset, FileOffset)]-> CGI CGIResult211 outputRange h size ctype Nothing = outputAll h size ctype212 outputRange h size ctype (Just [(a, b)]) = do198 outputRange :: Handle -> FileOffset -> Maybe (FileOffset, FileOffset) -> CGI CGIResult 199 outputRange h size Nothing = outputAll h size 200 outputRange h size (Just (a, b)) = do 213 201 let len = b - a + 1 214 202 215 203 setStatus 206 "Partial Content" 216 setHeader "Content-Type" ctype217 204 setHeader "Content-Range" $ 218 205 "bytes " ++ show a ++ "-" ++ show b ++ "/" ++ show size … … 220 207 liftIO $ hSeek h AbsoluteSeek (fromIntegral a) 221 208 outputFPS =<< liftIO (hGetClose h (fromIntegral len)) 222 outputRange h size ctype (Just rs) = do223 seed <- liftIO getStdGen224 let ints = take 16 $ unfoldr (Just . random) seed :: [Int]225 sep = concat $ map (flip showHex "" . (`mod` 16)) ints226 setStatus 206 "Partial Content"227 228 setHeader "Content-Type" $ "multipart/byteranges; boundary=" ++ sep229 -- Need Content-Length? RFC doesn't seem to mandate it...230 chunks <- liftIO $ sequence $ map readChunk rs231 let parts = map (uncurry $ mkPartHeader sep) (zip rs chunks)232 body = B.concat [ pack "\r\n"233 , B.concat parts234 , 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 before238 -- reading is finished...239 outputFPS (B.append body end)240 where readChunk :: (FileOffset, FileOffset) -> IO B.ByteString241 readChunk (a, b) = do242 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 way245 B.hGet h (fromIntegral $ b - a + 1)246 mkPartHeader :: String -> (FileOffset, FileOffset) -> B.ByteString -> B.ByteString247 mkPartHeader sep (a, b) chunk = B.concat [ pack "--" , pack sep248 , pack "\r\nContent-Type: ", pack ctype249 , pack "\r\nContent-Range: bytes "250 , pack $ show a, pack "-", pack $ show b251 , pack "/", pack $ show size252 , pack "\r\n\r\n", chunk, pack "\r\n"253 ]254 255 209 256 210 serveFile :: FilePath -> CGI CGIResult 257 211 serveFile 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 262 213 263 214 checkMethod $ do … … 275 226 checkModified mTime 276 227 277 range s <- checkRangesmTime size278 outputRange h size ctype ranges228 range <- checkRange mTime size 229 outputRange h size range 279 230 280 231 main :: IO () -
trunk/server/common/oursrc/scripts-static-cat/scripts-static-cat.cabal
r1900 r1931 19 19 MonadCatchIO-mtl, 20 20 old-locale, 21 random,22 split,23 21 time, 24 22 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/python2 3 from subprocess import Popen, PIPE4 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 OK13 Date: Sun, 12 Jun 2011 02:59:36 GMT14 Server: Apache15 Last-Modified: Sat, 11 Jun 2011 21:55:23 GMT16 ETag: "823818c-2c6-4a576be3968c0"17 Accept-Ranges: bytes18 Content-Length: 71019 Vary: Accept-Encoding20 Content-Type: text/html21 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 Content33 Date: Sun, 12 Jun 2011 03:05:41 GMT34 Server: Apache35 Last-Modified: Sat, 11 Jun 2011 21:55:23 GMT36 ETag: "823818c-2c6-4a576be3968c0"37 Accept-Ranges: bytes38 Content-Length: 10139 Vary: Accept-Encoding40 Content-Range: bytes 100-200/71041 Content-Type: text/html42 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 above48 49 50 def test_overlapping_ranges():51 truth =\52 r"""HTTP/1.1 206 Partial Content53 Date: Sun, 12 Jun 2011 03:07:02 GMT54 Server: Apache55 Last-Modified: Sat, 11 Jun 2011 21:55:23 GMT56 ETag: "823818c-2c6-4a576be3968c0"57 Accept-Ranges: bytes58 Content-Length: 39559 Vary: Accept-Encoding60 Content-Type: multipart/byteranges; boundary=4a57b18cf808c49ff61 62 63 --4a57b18cf808c49ff64 Content-type: text/html65 Content-range: bytes 100-200/71066 67 aut quid malum, sensu iudicari, sed animo etiam ac ratione intellegi posse et voluptatem ipsam per se68 --4a57b18cf808c49ff69 Content-type: text/html70 Content-range: bytes 150-250/71071 72 ratione intellegi posse et voluptatem ipsam per se esse expetendam et dolorem ipsum per se esse fugi73 --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 Content84 Date: Sun, 12 Jun 2011 03:08:19 GMT85 Server: Apache86 Last-Modified: Sat, 11 Jun 2011 21:55:23 GMT87 ETag: "823818c-2c6-4a576be3968c0"88 Accept-Ranges: bytes89 Content-Length: 42990 Vary: Accept-Encoding91 Content-Type: multipart/byteranges; boundary=4a57b1d5f1d8949fd92 93 94 --4a57b1d5f1d8949fd95 Content-type: text/html96 Content-range: bytes 50-100/71097 98 lint tradere et negent satis esse, quid bonum sit a99 --4a57b1d5f1d8949fd100 Content-type: text/html101 Content-range: bytes 150-200/710102 103 ratione intellegi posse et voluptatem ipsam per se104 --4a57b1d5f1d8949fd105 Content-type: text/html106 Content-range: bytes 250-300/710107 108 iendum. itaque aiunt hanc quasi naturalem atque ins109 --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.