{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Data.Conduit.Tar.Unix
( getFileInfo
, restoreFile
) where
import Conduit
import Control.Exception.Safe
import Control.Monad (void, when)
import Data.Bits
import qualified Data.ByteString.Char8 as S8
import Data.Conduit.Tar.Types
import Foreign.C.Types (CTime (..))
import qualified System.Directory as Dir
import qualified System.Posix.Files as Posix
import qualified System.Posix.User as Posix
getFileInfo :: FilePath -> IO FileInfo
getFileInfo fpStr = do
let fp = encodeFilePath fpStr
fs <- Posix.getSymbolicLinkStatus fpStr
let uid = Posix.fileOwner fs
gid = Posix.fileGroup fs
euEntry :: Either IOException Posix.UserEntry <- try $ Posix.getUserEntryForID uid
egEntry :: Either IOException Posix.GroupEntry <- try $ Posix.getGroupEntryForID gid
(fType, fSize) <-
case () of
() | Posix.isRegularFile fs -> return (FTNormal, Posix.fileSize fs)
| Posix.isSymbolicLink fs -> do
ln <- Posix.readSymbolicLink fpStr
return (FTSymbolicLink (encodeFilePath ln), 0)
| Posix.isCharacterDevice fs -> return (FTCharacterSpecial, 0)
| Posix.isBlockDevice fs -> return (FTBlockSpecial, 0)
| Posix.isDirectory fs -> return (FTDirectory, 0)
| Posix.isNamedPipe fs -> return (FTFifo, 0)
| otherwise -> error $ "Unsupported file type: " ++ S8.unpack fp
return $! FileInfo
{ filePath = fp
, fileUserId = uid
, fileUserName = either (const "") (S8.pack . Posix.userName) euEntry
, fileGroupId = gid
, fileGroupName = either (const "") (S8.pack . Posix.groupName) egEntry
, fileMode = Posix.fileMode fs .&. 0o7777
, fileSize = fSize
, fileType = fType
, fileModTime = Posix.modificationTime fs
}
restoreFile :: (MonadResource m) =>
FileInfo -> ConduitM S8.ByteString (IO ()) m ()
restoreFile FileInfo {..} = do
let fpStr = decodeFilePath filePath
restorePermissions = do
void $ tryAny $ Posix.setOwnerAndGroup fpStr fileUserId fileGroupId
void $ tryAny $ Posix.setFileMode fpStr fileMode
case fileType of
FTDirectory -> do
liftIO $ do
Dir.createDirectoryIfMissing False fpStr
restorePermissions
yield $
(Dir.doesDirectoryExist fpStr >>=
(`when` Posix.setFileTimes fpStr fileModTime fileModTime))
FTSymbolicLink link ->
liftIO $ do
_ <- tryAny $ Posix.removeLink fpStr
Posix.createSymbolicLink (decodeFilePath link) fpStr
_ <- tryAny $ Posix.setSymbolicLinkOwnerAndGroup fpStr fileUserId fileGroupId
#if MIN_VERSION_unix(2,7,0)
let CTime epochInt32 = fileModTime
unixModTime = fromInteger (fromIntegral epochInt32)
void $ tryAny $ Posix.setSymbolicLinkTimesHiRes fpStr unixModTime unixModTime
#endif
FTNormal -> do
sinkFile fpStr
liftIO $ do
restorePermissions
Posix.setFileTimes fpStr fileModTime fileModTime
ty -> error $ "Unsupported tar entry type: " ++ show ty