diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,13 @@ # Changelog +## 0.4.1.0 — 2026-06-10 + +- **Server: landing page at `GET /`** — a human-facing page with live stats + (store-path count, signing status, priority), the substituter snippet, and + protocol endpoint documentation. The cache protocol routes are unchanged; + the page is briefly cacheable (`max-age=300, must-revalidate`) since its + stats change as paths are added. + ## 0.4.0.0 — 2026-06-08 ### Breaking changes diff --git a/exe/Main.hs b/exe/Main.hs --- a/exe/Main.hs +++ b/exe/Main.hs @@ -6,7 +6,7 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BS8 import qualified Data.ByteString.Lazy as BL -import Data.Maybe (fromMaybe) +import Data.Maybe (fromMaybe, isJust) import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as TE @@ -28,7 +28,8 @@ import Network.Wai.Middleware.RequestLogger (logStdout) import NovaCache.NarInfo (NarInfo (..), parseNarInfo, renderNarInfo) import NovaCache.Signing (SecretKey, parseSecretKey, sign) -import NovaCache.Store (FileStore, getCacheInfo, listNarInfoHashes, newFileStore, readNar, readNarInfo, writeNar, writeNarInfo) +import NovaCache.Store (CacheInfo (..), FileStore, getCacheInfo, listNarInfoHashes, newFileStore, readNar, readNarInfo, writeNar, writeNarInfo) +import NovaCache.StorePath (defaultStoreDir, parseStorePath, storePathHashString) import NovaCache.Validate (validateNarInfo) import System.Environment (getArgs, lookupEnv) import System.Exit (exitFailure) @@ -59,10 +60,16 @@ requestLogEnvVar :: String requestLogEnvVar = "LOG_REQUESTS" --- | Maximum allowed request body size (100 MB). -maxBodySize :: Int -maxBodySize = 100 * 1024 * 1024 +-- | Maximum narinfo request body — narinfo is small text, so a tight cap. +maxNarInfoBodySize :: Int +maxNarInfoBodySize = 4 * 1024 * 1024 -- 4 MB +-- | Maximum NAR request body. A real store path's NAR can be very large +-- (toolchains, GHC, LLVM), so this is far higher than the narinfo cap while +-- still bounding memory. +maxNarBodySize :: Int +maxNarBodySize = 4 * 1024 * 1024 * 1024 -- 4 GB + -- --------------------------------------------------------------------------- -- Server configuration -- --------------------------------------------------------------------------- @@ -87,12 +94,15 @@ sigKeyPath <- lookupEnv signingKeyEnvVar logRequestsEnv <- lookupEnv requestLogEnvVar - let port = case args of - ("--port" : p : _) -> fromMaybe defaultPort (readMaybe p) - _ -> maybe defaultPort (fromMaybe defaultPort . readMaybe) portEnv - storeRoot = case args of - ("--store" : s : _) -> s - _ -> fromMaybe defaultStoreRoot storeEnv + -- Order-independent flag parsing: take the value following a flag wherever it + -- appears, so e.g. `--allow-open-writes --port 8080` still honours --port. + let argValue flag = case dropWhile (/= flag) args of + (_ : v : _) -> Just v + _ -> Nothing + port = case argValue "--port" >>= readMaybe of + Just p -> p + Nothing -> maybe defaultPort (fromMaybe defaultPort . readMaybe) portEnv + storeRoot = fromMaybe (fromMaybe defaultStoreRoot storeEnv) (argValue "--store") allowOpenWrites = "--allow-open-writes" `elem` args store <- newFileStore storeRoot @@ -150,6 +160,13 @@ -- | WAI application implementing the Nix binary cache HTTP protocol. app :: Config -> Application app cfg req respond = case (requestMethod req, pathInfo req) of + -- GET / — human-facing landing page (the protocol lives at the other routes) + ("GET", []) -> do + pathCount <- length <$> listNarInfoHashes (cfgStore cfg) + let info = getCacheInfo (cfgStore cfg) + signingEnabled = isJust (cfgSigningKey cfg) + body = TE.encodeUtf8 (landingHtml info signingEnabled pathCount) + respond (responseLBS HTTP.status200 htmlHeaders (BL.fromStrict body)) -- GET /nix-cache-info ("GET", ["nix-cache-info"]) -> respond (responseLBS HTTP.status200 textHeaders (BL.fromStrict (renderCacheInfo (cfgStore cfg)))) @@ -179,23 +196,32 @@ ("PUT", [hashNarinfo]) | Just hashKey <- T.stripSuffix ".narinfo" hashNarinfo -> requireAuth cfg req respond $ - withLimitedBody req respond $ \body -> + withLimitedBody maxNarInfoBodySize req respond $ \body -> case decodeAndValidate body of Left err -> do logWarn req ("INVALID: " <> T.unpack err) respond (badRequest err) - Right ni -> do - signed <- signNarInfo (cfgSigningKey cfg) ni - ok <- writeNarInfo (cfgStore cfg) hashKey signed - if ok - then respond (responseLBS HTTP.status200 textHeaders "ok") - else do - logWarn req "BADPATH" - respond (badRequest "invalid path") + Right ni + | not (narInfoHashMatches hashKey ni) -> do + logWarn req "HASHMISMATCH" + respond (badRequest "narinfo StorePath hash does not match request") + | otherwise -> do + signedResult <- signNarInfo (cfgSigningKey cfg) ni + case signedResult of + Left err -> do + logWarn req ("SIGNFAIL: " <> err) + respond (responseLBS HTTP.status500 textHeaders "signing failed") + Right signed -> do + ok <- writeNarInfo (cfgStore cfg) hashKey signed + if ok + then respond (responseLBS HTTP.status200 textHeaders "ok") + else do + logWarn req "BADPATH" + respond (badRequest "invalid path") -- PUT /nar/ (auth required) ("PUT", ["nar", fileName]) -> requireAuth cfg req respond $ - withLimitedBody req respond $ \body -> do + withLimitedBody maxNarBodySize req respond $ \body -> do ok <- writeNar (cfgStore cfg) fileName body if ok then respond (responseLBS HTTP.status200 textHeaders "ok") @@ -220,37 +246,45 @@ ni <- first T.pack (parseNarInfo decoded) first (T.unlines . map (T.pack . show)) (validateNarInfo ni) +-- | Whether the narinfo's declared StorePath actually carries the requested +-- hash — so an authenticated writer cannot store a narinfo describing path X +-- under path Y's key (a cache-poisoning / confused-deputy shape). +narInfoHashMatches :: Text -> NarInfo -> Bool +narInfoHashMatches hashKey ni = + case parseStorePath defaultStoreDir (niStorePath ni) of + Right sp -> storePathHashString sp == hashKey + Left _ -> False + -- --------------------------------------------------------------------------- -- Request body limiting -- --------------------------------------------------------------------------- --- | Read the request body, rejecting payloads over 'maxBodySize'. +-- | Read the request body, rejecting payloads over the given limit. -- --- Returns 'Nothing' if the declared @Content-Length@ exceeds the limit. --- For chunked transfers the body is read and checked after the fact. -readBodyLimited :: Request -> IO (Maybe BS.ByteString) -readBodyLimited req = case requestBodyLength req of +-- A declared @Content-Length@ over the limit is rejected up front; otherwise +-- (including unsized/chunked transfers) the body is read in bounded chunks with +-- a running size check that aborts before exceeding the limit, so memory stays +-- bounded regardless of the declared length. +readBodyLimited :: Int -> Request -> IO (Maybe BS.ByteString) +readBodyLimited limit req = case requestBodyLength req of KnownLength len - | len > fromIntegral maxBodySize -> pure Nothing + | len > fromIntegral limit -> pure Nothing _ -> readChunks [] 0 where - -- Stream the body in chunks, aborting as soon as the running total - -- exceeds the cap — so an unsized (chunked) upload can never buffer - -- more than 'maxBodySize' into memory. readChunks acc total = do chunk <- getRequestBodyChunk req if BS.null chunk then pure (Just (BS.concat (reverse acc))) else let newTotal = total + BS.length chunk - in if newTotal > maxBodySize + in if newTotal > limit then pure Nothing else readChunks (chunk : acc) newTotal -- | Run an action with the limited request body, responding 413 if too large. -withLimitedBody :: Request -> (Response -> IO ResponseReceived) -> (BS.ByteString -> IO ResponseReceived) -> IO ResponseReceived -withLimitedBody req respond action = do - bodyResult <- readBodyLimited req +withLimitedBody :: Int -> Request -> (Response -> IO ResponseReceived) -> (BS.ByteString -> IO ResponseReceived) -> IO ResponseReceived +withLimitedBody limit req respond action = do + bodyResult <- readBodyLimited limit req case bodyResult of Nothing -> do logWarn req "OVERLIMIT" @@ -284,17 +318,19 @@ -- | Sign a validated 'NarInfo' if a signing key is configured. -- --- Logs a warning to stderr if signing fails, then returns the unsigned --- rendering so the upload is not rejected. -signNarInfo :: Maybe SecretKey -> NarInfo -> IO BS.ByteString -signNarInfo Nothing ni = pure (renderNarInfoBytes ni) +-- With no key, returns the unsigned rendering (intentional — the operator +-- configured none). With a key, FAILS CLOSED: a signing error returns 'Left' +-- so the handler refuses the write rather than persisting an unsigned narinfo +-- on a cache that is supposed to sign. +signNarInfo :: Maybe SecretKey -> NarInfo -> IO (Either String BS.ByteString) +signNarInfo Nothing ni = pure (Right (renderNarInfoBytes ni)) signNarInfo (Just sk) ni = case sign sk ni of Left err -> do - hPutStrLn stderr ("WARNING: signNarInfo: sign failed: " ++ err) - pure (renderNarInfoBytes ni) + hPutStrLn stderr ("ERROR: signNarInfo: sign failed: " ++ err) + pure (Left err) Right sig -> let signed = ni {niSigs = niSigs ni ++ [sig]} - in pure (renderNarInfoBytes signed) + in pure (Right (renderNarInfoBytes signed)) -- | Render a 'NarInfo' to its UTF-8 encoded wire format. renderNarInfoBytes :: NarInfo -> BS.ByteString @@ -321,12 +357,12 @@ -- | Render the nix-cache-info response body. renderCacheInfo :: FileStore -> BS.ByteString renderCacheInfo store = - let (storeDir, wantMassQuery, priority) = getCacheInfo store + let info = getCacheInfo store in TE.encodeUtf8 $ T.unlines - [ "StoreDir: " <> storeDir, - "WantMassQuery: " <> boolText wantMassQuery, - "Priority: " <> T.pack (show priority) + [ "StoreDir: " <> ciStoreDir info, + "WantMassQuery: " <> boolText (ciWantMassQuery info), + "Priority: " <> T.pack (show (ciPriority info)) ] -- | Render a Bool as @1@ or @0@. @@ -334,6 +370,91 @@ boolText True = "1" boolText False = "0" +-- | The landing page served at @GET /@. Static apart from three live +-- values (store-path count, store dir, signing status); styled to match +-- novavero.ai. No user input is interpolated, so no escaping is needed. +landingHtml :: CacheInfo -> Bool -> Int -> Text +landingHtml info signingEnabled pathCount = + T.unlines + [ "", + "", + "", + "", + "", + "cache.novavero.ai - Nix binary cache", + "", + " novaveroLogoSvgEscaped <> "\" />", + "", + "", + "", + "
", + "
" <> novaveroLogoSvg <> "

