summaryrefslogtreecommitdiff
path: root/src/Codec/Archive/Unpack.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Codec/Archive/Unpack.hs')
-rw-r--r--src/Codec/Archive/Unpack.hs24
1 files changed, 18 insertions, 6 deletions
diff --git a/src/Codec/Archive/Unpack.hs b/src/Codec/Archive/Unpack.hs
index a34772b..6d932fa 100644
--- a/src/Codec/Archive/Unpack.hs
+++ b/src/Codec/Archive/Unpack.hs
@@ -101,8 +101,20 @@ unpackEntriesFp a fp = do
let file' = fp </> file
liftIO $ withCString file' $ \fileC ->
archiveEntrySetPathname x fileC
- ignore $ archiveReadExtract a x archiveExtractTime
- liftIO $ archiveEntrySetPathname x preFile
+ ft <- liftIO $ archiveEntryFiletype x
+ case ft of
+ Just{} -> do
+ ignore $ archiveReadExtract a x archiveExtractTime
+ liftIO $ archiveEntrySetPathname x preFile
+ Nothing -> do
+ preHardlink <- liftIO $ archiveEntryHardlink x
+ hardlink <- liftIO $ peekCString preHardlink
+ let hardlink' = fp </> hardlink
+ liftIO $ withCString hardlink' $ \hl ->
+ archiveEntrySetHardlink x hl
+ ignore $ archiveReadExtract a x archiveExtractTime
+ liftIO $ archiveEntrySetPathname x preFile
+ liftIO $ archiveEntrySetHardlink x preHardlink
ignore $ archiveReadDataSkip a
unpackEntriesFp a fp
@@ -114,11 +126,11 @@ readBS a sz =
readContents :: Ptr Archive -> Ptr ArchiveEntry -> IO EntryContent
readContents a entry = go =<< archiveEntryFiletype entry
- where go Nothing = Hardlink <$> (peekCString =<< archiveEntryHardlink entry)
- go (Just FtRegular) = NormalFile <$> (readBS a =<< sz)
- go (Just FtLink) = Symlink <$> (peekCString =<< archiveEntrySymlink entry)
+ where go Nothing = Hardlink <$> (peekCString =<< archiveEntryHardlink entry)
+ go (Just FtRegular) = NormalFile <$> (readBS a =<< sz)
+ go (Just FtLink) = Symlink <$> (peekCString =<< archiveEntrySymlink entry)
go (Just FtDirectory) = pure Directory
- go (Just _) = error "Unsupported filetype"
+ go (Just _) = error "Unsupported filetype"
sz = fromIntegral <$> archiveEntrySize entry
archiveGetterHelper :: (Ptr ArchiveEntry -> IO a) -> (Ptr ArchiveEntry -> IO Bool) -> Ptr ArchiveEntry -> IO (Maybe a)