Check that filenames are ASCII instead of silent corruption (see #6)

Author: Bodigrim

Codec/Archive/Tar/Index/Internal.hs

@@ -67,6 +67,7 @@ import qualified Codec.Archive.Tar.Index.StringTable as StringTable
 import Codec.Archive.Tar.Index.StringTable (StringTable, StringTableBuilder)
 import qualified Codec.Archive.Tar.Index.IntTrie as IntTrie
 import Codec.Archive.Tar.Index.IntTrie (IntTrie, IntTrieBuilder)
+import Codec.Archive.Tar.PackAscii
 
 import qualified System.FilePath.Posix as FilePath
 import Data.Monoid (Monoid(..))
@@ -174,7 +175,7 @@ toComponentIds table =
     lookupComponents []
   . filter (/= BS.Char8.singleton '.')
   . splitDirectories
-  . BS.Char8.pack
+  . packAscii
   where
     lookupComponents cs' []     = Just (reverse cs')
     lookupComponents cs' (c:cs) = case StringTable.lookup table c of

Codec/Archive/Tar/PackAscii.hs

@@ -0,0 +1,14 @@
+module Codec.Archive.Tar.PackAscii
+  ( packAscii
+  ) where
+
+import qualified Data.ByteString.Char8 as BS.Char8
+import Data.Char
+import GHC.Stack
+
+-- | We should really migrate to 'OsPath' from 'filepath',
+-- but for now let's not corrupt data silently.
+packAscii :: HasCallStack => FilePath -> BS.Char8.ByteString
+packAscii xs
+  | all isAscii xs = BS.Char8.pack xs
+  | otherwise = error $ "packAscii: only ASCII filenames are supported, but got " ++ xs

Codec/Archive/Tar/Types.hs

@@ -74,6 +74,8 @@ import qualified System.FilePath.Windows as FilePath.Windows
 import System.Posix.Types
          ( FileMode )
 
+import Codec.Archive.Tar.PackAscii
+
 type FileSize  = Int64
 -- | The number of seconds since the UNIX epoch
 type EpochTime = Int64
@@ -357,14 +359,14 @@ splitLongPath :: FilePath -> Either String TarPath
 splitLongPath path =
   case packName nameMax (reverse (FilePath.Posix.splitPath path)) of
     Left err                 -> Left err
-    Right (name, [])         -> Right $! TarPath (BS.Char8.pack name)
+    Right (name, [])         -> Right $! TarPath (packAscii name)
                                                   BS.empty
     Right (name, first:rest) -> case packName prefixMax remainder of
       Left err               -> Left err
       Right (_     , (_:_))  -> Left $ "Filename " ++ path ++
                                        " too long (cannot split)"
-      Right (prefix, [])     -> Right $! TarPath (BS.Char8.pack name)
-                                                 (BS.Char8.pack prefix)
+      Right (prefix, [])     -> Right $! TarPath (packAscii name)
+                                                 (packAscii prefix)
       where
         -- drop the '/' between the name and prefix:
         remainder = init first : rest
@@ -399,7 +401,7 @@ instance NFData LinkTarget where
 -- characters.
 --
 toLinkTarget   :: FilePath -> Maybe LinkTarget
-toLinkTarget path | length path <= 100 = Just $! LinkTarget (BS.Char8.pack path)
+toLinkTarget path | length path <= 100 = Just $! LinkTarget (packAscii path)
                   | otherwise          = Nothing
 
 -- | Convert a tar 'LinkTarget' to a native 'FilePath'.

changelog.md

@@ -7,6 +7,7 @@ See also http://pvp.haskell.org/faq
   * Speed up `fromTarPathToPosixPath`
   * Set permissions on extracted files
   * Handle > 8 GB files
+  * Prohibit non-ASCII file names instead of silent corruption
 
 0.5.1.1 Herbert Valerio Riedel <[email protected]> August 2019
 

tar.cabal

@@ -62,6 +62,7 @@ library tar-internal
     Codec.Archive.Tar.Read
     Codec.Archive.Tar.Write
     Codec.Archive.Tar.Pack
+    Codec.Archive.Tar.PackAscii
     Codec.Archive.Tar.Unpack
     Codec.Archive.Tar.Index.StringTable
     Codec.Archive.Tar.Index.IntTrie