[Git][ghc/ghc][wip/T13660] 2 commits: base: Ensure that FilePaths don't contain NULs on POSIX

[Ben Gamari (@bgamari)]

Ben Gamari pushed to branch wip/T13660 at Glasgow Haskell Compiler / GHC


Commits:
470e3d57 by Ben Gamari at 2023-03-10T12:04:35-05:00
base: Ensure that FilePaths don't contain NULs on POSIX

POSIX filepaths may not contain the NUL octet but previously we did not
reject such paths. This could be exploited by untrusted input to cause
discrepancies between various `FilePath` queries and the opened
filename. For instance, `readFile "hello.so\x00.txt"` would open the
file `"hello.so"` yet `takeFileExtension` would return `".txt"`.

Fixes #13660 on POSIX platforms.

- - - - -
e316cbba by Ben Gamari at 2023-03-10T12:04:40-05:00
base: Reject NUL codepoints in Windows FilePaths

Similarly to POSIX, Windows rejects NULs in FilePaths. Unlike POSIX, we
can check the `FilePath` rather than its encoding since all paths are
UTF-16 on Windows.

Fixes #13660 on Windows.

- - - - -


1 changed file:

- libraries/base/System/Posix/Internals.hs


Changes:

=====================================
libraries/base/System/Posix/Internals.hs
=====================================
@@ -164,13 +164,35 @@ fdGetMode fd = do
 
 #if defined(mingw32_HOST_OS)
 withFilePath :: FilePath -> (CWString -> IO a) -> IO a
-withFilePath = withCWString
+withFilePath fp f = do
+    checkForInteriorNuls fp
+    withCWString fp f
 
 newFilePath :: FilePath -> IO CWString
-newFilePath = newCWString
+newFilePath fp = do
+    checkForInteriorNuls fp
+    newCWString fp
 
 peekFilePath :: CWString -> IO FilePath
 peekFilePath = peekCWString
+
+-- | Check a 'FilePath' for internal NUL codepoints as these are
+-- disallowed in Windows filepaths. See #13660.
+checkForInteriorNuls :: FilePath -> IO ()
+checkForInteriorNuls = mapM_ f
+  where
+    f '\0' = ioError err
+    f _    = return ()
+
+    err =
+        IOError
+          { ioe_handle = Nothing
+          , ioe_type = InvalidArgument
+          , ioe_location = "checkForInteriorNuls"
+          , ioe_description = "Windows filepaths must not contain internal NUL codepoints."
+          , ioe_errno = Nothing
+          , ioe_filename = Just fp
+          }
 #else
 
 withFilePath :: FilePath -> (CString -> IO a) -> IO a
@@ -178,11 +200,44 @@ newFilePath :: FilePath -> IO CString
 peekFilePath :: CString -> IO FilePath
 peekFilePathLen :: CStringLen -> IO FilePath
 
-withFilePath fp f = getFileSystemEncoding >>= \enc -> GHC.withCString enc fp f
-newFilePath fp = getFileSystemEncoding >>= \enc -> GHC.newCString enc fp
+withFilePath fp f = do
+    enc <- getFileSystemEncoding
+    GHC.withCStringLen enc fp $ \(str, len) -> do
+        checkForInteriorNuls fp (str, len)
+        f str
+newFilePath fp = do
+    enc <- getFileSystemEncoding
+    (str, len) <- GHC.newCStringLen enc fp
+    checkForInteriorNuls fp (str, len)
+    return str
 peekFilePath fp = getFileSystemEncoding >>= \enc -> GHC.peekCString enc fp
 peekFilePathLen fp = getFileSystemEncoding >>= \enc -> GHC.peekCStringLen enc fp
 
+-- | Check an encoded 'FilePath' for internal NUL octets as these are
+-- disallowed in POSIX filepaths. See #13660.
+checkForInteriorNuls :: FilePath -> CStringLen -> IO ()
+checkForInteriorNuls fp (str, len) = go (len-1)
+  where
+    -- Here we walk backwards through the encoded path, ensuring that the body
+    -- of the string (that is, excluding the terminal NUL) contains no NUL
+    -- octets.
+    go i | i < 0 = return ()
+    go i = do
+      c <- peekByteOff str i :: IO Word8
+      when (c == 0) $ do
+        ioError err
+      go (i-1)
+
+    err =
+        IOError
+          { ioe_handle = Nothing
+          , ioe_type = InvalidArgument
+          , ioe_location = "checkForInteriorNuls"
+          , ioe_description = "POSIX filepaths must not contain internal NUL octets."
+          , ioe_errno = Nothing
+          , ioe_filename = Just fp
+          }
+
 #endif
 
 -- ---------------------------------------------------------------------------



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c543fed5b468d20d5757fe621f2e44dd01a09ab8...e316cbba1e70ce1974498e2a48f89212b814d33d

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c543fed5b468d20d5757fe621f2e44dd01a09ab8...e316cbba1e70ce1974498e2a48f89212b814d33d
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230310/31ed5270/attachment-0001.html>