Compare commits

..

4 Commits

View File

@ -12,7 +12,6 @@ import Control.Monad.IO.Class (liftIO)
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
import Data.CharSet.ByteSet (ByteSet(..)) import Data.CharSet.ByteSet (ByteSet(..))
import Data.Function ((&)) import Data.Function ((&))
import Data.Word (Word8)
import Network.Socket (SockAddr(..)) import Network.Socket (SockAddr(..))
import Network.Wai (Application) import Network.Wai (Application)
import Nix (NoSuchPath(..), PathInfo(..)) import Nix (NoSuchPath(..), PathInfo(..))
@ -58,20 +57,6 @@ validHashPartBytes =
<> [ 0x76 .. 0x7A ] -- vwxyz <> [ 0x76 .. 0x7A ] -- vwxyz
) )
type HostAddressTuple = (Word8, Word8, Word8, Word8)
isInWhitelist :: Socket.HostAddress -> Bool
isInWhitelist host = any (uncurry (inRange $ Socket.hostAddressToTuple host)) allowedIPs
where
allowedIPs :: [(HostAddressTuple, HostAddressTuple)]
allowedIPs = [
((127,0,0,1), (127,0,0,1)),
((10,0,0,1), (10,255,255,254)),
((192,168,72,1), (192,168,79,254))
]
inRange ip a b = ip >= a && ip <= b
validHashPart :: ByteString -> Bool validHashPart :: ByteString -> Bool
validHashPart hash = ByteString.all (`ByteSet.member` validHashPartBytes) hash validHashPart hash = ByteString.all (`ByteSet.member` validHashPartBytes) hash
@ -271,27 +256,8 @@ makeApplication ApplicationOptions{..} request respond = do
let privateFilePath = ByteString.Char8.unpack storePath ++ "/nix-support/private" let privateFilePath = ByteString.Char8.unpack storePath ++ "/nix-support/private"
isPrivate <- liftIO $ Directory.doesPathExist privateFilePath isPrivate <- liftIO $ Directory.doesPathExist privateFilePath
let isLocal = case Wai.remoteHost request of
SockAddrInet _ host -> isInWhitelist host
_ -> False
traceM $ show (Wai.remoteHost request, isLocal)
traceM $ show (privateFilePath, isPrivate) traceM $ show (privateFilePath, isPrivate)
Monad.when (isPrivate && not isLocal) do
let headers = [ ("Content-Type", "text/plain") ]
let builder = "Forbidden.\n"
let response =
Wai.responseBuilder
Types.status403
headers
builder
done response
let streamingBody write flush = do let streamingBody write flush = do
result <- Nix.dumpPath hashPart callback result <- Nix.dumpPath hashPart callback
@ -303,7 +269,7 @@ makeApplication ApplicationOptions{..} request respond = do
() <- write builder () <- write builder
flush flush
let headers = [ ("Content-Type", "text/plain") ] let headers = [ ("Content-Type", "text/plain") ] <> [("X-Private", "true") | isPrivate]
let response = let response =
Wai.responseStream Types.status200 headers streamingBody Wai.responseStream Types.status200 headers streamingBody