cache.novavero.ai

", + "

Nix binary cache — serving store paths for nova-nix, the Windows-native Nix.

", + "
", + "
" <> T.pack (show pathCount) <> "
store paths
", + "
" <> (if signingEnabled then "ed25519" else "off") <> "
signing
", + "
" <> T.pack (show (ciPriority info)) <> "
priority
", + "
", + "

Use it

", + "
substituters = https://cache.novavero.ai
", + "

Store dir: " <> ciStoreDir info <> " · protocol endpoints: /nix-cache-info, /<hash>.narinfo, /nar/<file>

", + "

What this is

", + "

The binary cache behind the Novavero Nix toolchain. Powered by nova-cache, a Haskell implementation of the Nix binary cache protocol. Read about the first package built by Nix natively on Windows on the blog.

", + "
Novavero AI · Waterloo, Canada
", + "
", + "", + "" + ] + +-- | The Novavero mark (the novavero.ai favicon), inlined so the page stays +-- a single self-contained response with no external assets. +novaveroLogoSvg :: Text +novaveroLogoSvg = + "" + <> "" + <> "" + <> "" + +-- | The same mark, URL-escaped for a data-URI favicon link. +novaveroLogoSvgEscaped :: Text +novaveroLogoSvgEscaped = + T.concatMap escapeForDataUri novaveroLogoSvg + where + escapeForDataUri c = case c of + '<' -> "%3C" + '>' -> "%3E" + '"' -> "%22" + '#' -> "%23" + other -> T.singleton other + +-- | Content-Type and caching headers for the landing page. Stats change as +-- paths are added, so it stays briefly cacheable but revalidates. +htmlHeaders :: HTTP.ResponseHeaders +htmlHeaders = + [ (HTTP.hContentType, "text/html; charset=utf-8"), + (HTTP.hCacheControl, "public, max-age=300, must-revalidate") + ] + -- | 404 Not Found response. notFound :: Response notFound = responseLBS HTTP.status404 textHeaders "not found" @@ -351,14 +472,14 @@ textHeaders :: HTTP.ResponseHeaders textHeaders = [(HTTP.hContentType, "text/plain")] --- | Content-Type: application/x-nix-narinfo headers. --- Narinfo files are content-addressed (keyed by store path hash) and --- immutable once written, so they are safe to cache indefinitely at the --- CDN edge. +-- | Content-Type and caching headers for a narinfo response. +-- A narinfo body is NOT immutable for a fixed key — re-uploading the same store +-- path to add or rotate a signature changes it — so it is cacheable but must +-- stay revalidatable (no @immutable@). narInfoHeaders :: HTTP.ResponseHeaders narInfoHeaders = [ (HTTP.hContentType, "text/x-nix-narinfo"), - (HTTP.hCacheControl, "public, max-age=31536000, immutable") + (HTTP.hCacheControl, "public, max-age=3600, must-revalidate") ] -- | Content-Type: application/octet-stream headers. diff --git a/nova-cache.cabal b/nova-cache.cabal --- a/nova-cache.cabal +++ b/nova-cache.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: nova-cache -version: 0.4.0.0 +version: 0.4.1.0 synopsis: Pure-first Nix binary cache protocol library description: A pure-first library implementing the Nix binary cache protocol — diff --git a/src/NovaCache/Base32.hs b/src/NovaCache/Base32.hs --- a/src/NovaCache/Base32.hs +++ b/src/NovaCache/Base32.hs @@ -17,6 +17,7 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Unsafe as BSU import Data.Char (ord) +import Data.STRef (newSTRef, readSTRef, writeSTRef) import Data.Text (Text) import qualified Data.Text as T import Data.Vector.Unboxed (Vector) @@ -129,7 +130,7 @@ | T.null txt = Right BS.empty | otherwise = do values <- traverse lookupChar (T.unpack txt) - Right (scatterDecode values inputLen outputLen) + scatterDecode values inputLen outputLen where inputLen = T.length txt outputLen = (inputLen * bitsPerChar) `div` bitsPerByte @@ -148,30 +149,39 @@ -- -- O(n) in the number of input characters. Each character contributes -- exactly 5 bits, placed at the correct byte and bit offset. -scatterDecode :: [Word8] -> Int -> Int -> ByteString +scatterDecode :: [Word8] -> Int -> Int -> Either String ByteString scatterDecode values inputLen outputLen = runST $ do arr <- MV.replicate outputLen (0 :: Word8) - scatterAll arr 0 values - frozen <- V.unsafeFreeze arr - pure (BS.pack (V.toList frozen)) + canonical <- newSTRef True + scatterAll arr canonical 0 values + ok <- readSTRef canonical + if ok + then do + frozen <- V.unsafeFreeze arr + pure (Right (BS.pack (V.toList frozen))) + else pure (Left "non-canonical nix-base32: padding bits must be zero") where - scatterAll _ !_ [] = pure () - scatterAll arr !n (c5 : rest) = do + scatterAll _ _ !_ [] = pure () + scatterAll arr canonical !n (c5 : rest) = do let bitsStart = bitsPerChar * (inputLen - 1 - n) - scatterBits arr c5 bitsStart 0 - scatterAll arr (n + 1) rest + scatterBits arr canonical c5 bitsStart 0 + scatterAll arr canonical (n + 1) rest - scatterBits arr c5 bitsStart !bit + scatterBits arr canonical c5 bitsStart !bit | bit >= bitsPerChar = pure () | otherwise = do let b = bitsStart + bit byteIdx = b `shiftR` 3 bitIdx = b .&. byteAlignMask bitVal = (c5 `shiftR` bit) .&. 1 - when (byteIdx < outputLen) $ do - old <- MV.unsafeRead arr byteIdx - MV.unsafeWrite arr byteIdx (old .|. (bitVal `shiftL` bitIdx)) - scatterBits arr c5 bitsStart (bit + 1) + if byteIdx < outputLen + then do + old <- MV.unsafeRead arr byteIdx + MV.unsafeWrite arr byteIdx (old .|. (bitVal `shiftL` bitIdx)) + -- A set bit landing outside the output is a non-canonical encoding + -- (Nix requires these padding bits to be zero); reject it. + else when (bitVal /= 0) (writeSTRef canonical False) + scatterBits arr canonical c5 bitsStart (bit + 1) invalidCharMsg :: Char -> String invalidCharMsg c = "invalid nix-base32 character: " ++ [c] diff --git a/src/NovaCache/Compression.hs b/src/NovaCache/Compression.hs --- a/src/NovaCache/Compression.hs +++ b/src/NovaCache/Compression.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE ScopedTypeVariables #-} + -- | xz compression and decompression for NAR files. -- -- Thin wrappers around the @lzma@ package, converting between strict @@ -9,7 +11,7 @@ where import qualified Codec.Compression.Lzma as Lzma -import Control.Exception (SomeException, evaluate, try) +import Control.Exception (SomeAsyncException, SomeException, evaluate, fromException, throwIO, try) import Data.ByteString (ByteString) import qualified Data.ByteString.Lazy as BL @@ -23,6 +25,11 @@ decompressXz :: ByteString -> IO (Either String ByteString) decompressXz bs = do result <- try (evaluate (BL.toStrict (Lzma.decompress (BL.fromStrict bs)))) - pure $ case result of - Left err -> Left ("xz decompression failed: " ++ show (err :: SomeException)) - Right decompressed -> Right decompressed + case result of + Right decompressed -> pure (Right decompressed) + -- Catch only SYNCHRONOUS failures; re-raise async exceptions (timeout, + -- ThreadKilled) so a caller's timeout/cancellation still works on this + -- untrusted-input decoder. + Left err + | Just (_ :: SomeAsyncException) <- fromException err -> throwIO err + | otherwise -> pure (Left ("xz decompression failed: " ++ show (err :: SomeException))) diff --git a/src/NovaCache/NAR.hs b/src/NovaCache/NAR.hs --- a/src/NovaCache/NAR.hs +++ b/src/NovaCache/NAR.hs @@ -53,7 +53,9 @@ NarRegular !Bool !ByteString | -- | Symbolic link: target path. NarSymlink !Text - | -- | Directory: sorted list of (name, entry) pairs. + | -- | Directory: list of (name, entry) pairs. Names must be unique; the + -- serializer sorts them and 'deserialise' rejects duplicate or + -- out-of-order names. NarDirectory ![(Text, NarEntry)] deriving (Eq, Show) @@ -166,7 +168,10 @@ deserialise bs = do (magic, rest) <- readStr bs expect tokMagic magic - fst <$> parseNode rest + (entry, rest2) <- parseNode rest + if BS.null rest2 + then Right entry + else Left "trailing bytes after NAR root node" -- | Parse a single NAR node. parseNode :: NarParser NarEntry @@ -204,10 +209,10 @@ (rp, final) <- readStr afterContents expect tokRParen rp pure (NarRegular False contents, final) - | tok == tokRParen = - pure (NarRegular False BS.empty, rest) | otherwise = - Left ("expected 'executable', 'contents', or ')' in regular, got: " ++ show tok) + -- 'contents' is mandatory (even an empty file serialises with it), so + -- a regular node without it is malformed — reject, matching Nix. + Left ("expected 'executable' or 'contents' in regular, got: " ++ show tok) -- | Parse a symlink node. parseSymlink :: NarParser NarEntry @@ -222,9 +227,9 @@ -- | Parse a directory node (zero or more child entries). parseDirectory :: NarParser NarEntry -parseDirectory = go [] +parseDirectory = go Nothing [] where - go !acc bs = do + go !prev !acc bs = do (tok, afterTok) <- readStr bs if tok == tokRParen then pure (NarDirectory (reverse acc), afterTok) @@ -241,7 +246,20 @@ (rp, afterRp) <- readStr afterEntry expect tokRParen rp decodedName <- decodeUtf8Safe entryName - go ((decodedName, entry) : acc) afterRp + _ <- checkName prev decodedName + go (Just decodedName) ((decodedName, entry) : acc) afterRp + -- NAR directory entries must have safe names in strictly increasing + -- (sorted, unique) order. Enforcing this rejects malformed or hostile + -- archives, keeps @serialise . deserialise@ an identity, and forecloses the + -- path-traversal surface for any future NAR-extraction consumer. + checkName prev name + | T.null name = Left "empty NAR directory entry name" + | name == "." || name == ".." || T.any (\c -> c == '/' || c == '\0') name = + Left ("unsafe NAR directory entry name: " ++ T.unpack name) + | Just p <- prev, + name <= p = + Left ("NAR directory entries not strictly increasing: " ++ T.unpack name) + | otherwise = Right () -- --------------------------------------------------------------------------- -- Wire primitives @@ -354,7 +372,12 @@ contents <- BS.readFile path isExec <- checkExecutable path pure (NarRegular isExec contents) - else pure (NarRegular False BS.empty) + else + -- Not a symlink, directory, or regular file: a special file (FIFO, + -- socket, device) or a path that vanished mid-walk. Fail loudly rather + -- than fabricating an empty regular (which would silently change the NAR + -- and its hash) — matching Nix, which aborts on unsupported types. + fail ("serialiseFromPath: not a regular file (special or vanished): " ++ path) -- | Check whether a file has the executable permission set. -- Uses 'System.Directory.getPermissions' which is cross-platform: diff --git a/src/NovaCache/NarInfo.hs b/src/NovaCache/NarInfo.hs --- a/src/NovaCache/NarInfo.hs +++ b/src/NovaCache/NarInfo.hs @@ -14,6 +14,7 @@ import Data.Maybe (fromMaybe, mapMaybe) import Data.Text (Text) import qualified Data.Text as T +import qualified Data.Text.Read as TR -- --------------------------------------------------------------------------- -- Types @@ -163,10 +164,13 @@ Nothing -> Left ("missing required key: " ++ T.unpack key) Just val -> Right val --- | Parse an integer value from text. +-- | Parse a non-negative base-10 integer, matching C++ Nix's narinfo parser. +-- Uses 'TR.decimal' (not 'reads', which also accepts hex/octal/leading space) +-- and requires the whole field to be consumed, so a non-canonical value cannot +-- slip through and then be re-signed under the cache's key. parseInteger :: Text -> Text -> Either String Integer -parseInteger key txt = case reads (T.unpack txt) of - [(n, "")] -> Right n +parseInteger key txt = case TR.decimal txt of + Right (n, rest) | T.null rest -> Right n _ -> Left ("invalid integer for " ++ T.unpack key ++ ": " ++ T.unpack txt) -- | Show a value as 'Text'. diff --git a/src/NovaCache/Signing.hs b/src/NovaCache/Signing.hs --- a/src/NovaCache/Signing.hs +++ b/src/NovaCache/Signing.hs @@ -158,12 +158,17 @@ -- | Verify a @keyname:base64sig@ signature against a narinfo and public key. -- --- Returns 'False' for any malformed input rather than failing. +-- The signature's key name must match this key's name (Nix looks the public key +-- up BY name) before the Ed25519 check runs. Returns 'False' for any malformed +-- or non-matching input rather than failing. verify :: PublicKey -> NarInfo -> Text -> Bool -verify (PublicKey _ pubBytes) ni sigLine = - case extractSignaturePayload sigLine of - Nothing -> False - Just sigRaw -> verifyRaw pubBytes (TE.encodeUtf8 (fingerprint ni)) sigRaw +verify (PublicKey trustedName pubBytes) ni sigLine = + case T.breakOn keySeparator sigLine of + (sigName, sigRest) + | T.null sigRest || sigName /= trustedName -> False + | otherwise -> case extractSignaturePayload sigLine of + Nothing -> False + Just sigRaw -> verifyRaw pubBytes (TE.encodeUtf8 (fingerprint ni)) sigRaw -- | Extract the raw signature bytes from a @keyname:base64sig@ line. extractSignaturePayload :: Text -> Maybe ByteString diff --git a/src/NovaCache/Store.hs b/src/NovaCache/Store.hs --- a/src/NovaCache/Store.hs +++ b/src/NovaCache/Store.hs @@ -14,6 +14,7 @@ readNar, writeNar, listNarInfoHashes, + CacheInfo (..), getCacheInfo, sanitizePath, ) @@ -152,9 +153,26 @@ -- Cache metadata -- --------------------------------------------------------------------------- --- | Cache metadata: (storeDir, wantMassQuery, priority). -getCacheInfo :: FileStore -> (Text, Bool, Int) -getCacheInfo fs = (fsStoreDir fs, True, fsPriority fs) +-- | Cache metadata for the @nix-cache-info@ response. +data CacheInfo = CacheInfo + { ciStoreDir :: !Text, + ciWantMassQuery :: !Bool, + ciPriority :: !Int + } + deriving (Eq, Show) + +-- | This file-backed cache answers mass-query (path-existence) requests. +defaultWantMassQuery :: Bool +defaultWantMassQuery = True + +-- | Read the cache's metadata. +getCacheInfo :: FileStore -> CacheInfo +getCacheInfo fs = + CacheInfo + { ciStoreDir = fsStoreDir fs, + ciWantMassQuery = defaultWantMassQuery, + ciPriority = fsPriority fs + } -- --------------------------------------------------------------------------- -- Path sanitization diff --git a/src/NovaCache/StorePath.hs b/src/NovaCache/StorePath.hs --- a/src/NovaCache/StorePath.hs +++ b/src/NovaCache/StorePath.hs @@ -107,6 +107,8 @@ parseBaseName basename | T.length basename < minBaseNameLen = Left ("store path too short: " ++ T.unpack basename) + -- Safe: minBaseNameLen = storePathHashLen + 1, so the length guard above + -- guarantees index storePathHashLen is in bounds. | T.index basename storePathHashLen /= hashNameSeparator = Left ("expected '-' after hash in store path: " ++ T.unpack basename) | not (T.all isBase32Char hashPart) = diff --git a/src/NovaCache/Validate.hs b/src/NovaCache/Validate.hs --- a/src/NovaCache/Validate.hs +++ b/src/NovaCache/Validate.hs @@ -97,21 +97,23 @@ -- the declared 'niNarHash'. validateNarHash :: NarInfo -> ByteString -> Either ValidationError () validateNarHash ni narBytes = - let actual = formatNixHash (hashBytes narBytes) - expected = niNarHash ni - in if expected == actual - then Right () - else Left (NarHashMismatch expected actual) + -- Compare DECODED hash bytes, not re-formatted strings, so any valid encoding + -- of the declared NarHash (SRI, hex, base32) validates against the same digest. + case parseNixHash (niNarHash ni) of + Left err -> Left (InvalidNarHash (niNarHash ni) err) + Right declared + | declared == hashBytes narBytes -> Right () + | otherwise -> Left (NarHashMismatch (niNarHash ni) (formatNixHash (hashBytes narBytes))) -- | Validate that the SHA-256 hash of compressed file bytes matches -- the declared 'niFileHash'. validateFileHash :: NarInfo -> ByteString -> Either ValidationError () validateFileHash ni fileBytes = - let actual = formatNixHash (hashBytes fileBytes) - expected = niFileHash ni - in if expected == actual - then Right () - else Left (FileHashMismatch expected actual) + case parseNixHash (niFileHash ni) of + Left err -> Left (InvalidFileHash (niFileHash ni) err) + Right declared + | declared == hashBytes fileBytes -> Right () + | otherwise -> Left (FileHashMismatch (niFileHash ni) (formatNixHash (hashBytes fileBytes))) -- --------------------------------------------------------------------------- -- Signature validation diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -531,11 +531,11 @@ test "cacheInfo defaults" $ do tmpDir <- createTestDir store <- Store.newFileStore tmpDir - let (storeDir, wantMass, priority) = Store.getCacheInfo store + let info = Store.getCacheInfo store removeDirectoryRecursive tmpDir - ok1 <- assertEqual "storeDir" "/nix/store" storeDir - ok2 <- assertTrue "wantMassQuery" wantMass - ok3 <- assertEqual "priority" 50 priority + ok1 <- assertEqual "storeDir" "/nix/store" (Store.ciStoreDir info) + ok2 <- assertTrue "wantMassQuery" (Store.ciWantMassQuery info) + ok3 <- assertEqual "priority" 50 (Store.ciPriority info) pure (ok1 && ok2 && ok3), test "sanitizePath rejects traversal" $ assertEqual "dotdot" Nothing (Store.sanitizePath ".."),