use upstream unpack

src/Keter/TempTarball.hs

@@ -67,51 +67,9 @@ unpackTempTar :: Maybe (UserID, GroupID)
 unpackTempTar muid tf bundle appname withDir = do
     lbs <- L.readFile bundle
     bracketOnError (getFolder muid tf appname) D.removeDirectoryRecursive $ \dir -> do
-        unpackTar muid dir $ Tar.read $ decompress lbs
+        D.createDirectoryIfMissing True dir
+        let entries = Tar.read $ decompress lbs
+        Tar.unpack dir entries
+        forM entries $ \genEntry ->
+          setOwnerAndGroup (Tar.entryPath genEntry) uid gid
         withDir dir
-
-unpackTar :: Maybe (UserID, GroupID)
-          -> FilePath
-          -> Tar.Entries Tar.FormatError
-          -> IO ()
-unpackTar muid dir =
-    loop . Tar.checkSecurity
-  where
-    loop Tar.Done = return ()
-    loop (Tar.Fail e) = either throwIO throwIO e
-    loop (Tar.Next e es) = go e >> loop es
-
-    go e = do
-        let fp = dir </> Tar.entryPath e
-        case Tar.entryContent e of
-            Tar.NormalFile lbs _ -> do
-                case muid of
-                    Nothing -> D.createDirectoryIfMissing True $ F.takeDirectory fp
-                    Just (uid, gid) -> createTreeUID uid gid $ F.takeDirectory fp
-                let write fd bs = unsafeUseAsCStringLen bs $ \(ptr, len) -> do
-                        _ <- fdWriteBuf fd (castPtr ptr) (fromIntegral len)
-                        return ()
-                bracket
-                    (do
-                        fd <- createFile fp $ Tar.entryPermissions e
-                        setFdOption fd CloseOnExec True
-                        case muid of
-                            Nothing -> return ()
-                            Just (uid, gid) -> setFdOwnerAndGroup fd uid gid
-                        return fd)
-                    closeFd
-                    (\fd -> mapM_ (write fd) (L.toChunks lbs))
-            _ -> return ()
-
--- | Create a directory tree, setting the uid and gid of all newly created
--- folders.
-createTreeUID :: UserID -> GroupID -> FilePath -> IO ()
-createTreeUID uid gid =
-    go
-  where
-    go fp = do
-        exists <- D.doesDirectoryExist fp
-        unless exists $ do
-            go $ F.takeDirectory fp
-            D.createDirectoryIfMissing False fp
-            setOwnerAndGroup fp uid gid