diff --git a/dhall/src/Dhall/DirectoryTree.hs b/dhall/src/Dhall/DirectoryTree.hs index b0ec12718..a49a95f61 100644 --- a/dhall/src/Dhall/DirectoryTree.hs +++ b/dhall/src/Dhall/DirectoryTree.hs @@ -20,7 +20,7 @@ module Dhall.DirectoryTree import Control.Applicative (empty) import Control.Exception (Exception) -import Control.Monad (unless, when) +import Control.Monad (unless) import Data.Either.Validation (Validation (..)) import Data.Functor.Identity (Identity (..)) import Data.Maybe (fromMaybe) @@ -52,7 +52,6 @@ import qualified Dhall.TypeCheck as TypeCheck import qualified Dhall.Util as Util import qualified Prettyprinter.Render.String as Pretty import qualified System.Directory as Directory -import qualified System.FilePath as FilePath import qualified System.PosixCompat.Files as Posix import qualified System.PosixCompat.User as Posix @@ -60,7 +59,7 @@ import qualified System.PosixCompat.User as Posix * Records are translated into directories - * @Map@s are also translated into directories + * @Map@s are translated into directory trees, if allowSeparators option is enabled * @Text@ values or fields are translated into files @@ -68,7 +67,7 @@ import qualified System.PosixCompat.User as Posix * There is a more advanced way to construct directory trees using a fixpoint encoding. See the documentation below on that. - + For example, the following Dhall record: > { dir = { `hello.txt` = "Hello\n" } @@ -112,6 +111,14 @@ import qualified System.PosixCompat.User as Posix > ! "bar": null > ! "foo": "Hello" + /Construction of directory trees from maps/ + + In @Map@s, the keys specify paths relative to the work dir. + Only forward slashes (@/@) must be used as directory separators. + They will be automatically transformed on Windows. + Absolute paths (starting with @/@) and parent directory segments (@..@) + are prohibited for security concerns. + /Advanced construction of directory trees/ In addition to the ways described above using "simple" Dhall values to @@ -215,12 +222,39 @@ toDirectoryTree allowSeparators path expression = case expression of empty process key value = do - when (not allowSeparators && Text.isInfixOf (Text.pack [ FilePath.pathSeparator ]) key) $ - die - - Directory.createDirectoryIfMissing allowSeparators path - - toDirectoryTree allowSeparators (path Text.unpack key) value + case keyPathSegments of + -- Fail if path is absolute, which is a security risk. + "" : _ -> + die + -- Detect Windows absolute paths like "C:". + [_ , ':'] : _ -> + die + -- Fail if separators are not allowed by the option. + _ : _ | not allowSeparators -> + die + _ -> + return () + + -- Fail if path contains attempts to go to container directory, + -- which is a security risk. + if elem ".." keyPathSegments + then die + else return () + + (dirPath, fileName) <- case reverse keyPathSegments of + h : t -> + return + ( Foldable.foldl' () path (reverse t) + , h ) + _ -> + die + + Directory.createDirectoryIfMissing True dirPath + + toDirectoryTree allowSeparators (dirPath fileName) value + where + keyPathSegments = + fmap Text.unpack $ Text.splitOn "/" key die = Exception.throwIO FilesystemError{..} where