arx 0.2.3 → 0.3.0
raw patch · 7 files changed
+81/−53 lines, 7 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ System.Posix.ARX: TXZ :: Tar
+ System.Posix.ARX.CLI: instance Data.Semigroup.Semigroup System.Posix.ARX.CLI.ZOM
+ System.Posix.ARX.CLI.Options: tmpdir :: ArgsParser ByteString
+ System.Posix.ARX.TMPXTools: [tmpdir] :: Template -> ByteString
+ System.Posix.ARX.Tar: TXZ :: Tar
+ System.Posix.ARX.Tar: xzMagic :: ByteString -> Bool
- System.Posix.ARX: TMPX :: SHDAT -> ByteString -> [(Var, Val)] -> Bool -> Bool -> Bool -> TMPX
+ System.Posix.ARX: TMPX :: SHDAT -> ByteString -> [(Var, Val)] -> ByteString -> Bool -> Bool -> Bool -> TMPX
- System.Posix.ARX.CLI: die :: ByteString -> IO b
+ System.Posix.ARX.CLI: die :: () => ByteString -> IO b
- System.Posix.ARX.CLI: tmpxOpen :: Word -> [(Var, Val)] -> (Bool, Bool, Bool) -> ByteSource -> IO TMPX
+ System.Posix.ARX.CLI: tmpxOpen :: Word -> [(Var, Val)] -> (Bool, Bool, Bool) -> ByteString -> ByteSource -> IO TMPX
- System.Posix.ARX.CLI: tmpxResolve :: ([Word], [IOStream], [IOStream], [(Var, Val)], [(Bool, Bool)], [Bool], [ByteSource]) -> (Word, IOStream, [IOStream], [(Var, Val)], (Bool, Bool), Bool, ByteSource)
+ System.Posix.ARX.CLI: tmpxResolve :: ([Word], [IOStream], [IOStream], [(Var, Val)], [ByteString], [(Bool, Bool)], [Bool], [ByteSource]) -> (Word, IOStream, [IOStream], [(Var, Val)], ByteString, (Bool, Bool), Bool, ByteSource)
- System.Posix.ARX.CLI.Options: tmpx :: ArgsParser ([Word], [IOStream], [IOStream], [(Var, Val)], [(Bool, Bool)], [Bool], [ByteSource])
+ System.Posix.ARX.CLI.Options: tmpx :: ArgsParser ([Word], [IOStream], [IOStream], [(Var, Val)], [ByteString], [(Bool, Bool)], [Bool], [ByteSource])
- System.Posix.ARX.Programs: TMPX :: SHDAT -> ByteString -> [(Var, Val)] -> Bool -> Bool -> Bool -> TMPX
+ System.Posix.ARX.Programs: TMPX :: SHDAT -> ByteString -> [(Var, Val)] -> ByteString -> Bool -> Bool -> Bool -> TMPX
- System.Posix.ARX.TMPXTools: Template :: Bool -> Bool -> Bool -> Builder -> Builder -> Builder -> Template
+ System.Posix.ARX.TMPXTools: Template :: Bool -> Bool -> Bool -> ByteString -> Builder -> Builder -> Builder -> Template
Files
- System/Posix/ARX/CLI.hs +21/−16
- System/Posix/ARX/CLI/Options.hs +31/−26
- System/Posix/ARX/Programs.hs +4/−2
- System/Posix/ARX/TMPXTools.hs +6/−3
- System/Posix/ARX/Tar.hs +5/−1
- arx.cabal +11/−2
- model-scripts/tmpx.sh +3/−3
System/Posix/ARX/CLI.hs view
@@ -15,6 +15,7 @@ import Data.Maybe import Data.Monoid import Data.Ord+import Data.Semigroup import Data.Word import System.Environment import System.Exit (exitFailure)@@ -43,11 +44,12 @@ let apply i = interpret (SHDAT size) <$> inIOStream i mapM_ ((send out =<<) . apply) ins Right (Right tmpxArgs) -> do- let (sz, out, tars, env, (rm0, rm1), shared, cmd) = tmpxResolve tmpxArgs+ let (sz, out, tars, env, tmpdir,+ (rm0, rm1), shared, cmd) = tmpxResolve tmpxArgs case tmpxCheckStreams tars cmd of Nothing -> return () Just msg -> do die msg cmd' <- openByteSource cmd- let tmpx = TMPX (SHDAT sz) cmd' env rm0 rm1 shared+ let tmpx = TMPX (SHDAT sz) cmd' env tmpdir rm0 rm1 shared (badAr, goodAr) <- partitionEithers <$> mapM openArchive tars (badAr /= []) `when` do (((die .) .) . blockMessage) "The file magic of some archives:"@@ -86,16 +88,17 @@ {-| Apply defaulting and overrides appropriate to 'TMPX' programs. -} tmpxResolve :: ( [Word], [IOStream], [IOStream],- [(Var, Val)], [(Bool, Bool)], [Bool],- [ByteSource] )+ [(Var, Val)], [ByteString], [(Bool, Bool)],+ [Bool], [ByteSource] ) -> ( Word, IOStream, [IOStream],- [(Var, Val)], (Bool, Bool), Bool,+ [(Var, Val)], ByteString, (Bool, Bool), Bool, ByteSource )-tmpxResolve (sizes, outs, tars, env, rms, shareds, cmds) =- (size, out, tars, env, rm, shared, cmd)+tmpxResolve (sizes, outs, tars, env, dirs, rms, shareds, cmds) =+ (size, out, tars, env, tmpdir, rm, shared, cmd) where size = last (defaultBlock:sizes) out = last (STDIO:outs)+ tmpdir = last ("/tmp":dirs) rm = last ((True,True):rms) shared = last (False:shareds) cmd = last (defaultTask:cmds)@@ -111,13 +114,14 @@ | cmd == IOStream STDIO = One "as a command input" | otherwise = Zero -tmpxOpen :: Word -> [(Var, Val)] -> (Bool, Bool, Bool) -> ByteSource -> IO TMPX-tmpxOpen size env (rm0, rm1, rm2) cmd = do+tmpxOpen :: Word -> [(Var, Val)] -> (Bool, Bool, Bool)+ -> ByteString -> ByteSource -> IO TMPX+tmpxOpen size env (rm0, rm1, rm2) tmpdir cmd = do text <- case cmd of ByteString b -> return (LazyB.fromChunks [b]) IOStream STDIO -> LazyB.getContents IOStream (Path b) -> LazyB.readFile (Char8.unpack b)- return (TMPX (SHDAT size) text env rm0 rm1 rm2)+ return (TMPX (SHDAT size) text env tmpdir rm0 rm1 rm2) openByteSource :: ByteSource -> IO LazyB.ByteString@@ -150,14 +154,15 @@ data ZOM = Zero | One !ByteString | Many ![ByteString]+instance Semigroup ZOM where+ Zero <> x = x+ x <> Zero = x+ One m <> One m' = Many [m, m']+ One m <> Many ms = Many (mappend [m] ms)+ Many ms <> One m = Many (mappend ms [m])+ Many ms <> Many ms' = Many (mappend ms ms') instance Monoid ZOM where mempty = Zero- Zero `mappend` x = x- x `mappend` Zero = x- One m `mappend` One m' = Many [m, m']- One m `mappend` Many ms = Many (mappend [m] ms)- Many ms `mappend` One m = Many (mappend ms [m])- Many ms `mappend` Many ms' = Many (mappend ms ms') streamsMessage filtered = case foldl' mappend Zero filtered of Many messages -> Just (template messages)
System/Posix/ARX/CLI/Options.hs view
@@ -39,7 +39,7 @@ f _ stuff = stuff tmpx :: ArgsParser ( [Word], [IOStream], [IOStream], [(Sh.Var, Sh.Val)],- [(Bool, Bool)], [Bool], [ByteSource] )+ [ByteString], [(Bool, Bool)], [Bool], [ByteSource] ) tmpx = do arg "tmpx" bars <- (try . lookAhead) slashes@@ -47,38 +47,41 @@ Nothing -> flags eof Just bars -> do let eof_bars = () <$ arg bars <|> eof before <- flags eof_bars- cmd <- _7 (gather eof_bars)+ cmd <- _8 (gather eof_bars) after <- flags eof return (before ++ (cmd:after)) where flags = manyTill flag gather = (ByteString . Char8.unwords <$>) . manyTill anyArg flag = _1 blockSize <|> _2 outputFile <|> _3 ioStream- <|> _4 env <|> _5 rm <|> _6 shared- <|> _7 scriptToRun- _1 = ((,Nothing,Nothing,Nothing,Nothing,Nothing,Nothing) . Just <$>)- _2 = ((Nothing,,Nothing,Nothing,Nothing,Nothing,Nothing) . Just <$>)- _3 = ((Nothing,Nothing,,Nothing,Nothing,Nothing,Nothing) . Just <$>)- _4 = ((Nothing,Nothing,Nothing,,Nothing,Nothing,Nothing) . Just <$>)- _5 = ((Nothing,Nothing,Nothing,Nothing,,Nothing,Nothing) . Just <$>)- _6 = ((Nothing,Nothing,Nothing,Nothing,Nothing,,Nothing) . Just <$>)- _7 = ((Nothing,Nothing,Nothing,Nothing,Nothing,Nothing,) . Just <$>)- coalesce = foldr f ([], [], [], [], [], [], [])+ <|> _4 env <|> _5 tmpdir <|> _6 rm+ <|> _7 shared <|> _8 scriptToRun+ _1 = ((,Nothing,Nothing,Nothing,Nothing,Nothing,Nothing,Nothing) . Just <$>)+ _2 = ((Nothing,,Nothing,Nothing,Nothing,Nothing,Nothing,Nothing) . Just <$>)+ _3 = ((Nothing,Nothing,,Nothing,Nothing,Nothing,Nothing,Nothing) . Just <$>)+ _4 = ((Nothing,Nothing,Nothing,,Nothing,Nothing,Nothing,Nothing) . Just <$>)+ _5 = ((Nothing,Nothing,Nothing,Nothing,,Nothing,Nothing,Nothing) . Just <$>)+ _6 = ((Nothing,Nothing,Nothing,Nothing,Nothing,,Nothing,Nothing) . Just <$>)+ _7 = ((Nothing,Nothing,Nothing,Nothing,Nothing,Nothing,,Nothing) . Just <$>)+ _8 = ((Nothing,Nothing,Nothing,Nothing,Nothing,Nothing,Nothing,) . Just <$>)+ coalesce = foldr f ([], [], [], [], [], [], [], []) where- f (Just a, _, _, _, _, _, _) (as, bs, cs, ds, es, fs, gs)- = (a:as, bs, cs, ds, es, fs, gs)- f (_, Just b, _, _, _, _, _) (as, bs, cs, ds, es, fs, gs)- = (as, b:bs, cs, ds, es, fs, gs)- f (_, _, Just c, _, _, _, _) (as, bs, cs, ds, es, fs, gs)- = (as, bs, c:cs, ds, es, fs, gs)- f (_, _, _, Just d, _, _, _) (as, bs, cs, ds, es, fs, gs)- = (as, bs, cs, d:ds, es, fs, gs)- f (_, _, _, _, Just e, _, _) (as, bs, cs, ds, es, fs, gs)- = (as, bs, cs, ds, e:es, fs, gs)- f (_, _, _, _, _, Just f, _) (as, bs, cs, ds, es, fs, gs)- = (as, bs, cs, ds, es, f:fs, gs)- f (_, _, _, _, _, _, Just g) (as, bs, cs, ds, es, fs, gs)- = (as, bs, cs, ds, es, fs, g:gs)+ f (Just a, _, _, _, _, _, _, _) (as, bs, cs, ds, es, fs, gs, hs)+ = (a:as, bs, cs, ds, es, fs, gs, hs)+ f (_, Just b, _, _, _, _, _, _) (as, bs, cs, ds, es, fs, gs, hs)+ = (as, b:bs, cs, ds, es, fs, gs, hs)+ f (_, _, Just c, _, _, _, _, _) (as, bs, cs, ds, es, fs, gs, hs)+ = (as, bs, c:cs, ds, es, fs, gs, hs)+ f (_, _, _, Just d, _, _, _, _) (as, bs, cs, ds, es, fs, gs, hs)+ = (as, bs, cs, d:ds, es, fs, gs, hs)+ f (_, _, _, _, Just e, _, _, _) (as, bs, cs, ds, es, fs, gs, hs)+ = (as, bs, cs, ds, e:es, fs, gs, hs)+ f (_, _, _, _, _, Just f, _, _) (as, bs, cs, ds, es, fs, gs, hs)+ = (as, bs, cs, ds, es, f:fs, gs, hs)+ f (_, _, _, _, _, _, Just g, _) (as, bs, cs, ds, es, fs, gs, hs)+ = (as, bs, cs, ds, es, fs, g:gs, hs)+ f (_, _, _, _, _, _, _, Just h) (as, bs, cs, ds, es, fs, gs, hs)+ = (as, bs, cs, ds, es, fs, gs, h:hs) f _ stuff = stuff blockSize :: ArgsParser Word@@ -98,6 +101,8 @@ shared :: ArgsParser Bool shared = True <$ arg "--shared" +tmpdir :: ArgsParser ByteString+tmpdir = arg "--tmpdir" >> tokCL QualifiedPath rm :: ArgsParser (Bool, Bool) rm = (True, False) <$ arg "-rm0" <|> (False, True) <$ arg "-rm1"
System/Posix/ARX/Programs.hs view
@@ -57,12 +57,13 @@ -} data TMPX = TMPX SHDAT LazyB.ByteString -- Code of task to run. [(Sh.Var, Sh.Val)] -- Environment mapping.+ ByteString -- Place to put tmp dir. Bool -- Destroy tmp if task runs successfully. Bool -- Destroy tmp if task exits with an error code. Bool -- Reuse tmp dir if available. instance ARX TMPX [(Tar, LazyB.ByteString)] where- interpret (TMPX encoder run env rm0 rm1 rm2) stuff = TMPXTools.render- (TMPXTools.Template rm0 rm1 rm2 env' run' archives)+ interpret (TMPX encoder run env tmpdir rm0 rm1 rm2) stuff = TMPXTools.render+ (TMPXTools.Template rm0 rm1 rm2 tmpdir env' run' archives) where archives = mconcat (uncurry archive <$> stuff) archive tar bytes = mconcat@@ -70,6 +71,7 @@ flags TAR = "-x" flags TGZ = "-x -z" flags TBZ = "-x -j"+ flags TXZ = "-x -J" run' = case run of "" -> "" _ -> shdat run env' = case env of _:_ -> (shdat . unblz . Sh.render) env
System/Posix/ARX/TMPXTools.hs view
@@ -22,12 +22,14 @@ data Template = Template { rm0 :: Bool, {-^ Remove tmp on run success? -} rm1 :: Bool, {-^ Remove tmp on run error? -} shared :: Bool, {-^ Share directory across runs? -}+ tmpdir :: ByteString, {-^ Temp file location. -} env :: Blaze.Builder, {-^ Stream for env text. -} run :: Blaze.Builder, {-^ Stream for run text. -} dat :: Blaze.Builder {-^ Data text. -} } instance Show Template where show Template{..} =- "Template { rm0=" ++ tf rm0 ++ " rm1=" ++ tf rm1 +++ "Template { tmpdir=" ++ Bytes.unpack tmpdir+ ++ " rm0=" ++ tf rm0 ++ " rm1=" ++ tf rm1 ++ " shared=" ++ tf shared ++ " ... }" where tf True = "true"@@ -47,14 +49,15 @@ flags = mconcat [ "rm0=", tf rm0, " ; ", "rm1=", tf rm1, " ; ", "shared=", tf shared, " ; ",- "hash=", (hexStr . hash) dat, "\n" ]+ "hash=", (hexStr . hash) dat, " ; ",+ "tmpdir=", blaze tmpdir, "\n" ] hash = abs . Data.Hashable.hash . Blaze.toByteString hexStr = blaze . Bytes.pack . hex hex i = Numeric.showIntAtBase 16 Data.Char.intToDigit i "" blaze = Blaze.fromByteString tf True = "true" tf False = "false"- a : b : c : d : e : [] = findChunks $(embedFile "./model-scripts/tmpx.sh")+ a : b : c : d : e : f : [] = findChunks $(embedFile "./model-scripts/tmpx.sh") findChunks :: ByteString -> [ByteString] findChunks = coalesce . markHoles
System/Posix/ARX/Tar.hs view
@@ -9,7 +9,7 @@ {-| Handled styles of Tar archive. -}-data Tar = TAR | TGZ | TBZ+data Tar = TAR | TBZ | TGZ | TXZ deriving instance Eq Tar deriving instance Ord Tar deriving instance Show Tar@@ -21,6 +21,7 @@ magic b | bzMagic b = Just TBZ | gzMagic b = Just TGZ | tarMagic b = Just TAR+ | xzMagic b = Just TXZ | otherwise = Nothing bzMagic = (== "BZh") . take 3@@ -29,3 +30,6 @@ tarMagic = (== "ustar") . take 5 . drop 257 +xzMagic = (== xzBytes) . take 6+ where+ xzBytes = '\xFD' `cons` "7zXZ\0"
arx.cabal view
@@ -1,5 +1,5 @@ name : arx-version : 0.2.3+version : 0.3.0 category : Text license : BSD3 license-file : LICENSE@@ -85,8 +85,8 @@ System.Posix.ARX.HEREDat System.Posix.ARX.Programs System.Posix.ARX.Sh- System.Posix.ARX.Tar System.Posix.ARX.TMPXTools+ System.Posix.ARX.Tar extensions : FlexibleInstances FunctionalDependencies MultiParamTypeClasses@@ -119,4 +119,13 @@ OverloadedStrings StandaloneDeriving TupleSections+ other-modules: System.Posix.ARX+ System.Posix.ARX.CLI+ System.Posix.ARX.CLI.CLTokens+ System.Posix.ARX.CLI.Options+ System.Posix.ARX.HEREDat+ System.Posix.ARX.Programs+ System.Posix.ARX.Sh+ System.Posix.ARX.TMPXTools+ System.Posix.ARX.Tar
model-scripts/tmpx.sh view
@@ -2,7 +2,7 @@ set -e -u unset rm_ dir tmp=true ; run=true-rm0=true ; rm1=true ; shared=false ; hash="" # To be set by tool.+tmpdir= ; rm0=true ; rm1=true ; shared=false ; hash="" # To be set by tool. token=`date -u +%FT%TZ | tr -d :-`-`hexdump -n4 -e '"%08x"' </dev/urandom` opts() { cmd="$1" ; shift@@ -39,9 +39,9 @@ if $shared then rm_=false- dir=/tmp/tmpx-"$hash"+ dir="$tmpdir"/tmpx-"$hash" else- dir=/tmp/tmpx-"$token"+ dir="$tmpdir"/tmpx-"$token" fi : ${rm_:=true} if $rm_