Compare commits
2 Commits
d676436e38
...
8b962f1c44
Author | SHA1 | Date | |
---|---|---|---|
8b962f1c44 | |||
85e97b5260 |
@ -48,6 +48,7 @@ executable nix-serve
|
||||
, base32
|
||||
, bytestring
|
||||
, charset
|
||||
, directory
|
||||
, http-types
|
||||
, managed
|
||||
, megaparsec
|
||||
|
29
src/Main.hs
29
src/Main.hs
@ -6,6 +6,8 @@
|
||||
|
||||
module Main where
|
||||
|
||||
import Debug.Trace
|
||||
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Data.ByteString (ByteString)
|
||||
import Data.CharSet.ByteSet (ByteSet(..))
|
||||
@ -35,6 +37,7 @@ import qualified Network.Wai.Middleware.RequestLogger as RequestLogger
|
||||
import qualified Nix
|
||||
import qualified Options
|
||||
import qualified Options.Applicative as Options
|
||||
import qualified System.Directory as Directory
|
||||
import qualified System.Environment as Environment
|
||||
|
||||
data ApplicationOptions = ApplicationOptions
|
||||
@ -250,6 +253,32 @@ makeApplication ApplicationOptions{..} request respond = do
|
||||
|
||||
done response
|
||||
|
||||
isPrivate <- not <$> liftIO (Directory.doesPathExist (ByteString.Char8.unpack storePath ++ "/.private"))
|
||||
let sockAddr = Wai.remoteHost request
|
||||
hostAddr <- case sockAddr of
|
||||
SockAddrInet _ host -> return host
|
||||
_ -> return $ Socket.tupleToHostAddress (255, 255, 255, 255)
|
||||
|
||||
let isInternalClient = hostAddr >= Socket.tupleToHostAddress (10, 0, 0, 0) && hostAddr < Socket.tupleToHostAddress (11, 0, 0, 0)
|
||||
|
||||
traceM $ show (ByteString.Char8.unpack storePath, "private", isPrivate,
|
||||
"host", hostAddr,
|
||||
"isInternalClient", isInternalClient
|
||||
)
|
||||
Monad.unless (isInternalClient || not isPrivate) do
|
||||
let headers = [ ("Content-Type", "text/plain") ]
|
||||
|
||||
let builder = "Forbbiden.\n"
|
||||
|
||||
let response =
|
||||
Wai.responseBuilder
|
||||
Types.status403
|
||||
headers
|
||||
builder
|
||||
|
||||
done response
|
||||
|
||||
|
||||
let streamingBody write flush = do
|
||||
result <- Nix.dumpPath hashPart callback
|
||||
|
||||
|
Loading…
x
Reference in New Issue
Block a user