{-# LANGUAGE CPP, GeneralizedNewtypeDeriving, BangPatterns #-}
module Codec.Archive.Tar.Types (
Entry(..),
entryPath,
EntryContent(..),
FileSize,
Permissions,
Ownership(..),
EpochTime,
TypeCode,
DevMajor,
DevMinor,
Format(..),
simpleEntry,
fileEntry,
directoryEntry,
ordinaryFilePermissions,
executableFilePermissions,
directoryPermissions,
TarPath(..),
toTarPath,
fromTarPath,
fromTarPathToPosixPath,
fromTarPathToWindowsPath,
LinkTarget(..),
toLinkTarget,
fromLinkTarget,
fromLinkTargetToPosixPath,
fromLinkTargetToWindowsPath,
Entries(..),
mapEntries,
mapEntriesNoFail,
foldEntries,
foldlEntries,
unfoldEntries,
#ifdef TESTS
limitToV7FormatCompat
#endif
) where
import Data.Int (Int64)
import Data.Monoid (Monoid(..))
import Data.Semigroup as Sem
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS.Char8
import qualified Data.ByteString.Lazy as LBS
import Control.DeepSeq
import qualified System.FilePath as FilePath.Native
( joinPath, splitDirectories, addTrailingPathSeparator )
import qualified System.FilePath.Posix as FilePath.Posix
( joinPath, splitPath, splitDirectories, hasTrailingPathSeparator
, addTrailingPathSeparator )
import qualified System.FilePath.Windows as FilePath.Windows
( joinPath, addTrailingPathSeparator )
import System.Posix.Types
( FileMode )
#ifdef TESTS
import Test.QuickCheck
import Control.Applicative ((<$>), (<*>), pure)
import Data.Word (Word16)
#endif
type FileSize = Int64
type EpochTime = Int64
type DevMajor = Int
type DevMinor = Int
type TypeCode = Char
type Permissions = FileMode
data Entry = Entry {
Entry -> TarPath
entryTarPath :: {-# UNPACK #-} !TarPath,
Entry -> EntryContent
entryContent :: !EntryContent,
Entry -> Permissions
entryPermissions :: {-# UNPACK #-} !Permissions,
Entry -> Ownership
entryOwnership :: {-# UNPACK #-} !Ownership,
Entry -> EpochTime
entryTime :: {-# UNPACK #-} !EpochTime,
Entry -> Format
entryFormat :: !Format
}
deriving (Entry -> Entry -> Bool
(Entry -> Entry -> Bool) -> (Entry -> Entry -> Bool) -> Eq Entry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Entry -> Entry -> Bool
$c/= :: Entry -> Entry -> Bool
== :: Entry -> Entry -> Bool
$c== :: Entry -> Entry -> Bool
Eq, Int -> Entry -> ShowS
[Entry] -> ShowS
Entry -> String
(Int -> Entry -> ShowS)
-> (Entry -> String) -> ([Entry] -> ShowS) -> Show Entry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Entry] -> ShowS
$cshowList :: [Entry] -> ShowS
show :: Entry -> String
$cshow :: Entry -> String
showsPrec :: Int -> Entry -> ShowS
$cshowsPrec :: Int -> Entry -> ShowS
Show)
entryPath :: Entry -> FilePath
entryPath :: Entry -> String
entryPath = TarPath -> String
fromTarPath (TarPath -> String) -> (Entry -> TarPath) -> Entry -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entry -> TarPath
entryTarPath
data EntryContent = NormalFile LBS.ByteString {-# UNPACK #-} !FileSize
| Directory
| SymbolicLink !LinkTarget
| HardLink !LinkTarget
| CharacterDevice {-# UNPACK #-} !DevMajor
{-# UNPACK #-} !DevMinor
| BlockDevice {-# UNPACK #-} !DevMajor
{-# UNPACK #-} !DevMinor
| NamedPipe
| OtherEntryType {-# UNPACK #-} !TypeCode LBS.ByteString
{-# UNPACK #-} !FileSize
deriving (EntryContent -> EntryContent -> Bool
(EntryContent -> EntryContent -> Bool)
-> (EntryContent -> EntryContent -> Bool) -> Eq EntryContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EntryContent -> EntryContent -> Bool
$c/= :: EntryContent -> EntryContent -> Bool
== :: EntryContent -> EntryContent -> Bool
$c== :: EntryContent -> EntryContent -> Bool
Eq, Eq EntryContent
Eq EntryContent =>
(EntryContent -> EntryContent -> Ordering)
-> (EntryContent -> EntryContent -> Bool)
-> (EntryContent -> EntryContent -> Bool)
-> (EntryContent -> EntryContent -> Bool)
-> (EntryContent -> EntryContent -> Bool)
-> (EntryContent -> EntryContent -> EntryContent)
-> (EntryContent -> EntryContent -> EntryContent)
-> Ord EntryContent
EntryContent -> EntryContent -> Bool
EntryContent -> EntryContent -> Ordering
EntryContent -> EntryContent -> EntryContent
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EntryContent -> EntryContent -> EntryContent
$cmin :: EntryContent -> EntryContent -> EntryContent
max :: EntryContent -> EntryContent -> EntryContent
$cmax :: EntryContent -> EntryContent -> EntryContent
>= :: EntryContent -> EntryContent -> Bool
$c>= :: EntryContent -> EntryContent -> Bool
> :: EntryContent -> EntryContent -> Bool
$c> :: EntryContent -> EntryContent -> Bool
<= :: EntryContent -> EntryContent -> Bool
$c<= :: EntryContent -> EntryContent -> Bool
< :: EntryContent -> EntryContent -> Bool
$c< :: EntryContent -> EntryContent -> Bool
compare :: EntryContent -> EntryContent -> Ordering
$ccompare :: EntryContent -> EntryContent -> Ordering
$cp1Ord :: Eq EntryContent
Ord, Int -> EntryContent -> ShowS
[EntryContent] -> ShowS
EntryContent -> String
(Int -> EntryContent -> ShowS)
-> (EntryContent -> String)
-> ([EntryContent] -> ShowS)
-> Show EntryContent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EntryContent] -> ShowS
$cshowList :: [EntryContent] -> ShowS
show :: EntryContent -> String
$cshow :: EntryContent -> String
showsPrec :: Int -> EntryContent -> ShowS
$cshowsPrec :: Int -> EntryContent -> ShowS
Show)
data Ownership = Ownership {
Ownership -> String
ownerName :: String,
Ownership -> String
groupName :: String,
Ownership -> Int
ownerId :: {-# UNPACK #-} !Int,
Ownership -> Int
groupId :: {-# UNPACK #-} !Int
}
deriving (Ownership -> Ownership -> Bool
(Ownership -> Ownership -> Bool)
-> (Ownership -> Ownership -> Bool) -> Eq Ownership
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ownership -> Ownership -> Bool
$c/= :: Ownership -> Ownership -> Bool
== :: Ownership -> Ownership -> Bool
$c== :: Ownership -> Ownership -> Bool
Eq, Eq Ownership
Eq Ownership =>
(Ownership -> Ownership -> Ordering)
-> (Ownership -> Ownership -> Bool)
-> (Ownership -> Ownership -> Bool)
-> (Ownership -> Ownership -> Bool)
-> (Ownership -> Ownership -> Bool)
-> (Ownership -> Ownership -> Ownership)
-> (Ownership -> Ownership -> Ownership)
-> Ord Ownership
Ownership -> Ownership -> Bool
Ownership -> Ownership -> Ordering
Ownership -> Ownership -> Ownership
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Ownership -> Ownership -> Ownership
$cmin :: Ownership -> Ownership -> Ownership
max :: Ownership -> Ownership -> Ownership
$cmax :: Ownership -> Ownership -> Ownership
>= :: Ownership -> Ownership -> Bool
$c>= :: Ownership -> Ownership -> Bool
> :: Ownership -> Ownership -> Bool
$c> :: Ownership -> Ownership -> Bool
<= :: Ownership -> Ownership -> Bool
$c<= :: Ownership -> Ownership -> Bool
< :: Ownership -> Ownership -> Bool
$c< :: Ownership -> Ownership -> Bool
compare :: Ownership -> Ownership -> Ordering
$ccompare :: Ownership -> Ownership -> Ordering
$cp1Ord :: Eq Ownership
Ord, Int -> Ownership -> ShowS
[Ownership] -> ShowS
Ownership -> String
(Int -> Ownership -> ShowS)
-> (Ownership -> String)
-> ([Ownership] -> ShowS)
-> Show Ownership
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ownership] -> ShowS
$cshowList :: [Ownership] -> ShowS
show :: Ownership -> String
$cshow :: Ownership -> String
showsPrec :: Int -> Ownership -> ShowS
$cshowsPrec :: Int -> Ownership -> ShowS
Show)
data Format =
V7Format
| UstarFormat
| GnuFormat
deriving (Format -> Format -> Bool
(Format -> Format -> Bool)
-> (Format -> Format -> Bool) -> Eq Format
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Format -> Format -> Bool
$c/= :: Format -> Format -> Bool
== :: Format -> Format -> Bool
$c== :: Format -> Format -> Bool
Eq, Eq Format
Eq Format =>
(Format -> Format -> Ordering)
-> (Format -> Format -> Bool)
-> (Format -> Format -> Bool)
-> (Format -> Format -> Bool)
-> (Format -> Format -> Bool)
-> (Format -> Format -> Format)
-> (Format -> Format -> Format)
-> Ord Format
Format -> Format -> Bool
Format -> Format -> Ordering
Format -> Format -> Format
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Format -> Format -> Format
$cmin :: Format -> Format -> Format
max :: Format -> Format -> Format
$cmax :: Format -> Format -> Format
>= :: Format -> Format -> Bool
$c>= :: Format -> Format -> Bool
> :: Format -> Format -> Bool
$c> :: Format -> Format -> Bool
<= :: Format -> Format -> Bool
$c<= :: Format -> Format -> Bool
< :: Format -> Format -> Bool
$c< :: Format -> Format -> Bool
compare :: Format -> Format -> Ordering
$ccompare :: Format -> Format -> Ordering
$cp1Ord :: Eq Format
Ord, Int -> Format -> ShowS
[Format] -> ShowS
Format -> String
(Int -> Format -> ShowS)
-> (Format -> String) -> ([Format] -> ShowS) -> Show Format
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Format] -> ShowS
$cshowList :: [Format] -> ShowS
show :: Format -> String
$cshow :: Format -> String
showsPrec :: Int -> Format -> ShowS
$cshowsPrec :: Int -> Format -> ShowS
Show)
instance NFData Entry where
rnf :: Entry -> ()
rnf (Entry _ c :: EntryContent
c _ _ _ _) = EntryContent -> ()
forall a. NFData a => a -> ()
rnf EntryContent
c
instance NFData EntryContent where
rnf :: EntryContent -> ()
rnf x :: EntryContent
x = case EntryContent
x of
NormalFile c :: ByteString
c _ -> ByteString -> ()
rnflbs ByteString
c
OtherEntryType _ c :: ByteString
c _ -> ByteString -> ()
rnflbs ByteString
c
_ -> EntryContent -> () -> ()
forall a b. a -> b -> b
seq EntryContent
x ()
where
#if MIN_VERSION_bytestring(0,10,0)
rnflbs :: ByteString -> ()
rnflbs = ByteString -> ()
forall a. NFData a => a -> ()
rnf
#else
rnflbs = foldr (\ !_bs r -> r) () . LBS.toChunks
#endif
instance NFData Ownership where
rnf :: Ownership -> ()
rnf (Ownership o :: String
o g :: String
g _ _) = String -> ()
forall a. NFData a => a -> ()
rnf String
o () -> () -> ()
forall a b. a -> b -> b
`seq` String -> ()
forall a. NFData a => a -> ()
rnf String
g
ordinaryFilePermissions :: Permissions
ordinaryFilePermissions :: Permissions
ordinaryFilePermissions = 0o0644
executableFilePermissions :: Permissions
executableFilePermissions :: Permissions
executableFilePermissions = 0o0755
directoryPermissions :: Permissions
directoryPermissions :: Permissions
directoryPermissions = 0o0755
simpleEntry :: TarPath -> EntryContent -> Entry
simpleEntry :: TarPath -> EntryContent -> Entry
simpleEntry tarpath :: TarPath
tarpath content :: EntryContent
content = $WEntry :: TarPath
-> EntryContent
-> Permissions
-> Ownership
-> EpochTime
-> Format
-> Entry
Entry {
entryTarPath :: TarPath
entryTarPath = TarPath
tarpath,
entryContent :: EntryContent
entryContent = EntryContent
content,
entryPermissions :: Permissions
entryPermissions = case EntryContent
content of
Directory -> Permissions
directoryPermissions
_ -> Permissions
ordinaryFilePermissions,
entryOwnership :: Ownership
entryOwnership = String -> String -> Int -> Int -> Ownership
Ownership "" "" 0 0,
entryTime :: EpochTime
entryTime = 0,
entryFormat :: Format
entryFormat = Format
UstarFormat
}
fileEntry :: TarPath -> LBS.ByteString -> Entry
fileEntry :: TarPath -> ByteString -> Entry
fileEntry name :: TarPath
name fileContent :: ByteString
fileContent =
TarPath -> EntryContent -> Entry
simpleEntry TarPath
name (ByteString -> EpochTime -> EntryContent
NormalFile ByteString
fileContent (ByteString -> EpochTime
LBS.length ByteString
fileContent))
directoryEntry :: TarPath -> Entry
directoryEntry :: TarPath -> Entry
directoryEntry name :: TarPath
name = TarPath -> EntryContent -> Entry
simpleEntry TarPath
name EntryContent
Directory
data TarPath = TarPath {-# UNPACK #-} !BS.ByteString
{-# UNPACK #-} !BS.ByteString
deriving (TarPath -> TarPath -> Bool
(TarPath -> TarPath -> Bool)
-> (TarPath -> TarPath -> Bool) -> Eq TarPath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TarPath -> TarPath -> Bool
$c/= :: TarPath -> TarPath -> Bool
== :: TarPath -> TarPath -> Bool
$c== :: TarPath -> TarPath -> Bool
Eq, Eq TarPath
Eq TarPath =>
(TarPath -> TarPath -> Ordering)
-> (TarPath -> TarPath -> Bool)
-> (TarPath -> TarPath -> Bool)
-> (TarPath -> TarPath -> Bool)
-> (TarPath -> TarPath -> Bool)
-> (TarPath -> TarPath -> TarPath)
-> (TarPath -> TarPath -> TarPath)
-> Ord TarPath
TarPath -> TarPath -> Bool
TarPath -> TarPath -> Ordering
TarPath -> TarPath -> TarPath
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TarPath -> TarPath -> TarPath
$cmin :: TarPath -> TarPath -> TarPath
max :: TarPath -> TarPath -> TarPath
$cmax :: TarPath -> TarPath -> TarPath
>= :: TarPath -> TarPath -> Bool
$c>= :: TarPath -> TarPath -> Bool
> :: TarPath -> TarPath -> Bool
$c> :: TarPath -> TarPath -> Bool
<= :: TarPath -> TarPath -> Bool
$c<= :: TarPath -> TarPath -> Bool
< :: TarPath -> TarPath -> Bool
$c< :: TarPath -> TarPath -> Bool
compare :: TarPath -> TarPath -> Ordering
$ccompare :: TarPath -> TarPath -> Ordering
$cp1Ord :: Eq TarPath
Ord)
instance NFData TarPath where
rnf :: TarPath -> ()
rnf (TarPath _ _) = ()
instance Show TarPath where
show :: TarPath -> String
show = ShowS
forall a. Show a => a -> String
show ShowS -> (TarPath -> String) -> TarPath -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TarPath -> String
fromTarPath
fromTarPath :: TarPath -> FilePath
fromTarPath :: TarPath -> String
fromTarPath (TarPath namebs :: ByteString
namebs prefixbs :: ByteString
prefixbs) = ShowS
adjustDirectory ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
[String] -> String
FilePath.Native.joinPath ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String]
FilePath.Posix.splitDirectories String
prefix
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String -> [String]
FilePath.Posix.splitDirectories String
name
where
name :: String
name = ByteString -> String
BS.Char8.unpack ByteString
namebs
prefix :: String
prefix = ByteString -> String
BS.Char8.unpack ByteString
prefixbs
adjustDirectory :: ShowS
adjustDirectory | String -> Bool
FilePath.Posix.hasTrailingPathSeparator String
name
= ShowS
FilePath.Native.addTrailingPathSeparator
| Bool
otherwise = ShowS
forall a. a -> a
id
fromTarPathToPosixPath :: TarPath -> FilePath
fromTarPathToPosixPath :: TarPath -> String
fromTarPathToPosixPath (TarPath namebs :: ByteString
namebs prefixbs :: ByteString
prefixbs) = ShowS
adjustDirectory ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
[String] -> String
FilePath.Posix.joinPath ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String]
FilePath.Posix.splitDirectories String
prefix
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String -> [String]
FilePath.Posix.splitDirectories String
name
where
name :: String
name = ByteString -> String
BS.Char8.unpack ByteString
namebs
prefix :: String
prefix = ByteString -> String
BS.Char8.unpack ByteString
prefixbs
adjustDirectory :: ShowS
adjustDirectory | String -> Bool
FilePath.Posix.hasTrailingPathSeparator String
name
= ShowS
FilePath.Posix.addTrailingPathSeparator
| Bool
otherwise = ShowS
forall a. a -> a
id
fromTarPathToWindowsPath :: TarPath -> FilePath
fromTarPathToWindowsPath :: TarPath -> String
fromTarPathToWindowsPath (TarPath namebs :: ByteString
namebs prefixbs :: ByteString
prefixbs) = ShowS
adjustDirectory ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
[String] -> String
FilePath.Windows.joinPath ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String]
FilePath.Posix.splitDirectories String
prefix
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String -> [String]
FilePath.Posix.splitDirectories String
name
where
name :: String
name = ByteString -> String
BS.Char8.unpack ByteString
namebs
prefix :: String
prefix = ByteString -> String
BS.Char8.unpack ByteString
prefixbs
adjustDirectory :: ShowS
adjustDirectory | String -> Bool
FilePath.Posix.hasTrailingPathSeparator String
name
= ShowS
FilePath.Windows.addTrailingPathSeparator
| Bool
otherwise = ShowS
forall a. a -> a
id
toTarPath :: Bool
-> FilePath -> Either String TarPath
toTarPath :: Bool -> String -> Either String TarPath
toTarPath isDir :: Bool
isDir = String -> Either String TarPath
splitLongPath
(String -> Either String TarPath)
-> ShowS -> String -> Either String TarPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
addTrailingSep
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
FilePath.Posix.joinPath
([String] -> String) -> (String -> [String]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
FilePath.Native.splitDirectories
where
addTrailingSep :: ShowS
addTrailingSep | Bool
isDir = ShowS
FilePath.Posix.addTrailingPathSeparator
| Bool
otherwise = ShowS
forall a. a -> a
id
splitLongPath :: FilePath -> Either String TarPath
splitLongPath :: String -> Either String TarPath
splitLongPath path :: String
path =
case Int -> [String] -> Either String (String, [String])
packName Int
nameMax ([String] -> [String]
forall a. [a] -> [a]
reverse (String -> [String]
FilePath.Posix.splitPath String
path)) of
Left err :: String
err -> String -> Either String TarPath
forall a b. a -> Either a b
Left String
err
Right (name :: String
name, []) -> TarPath -> Either String TarPath
forall a b. b -> Either a b
Right (TarPath -> Either String TarPath)
-> TarPath -> Either String TarPath
forall a b. (a -> b) -> a -> b
$! ByteString -> ByteString -> TarPath
TarPath (String -> ByteString
BS.Char8.pack String
name)
ByteString
BS.empty
Right (name :: String
name, first :: String
first:rest :: [String]
rest) -> case Int -> [String] -> Either String (String, [String])
packName Int
prefixMax [String]
remainder of
Left err :: String
err -> String -> Either String TarPath
forall a b. a -> Either a b
Left String
err
Right (_ , (_:_)) -> String -> Either String TarPath
forall a b. a -> Either a b
Left "File name too long (cannot split)"
Right (prefix :: String
prefix, []) -> TarPath -> Either String TarPath
forall a b. b -> Either a b
Right (TarPath -> Either String TarPath)
-> TarPath -> Either String TarPath
forall a b. (a -> b) -> a -> b
$! ByteString -> ByteString -> TarPath
TarPath (String -> ByteString
BS.Char8.pack String
name)
(String -> ByteString
BS.Char8.pack String
prefix)
where
remainder :: [String]
remainder = ShowS
forall a. [a] -> [a]
init String
first String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
rest
where
nameMax, prefixMax :: Int
nameMax :: Int
nameMax = 100
prefixMax :: Int
prefixMax = 155
packName :: Int -> [String] -> Either String (String, [String])
packName _ [] = String -> Either String (String, [String])
forall a b. a -> Either a b
Left "File name empty"
packName maxLen :: Int
maxLen (c :: String
c:cs :: [String]
cs)
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxLen = String -> Either String (String, [String])
forall a b. a -> Either a b
Left "File name too long"
| Bool
otherwise = (String, [String]) -> Either String (String, [String])
forall a b. b -> Either a b
Right (Int -> Int -> [String] -> [String] -> (String, [String])
packName' Int
maxLen Int
n [String
c] [String]
cs)
where n :: Int
n = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
c
packName' :: Int -> Int -> [String] -> [String] -> (String, [String])
packName' maxLen :: Int
maxLen n :: Int
n ok :: [String]
ok (c :: String
c:cs :: [String]
cs)
| Int
n' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxLen = Int -> Int -> [String] -> [String] -> (String, [String])
packName' Int
maxLen Int
n' (String
cString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
ok) [String]
cs
where n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
c
packName' _ _ ok :: [String]
ok cs :: [String]
cs = ([String] -> String
FilePath.Posix.joinPath [String]
ok, [String]
cs)
newtype LinkTarget = LinkTarget BS.ByteString
deriving (LinkTarget -> LinkTarget -> Bool
(LinkTarget -> LinkTarget -> Bool)
-> (LinkTarget -> LinkTarget -> Bool) -> Eq LinkTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LinkTarget -> LinkTarget -> Bool
$c/= :: LinkTarget -> LinkTarget -> Bool
== :: LinkTarget -> LinkTarget -> Bool
$c== :: LinkTarget -> LinkTarget -> Bool
Eq, Eq LinkTarget
Eq LinkTarget =>
(LinkTarget -> LinkTarget -> Ordering)
-> (LinkTarget -> LinkTarget -> Bool)
-> (LinkTarget -> LinkTarget -> Bool)
-> (LinkTarget -> LinkTarget -> Bool)
-> (LinkTarget -> LinkTarget -> Bool)
-> (LinkTarget -> LinkTarget -> LinkTarget)
-> (LinkTarget -> LinkTarget -> LinkTarget)
-> Ord LinkTarget
LinkTarget -> LinkTarget -> Bool
LinkTarget -> LinkTarget -> Ordering
LinkTarget -> LinkTarget -> LinkTarget
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LinkTarget -> LinkTarget -> LinkTarget
$cmin :: LinkTarget -> LinkTarget -> LinkTarget
max :: LinkTarget -> LinkTarget -> LinkTarget
$cmax :: LinkTarget -> LinkTarget -> LinkTarget
>= :: LinkTarget -> LinkTarget -> Bool
$c>= :: LinkTarget -> LinkTarget -> Bool
> :: LinkTarget -> LinkTarget -> Bool
$c> :: LinkTarget -> LinkTarget -> Bool
<= :: LinkTarget -> LinkTarget -> Bool
$c<= :: LinkTarget -> LinkTarget -> Bool
< :: LinkTarget -> LinkTarget -> Bool
$c< :: LinkTarget -> LinkTarget -> Bool
compare :: LinkTarget -> LinkTarget -> Ordering
$ccompare :: LinkTarget -> LinkTarget -> Ordering
$cp1Ord :: Eq LinkTarget
Ord, Int -> LinkTarget -> ShowS
[LinkTarget] -> ShowS
LinkTarget -> String
(Int -> LinkTarget -> ShowS)
-> (LinkTarget -> String)
-> ([LinkTarget] -> ShowS)
-> Show LinkTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LinkTarget] -> ShowS
$cshowList :: [LinkTarget] -> ShowS
show :: LinkTarget -> String
$cshow :: LinkTarget -> String
showsPrec :: Int -> LinkTarget -> ShowS
$cshowsPrec :: Int -> LinkTarget -> ShowS
Show)
instance NFData LinkTarget where
#if MIN_VERSION_bytestring(0,10,0)
rnf :: LinkTarget -> ()
rnf (LinkTarget bs :: ByteString
bs) = ByteString -> ()
forall a. NFData a => a -> ()
rnf ByteString
bs
#else
rnf (LinkTarget !_bs) = ()
#endif
toLinkTarget :: FilePath -> Maybe LinkTarget
toLinkTarget :: String -> Maybe LinkTarget
toLinkTarget path :: String
path | String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
path Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 100 = LinkTarget -> Maybe LinkTarget
forall a. a -> Maybe a
Just (LinkTarget -> Maybe LinkTarget) -> LinkTarget -> Maybe LinkTarget
forall a b. (a -> b) -> a -> b
$! ByteString -> LinkTarget
LinkTarget (String -> ByteString
BS.Char8.pack String
path)
| Bool
otherwise = Maybe LinkTarget
forall a. Maybe a
Nothing
fromLinkTarget :: LinkTarget -> FilePath
fromLinkTarget :: LinkTarget -> String
fromLinkTarget (LinkTarget pathbs :: ByteString
pathbs) = ShowS
adjustDirectory ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
[String] -> String
FilePath.Native.joinPath ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String]
FilePath.Posix.splitDirectories String
path
where
path :: String
path = ByteString -> String
BS.Char8.unpack ByteString
pathbs
adjustDirectory :: ShowS
adjustDirectory | String -> Bool
FilePath.Posix.hasTrailingPathSeparator String
path
= ShowS
FilePath.Native.addTrailingPathSeparator
| Bool
otherwise = ShowS
forall a. a -> a
id
fromLinkTargetToPosixPath :: LinkTarget -> FilePath
fromLinkTargetToPosixPath :: LinkTarget -> String
fromLinkTargetToPosixPath (LinkTarget pathbs :: ByteString
pathbs) = ShowS
adjustDirectory ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
[String] -> String
FilePath.Posix.joinPath ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String]
FilePath.Posix.splitDirectories String
path
where
path :: String
path = ByteString -> String
BS.Char8.unpack ByteString
pathbs
adjustDirectory :: ShowS
adjustDirectory | String -> Bool
FilePath.Posix.hasTrailingPathSeparator String
path
= ShowS
FilePath.Native.addTrailingPathSeparator
| Bool
otherwise = ShowS
forall a. a -> a
id
fromLinkTargetToWindowsPath :: LinkTarget -> FilePath
fromLinkTargetToWindowsPath :: LinkTarget -> String
fromLinkTargetToWindowsPath (LinkTarget pathbs :: ByteString
pathbs) = ShowS
adjustDirectory ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
[String] -> String
FilePath.Windows.joinPath ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String]
FilePath.Posix.splitDirectories String
path
where
path :: String
path = ByteString -> String
BS.Char8.unpack ByteString
pathbs
adjustDirectory :: ShowS
adjustDirectory | String -> Bool
FilePath.Posix.hasTrailingPathSeparator String
path
= ShowS
FilePath.Windows.addTrailingPathSeparator
| Bool
otherwise = ShowS
forall a. a -> a
id
data Entries e = Next Entry (Entries e)
| Done
| Fail e
deriving (Entries e -> Entries e -> Bool
(Entries e -> Entries e -> Bool)
-> (Entries e -> Entries e -> Bool) -> Eq (Entries e)
forall e. Eq e => Entries e -> Entries e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Entries e -> Entries e -> Bool
$c/= :: forall e. Eq e => Entries e -> Entries e -> Bool
== :: Entries e -> Entries e -> Bool
$c== :: forall e. Eq e => Entries e -> Entries e -> Bool
Eq, Int -> Entries e -> ShowS
[Entries e] -> ShowS
Entries e -> String
(Int -> Entries e -> ShowS)
-> (Entries e -> String)
-> ([Entries e] -> ShowS)
-> Show (Entries e)
forall e. Show e => Int -> Entries e -> ShowS
forall e. Show e => [Entries e] -> ShowS
forall e. Show e => Entries e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Entries e] -> ShowS
$cshowList :: forall e. Show e => [Entries e] -> ShowS
show :: Entries e -> String
$cshow :: forall e. Show e => Entries e -> String
showsPrec :: Int -> Entries e -> ShowS
$cshowsPrec :: forall e. Show e => Int -> Entries e -> ShowS
Show)
infixr 5 `Next`
unfoldEntries :: (a -> Either e (Maybe (Entry, a))) -> a -> Entries e
unfoldEntries :: (a -> Either e (Maybe (Entry, a))) -> a -> Entries e
unfoldEntries f :: a -> Either e (Maybe (Entry, a))
f = a -> Entries e
unfold
where
unfold :: a -> Entries e
unfold x :: a
x = case a -> Either e (Maybe (Entry, a))
f a
x of
Left err :: e
err -> e -> Entries e
forall e. e -> Entries e
Fail e
err
Right Nothing -> Entries e
forall e. Entries e
Done
Right (Just (e :: Entry
e, x' :: a
x')) -> Entry -> Entries e -> Entries e
forall e. Entry -> Entries e -> Entries e
Next Entry
e (a -> Entries e
unfold a
x')
foldEntries :: (Entry -> a -> a) -> a -> (e -> a) -> Entries e -> a
foldEntries :: (Entry -> a -> a) -> a -> (e -> a) -> Entries e -> a
foldEntries next :: Entry -> a -> a
next done :: a
done fail' :: e -> a
fail' = Entries e -> a
fold
where
fold :: Entries e -> a
fold (Next e :: Entry
e es :: Entries e
es) = Entry -> a -> a
next Entry
e (Entries e -> a
fold Entries e
es)
fold Done = a
done
fold (Fail err :: e
err) = e -> a
fail' e
err
foldlEntries :: (a -> Entry -> a) -> a -> Entries e -> Either (e, a) a
foldlEntries :: (a -> Entry -> a) -> a -> Entries e -> Either (e, a) a
foldlEntries f :: a -> Entry -> a
f z :: a
z = a -> Entries e -> Either (e, a) a
forall a. a -> Entries a -> Either (a, a) a
go a
z
where
go :: a -> Entries a -> Either (a, a) a
go !a
acc (Next e :: Entry
e es :: Entries a
es) = a -> Entries a -> Either (a, a) a
go (a -> Entry -> a
f a
acc Entry
e) Entries a
es
go !a
acc Done = a -> Either (a, a) a
forall a b. b -> Either a b
Right a
acc
go !a
acc (Fail err :: a
err) = (a, a) -> Either (a, a) a
forall a b. a -> Either a b
Left (a
err, a
acc)
mapEntries :: (Entry -> Either e' Entry) -> Entries e -> Entries (Either e e')
mapEntries :: (Entry -> Either e' Entry) -> Entries e -> Entries (Either e e')
mapEntries f :: Entry -> Either e' Entry
f =
(Entry -> Entries (Either e e') -> Entries (Either e e'))
-> Entries (Either e e')
-> (e -> Entries (Either e e'))
-> Entries e
-> Entries (Either e e')
forall a e. (Entry -> a -> a) -> a -> (e -> a) -> Entries e -> a
foldEntries (\entry :: Entry
entry rest :: Entries (Either e e')
rest -> (e' -> Entries (Either e e'))
-> (Entry -> Entries (Either e e'))
-> Either e' Entry
-> Entries (Either e e')
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either e e' -> Entries (Either e e')
forall e. e -> Entries e
Fail (Either e e' -> Entries (Either e e'))
-> (e' -> Either e e') -> e' -> Entries (Either e e')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e' -> Either e e'
forall a b. b -> Either a b
Right) ((Entry -> Entries (Either e e') -> Entries (Either e e'))
-> Entries (Either e e') -> Entry -> Entries (Either e e')
forall a b c. (a -> b -> c) -> b -> a -> c
flip Entry -> Entries (Either e e') -> Entries (Either e e')
forall e. Entry -> Entries e -> Entries e
Next Entries (Either e e')
rest) (Entry -> Either e' Entry
f Entry
entry)) Entries (Either e e')
forall e. Entries e
Done (Either e e' -> Entries (Either e e')
forall e. e -> Entries e
Fail (Either e e' -> Entries (Either e e'))
-> (e -> Either e e') -> e -> Entries (Either e e')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Either e e'
forall a b. a -> Either a b
Left)
mapEntriesNoFail :: (Entry -> Entry) -> Entries e -> Entries e
mapEntriesNoFail :: (Entry -> Entry) -> Entries e -> Entries e
mapEntriesNoFail f :: Entry -> Entry
f =
(Entry -> Entries e -> Entries e)
-> Entries e -> (e -> Entries e) -> Entries e -> Entries e
forall a e. (Entry -> a -> a) -> a -> (e -> a) -> Entries e -> a
foldEntries (\entry :: Entry
entry -> Entry -> Entries e -> Entries e
forall e. Entry -> Entries e -> Entries e
Next (Entry -> Entry
f Entry
entry)) Entries e
forall e. Entries e
Done e -> Entries e
forall e. e -> Entries e
Fail
instance Sem.Semigroup (Entries e) where
a :: Entries e
a <> :: Entries e -> Entries e -> Entries e
<> b :: Entries e
b = (Entry -> Entries e -> Entries e)
-> Entries e -> (e -> Entries e) -> Entries e -> Entries e
forall a e. (Entry -> a -> a) -> a -> (e -> a) -> Entries e -> a
foldEntries Entry -> Entries e -> Entries e
forall e. Entry -> Entries e -> Entries e
Next Entries e
b e -> Entries e
forall e. e -> Entries e
Fail Entries e
a
instance Monoid (Entries e) where
mempty :: Entries e
mempty = Entries e
forall e. Entries e
Done
mappend :: Entries e -> Entries e -> Entries e
mappend = Entries e -> Entries e -> Entries e
forall a. Semigroup a => a -> a -> a
(Sem.<>)
instance Functor Entries where
fmap :: (a -> b) -> Entries a -> Entries b
fmap f :: a -> b
f = (Entry -> Entries b -> Entries b)
-> Entries b -> (a -> Entries b) -> Entries a -> Entries b
forall a e. (Entry -> a -> a) -> a -> (e -> a) -> Entries e -> a
foldEntries Entry -> Entries b -> Entries b
forall e. Entry -> Entries e -> Entries e
Next Entries b
forall e. Entries e
Done (b -> Entries b
forall e. e -> Entries e
Fail (b -> Entries b) -> (a -> b) -> a -> Entries b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
instance NFData e => NFData (Entries e) where
rnf :: Entries e -> ()
rnf (Next e :: Entry
e es :: Entries e
es) = Entry -> ()
forall a. NFData a => a -> ()
rnf Entry
e () -> () -> ()
forall a b. a -> b -> b
`seq` Entries e -> ()
forall a. NFData a => a -> ()
rnf Entries e
es
rnf Done = ()
rnf (Fail e :: e
e) = e -> ()
forall a. NFData a => a -> ()
rnf e
e
#ifdef TESTS
instance Arbitrary Entry where
arbitrary = Entry <$> arbitrary <*> arbitrary <*> arbitraryPermissions
<*> arbitrary <*> arbitraryEpochTime <*> arbitrary
where
arbitraryPermissions :: Gen Permissions
arbitraryPermissions = fromIntegral <$> (arbitrary :: Gen Word16)
arbitraryEpochTime :: Gen EpochTime
arbitraryEpochTime = arbitraryOctal 11
shrink (Entry path content perms author time format) =
[ Entry path' content' perms author' time' format
| (path', content', author', time') <-
shrink (path, content, author, time) ]
++ [ Entry path content perms' author time format
| perms' <- shrinkIntegral perms ]
instance Arbitrary TarPath where
arbitrary = either error id
. toTarPath False
. FilePath.Posix.joinPath
<$> listOf1ToN (255 `div` 5)
(elements (map (replicate 4) "abcd"))
shrink = map (either error id . toTarPath False)
. map FilePath.Posix.joinPath
. filter (not . null)
. shrinkList shrinkNothing
. FilePath.Posix.splitPath
. fromTarPathToPosixPath
instance Arbitrary LinkTarget where
arbitrary = maybe (error "link target too large") id
. toLinkTarget
. FilePath.Native.joinPath
<$> listOf1ToN (100 `div` 5)
(elements (map (replicate 4) "abcd"))
shrink = map (maybe (error "link target too large") id . toLinkTarget)
. map FilePath.Posix.joinPath
. filter (not . null)
. shrinkList shrinkNothing
. FilePath.Posix.splitPath
. fromLinkTargetToPosixPath
listOf1ToN :: Int -> Gen a -> Gen [a]
listOf1ToN n g = sized $ \sz -> do
n <- choose (1, min n (max 1 sz))
vectorOf n g
listOf0ToN :: Int -> Gen a -> Gen [a]
listOf0ToN n g = sized $ \sz -> do
n <- choose (0, min n sz)
vectorOf n g
instance Arbitrary EntryContent where
arbitrary =
frequency
[ (16, do bs <- arbitrary;
return (NormalFile bs (LBS.length bs)))
, (2, pure Directory)
, (1, SymbolicLink <$> arbitrary)
, (1, HardLink <$> arbitrary)
, (1, CharacterDevice <$> arbitraryOctal 7 <*> arbitraryOctal 7)
, (1, BlockDevice <$> arbitraryOctal 7 <*> arbitraryOctal 7)
, (1, pure NamedPipe)
, (1, do c <- elements (['A'..'Z']++['a'..'z'])
bs <- arbitrary;
return (OtherEntryType c bs (LBS.length bs)))
]
shrink (NormalFile bs _) = [ NormalFile bs' (LBS.length bs')
| bs' <- shrink bs ]
shrink Directory = []
shrink (SymbolicLink link) = [ SymbolicLink link' | link' <- shrink link ]
shrink (HardLink link) = [ HardLink link' | link' <- shrink link ]
shrink (CharacterDevice ma mi) = [ CharacterDevice ma' mi'
| (ma', mi') <- shrink (ma, mi) ]
shrink (BlockDevice ma mi) = [ BlockDevice ma' mi'
| (ma', mi') <- shrink (ma, mi) ]
shrink NamedPipe = []
shrink (OtherEntryType c bs _) = [ OtherEntryType c bs' (LBS.length bs')
| bs' <- shrink bs ]
instance Arbitrary LBS.ByteString where
arbitrary = fmap LBS.pack arbitrary
shrink = map LBS.pack . shrink . LBS.unpack
instance Arbitrary BS.ByteString where
arbitrary = fmap BS.pack arbitrary
shrink = map BS.pack . shrink . BS.unpack
instance Arbitrary Ownership where
arbitrary = Ownership <$> name <*> name
<*> idno <*> idno
where
name = do
first <- choose ('a', 'z')
rest <- listOf0ToN 30 (oneof [choose ('a', 'z'), choose ('0', '9'), pure '-'])
return $ first : rest
idno = arbitraryOctal 7
shrink (Ownership oname gname oid gid) =
[ Ownership oname' gname' oid' gid'
| (oname', gname', oid', gid') <- shrink (oname, gname, oid, gid) ]
instance Arbitrary Format where
arbitrary = elements [V7Format, UstarFormat, GnuFormat]
arbitraryOctal n =
oneof [ pure 0
, choose (0, upperBound)
, pure upperBound
]
where
upperBound = 8^n-1
limitToV7FormatCompat :: Entry -> Entry
limitToV7FormatCompat entry@Entry { entryFormat = V7Format } =
entry {
entryContent = case entryContent entry of
CharacterDevice _ _ -> OtherEntryType '3' LBS.empty 0
BlockDevice _ _ -> OtherEntryType '4' LBS.empty 0
Directory -> OtherEntryType '5' LBS.empty 0
NamedPipe -> OtherEntryType '6' LBS.empty 0
other -> other,
entryOwnership = (entryOwnership entry) {
groupName = "",
ownerName = ""
},
entryTarPath = let TarPath name _prefix = entryTarPath entry
in TarPath name BS.empty
}
limitToV7FormatCompat entry = entry
#endif