{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving, CPP #-}
module GHC.SysTools.Ar
(ArchiveEntry(..)
,Archive(..)
,afilter
,parseAr
,loadAr
,loadObj
,writeBSDAr
,writeGNUAr
,isBSDSymdef
,isGNUSymdef
)
where
import GHC.Prelude
import Data.List (mapAccumL, isPrefixOf)
import Data.Monoid ((<>))
import Data.Binary.Get
import Data.Binary.Put
import Control.Monad
import Control.Applicative
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import qualified Data.ByteString.Lazy as L
#if !defined(mingw32_HOST_OS)
import qualified System.Posix.Files as POSIX
#endif
import System.FilePath (takeFileName)
data ArchiveEntry = ArchiveEntry
{ ArchiveEntry -> [Char]
filename :: String
, ArchiveEntry -> Int
filetime :: Int
, ArchiveEntry -> Int
fileown :: Int
, ArchiveEntry -> Int
filegrp :: Int
, ArchiveEntry -> Int
filemode :: Int
, ArchiveEntry -> Int
filesize :: Int
, ArchiveEntry -> ByteString
filedata :: B.ByteString
} deriving (ArchiveEntry -> ArchiveEntry -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArchiveEntry -> ArchiveEntry -> Bool
$c/= :: ArchiveEntry -> ArchiveEntry -> Bool
== :: ArchiveEntry -> ArchiveEntry -> Bool
$c== :: ArchiveEntry -> ArchiveEntry -> Bool
Eq, Int -> ArchiveEntry -> ShowS
[ArchiveEntry] -> ShowS
ArchiveEntry -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ArchiveEntry] -> ShowS
$cshowList :: [ArchiveEntry] -> ShowS
show :: ArchiveEntry -> [Char]
$cshow :: ArchiveEntry -> [Char]
showsPrec :: Int -> ArchiveEntry -> ShowS
$cshowsPrec :: Int -> ArchiveEntry -> ShowS
Show)
newtype Archive = Archive [ArchiveEntry]
deriving (Archive -> Archive -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Archive -> Archive -> Bool
$c/= :: Archive -> Archive -> Bool
== :: Archive -> Archive -> Bool
$c== :: Archive -> Archive -> Bool
Eq, Int -> Archive -> ShowS
[Archive] -> ShowS
Archive -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Archive] -> ShowS
$cshowList :: [Archive] -> ShowS
show :: Archive -> [Char]
$cshow :: Archive -> [Char]
showsPrec :: Int -> Archive -> ShowS
$cshowsPrec :: Int -> Archive -> ShowS
Show, NonEmpty Archive -> Archive
Archive -> Archive -> Archive
forall b. Integral b => b -> Archive -> Archive
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Archive -> Archive
$cstimes :: forall b. Integral b => b -> Archive -> Archive
sconcat :: NonEmpty Archive -> Archive
$csconcat :: NonEmpty Archive -> Archive
<> :: Archive -> Archive -> Archive
$c<> :: Archive -> Archive -> Archive
Semigroup, Semigroup Archive
Archive
[Archive] -> Archive
Archive -> Archive -> Archive
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Archive] -> Archive
$cmconcat :: [Archive] -> Archive
mappend :: Archive -> Archive -> Archive
$cmappend :: Archive -> Archive -> Archive
mempty :: Archive
$cmempty :: Archive
Monoid)
afilter :: (ArchiveEntry -> Bool) -> Archive -> Archive
afilter :: (ArchiveEntry -> Bool) -> Archive -> Archive
afilter ArchiveEntry -> Bool
f (Archive [ArchiveEntry]
xs) = [ArchiveEntry] -> Archive
Archive (forall a. (a -> Bool) -> [a] -> [a]
filter ArchiveEntry -> Bool
f [ArchiveEntry]
xs)
isBSDSymdef, isGNUSymdef :: ArchiveEntry -> Bool
isBSDSymdef :: ArchiveEntry -> Bool
isBSDSymdef ArchiveEntry
a = [Char]
"__.SYMDEF" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` (ArchiveEntry -> [Char]
filename ArchiveEntry
a)
isGNUSymdef :: ArchiveEntry -> Bool
isGNUSymdef ArchiveEntry
a = [Char]
"/" forall a. Eq a => a -> a -> Bool
== (ArchiveEntry -> [Char]
filename ArchiveEntry
a)
getPaddedInt :: B.ByteString -> Int
getPaddedInt :: ByteString -> Int
getPaddedInt = forall a. Read a => [Char] -> a
read forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
C.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> ByteString
C.takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
'\x20')
putPaddedInt :: Int -> Int -> Put
putPaddedInt :: Int -> Int -> Put
putPaddedInt Int
padding Int
i = Char -> Int -> [Char] -> Put
putPaddedString Char
'\x20' Int
padding (forall a. Show a => a -> [Char]
show Int
i)
putPaddedString :: Char -> Int -> String -> Put
putPaddedString :: Char -> Int -> [Char] -> Put
putPaddedString Char
pad Int
padding [Char]
s = ByteString -> Put
putByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ByteString
C.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
padding forall a b. (a -> b) -> a -> b
$ [Char]
s forall a. Monoid a => a -> a -> a
`mappend` (forall a. a -> [a]
repeat Char
pad)
getBSDArchEntries :: Get [ArchiveEntry]
getBSDArchEntries :: Get [ArchiveEntry]
getBSDArchEntries = do
Bool
empty <- Get Bool
isEmpty
if Bool
empty then
forall (m :: * -> *) a. Monad m => a -> m a
return []
else do
ByteString
name <- Int -> Get ByteString
getByteString Int
16
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Char
'/' Char -> ByteString -> Bool
`C.elem` ByteString
name Bool -> Bool -> Bool
&& Int -> ByteString -> ByteString
C.take Int
3 ByteString
name forall a. Eq a => a -> a -> Bool
/= ByteString
"#1/") forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Looks like GNU Archive"
Int
time <- ByteString -> Int
getPaddedInt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
12
Int
own <- ByteString -> Int
getPaddedInt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
6
Int
grp <- ByteString -> Int
getPaddedInt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
6
Int
mode <- ByteString -> Int
getPaddedInt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
8
Int
st_size <- ByteString -> Int
getPaddedInt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
10
ByteString
end <- Int -> Get ByteString
getByteString Int
2
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString
end forall a. Eq a => a -> a -> Bool
/= ByteString
"\x60\x0a") forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"[BSD Archive] Invalid archive header end marker for name: " forall a. [a] -> [a] -> [a]
++
ByteString -> [Char]
C.unpack ByteString
name)
Int
off1 <- forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a b. (Integral a, Num b) => a -> b
fromIntegral Get Int64
bytesRead :: Get Int
[Char]
name <- if ByteString -> [Char]
C.unpack (Int -> ByteString -> ByteString
C.take Int
3 ByteString
name) forall a. Eq a => a -> a -> Bool
== [Char]
"#1/" then
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (ByteString -> [Char]
C.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> ByteString
C.takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
'\0')) (Int -> Get ByteString
getByteString forall a b. (a -> b) -> a -> b
$ forall a. Read a => [Char] -> a
read forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
C.unpack forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
C.drop Int
3 ByteString
name)
else
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
C.unpack forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ByteString -> ByteString
C.takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
' ') ByteString
name
Int
off2 <- forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a b. (Integral a, Num b) => a -> b
fromIntegral Get Int64
bytesRead :: Get Int
ByteString
file <- Int -> Get ByteString
getByteString (Int
st_size forall a. Num a => a -> a -> a
- (Int
off2 forall a. Num a => a -> a -> a
- Int
off1))
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Integral a => a -> Bool
odd Int
st_size) forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Int -> Get ByteString
getByteString Int
1)
[ArchiveEntry]
rest <- Get [ArchiveEntry]
getBSDArchEntries
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ([Char]
-> Int -> Int -> Int -> Int -> Int -> ByteString -> ArchiveEntry
ArchiveEntry [Char]
name Int
time Int
own Int
grp Int
mode (Int
st_size forall a. Num a => a -> a -> a
- (Int
off2 forall a. Num a => a -> a -> a
- Int
off1)) ByteString
file) forall a. a -> [a] -> [a]
: [ArchiveEntry]
rest
getGNUArchEntries :: Maybe ArchiveEntry -> Get [ArchiveEntry]
getGNUArchEntries :: Maybe ArchiveEntry -> Get [ArchiveEntry]
getGNUArchEntries Maybe ArchiveEntry
extInfo = do
Bool
empty <- Get Bool
isEmpty
if Bool
empty
then forall (m :: * -> *) a. Monad m => a -> m a
return []
else
do
ByteString
name <- Int -> Get ByteString
getByteString Int
16
Int
time <- ByteString -> Int
getPaddedInt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
12
Int
own <- ByteString -> Int
getPaddedInt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
6
Int
grp <- ByteString -> Int
getPaddedInt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
6
Int
mode <- ByteString -> Int
getPaddedInt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
8
Int
st_size <- ByteString -> Int
getPaddedInt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
10
ByteString
end <- Int -> Get ByteString
getByteString Int
2
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString
end forall a. Eq a => a -> a -> Bool
/= ByteString
"\x60\x0a") forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"[BSD Archive] Invalid archive header end marker for name: " forall a. [a] -> [a] -> [a]
++
ByteString -> [Char]
C.unpack ByteString
name)
ByteString
file <- Int -> Get ByteString
getByteString Int
st_size
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Integral a => a -> Bool
odd Int
st_size) forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Int -> Get ByteString
getByteString Int
1)
[Char]
name <- forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
C.unpack forall a b. (a -> b) -> a -> b
$
if ByteString -> [Char]
C.unpack (Int -> ByteString -> ByteString
C.take Int
1 ByteString
name) forall a. Eq a => a -> a -> Bool
== [Char]
"/"
then case (Char -> Bool) -> ByteString -> ByteString
C.takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
' ') ByteString
name of
name :: ByteString
name@ByteString
"/" -> ByteString
name
name :: ByteString
name@ByteString
"//" -> ByteString
name
ByteString
name -> Maybe ArchiveEntry -> Int -> ByteString
getExtName Maybe ArchiveEntry
extInfo (forall a. Read a => [Char] -> a
read forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
C.unpack forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
C.drop Int
1 ByteString
name)
else (Char -> Bool) -> ByteString -> ByteString
C.takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
'/') ByteString
name
case [Char]
name of
[Char]
"/" -> Maybe ArchiveEntry -> Get [ArchiveEntry]
getGNUArchEntries Maybe ArchiveEntry
extInfo
[Char]
"//" -> Maybe ArchiveEntry -> Get [ArchiveEntry]
getGNUArchEntries (forall a. a -> Maybe a
Just ([Char]
-> Int -> Int -> Int -> Int -> Int -> ByteString -> ArchiveEntry
ArchiveEntry [Char]
name Int
time Int
own Int
grp Int
mode Int
st_size ByteString
file))
[Char]
_ -> ([Char]
-> Int -> Int -> Int -> Int -> Int -> ByteString -> ArchiveEntry
ArchiveEntry [Char]
name Int
time Int
own Int
grp Int
mode Int
st_size ByteString
file forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ArchiveEntry -> Get [ArchiveEntry]
getGNUArchEntries Maybe ArchiveEntry
extInfo
where
getExtName :: Maybe ArchiveEntry -> Int -> B.ByteString
getExtName :: Maybe ArchiveEntry -> Int -> ByteString
getExtName Maybe ArchiveEntry
Nothing Int
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"Invalid extended filename reference."
getExtName (Just ArchiveEntry
info) Int
offset = (Char -> Bool) -> ByteString -> ByteString
C.takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
'/') forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
C.drop Int
offset forall a b. (a -> b) -> a -> b
$ ArchiveEntry -> ByteString
filedata ArchiveEntry
info
putArchEntry :: ArchiveEntry -> PutM ()
putArchEntry :: ArchiveEntry -> Put
putArchEntry (ArchiveEntry [Char]
name Int
time Int
own Int
grp Int
mode Int
st_size ByteString
file) = do
Char -> Int -> [Char] -> Put
putPaddedString Char
' ' Int
16 [Char]
name
Int -> Int -> Put
putPaddedInt Int
12 Int
time
Int -> Int -> Put
putPaddedInt Int
6 Int
own
Int -> Int -> Put
putPaddedInt Int
6 Int
grp
Int -> Int -> Put
putPaddedInt Int
8 Int
mode
Int -> Int -> Put
putPaddedInt Int
10 (Int
st_size forall a. Num a => a -> a -> a
+ Int
pad)
ByteString -> Put
putByteString ByteString
"\x60\x0a"
ByteString -> Put
putByteString ByteString
file
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
pad forall a. Eq a => a -> a -> Bool
== Int
1) forall a b. (a -> b) -> a -> b
$
Word8 -> Put
putWord8 Word8
0x0a
where
pad :: Int
pad = Int
st_size forall a. Integral a => a -> a -> a
`mod` Int
2
getArchMagic :: Get ()
getArchMagic :: Get ()
getArchMagic = do
[Char]
magic <- forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ByteString -> [Char]
C.unpack forall a b. (a -> b) -> a -> b
$ Int -> Get ByteString
getByteString Int
8
if [Char]
magic forall a. Eq a => a -> a -> Bool
/= [Char]
"!<arch>\n"
then forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid magic number " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [Char]
magic
else forall (m :: * -> *) a. Monad m => a -> m a
return ()
putArchMagic :: Put
putArchMagic :: Put
putArchMagic = ByteString -> Put
putByteString forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
C.pack [Char]
"!<arch>\n"
getArch :: Get Archive
getArch :: Get Archive
getArch = [ArchiveEntry] -> Archive
Archive forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
Get ()
getArchMagic
Get [ArchiveEntry]
getBSDArchEntries forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe ArchiveEntry -> Get [ArchiveEntry]
getGNUArchEntries forall a. Maybe a
Nothing
putBSDArch :: Archive -> PutM ()
putBSDArch :: Archive -> Put
putBSDArch (Archive [ArchiveEntry]
as) = do
Put
putArchMagic
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ArchiveEntry -> Put
putArchEntry ([ArchiveEntry] -> [ArchiveEntry]
processEntries [ArchiveEntry]
as)
where
padStr :: a -> Int -> [a] -> [a]
padStr a
pad Int
size [a]
str = forall a. Int -> [a] -> [a]
take Int
size forall a b. (a -> b) -> a -> b
$ [a]
str forall a. Semigroup a => a -> a -> a
<> forall a. a -> [a]
repeat a
pad
nameSize :: t a -> Int
nameSize t a
name = case forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
name forall a. Integral a => a -> a -> (a, a)
`divMod` Int
4 of
(Int
n, Int
0) -> Int
4 forall a. Num a => a -> a -> a
* Int
n
(Int
n, Int
_) -> Int
4 forall a. Num a => a -> a -> a
* (Int
n forall a. Num a => a -> a -> a
+ Int
1)
needExt :: t Char -> Bool
needExt t Char
name = forall (t :: * -> *) a. Foldable t => t a -> Int
length t Char
name forall a. Ord a => a -> a -> Bool
> Int
16 Bool -> Bool -> Bool
|| Char
' ' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Char
name
processEntry :: ArchiveEntry -> ArchiveEntry
processEntry :: ArchiveEntry -> ArchiveEntry
processEntry archive :: ArchiveEntry
archive@(ArchiveEntry [Char]
name Int
_ Int
_ Int
_ Int
_ Int
st_size ByteString
_)
| forall {t :: * -> *}. Foldable t => t Char -> Bool
needExt [Char]
name = ArchiveEntry
archive { filename :: [Char]
filename = [Char]
"#1/" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Int
sz
, filedata :: ByteString
filedata = [Char] -> ByteString
C.pack (forall {a}. a -> Int -> [a] -> [a]
padStr Char
'\0' Int
sz [Char]
name) forall a. Semigroup a => a -> a -> a
<> ArchiveEntry -> ByteString
filedata ArchiveEntry
archive
, filesize :: Int
filesize = Int
st_size forall a. Num a => a -> a -> a
+ Int
sz }
| Bool
otherwise = ArchiveEntry
archive
where sz :: Int
sz = forall {t :: * -> *} {a}. Foldable t => t a -> Int
nameSize [Char]
name
processEntries :: [ArchiveEntry] -> [ArchiveEntry]
processEntries = forall a b. (a -> b) -> [a] -> [b]
map ArchiveEntry -> ArchiveEntry
processEntry
putGNUArch :: Archive -> PutM ()
putGNUArch :: Archive -> Put
putGNUArch (Archive [ArchiveEntry]
as) = do
Put
putArchMagic
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ArchiveEntry -> Put
putArchEntry ([ArchiveEntry] -> [ArchiveEntry]
processEntries [ArchiveEntry]
as)
where
processEntry :: ArchiveEntry -> ArchiveEntry -> (ArchiveEntry, ArchiveEntry)
processEntry :: ArchiveEntry -> ArchiveEntry -> (ArchiveEntry, ArchiveEntry)
processEntry ArchiveEntry
extInfo archive :: ArchiveEntry
archive@(ArchiveEntry [Char]
name Int
_ Int
_ Int
_ Int
_ Int
_ ByteString
_)
| forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
name forall a. Ord a => a -> a -> Bool
> Int
15 = ( ArchiveEntry
extInfo { filesize :: Int
filesize = ArchiveEntry -> Int
filesize ArchiveEntry
extInfo forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
name forall a. Num a => a -> a -> a
+ Int
2
, filedata :: ByteString
filedata = ArchiveEntry -> ByteString
filedata ArchiveEntry
extInfo forall a. Semigroup a => a -> a -> a
<> [Char] -> ByteString
C.pack [Char]
name forall a. Semigroup a => a -> a -> a
<> ByteString
"/\n" }
, ArchiveEntry
archive { filename :: [Char]
filename = [Char]
"/" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show (ArchiveEntry -> Int
filesize ArchiveEntry
extInfo) } )
| Bool
otherwise = ( ArchiveEntry
extInfo, ArchiveEntry
archive { filename :: [Char]
filename = [Char]
name forall a. Semigroup a => a -> a -> a
<> [Char]
"/" } )
processEntries :: [ArchiveEntry] -> [ArchiveEntry]
processEntries :: [ArchiveEntry] -> [ArchiveEntry]
processEntries =
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL ArchiveEntry -> ArchiveEntry -> (ArchiveEntry, ArchiveEntry)
processEntry ([Char]
-> Int -> Int -> Int -> Int -> Int -> ByteString -> ArchiveEntry
ArchiveEntry [Char]
"//" Int
0 Int
0 Int
0 Int
0 Int
0 forall a. Monoid a => a
mempty)
parseAr :: B.ByteString -> Archive
parseAr :: ByteString -> Archive
parseAr = forall a. Get a -> ByteString -> a
runGet Get Archive
getArch forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
L.fromChunks forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
writeBSDAr, writeGNUAr :: FilePath -> Archive -> IO ()
writeBSDAr :: [Char] -> Archive -> IO ()
writeBSDAr [Char]
fp = [Char] -> ByteString -> IO ()
L.writeFile [Char]
fp forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPut forall b c a. (b -> c) -> (a -> b) -> a -> c
. Archive -> Put
putBSDArch
writeGNUAr :: [Char] -> Archive -> IO ()
writeGNUAr [Char]
fp = [Char] -> ByteString -> IO ()
L.writeFile [Char]
fp forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPut forall b c a. (b -> c) -> (a -> b) -> a -> c
. Archive -> Put
putGNUArch
loadAr :: FilePath -> IO Archive
loadAr :: [Char] -> IO Archive
loadAr [Char]
fp = ByteString -> Archive
parseAr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO ByteString
B.readFile [Char]
fp
loadObj :: FilePath -> IO ArchiveEntry
loadObj :: [Char] -> IO ArchiveEntry
loadObj [Char]
fp = do
ByteString
payload <- [Char] -> IO ByteString
B.readFile [Char]
fp
(Int
modt, Int
own, Int
grp, Int
mode) <- [Char] -> IO (Int, Int, Int, Int)
fileInfo [Char]
fp
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Char]
-> Int -> Int -> Int -> Int -> Int -> ByteString -> ArchiveEntry
ArchiveEntry
(ShowS
takeFileName [Char]
fp) Int
modt Int
own Int
grp Int
mode
(ByteString -> Int
B.length ByteString
payload) ByteString
payload
fileInfo :: FilePath -> IO ( Int, Int, Int, Int)
#if defined(mingw32_HOST_OS)
fileInfo _ = pure (0,0,0,0)
#else
fileInfo :: [Char] -> IO (Int, Int, Int, Int)
fileInfo [Char]
fp = forall {b} {c}. (Num b, Num c) => FileStatus -> (Int, b, c, Int)
go forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO FileStatus
POSIX.getFileStatus [Char]
fp
where go :: FileStatus -> (Int, b, c, Int)
go FileStatus
status = ( forall a. Enum a => a -> Int
fromEnum forall a b. (a -> b) -> a -> b
$ FileStatus -> EpochTime
POSIX.modificationTime FileStatus
status
, forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ FileStatus -> UserID
POSIX.fileOwner FileStatus
status
, forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ FileStatus -> GroupID
POSIX.fileGroup FileStatus
status
, Int -> Int
oct2dec forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ FileStatus -> FileMode
POSIX.fileMode FileStatus
status
)
oct2dec :: Int -> Int
oct2dec :: Int -> Int
oct2dec = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Int
a Int
b -> Int
a forall a. Num a => a -> a -> a
* Int
10 forall a. Num a => a -> a -> a
+ Int
b) Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t}. Integral t => t -> t -> [t]
dec Int
8
where dec :: t -> t -> [t]
dec t
_ t
0 = []
dec t
b t
i = let (t
rest, t
last) = t
i forall a. Integral a => a -> a -> (a, a)
`quotRem` t
b
in t
lastforall a. a -> [a] -> [a]
:t -> t -> [t]
dec t
b t
rest
#endif