Set X-Private header for private derivations
This commit is contained in:
parent
6c6b5d3377
commit
b4fac5ab8c
36
src/Main.hs
36
src/Main.hs
@ -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
|
||||||
|
Loading…
x
Reference in New Issue
Block a user