1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
|
{-# LANGUAGE OverloadedStrings #-}
module ResponseSpec (main, spec) where
import Control.Concurrent (threadDelay)
import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as S8
import Data.Maybe (mapMaybe)
import Network.HTTP.Types
import Network.Wai hiding (responseHeaders)
import Network.Wai.Handler.Warp
import Network.Wai.Handler.Warp.Response
import RunSpec (msRead, msWrite, withApp, withMySocket)
import Test.Hspec
main :: IO ()
main = hspec spec
testRange
:: S.ByteString
-- ^ range value
-> String
-- ^ expected output
-> Maybe String
-- ^ expected content-range value
-> Spec
testRange range out crange = it title $ withApp defaultSettings app $ withMySocket $ \ms -> do
msWrite ms "GET / HTTP/1.0\r\n"
msWrite ms "Range: bytes="
msWrite ms range
msWrite ms "\r\n\r\n"
threadDelay 10000
bss <- fmap (lines . filter (/= '\r') . S8.unpack) $ msRead ms 1024
last bss `shouldBe` out
let hs = mapMaybe toHeader bss
lookup "Content-Range" hs `shouldBe` fmap ("bytes " ++) crange
lookup "Content-Length" hs `shouldBe` Just (show $ length $ last bss)
where
app _ = ($ responseFile status200 [] "attic/hex" Nothing)
title = show (range, out, crange)
toHeader s =
case break (== ':') s of
(x, ':' : y) -> Just (x, dropWhile (== ' ') y)
_ -> Nothing
testPartial
:: Integer
-- ^ file size
-> Integer
-- ^ offset
-> Integer
-- ^ byte count
-> String
-- ^ expected output
-> Spec
testPartial size offset count out = it title $ withApp defaultSettings app $ withMySocket $ \ms -> do
msWrite ms "GET / HTTP/1.0\r\n\r\n"
threadDelay 10000
bss <- fmap (lines . filter (/= '\r') . S8.unpack) $ msRead ms 1024
out `shouldBe` last bss
let hs = mapMaybe toHeader bss
lookup "Content-Length" hs `shouldBe` Just (show $ length $ last bss)
lookup "Content-Range" hs `shouldBe` Just range
where
app _ = ($ responseFile status200 [] "attic/hex" $ Just $ FilePart offset count size)
title = show (offset, count, out)
toHeader s =
case break (== ':') s of
(x, ':' : y) -> Just (x, dropWhile (== ' ') y)
_ -> Nothing
range =
"bytes " ++ show offset ++ "-" ++ show (offset + count - 1) ++ "/" ++ show size
spec :: Spec
spec = do
{- http-client does not support this.
describe "preventing response splitting attack" $ do
it "sanitizes header values" $ do
let app _ respond = respond $ responseLBS status200 [("foo", "foo\r\nbar")] "Hello"
withApp defaultSettings app $ \port -> do
res <- sendGET $ "http://127.0.0.1:" ++ show port
getHeaderValue "foo" (responseHeaders res) `shouldBe`
Just "foo bar" -- HTTP inserts two spaces for \r\n.
-}
describe "sanitizeHeaderValue" $ do
it "doesn't alter valid multiline header values" $ do
sanitizeHeaderValue "foo\r\n bar" `shouldBe` "foo\r\n bar"
it "adds missing spaces after \r\n" $ do
sanitizeHeaderValue "foo\r\nbar" `shouldBe` "foo\r\n bar"
it "discards empty lines" $ do
sanitizeHeaderValue "foo\r\n\r\nbar" `shouldBe` "foo\r\n bar"
context "when sanitizing single occurrences of \n" $ do
it "replaces \n with \r\n" $ do
sanitizeHeaderValue "foo\n bar" `shouldBe` "foo\r\n bar"
it "adds missing spaces after \n" $ do
sanitizeHeaderValue "foo\nbar" `shouldBe` "foo\r\n bar"
it "discards single occurrences of \r" $ do
sanitizeHeaderValue "foo\rbar" `shouldBe` "foobar"
describe "range requests" $ do
testRange "2-3" "23" $ Just "2-3/16"
testRange "5-" "56789abcdef" $ Just "5-15/16"
testRange "5-8" "5678" $ Just "5-8/16"
testRange "-3" "def" $ Just "13-15/16"
testRange "16-" "" $ Just "*/16"
testRange "-17" "0123456789abcdef" Nothing
describe "partial files" $ do
testPartial 16 2 2 "23"
testPartial 16 0 2 "01"
testPartial 16 3 8 "3456789a"
|
