Enable translation of maps into directory trees

dhall/src/Dhall/DirectoryTree.hs

@@ -25,17 +25,22 @@ import qualified Dhall.Pretty
 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
 
 {-| Attempt to transform a Dhall record into a directory tree where:
 
     * Records are translated into directories
 
-    * @Map@s are also translated into directories
+    * @Map@s are translated into directory trees
 
     * @Text@ values or fields are translated into files
 
     * @Optional@ values are omitted if @None@
+
+    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.
 
     For example, the following Dhall record:
 
@@ -124,13 +129,36 @@ toDirectoryTree path expression = case expression of
         empty
 
     process key value = do
-        if Text.isInfixOf (Text.pack [ FilePath.pathSeparator ]) key
+        -- Fail if path is absolute, which is a security risk.
+        case keyPathSegments of
+            "" : _ ->
+                die
+            -- Detect Windows absolute paths like "C:".
+            [_ , ':'] : _ ->
+                die
+            _ ->
+                return ()
+
+        -- Fail if path contains attempts to go to container directory,
+        -- which is a security risk.
+        if elem ".." keyPathSegments
             then die
             else return ()
 
-        Directory.createDirectoryIfMissing False path
+        (dirPath, fileName) <- case reverse keyPathSegments of
+            h : t ->
+                return
+                    ( Foldable.foldl' (</>) path (reverse t)
+                    , h )
+            _ ->
+                die
 
-        toDirectoryTree (path </> Text.unpack key) value
+        Directory.createDirectoryIfMissing True dirPath
+
+        toDirectoryTree (dirPath </> fileName) value
+      where
+        keyPathSegments =
+            fmap Text.unpack $ Text.splitOn "/" key
 
     die = Exception.throwIO FilesystemError{..}
       where