diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,13 @@ # Changelog +## 0.7.0.0 - 2026-07-21 + +- **NAR entry names and symlink targets are byte strings.** The format imposes no text encoding on either, and upstream carries both verbatim; decoding them as UTF-8 at parse rejected archives real Nix accepts. `NarEntry` now carries `ByteString` for directory entry names and symlink targets (the breaking change behind the major bump), the parser stops decoding, and entry order is defined bytewise. For names both representations accept - valid UTF-8 - code-point order and byte order coincide, so previously-valid archives keep their exact bytes and hashes. The `checkName` rejection categories apply unchanged to the byte form; they are ASCII-structural, so they now also catch hazards inside names that do not decode (a `nul.` device stem followed by undecodable bytes used to fail as bad UTF-8 and still fails - for the real reason). +- **`serialiseFromPath` walks the filesystem byte-true.** The walk moves to the platform-native path type (`System.Directory.OsPath`). On POSIX, names and symlink targets enter the archive as the raw bytes the filesystem reports - previously a non-UTF-8 on-disk name was silently rewritten with replacement characters, changing the archived name and hash. On Windows, names are the UTF-8 encoding of their UTF-16 spelling, and a name holding an unpaired surrogate (no UTF-8 form exists, and upstream defines no byte spelling) fails loudly instead of guessing. Public signatures are unchanged. +- **`NovaCache.SafeName` predicates take bytes.** `isReservedDeviceName` and `hasTrailingDotOrSpace` operate on `ByteString`, the form NAR entry names have; Text callers (the store-key allowlist) encode first. +- **`caseHackSuffix` is a `ByteString`**, matching the entry names it marks. +- Dependency floors rise to `directory >= 1.3.8` and `filepath >= 1.4.100` (the `OsPath` API); both the 1.4 and 1.5 `filepath` lineages are supported. + ## 0.6.0.0 - 2026-07-20 - **NAR serialisation understands upstream's case-hack.** A case-folding store filesystem (Windows NTFS, default macOS APFS) cannot hold two sibling names differing only by case, so an extractor there materializes the collision with upstream's reversible `~nix~case~hack~` suffix. `serialiseFromPath` now strips the suffix on those platforms - entries are emitted under their NAR names, ordered by them - so a hacked tree reproduces its original NAR bytes; two on-disk names stripping to the same entry fail loudly. New `serialiseFromPathWith` takes the mode explicitly (`CaseHack`, `defaultCaseHack`, `caseHackSuffix` exported); on other platforms a file legitimately named with the suffix still serialises verbatim. The platform-dependent default of `serialiseFromPath` is the behavior change behind the major bump. 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.6.0.0 +version: 0.7.0.0 synopsis: Pure-first Nix binary cache protocol library description: A pure-first library implementing the Nix binary cache protocol - @@ -48,8 +48,8 @@ , bytestring >= 0.11 && < 0.13 , containers >= 0.6 && < 0.9 , crypton >= 1.1 && < 2 - , directory >= 1.3 && < 1.4 - , filepath >= 1.4 && < 1.6 + , directory >= 1.3.8 && < 1.4 + , filepath >= 1.4.100 && < 1.6 , http-types >= 0.12 && < 0.13 , ram >= 0.20 && < 1 , text >= 2.0 && < 2.2 diff --git a/src/NovaCache/NAR.hs b/src/NovaCache/NAR.hs --- a/src/NovaCache/NAR.hs +++ b/src/NovaCache/NAR.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + -- | NAR (Nix ARchive) binary format serialization and deserialization. -- -- NAR is a deterministic archive format used by Nix. All strings are @@ -11,6 +13,9 @@ -- directory ::= (entry)* -- entry ::= "entry" "(" "name" STRING "node" node ")" -- @ +-- +-- Entry names and symlink targets are raw byte strings: the format +-- imposes no text encoding on them, and upstream carries them verbatim. module NovaCache.NAR ( NarEntry (..), serialise, @@ -28,16 +33,14 @@ import Data.ByteString (ByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Builder as B +import qualified Data.ByteString.Char8 as BS8 import qualified Data.ByteString.Lazy as BL import Data.List (sort, sortBy) import Data.Ord (comparing) -import Data.Text (Text) -import qualified Data.Text as T -import qualified Data.Text.Encoding as TE import Data.Word (Word64) import qualified NovaCache.Hash as Hash import NovaCache.SafeName (hasTrailingDotOrSpace, isReservedDeviceName) -import System.Directory +import System.Directory.OsPath ( doesDirectoryExist, doesFileExist, executable, @@ -46,8 +49,15 @@ listDirectory, pathIsSymbolicLink, ) -import System.FilePath (()) import qualified System.Info +import System.OsPath (OsPath, decodeFS, encodeFS, ()) +import qualified System.OsPath as OP +#ifdef mingw32_HOST_OS +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +#else +import System.IO (latin1) +#endif -- --------------------------------------------------------------------------- -- Types @@ -57,12 +67,14 @@ data NarEntry = -- | Regular file: executable flag and contents. NarRegular !Bool !ByteString - | -- | Symbolic link: target path. - NarSymlink !Text - | -- | Directory: list of (name, entry) pairs. Names must be unique; the - -- serializer sorts them and 'deserialise' rejects duplicate or + | -- | Symbolic link: target path, as the raw bytes the archive + -- carries. + NarSymlink !ByteString + | -- | Directory: list of (name, entry) pairs. Names are the raw + -- bytes the archive carries; they must be unique, the serializer + -- sorts them bytewise, and 'deserialise' rejects duplicate or -- out-of-order names. - NarDirectory ![(Text, NarEntry)] + NarDirectory ![(ByteString, NarEntry)] deriving (Eq, Show) -- --------------------------------------------------------------------------- @@ -121,7 +133,7 @@ <> narStr tokType <> narStr tokSymlink <> narStr tokTarget - <> narStr (TE.encodeUtf8 target) + <> narStr target <> narStr tokRParen buildNode (NarDirectory entries) = narStr tokLParen @@ -136,12 +148,12 @@ execFlag False = mempty -- | Build a single directory entry: @"entry" "(" "name" \ "node" \ ")"@. -buildDirEntry :: (Text, NarEntry) -> B.Builder +buildDirEntry :: (ByteString, NarEntry) -> B.Builder buildDirEntry (entryName, entry) = narStr tokEntry <> narStr tokLParen <> narStr tokName - <> narStr (TE.encodeUtf8 entryName) + <> narStr entryName <> narStr tokNode <> buildNode entry <> narStr tokRParen @@ -225,7 +237,8 @@ -- a regular node without it is malformed - reject, matching Nix. Left ("expected 'executable' or 'contents' in regular, got: " ++ show tok) --- | Parse a symlink node. +-- | Parse a symlink node. The target is carried verbatim: upstream +-- imposes no text encoding on it. parseSymlink :: NarParser NarEntry parseSymlink bs = do (tgt, afterTgt) <- readStr bs @@ -233,8 +246,7 @@ (targetPath, afterPath) <- readStr afterTgt (rp, final) <- readStr afterPath expect tokRParen rp - symTarget <- decodeUtf8Safe targetPath - pure (NarSymlink symTarget, final) + pure (NarSymlink targetPath, final) -- | Parse a directory node (zero or more child entries). parseDirectory :: NarParser NarEntry @@ -256,33 +268,35 @@ (entry, afterEntry) <- parseNode afterNodeTok (rp, afterRp) <- readStr afterEntry expect tokRParen rp - decodedName <- decodeUtf8Safe entryName - _ <- checkName prev decodedName - go (Just decodedName) ((decodedName, entry) : acc) afterRp + _ <- checkName prev entryName + go (Just entryName) ((entryName, 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. + -- (sorted, unique) byte 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. Names are arbitrary bytes; every check here is + -- ASCII-structural, so it stays exact whether or not the name + -- decodes as text (see "NovaCache.SafeName"). checkName prev name - | T.null name = Left "empty NAR directory entry name" + | BS.null name = Left "empty NAR directory entry name" -- Backslash is a directory separator on Windows - this library's -- primary consumer - so a name like "..\out.exe" is as much a -- traversal vector as one with '/'. A colon is a drive prefix -- ("C:evil") or an NTFS alternate data stream ("a:b"), either of -- which resolves the write somewhere other than a file of this name. - | name == "." || name == ".." || T.any (\c -> c == '/' || c == '\\' || c == '\0' || c == ':') name = - Left ("unsafe NAR directory entry name: " ++ T.unpack name) + | name == "." || name == ".." || BS8.any (\c -> c == '/' || c == '\\' || c == '\0' || c == ':') name = + Left ("unsafe NAR directory entry name: " ++ show name) -- Windows-unsafe categories, shared with the store-key allowlist -- (NovaCache.SafeName): a device name resolves to the device, and -- NTFS strips a trailing dot or space so the on-disk name would -- silently diverge from the NAR name. | isReservedDeviceName name = - Left ("Windows reserved device name as NAR directory entry: " ++ T.unpack name) + Left ("Windows reserved device name as NAR directory entry: " ++ show name) | hasTrailingDotOrSpace name = - Left ("NAR directory entry name ends with a dot or space: " ++ T.unpack name) + Left ("NAR directory entry name ends with a dot or space: " ++ show name) | Just p <- prev, name <= p = - Left ("NAR directory entries not strictly increasing: " ++ T.unpack name) + Left ("NAR directory entries not strictly increasing: " ++ show name) | otherwise = Right () -- --------------------------------------------------------------------------- @@ -347,12 +361,6 @@ | got == expected = Right () | otherwise = Left ("expected " ++ show expected ++ ", got " ++ show got) --- | Decode a UTF-8 bytestring, converting decode failures to parse errors. -decodeUtf8Safe :: ByteString -> Either String Text -decodeUtf8Safe bs = case TE.decodeUtf8' bs of - Right txt -> Right txt - Left err -> Left ("invalid UTF-8 in NAR: " ++ show err) - -- --------------------------------------------------------------------------- -- Hashing -- --------------------------------------------------------------------------- @@ -386,25 +394,34 @@ -- | Upstream's reversible collision suffix (its @caseHackSuffix@): an -- extractor appends @~nix~case~hack~@ to a sibling whose name -- case-folds onto an earlier one, and serialisation strips from the --- suffix onward to recover the NAR name. -caseHackSuffix :: Text +-- suffix onward to recover the NAR name. Bytes, matching the entry +-- names it marks. +caseHackSuffix :: ByteString caseHackSuffix = "~nix~case~hack~" -- | Walk a filesystem path and build a 'NarEntry' under -- 'defaultCaseHack'. -- --- This is the module's IO boundary. It classifies each path as symlink, --- directory, or regular file, then delegates to pure constructors. +-- This is the module's IO boundary: the platform-native walk +-- ('walkPath') classifies each path as symlink, directory, or regular +-- file and delegates to pure constructors. serialiseFromPath :: FilePath -> IO NarEntry serialiseFromPath = serialiseFromPathWith defaultCaseHack -- | 'serialiseFromPath' with the case-hack mode explicit, for callers -- and tests that need behavior independent of the host platform. serialiseFromPathWith :: CaseHack -> FilePath -> IO NarEntry -serialiseFromPathWith mode path = do +serialiseFromPathWith mode path = walkPath mode =<< encodeFS path + +-- | Walk one platform-native path. The walk runs on 'OsPath' so child +-- names reach the archive byte-true ('osPathBytes'); only the root +-- enters as 'FilePath', and the root's own name never appears in a +-- NAR. +walkPath :: CaseHack -> OsPath -> IO NarEntry +walkPath mode path = do isSym <- pathIsSymbolicLink path if isSym - then NarSymlink . T.pack <$> getSymbolicLinkTarget path + then NarSymlink <$> (osPathBytes =<< getSymbolicLinkTarget path) else do isDir <- doesDirectoryExist path if isDir @@ -417,40 +434,45 @@ -- two on-disk names stripping to the same entry name fail loudly, as -- upstream's serialiser does - continuing would emit an archive with -- duplicate entries no parser accepts. -buildDirectory :: CaseHack -> FilePath -> IO NarEntry +buildDirectory :: CaseHack -> OsPath -> IO NarEntry buildDirectory mode path = do names <- sort <$> listDirectory path - case unhackedDirNames mode names of - Left (first, second) -> + named <- traverse withNameBytes names + case unhackedDirNames mode named of + Left (first, second) -> do + firstPath <- decodeFS (path first) + secondPath <- decodeFS (path second) fail ( "serialiseFromPath: file name collision between '" - ++ (path first) + ++ firstPath ++ "' and '" - ++ (path second) + ++ secondPath ++ "' after case-hack stripping" ) - Right resolved -> do - entries <- traverse walkChild resolved - pure (NarDirectory entries) + Right resolved -> NarDirectory <$> traverse walkChild resolved where + withNameBytes diskName = do + nameBytes <- osPathBytes diskName + pure (nameBytes, diskName) walkChild (entryName, diskName) = do - entry <- serialiseFromPathWith mode (path diskName) + entry <- walkPath mode (path diskName) pure (entryName, entry) --- | Resolve on-disk child names to (NAR entry name, on-disk name) pairs, --- ordered by entry name. Under 'CaseHackDisabled' names pass through --- verbatim (already sorted by the caller). Under 'CaseHackEnabled' the --- case-hack suffix is stripped; @Left@ carries the first pair of disk --- names whose stripped entry names coincide. -unhackedDirNames :: CaseHack -> [FilePath] -> Either (FilePath, FilePath) [(Text, FilePath)] -unhackedDirNames CaseHackDisabled names = Right [(T.pack name, name) | name <- names] -unhackedDirNames CaseHackEnabled names = - detectCollision (sortBy (comparing fst) (map resolve names)) +-- | Resolve (NAR name, on-disk name) pairs for a directory's children. +-- Under 'CaseHackDisabled' pairs pass through verbatim (serialisation +-- sorts at emit). Under 'CaseHackEnabled' the case-hack suffix is +-- stripped from each NAR name and pairs are re-sorted by the stripped +-- bytes; @Left@ carries the first pair of disk names whose stripped +-- entry names coincide. +unhackedDirNames :: CaseHack -> [(ByteString, OsPath)] -> Either (OsPath, OsPath) [(ByteString, OsPath)] +unhackedDirNames CaseHackDisabled named = Right named +unhackedDirNames CaseHackEnabled named = + detectCollision (sortBy (comparing fst) (map resolve named)) where - resolve diskName = - let (unhacked, rest) = T.breakOn caseHackSuffix (T.pack diskName) - in if T.null rest - then (T.pack diskName, diskName) + resolve (nameBytes, diskName) = + let (unhacked, rest) = BS.breakSubstring caseHackSuffix nameBytes + in if BS.null rest + then (nameBytes, diskName) else (unhacked, diskName) detectCollision resolved = case [ (diskA, diskB) @@ -461,23 +483,58 @@ [] -> Right resolved -- | Build a regular file entry, checking the executable bit. -buildRegularFile :: FilePath -> IO NarEntry +buildRegularFile :: OsPath -> IO NarEntry buildRegularFile path = do isFile <- doesFileExist path if isFile then do - contents <- BS.readFile path + contents <- readFileBytes path isExec <- checkExecutable path pure (NarRegular isExec contents) - else + else do -- 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) + shownPath <- decodeFS path + fail ("serialiseFromPath: not a regular file (special or vanished): " ++ shownPath) -- | Check whether a file has the executable permission set. --- Uses 'System.Directory.getPermissions' which is cross-platform: +-- Uses 'System.Directory.OsPath.getPermissions' which is cross-platform: -- checks the user-execute bit on Unix, file extension on Windows. -checkExecutable :: FilePath -> IO Bool +checkExecutable :: OsPath -> IO Bool checkExecutable path = executable <$> getPermissions path + +-- | Read a file's contents by platform-native path. The byte-string +-- file API still takes 'FilePath', so the path bridges through +-- 'decodeFS' - interop with unmigrated APIs is that function's +-- documented purpose, and its contract is the exact round-trip: the +-- reopened path names the same file even when the name has no text +-- decoding. +readFileBytes :: OsPath -> IO ByteString +readFileBytes path = BS.readFile =<< decodeFS path + +-- | The NAR name for one platform-native path component: on POSIX the +-- raw bytes the filesystem reports, on Windows the UTF-8 encoding of +-- the UTF-16 name - each platform's spelling of the upstream rule that +-- a NAR carries names as byte strings. Symlink targets take the same +-- path. The one refusal is a Windows name holding an unpaired +-- surrogate: it has no UTF-8 form and upstream defines no byte +-- spelling for it, so failing loudly beats inventing a name (the same +-- policy 'buildRegularFile' applies to special files). +#ifdef mingw32_HOST_OS +osPathBytes :: OsPath -> IO ByteString +osPathBytes path = case OP.decodeUtf path of + Just decoded -> pure (TE.encodeUtf8 (T.pack decoded)) + Nothing -> + fail ("serialiseFromPath: name has no UTF-8 form (unpaired surrogate): " ++ show path) +#else +osPathBytes :: OsPath -> IO ByteString +osPathBytes path = case OP.decodeWith latin1 latin1 path of + Right decoded -> pure (BS8.pack decoded) + Left err -> + -- Unreachable: latin1 decoding is total - byte N reads as code + -- point N, and Char8 re-truncation above inverts it exactly - but + -- surfacing the impossible beats hiding it. + fail ("serialiseFromPath: undecodable name: " ++ show err) +#endif diff --git a/src/NovaCache/SafeName.hs b/src/NovaCache/SafeName.hs --- a/src/NovaCache/SafeName.hs +++ b/src/NovaCache/SafeName.hs @@ -3,32 +3,43 @@ -- "NovaCache.NAR": names Windows resolves to something other than an -- ordinary file of that exact spelling. Both guards reject the same -- categories from one definition, so they cannot drift apart. +-- +-- The predicates take raw bytes, the form NAR entry names have. Every +-- category here is ASCII-structural, and UTF-8 lead and continuation +-- bytes are all @>= 0x80@, so byte-level matching is exact - inside +-- valid UTF-8 and inside names that decode as nothing at all. Text +-- callers encode with 'Data.Text.Encoding.encodeUtf8' first. module NovaCache.SafeName ( isReservedDeviceName, hasTrailingDotOrSpace, ) where -import Data.Text (Text) -import qualified Data.Text as T +import Data.ByteString (ByteString) +import qualified Data.ByteString.Char8 as BS8 +import Data.Char (isAsciiUpper, toLower) -- | Is the name a Windows reserved device (@con@, @prn@, @aux@, @nul@, -- @com1@-@com9@, @lpt1@-@lpt9@)? Matched case-insensitively on the portion -- before the first dot, since @nul.txt@ also opens the device. Enforced on -- every platform so a Windows-hosted consumer is safe too. -isReservedDeviceName :: Text -> Bool -isReservedDeviceName txt = T.toLower (T.takeWhile (/= '.') txt) `elem` reservedNames +-- +-- Device matching is ASCII case-insensitive, so only @A@-@Z@ fold; any +-- other byte passes through and can never match the reserved set. +isReservedDeviceName :: ByteString -> Bool +isReservedDeviceName name = + BS8.map asciiLower (BS8.takeWhile (/= '.') name) `elem` reservedNames where + asciiLower c = if isAsciiUpper c then toLower c else c reservedNames = ["con", "prn", "aux", "nul"] - ++ ["com" <> n | n <- digits] - ++ ["lpt" <> n | n <- digits] - digits = [T.pack (show n) | n <- [1 .. 9 :: Int]] + ++ [device <> digit | device <- ["com", "lpt"], digit <- digits] + digits = [BS8.pack (show n) | n <- [1 .. 9 :: Int]] -- | Does the name end with a dot or a space? NTFS strips both at -- create time, so the on-disk name silently diverges from the requested -- one and the materialized tree no longer matches what named it. -hasTrailingDotOrSpace :: Text -> Bool -hasTrailingDotOrSpace name = case T.unsnoc name of +hasTrailingDotOrSpace :: ByteString -> Bool +hasTrailingDotOrSpace name = case BS8.unsnoc name of Just (_, end) -> end == '.' || end == ' ' Nothing -> False diff --git a/src/NovaCache/Store.hs b/src/NovaCache/Store.hs --- a/src/NovaCache/Store.hs +++ b/src/NovaCache/Store.hs @@ -29,6 +29,7 @@ import Data.Char (isAsciiLower, isAsciiUpper, isDigit) import Data.Text (Text) import qualified Data.Text as T +import qualified Data.Text.Encoding as TE import NovaCache.SafeName (hasTrailingDotOrSpace, isReservedDeviceName) import System.Directory ( createDirectoryIfMissing, @@ -248,10 +249,14 @@ | T.null txt = Nothing | T.isPrefixOf "." txt = Nothing | T.any (not . isSafeChar) txt = Nothing - | isReservedDeviceName txt = Nothing - | hasTrailingDotOrSpace txt = Nothing + | isReservedDeviceName keyBytes = Nothing + | hasTrailingDotOrSpace keyBytes = Nothing | otherwise = Just (T.unpack txt) where + -- The shared hazard predicates take the byte form NAR entry names + -- have; a store key is ASCII by the allowlist above, so its UTF-8 + -- encoding is the same spelling. + keyBytes = TE.encodeUtf8 txt isSafeChar c = isAsciiLower c || isAsciiUpper c || isDigit c || c `elem` ("._-+" :: [Char]) diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -32,6 +32,7 @@ import System.Directory (createDirectory, getTemporaryDirectory, listDirectory, removeDirectoryRecursive) import System.Exit (exitFailure, exitSuccess) import System.IO (hFlush, stdout) +import qualified System.Info -- --------------------------------------------------------------------------- -- Test harness (hand-rolled, no framework) @@ -403,6 +404,36 @@ names = ["nul2", "com10", "conx", "foo.bar", "a.b.c", "lpt0"] accepted bytes = either (const False) (const True) (NAR.deserialise bytes) in assertTrue "all near-miss names accepted" (all (accepted . plain) names), + -- Upstream carries names and targets as raw bytes: entries that + -- do not decode as UTF-8 parse and round-trip. + test "non-UTF-8 entry name round-trips" $ + let entry = NAR.NarDirectory [(BS.pack [0x66, 0xFF], NAR.NarRegular False "x")] + in assertRight "raw-byte name" entry (NAR.deserialise (NAR.serialise entry)), + test "non-UTF-8 symlink target round-trips" $ + let entry = NAR.NarSymlink (BS.pack [0x2F, 0x74, 0x6D, 0x70, 0x2F, 0xFF]) + in assertRight "raw-byte target" entry (NAR.deserialise (NAR.serialise entry)), + test "entries sort bytewise, non-UTF-8 names included" $ + let entry = + NAR.NarDirectory + [ (BS.pack [0xFF], NAR.NarRegular False "hi"), + ("b", NAR.NarRegular False "lo") + ] + in case NAR.deserialise (NAR.serialise entry) of + Left err -> do + putStrLn (" deserialise failed: " ++ err) + pure False + Right (NAR.NarDirectory entries) -> + assertEqual "byte order" ["b", BS.pack [0xFF]] (map fst entries) + Right other -> do + putStrLn (" expected directory, got: " ++ show other) + pure False, + -- The hazard checks are ASCII-structural, so they fire inside + -- names that do not decode as text. + test "hazards inside non-UTF-8 names still rejected" $ + let evil name = NAR.serialise (NAR.NarDirectory [(name, NAR.NarRegular False "x")]) + names = ["nul." <> BS.pack [0xFF], BS.pack [0xFF, 0x2E], BS.pack [0xFF] <> ":x"] + rejected bytes = either (const True) (const False) (NAR.deserialise bytes) + in assertTrue "all hazard bytes rejected" (all (rejected . evil) names), -- The case-hack strip: a tree materialized with upstream's -- collision suffix serialises back under its NAR names. test "serialiseFromPathWith strips the case-hack suffix" $ do @@ -435,7 +466,35 @@ removeDirectoryRecursive dir pure $ case (outcome :: Either SomeException NAR.NarEntry) of Left _ -> True - Right _ -> False + Right _ -> False, + -- The walk's boundary encoding: a Unicode disk name enters the + -- archive as its UTF-8 bytes on every platform. + test "serialiseFromPath encodes a Unicode disk name as UTF-8" $ do + dir <- caseHackFixture "nova-cache-test-uniname" + BS.writeFile (dir <> "/caf\233") "au lait" + entry <- NAR.serialiseFromPathWith NAR.CaseHackDisabled dir + removeDirectoryRecursive dir + assertEqual + "utf8 name" + (NAR.NarDirectory [(BS.pack [0x63, 0x61, 0x66, 0xC3, 0xA9], NAR.NarRegular False "au lait")]) + entry, + -- POSIX names are bytes; one that is not valid UTF-8 must archive + -- verbatim (it used to be silently rewritten with replacement + -- characters). Linux-gated: NTFS and APFS names are Unicode, so + -- the fixture cannot exist there. "\56575" is the lone surrogate + -- GHC's filesystem encoding round-trips to byte 0xFF. + test "serialiseFromPath carries a non-UTF-8 disk name verbatim" $ + if System.Info.os /= "linux" + then pure True + else do + dir <- caseHackFixture "nova-cache-test-rawname" + BS.writeFile (dir <> "/f\56575") "raw" + entry <- NAR.serialiseFromPathWith NAR.CaseHackDisabled dir + removeDirectoryRecursive dir + assertEqual + "raw byte name" + (NAR.NarDirectory [(BS.pack [0x66, 0xFF], NAR.NarRegular False "raw")]) + entry ] -- | A fresh, empty fixture directory under the system temp dir.