[Git][ghc/ghc][wip/T13660] 4 commits: base: Move implementation of GHC.Foreign to GHC.Internal
Ben Gamari (@bgamari)
gitlab at gitlab.haskell.org
Wed Mar 29 21:57:53 UTC 2023
Ben Gamari pushed to branch wip/T13660 at Glasgow Haskell Compiler / GHC
Commits:
e451ffd6 by Ben Gamari at 2023-03-29T17:52:09-04:00
base: Move implementation of GHC.Foreign to GHC.Internal
- - - - -
d39c9e1e by Ben Gamari at 2023-03-29T17:57:33-04:00
base: Introduce {new,with}CStringLen0
These are useful helpers for implementing the internal-NUL code unit
check needed to fix #13660.
- - - - -
804d2470 by Ben Gamari at 2023-03-29T17:57:40-04:00
base: Clean up documentation
- - - - -
9847f8eb by Ben Gamari at 2023-03-29T17:57:40-04:00
base: Ensure that FilePaths don't contain NULs
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"`.
The same argument applies to Windows FilePaths
Fixes #13660.
- - - - -
3 changed files:
- libraries/base/GHC/Foreign.hs → libraries/base/GHC/Foreign/Internal.hs
- libraries/base/System/Posix/Internals.hs
- libraries/base/base.cabal
Changes:
=====================================
libraries/base/GHC/Foreign.hs → libraries/base/GHC/Foreign/Internal.hs
=====================================
@@ -5,7 +5,7 @@
-----------------------------------------------------------------------------
-- |
--- Module : GHC.Foreign
+-- Module : GHC.Foreign.Internal
-- Copyright : (c) The University of Glasgow, 2008-2011
-- License : see libraries/base/LICENSE
--
@@ -17,24 +17,23 @@
--
-----------------------------------------------------------------------------
-module GHC.Foreign (
+module GHC.Foreign.Internal (
-- * C strings with a configurable encoding
CString, CStringLen,
- -- conversion of C strings into Haskell strings
- --
+ -- * Conversion of C strings into Haskell strings
peekCString,
peekCStringLen,
- -- conversion of Haskell strings into C strings
- --
+ -- * Conversion of Haskell strings into C strings
newCString,
newCStringLen,
+ newCStringLen0,
- -- conversion of Haskell strings into C strings using temporary storage
- --
+ -- * Conversion of Haskell strings into C strings using temporary storage
withCString,
withCStringLen,
+ withCStringLen0,
withCStringsLen,
charIsRepresentable,
@@ -111,6 +110,8 @@ newCString enc = liftM fst . newEncodedCString enc True
-- | Marshal a Haskell string into a C string (ie, character array) with
-- explicit length information.
--
+-- Note that this does not NUL terminate the resulting string.
+--
-- * new storage is allocated for the C string and must be
-- explicitly freed using 'Foreign.Marshal.Alloc.free' or
-- 'Foreign.Marshal.Alloc.finalizerFree'.
@@ -133,6 +134,8 @@ withCString enc s act = withEncodedCString enc True s $ \(cp, _sz) -> act cp
-- | Marshal a Haskell string into a C string (ie, character array)
-- in temporary storage, with explicit length information.
--
+-- Note that this does not NUL terminate the resulting string.
+--
-- * the memory is freed when the subcomputation terminates (either
-- normally or via an exception), so the pointer to the temporary
-- storage must /not/ be used after this.
@@ -140,6 +143,28 @@ withCString enc s act = withEncodedCString enc True s $ \(cp, _sz) -> act cp
withCStringLen :: TextEncoding -> String -> (CStringLen -> IO a) -> IO a
withCStringLen enc = withEncodedCString enc False
+-- | Marshal a Haskell string into a NUL-terminated C string (ie, character array)
+-- with explicit length information.
+--
+-- * new storage is allocated for the C string and must be
+-- explicitly freed using 'Foreign.Marshal.Alloc.free' or
+-- 'Foreign.Marshal.Alloc.finalizerFree'.
+--
+-- @since 4.19.0.0
+newCStringLen0 :: TextEncoding -> String -> IO CStringLen
+newCStringLen0 enc = newEncodedCString enc True
+
+-- | Marshal a Haskell string into a NUL-terminated C string (ie, character array)
+-- in temporary storage, with explicit length information.
+--
+-- * the memory is freed when the subcomputation terminates (either
+-- normally or via an exception), so the pointer to the temporary
+-- storage must /not/ be used after this.
+--
+-- @since 4.19.0.0
+withCStringLen0 :: TextEncoding -> String -> (CStringLen -> IO a) -> IO a
+withCStringLen0 enc = withEncodedCString enc True
+
-- | Marshal a list of Haskell strings into an array of NUL terminated C strings
-- using temporary storage.
--
=====================================
libraries/base/System/Posix/Internals.hs
=====================================
@@ -43,6 +43,7 @@ import System.IO.Error
import GHC.Base
import GHC.Num
+import GHC.Ptr
import GHC.Real
import GHC.IO
import GHC.IO.IOMode
@@ -164,13 +165,22 @@ 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 fp = when ('\0' `elem` fp) (throwInternalNulError fp)
#else
withFilePath :: FilePath -> (CString -> IO a) -> IO a
@@ -178,13 +188,43 @@ 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.withCStringLen0 enc fp $ \(str, len) -> do
+ checkForInteriorNuls fp (str, len)
+ f str
+newFilePath fp = do
+ enc <- getFileSystemEncoding
+ (str, len) <- GHC.newCStringLen0 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) =
+ when (len' /= len) (throwInternalNulError fp)
+ -- N.B. If the string contains internal NUL codeunits then the strlen will
+ -- indicate a size smaller than that returned by withCStringLen.
+ where
+ len' = case str of Ptr ptr -> I# (cstringLength# ptr)
#endif
+throwInternalNulError :: FilePath -> IO a
+throwInternalNulError fp = ioError err
+ where
+ err =
+ IOError
+ { ioe_handle = Nothing
+ , ioe_type = InvalidArgument
+ , ioe_location = "checkForInteriorNuls"
+ , ioe_description = "FilePaths must not contain internal NUL code units."
+ , ioe_errno = Nothing
+ , ioe_filename = Just fp
+ }
+
-- ---------------------------------------------------------------------------
-- Terminal-related stuff
=====================================
libraries/base/base.cabal
=====================================
@@ -351,6 +351,7 @@ Library
GHC.Event.IntVar
GHC.Event.PSQ
GHC.Event.Unique
+ GHC.Foreign.Internal
-- GHC.IOPort -- TODO: hide again after debug
GHC.Unicode.Internal.Bits
GHC.Unicode.Internal.Char.DerivedCoreProperties
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fdee87f9ab056846a8e467741cb836146063e474...9847f8eb9a406860bd532bc5efba1cb1a4b891f4
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fdee87f9ab056846a8e467741cb836146063e474...9847f8eb9a406860bd532bc5efba1cb1a4b891f4
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/20230329/dbb04a4f/attachment-0001.html>
More information about the ghc-commits
mailing list