From d676436e3883340ef6a4250562758150a32cee33 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Aleix=20Bon=C3=A9?= <aleix.boneribo@bsc.es>
Date: Mon, 6 Oct 2025 12:10:35 +0200
Subject: [PATCH] Fix private file path checks

---
 src/Main.hs | 28 +++++++++++++++++++++-------
 1 file changed, 21 insertions(+), 7 deletions(-)

diff --git a/src/Main.hs b/src/Main.hs
index 3701e2c..6d07fff 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -12,6 +12,7 @@ import Control.Monad.IO.Class (liftIO)
 import Data.ByteString (ByteString)
 import Data.CharSet.ByteSet (ByteSet(..))
 import Data.Function ((&))
+import Data.Word (Word8)
 import Network.Socket (SockAddr(..))
 import Network.Wai (Application)
 import Nix (NoSuchPath(..), PathInfo(..))
@@ -57,6 +58,20 @@ validHashPartBytes =
         <>  [ 0x76 .. 0x7A ]  -- vwxyz
         )
 
+type HostAddressTuple = (Word8, Word8, Word8, Word8)
+
+isAllowed :: Socket.HostAddress -> Bool
+isAllowed host = any (uncurry (ipMatches $ 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))
+            ]
+
+        ipMatches ip a b = ip >= a && ip <= b
+
 validHashPart :: ByteString -> Bool
 validHashPart hash = ByteString.all (`ByteSet.member` validHashPartBytes) hash
 
@@ -253,19 +268,18 @@ makeApplication ApplicationOptions{..} request respond = do
 
                     done response
 
-                isPrivate <- not <$> liftIO (Directory.doesPathExist (ByteString.Char8.unpack storePath ++ "/.private"))
+                let privateFilePath = ByteString.Char8.unpack storePath ++ "/.private"
+                isPrivate <- liftIO $ Directory.doesPathExist privateFilePath
+
                 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 (Socket.hostAddressToTuple hostAddr, isAllowed hostAddr)
+                traceM $ show (privateFilePath, isPrivate)
 
-                traceM $ show (ByteString.Char8.unpack storePath, "private", isPrivate,
-                    "host", hostAddr,
-                    "isInternalClient", isInternalClient
-                    )
-                Monad.unless (isInternalClient || not isPrivate) do
+                Monad.when (isPrivate && (not $ isAllowed hostAddr)) do
                     let headers = [ ("Content-Type", "text/plain") ]
 
                     let builder = "Forbidden.\n"