arx (empty) → 0.0.0
raw patch · 18 files changed
+1853/−0 lines, 18 filesdep +attoparsecdep +basedep +blaze-buildersetup-changed
Dependencies added: attoparsec, base, blaze-builder, bytestring, bytestring-nums, containers, file-embed, parsec, process, shell-escape, template-haskell, vector, vector-algorithms
Files
- LICENSE +28/−0
- README +153/−0
- Setup.hs +4/−0
- System/Posix/ARX.hs +13/−0
- System/Posix/ARX/BlazeIsString.hs +12/−0
- System/Posix/ARX/CLI.hs +179/−0
- System/Posix/ARX/CLI/CLTokens.hs +189/−0
- System/Posix/ARX/CLI/Options.hs +164/−0
- System/Posix/ARX/HEREDat.hs +302/−0
- System/Posix/ARX/Programs.hs +76/−0
- System/Posix/ARX/Sh.hs +71/−0
- System/Posix/ARX/TMPXTools.hs +69/−0
- System/Posix/ARX/Tar.hs +31/−0
- arx.cabal +110/−0
- arx.hs +31/−0
- docs/blessed/arx.man +218/−0
- docs/blessed/arx.txt +153/−0
- model-scripts/tmpx.sh +50/−0
+ LICENSE view
@@ -0,0 +1,28 @@++ ©2011 Jason Dusek.++ Redistribution and use in source and binary forms, with or without+ modification, are permitted provided that the following conditions are met:++ . Redistributions of source code must retain the above copyright notice,+ this list of conditions and the following disclaimer.++ . Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++ . Names of the contributors to this software may not be used to endorse or+ promote products derived from this software without specific prior written+ permission.++ This software is provided by the contributors "as is" and any express or+ implied warranties, including, but not limited to, the implied warranties of+ merchantability and fitness for a particular purpose are disclaimed. In no+ event shall the contributors be liable for any direct, indirect, incidental,+ special, exemplary, or consequential damages (including, but not limited to,+ procurement of substitute goods or services; loss of use, data, or profits;+ or business interruption) however caused and on any theory of liability,+ whether in contract, strict liability, or tort (including negligence or+ otherwise) arising in any way out of the use of this software, even if+ advised of the possibility of such damage.+
+ README view
@@ -0,0 +1,153 @@+SYNOPSIS+ arx ... (-h|-[?]|--help)? ...+ arx shdat (-b <size>)? (-o <output file>)? < input+ arx shdat (-b <size>)? (-o <output file>)? <input file>++ arx tmpx <option,archive>* (//+ <command> (//+ <option,archive>*)?)?++DESCRIPTION+ The arx tool automates a common task in the world of operations automa‐+ tion: packing code, sending it to a remote machine, unpacking in a tem‐+ porary directory, running a task therein and then removing the tempo‐+ rary directory. One might do this when setting up a moderately compli‐+ cated back-up script, installing a new version of nginx or even just to+ run jobs across ones infrastructure.++ The arx tool has no in-built notion of remote connections or server+ clusters; all automation is captured as Bourne compatible scripts that+ use a small number of UNIX utilities in a broadly portable way. At+ present, the utilities used are sed, tr, head, and tar. The calls to+ tar sometimes use -j and -z; these calls to tar may result in calls to+ bzip2 and gzip. Scripts have been tested with dash and the GNU tools as+ well as the sh and tools that are part of busybox.++ The tmpx subcommand of arx offers a variety of options for bundling+ code and a task to run. The shdat subcommand exposes the lower-level+ functionality of encoding binary data in a shell script that outputs+ that binary data, using HERE documents and some odd replacement rules+ for nulls.++ Scripts generated by tmpx and shdat may be fed to sh over STDIN to exe‐+ cute them. This can be helpful when using ssh and sudo to set up an+ execution context; for example:++ arx tmpx ... | ssh user@host.com sudo sh++ For all subcommands, when options overlap in their effect -- for exam‐+ ple, setting the output with -o -- the rightmost option takes prece‐+ dence. Whenever -h, -? or --help is present on the command line, help+ is displayed and the program exits.++ When paths are specified on an arx command line, they must be quali‐+ fied, starting with /, ./ or ../. This simplifies the command line syn‐+ tax, overall, without introducing troublesome ambiguities.++TMPX+ The tmpx subcommand bundles together archives, environment settings and+ an executable or shell command in to a Bourne-compatible script that+ runs the command or executable in a temporary directory, after having+ unpacked the archives and set the environment.++ Any number of file path arguments may be specified; they will be inter‐+ preted as tar archives to include in bundled script. If no archives are+ specified, or - is given, then STDIN will be included.++ The temporary directory created by the script is different for each+ invocation, with a name of the form /tmp/tmpx.<timestamp>.<pid>. The+ timestamp used is a UTC, ISO 8601 format timestamp. One happy conse‐+ quence of this is that earlier jobs sort ASCIIbetically before later+ jobs. After execution, the temporary directory is removed (or not,+ depending on the -rm[10!_] family of options).++ -rm0, -rm1, -rm_, -rm!++ By default, the temporary directory created by the script+ will be deleted no matter the exit status status of the task.+ These options cause a script to be generated that deletes the+ temporary directory only on success, only on failure, always+ (the default) or never.++ -b <size>++ Please see the documentation for this option, shared with+ shdat, below.++ -o <path>++ By default, the generated script is sent to STDOUT. With -o,+ output is redirected to the given path.++ -e <path>++ Causes the file specified to be packaged as the task to be+ run. A binary executable, a Ruby script or a longish shell+ script all fit here.++ In addition to these options, arguments of the form VAR=VALUE are rec‐+ ognized as environment mappings and stored away in the script, to be+ sourced on execution.++ Without -e, the tmpx subcommand tries to find the task to be run as a+ sequence of arguments delimited by a run of slashes. The following+ forms are all recognized:++ arx tmpx ...some args... // ...command...+ arx tmpx ...some args... // ...command... // ...more args...+ arx tmpx // ...command... // ...some args...++ The slash runs must have the same number of slashes and must be the+ longest continuous runs of slashes on the command line. The command+ will be included as is in a Bourne shell script.++SHDAT+ The shdat subcommand translates binary data in to a shell script which+ outputs the binary data. The data is encoded in HERE documents in such+ a way that data without NULs is not changed and that data with NULs is+ minimally expanded: about 1% for randomish data like compressed tar‐+ balls and about 10% in pathological cases.++ The shdat subcommand can be given any number of paths, which will be+ concatenated in the order given. If no path is given, or if - is given,+ then STDIN will be read.++ -b <size>++ The size of data chunks to place in each HERE document. The+ argument is a positive integer followed by suffixes like B,+ K, KiB, M and MiB, in the manner of dd, head and many other+ tools. The default is 4MiB. This is unlikely to make a dif‐+ ference for you unless the generated script is intended to be+ run on a memory-constrained system.++ -o <path>++ By default, the generated script is sent to STDOUT. With -o,+ output is redirected to the given path.++EXAMPLES+ # Installer script that preserves failed builds.+ git archive HEAD | bzip2 | arx tmpx -rm0 // make install > go.sh+ # Now install as root; but don't log in as root.+ cat ./go.sh | ssh joey@hostname sudo /bin/sh++ # Variation of the above.+ git archive HEAD | bzip2 | arx tmpx -rm0 -e ./build-script.py++ # Bundle an instance of an application with DB credentials and run it.+ arx tmpx -rm! ./app.tbz ./stage-info.tgz // rake start | ssh ...++ # Get dump of linking info for build that works here but not there.+ arx tmpx ./server-build.tgz LD_DEBUG=files // ./bin/start | ssh ...++ # Test out Cabal source distribution of this package:+ arx tmpx // 'cd arx-* && cabal configure && cabal build' // \+ -rm0 ./dist/arx-0.0.0.tar.gz | sh++BUGS+ The command line parser offers no hints or help of any kind; it fails+ with the simple message "argument error". The two most common mistakes+ I make are:++ · Not qualifying paths with /, ./ or ../.++ · Not specifying a subcommand (tmpx or shdat).+
+ Setup.hs view
@@ -0,0 +1,4 @@+import Distribution.Simple++main = defaultMain+
+ System/Posix/ARX.hs view
@@ -0,0 +1,13 @@+module System.Posix.ARX (+ -- * Interface and implementation of subcommands.+ ARX(..), SHDAT(..), TMPX(..),+ -- * Creation of environment bindings for 'TMPX'.+ Val, val, Var, var,+ -- * Tar archive types and magic detection.+ Tar(..), magic+ ) where++import System.Posix.ARX.Programs+import System.Posix.ARX.Sh+import System.Posix.ARX.Tar+
+ System/Posix/ARX/BlazeIsString.hs view
@@ -0,0 +1,12 @@++module System.Posix.ARX.BlazeIsString where++import Data.String++import qualified Blaze.ByteString.Builder as Blaze+import qualified Blaze.ByteString.Builder.Char8 as Blaze+++instance IsString Blaze.Builder where+ fromString = Blaze.fromString+
+ System/Posix/ARX/CLI.hs view
@@ -0,0 +1,179 @@+{-# LANGUAGE OverloadedStrings+ , TupleSections+ , StandaloneDeriving #-}++module System.Posix.ARX.CLI where++import Control.Applicative hiding (many)+import Control.Monad+import Data.ByteString (ByteString)+import qualified Data.ByteString as Bytes+import qualified Data.ByteString.Char8 as Char8+import qualified Data.ByteString.Lazy as LazyB+import Data.Either+import Data.List+import Data.Maybe+import Data.Monoid+import Data.Ord+import Data.Word+import System.Environment+import System.Exit+import System.IO++import qualified Blaze.ByteString.Builder as Blaze+import Text.Parsec hiding (satisfy, (<|>))++import System.Posix.ARX.CLI.CLTokens (Class(..))+import qualified System.Posix.ARX.CLI.CLTokens as CLTokens+import System.Posix.ARX.CLI.Options+import System.Posix.ARX+++{-| Run CLI tool, processing arguments and options.+ -}+main :: IO ()+main = do+ args <- (Char8.pack <$>) <$> getArgs+ case parse arx "<args>" args of+ Left _ -> die "Argument error."+ Right (Left shdatArgs) -> do+ let (size, out, ins) = shdatResolve shdatArgs+ case shdatCheckStreams ins of Nothing -> return ()+ Just msg -> do die msg+ let apply i = interpret (SHDAT size) <$> inIOStream i+ mapM_ ((send out =<<) . apply) ins+ Right (Right tmpxArgs) -> do+ let (size, out, tars, env, (rm0, rm1), cmd) = tmpxResolve tmpxArgs+ case tmpxCheckStreams tars cmd of Nothing -> return ()+ Just msg -> do die msg+ cmd' <- openByteSource cmd+ let tmpx = TMPX (SHDAT size) cmd' env rm0 rm1+ (badAr, goodAr) <- partitionEithers <$> mapM openArchive tars+ (badAr /= []) `when` do (((die .) .) . blockMessage)+ "The file magic of some archives:"+ badAr+ "could not be interpreted."+ send out (interpret tmpx goodAr)+ where+ arx = Left <$> shdat <|> Right <$> tmpx+ name STDIO = "-"+ name (Path b) = b+ send o b = (outIOStream o . Blaze.toLazyByteString) b+ openArchive io = do r <- arIOStream io+ return $ case r of Nothing -> Left (name io)+ Just x -> Right x++{-| Apply defaulting and overrides appropriate to 'SHDAT' programs.+ -}+shdatResolve :: ([Word], [IOStream], [IOStream])+ -> (Word, IOStream, [IOStream])+shdatResolve (sizes, outs, ins) = (size, out, ins')+ where+ size = last (defaultBlock:sizes)+ out = last (STDIO:outs)+ ins' | ins == [] = [STDIO]+ | otherwise = ins++shdatCheckStreams :: [IOStream] -> Maybe ByteString+shdatCheckStreams ins = streamsMessage [ins']+ where+ ins' = case [ x | x <- ins, x == STDIO ] of+ [] -> Zero+ [_] -> One "as a file input"+ _:_:_ -> Many ["more than once as a file input"]+++{-| Apply defaulting and overrides appropriate to 'TMPX' programs.+ -}+tmpxResolve :: ( [Word], [IOStream], [IOStream],+ [(Var, Val)], [(Bool, Bool)], [ByteSource] )+ -> ( Word, IOStream, [IOStream],+ [(Var, Val)], (Bool, Bool), ByteSource )+tmpxResolve (sizes, outs, tars, env, rms, cmds) =+ (size, out, tarsWithDefaulting, env, rm, cmd)+ where+ size = last (defaultBlock:sizes)+ out = last (STDIO:outs)+ rm = last ((True,True):rms)+ cmd = last (defaultTask:cmds)+ tarsWithDefaulting+ | tars == [] = [STDIO]+ | otherwise = tars++tmpxCheckStreams :: [IOStream] -> ByteSource -> Maybe ByteString+tmpxCheckStreams tars cmd = streamsMessage [tars', cmd']+ where+ tars' = case [ x | x <- tars, x == STDIO ] of+ [] -> Zero+ [_] -> One "as an archive input"+ _:_:_ -> Many ["more than once as an archive input"]+ cmd'+ | cmd == IOStream STDIO = One "as a command input"+ | otherwise = Zero++tmpxOpen :: Word -> [(Var, Val)] -> (Bool, Bool) -> ByteSource -> IO TMPX+tmpxOpen size env (rm0, rm1) 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)+++openByteSource :: ByteSource -> IO LazyB.ByteString+openByteSource source = case source of+ ByteString b -> return (LazyB.fromChunks [b])+ IOStream STDIO -> LazyB.getContents+ IOStream (Path b) -> LazyB.readFile (Char8.unpack b)++inIOStream STDIO = LazyB.getContents+inIOStream (Path b) = LazyB.readFile (Char8.unpack b)++outIOStream STDIO = LazyB.putStr+outIOStream (Path b) = LazyB.writeFile (Char8.unpack b)++arIOStream :: IOStream -> IO (Maybe (Tar, LazyB.ByteString))+arIOStream io = do opened <- inIOStream io+ return ((,opened) <$> magic opened)+++{-| By default, we encode binary data to HERE docs 4MiB at a time. (The+ encoded result may be up to 10% larger, though 1% is more likely.)+ -}+defaultBlock :: Word+defaultBlock = 0x400000++{-| The default task is a no-op call to @\/bin\/true@.+ -}+defaultTask :: ByteSource+defaultTask = ByteString "/bin/true"+++data ZOM = Zero | One !ByteString | Many ![ByteString]+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)+ _ -> Nothing+ where+ template clauses = blockMessage+ "STDIN is specified multiple times:"+ clauses+ "but restreaming STDIN is not supported."++blockMessage a bs c = Char8.unlines+ [a, Bytes.intercalate ",\n" (mappend " " <$> bs), c]++err "" = return ()+err b | Char8.last b == '\n' = Char8.hPutStr stderr b+ | otherwise = Char8.hPutStr stderr (b `Char8.snoc` '\n')++die msg = err msg >> exitFailure+
+ System/Posix/ARX/CLI/CLTokens.hs view
@@ -0,0 +1,189 @@+{-# LANGUAGE OverloadedStrings+ , ScopedTypeVariables+ , StandaloneDeriving #-}+{-| The CLTokens module describes non-overlapping classes of strings that are+ useful for disambiguating arguments to command line programs. Many common+ string formats -- environment variable assignments, URLs, option strings --+ are recognized by this module's utilities.+ -}+module System.Posix.ARX.CLI.CLTokens where++import Prelude hiding (takeWhile)+import Control.Applicative hiding (many)+import Data.ByteString (ByteString)+import Data.ByteString.Char8 ()+import Data.Either+import Data.Map (Map)+import qualified Data.Map as Map++import Data.Attoparsec.Char8+import Data.Attoparsec.FastSet+++{-| Non-overlapping classes of command line argument strings.+ -}+data Class = EnvBinding -- ^ An 'EnvBinding' has the form+ -- @<shell var name>=<string>@. For example,+ -- @SENDIN=the_clowns@.+ | QualifiedPath -- ^ A 'QualifiedPath' is a file path starting with+ -- @/@, @./@, or @../@.+ | DashDash -- ^ A 'DashDash' is a string of two dashes, @--@,+ -- commonly used to indicate the end of options+ -- processing.+ | LongOption -- ^ A 'LongOption' is a string beginning with two+ -- dashes and then at least one non-dash.+ | Dash -- ^ A 'Dash' is a single dash, @-@, commonly used+ -- to indicate input from @stdin@ or output to+ -- @stdout@.+ | ShortOption -- ^ A 'ShortOption' is a beginning with a dash and+ -- then at least one non-dash.+ | URL -- ^ A 'URL' is a scheme, separated from the+ -- resource, represented as an arbitrary string,+ -- by @://@. The scheme consists of ASCII,+ -- lower-case letters and digits, and may be+ -- multi-part, with each part separated by a @+@+ -- or @/@ (for example, @git+ssh@). An example+ -- URL: @http://example.com/?q=special@.+ | HexNum -- ^ A 'HexNum' is a sequence of hexadecimal+ -- digits, upper or lower case, beginning with+ -- @0x@; for example: @0x01a3@.+ | DecimalNum -- ^ A 'DecimalNum' is a string of decimal digits:+ -- @123123@.+ | Size -- ^ A 'Size' is a decimal number followed by a+ -- multiplicative suffix, in the manner of @dd@+ -- or @head@. Note that counts in terms of bytes+ -- require @B@ (unlike @dd@ or @head@). For a+ -- full list of suffixes, see 'sizes' below.+deriving instance Eq Class+deriving instance Ord Class+deriving instance Show Class+++{-| Determine if a particular 'ByteString' matches the given 'Class' of token.+ -}+match :: Class -> ByteString -> Bool+match = (e2b .) . parseOnly . recognizer+ where+ e2b (Left _) = False+ e2b (Right _) = True+++{-| Determine if a particular 'ByteString' matches any 'Class' of token.+ -}+recognize :: ByteString -> Maybe Class+recognize = e2m . parseOnly (choice recognizers)+ where+ e2m (Left _) = Nothing+ e2m (Right x) = Just x+ recognizeIt x = x <$ recognizer x+ recognizers = recognizeIt <$> [ EnvBinding,+ QualifiedPath,+ DashDash,+ LongOption,+ Dash,+ ShortOption,+ URL,+ HexNum,+ DecimalNum ]+++{-| A ByteString stand-in that demoes each token class.+ -}+exemplar :: Class -> ByteString+exemplar cls = case cls of+ EnvBinding -> "VAR=value"+ QualifiedPath -> "./qualified/path"+ DashDash -> "--"+ LongOption -> "--long-option"+ Dash -> "-"+ ShortOption -> "-shortopt"+ URL -> "scheme://url-to-resource"+ HexNum -> "0xA12FE"+ DecimalNum -> "0123456789"+ Size -> "4MiB"+++{-| The recognizer appropriate to each token class. Parses successfully if a+ the token class is recognized, returning '()'. Most token types are+ defined in terms of a prefix of the input -- for example, 'QualifiedPath'+ -- and the parsers for these tokens naturally return as soon as the prefix+ is recognized.+ -}+recognizer :: Class -> Parser ()+recognizer cls = case cls of+ EnvBinding -> () <$ do satisfy varFirst+ takeWhile varBody+ char8 '='+ QualifiedPath -> () <$ do string "/" <|> string "./"+ <|> string "../"+ DashDash -> string "--" *> endOfInput+ LongOption -> () <$ (string "--" >> satisfy (/= '-'))+ Dash -> char8 '-' *> endOfInput+ ShortOption -> () <$ (char8 '-' >> satisfy (/= '-'))+ URL -> () <$ do takeWhile1 isURLSchemeChar+ many $ do char8 '+' <|> char8 '/'+ takeWhile1 isURLSchemeChar+ string "://"+ HexNum -> string "0x" >> takeWhile1 isHexDigit+ *> endOfInput+ DecimalNum -> takeWhile1 isDigit *> endOfInput+ Size -> () <$ size++schemeSeparator = char8 '+' <|> char8 '/'++varFirst = inClass "a-zA-Z_"++varBody = inClass "a-zA-Z_0-9"++isLongOptionChar = inClass "a-zA-Z0-9-"++isShortOptionChar = inClass "a-zA-Z0-9!?"++isSchemeChar = inClass "a-z0-9"++isHexDigit = inClass "0-9a-fA-F"++isURLSchemeChar = inClass "a-z0-9"+++{-| A map from suffixes to sizes, following the conventions of command line+ tools (GNU @dd@ or @head@ and many others) as well as the standard for+ binary sizes established by the IEC.+@+ B = 1+ K = KiB = 1024B kB = 1000B+ M = MiB = 1024K MB = 1000kB+ G = GiB = 1024M GB = 1000MB+ T = TiB = 1024G TB = 1000GB+ P = PiB = 1024T PB = 1000TB+ E = EiB = 1024P EB = 1000PB+ Z = ZiB = 1024E ZB = 1000EB+ Y = YiB = 1024Z YB = 1000ZB+@+ -}+sizes :: Map ByteString Integer+sizes = Map.fromList+ [ ("B", 1),+ ("K", 2^10), ("KiB", 2^10), ("kB", 10^03),+ ("M", 2^20), ("MiB", 2^20), ("MB", 10^06),+ ("G", 2^30), ("GiB", 2^30), ("GB", 10^09),+ ("T", 2^40), ("TiB", 2^40), ("TB", 10^12),+ ("P", 2^50), ("PiB", 2^50), ("PB", 10^15),+ ("E", 2^60), ("EiB", 2^60), ("EB", 10^18),+ ("Z", 2^70), ("ZiB", 2^70), ("ZB", 10^21),+ ("Y", 2^80), ("YiB", 2^80), ("YB", 10^24) ]++{-| Parse a size, consuming the entire input string.+ -}+size :: Parser Integer+size = (*) <$> decimal <*> suffix+ where+ asSuffix (k, v) = v <$ try (string k <* endOfInput)+ suffix = choice (asSuffix <$> Map.toList sizes)++{-| Parse a size, consuming the entire input string, with the final result+ bounded by the maximum of a 'Bounded' type.+ -}+sizeBounded :: forall b . (Bounded b, Integral b) => Parser b+sizeBounded = fromInteger . min (toInteger (maxBound :: b)) <$> size+
+ System/Posix/ARX/CLI/Options.hs view
@@ -0,0 +1,164 @@+{-# LANGUAGE OverloadedStrings+ , TupleSections+ , StandaloneDeriving #-}++module System.Posix.ARX.CLI.Options where++import Control.Applicative hiding (many)+import Control.Monad+import Data.ByteString (ByteString)+import qualified Data.ByteString as Bytes+import qualified Data.ByteString.Char8 as Char8+import Data.Either+import Data.List+import Data.Maybe+import Data.Ord+import Data.Word+import Text.Parsec hiding (satisfy, (<|>))++import qualified Data.Attoparsec++import System.Posix.ARX.CLI.CLTokens (Class(..))+import qualified System.Posix.ARX.CLI.CLTokens as CLTokens+import qualified System.Posix.ARX.Sh as Sh+++shdat :: ArgsParser ([Word], [IOStream], [IOStream])+shdat = do+ arg "shdat"+ coalesce <$> manyTill (_1 blockSize <|> _2 outputFile <|> _3 ioStream) eof+ where+ _1 = ((,Nothing,Nothing) . Just <$>)+ _2 = ((Nothing,,Nothing) . Just <$>)+ _3 = ((Nothing,Nothing,) . Just <$>)+ coalesce = foldr f ([], [], [])+ where+ f (Just a, _, _) (as, bs, cs) = (a:as, bs, cs)+ f (_, Just b, _) (as, bs, cs) = (as, b:bs, cs)+ f (_, _, Just c) (as, bs, cs) = (as, bs, c:cs)+ f _ stuff = stuff++tmpx :: ArgsParser ( [Word], [IOStream], [IOStream], [(Sh.Var, Sh.Val)],+ [(Bool, Bool)], [ByteSource] )+tmpx = do+ arg "tmpx"+ bars <- (try . lookAhead) slashes+ coalesce <$> case bars of+ Nothing -> flags eof+ Just bars -> do let eof_bars = () <$ arg bars <|> eof+ before <- flags eof_bars+ cmd <- _6 (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 scriptToRun+ _1 = ((,Nothing,Nothing,Nothing,Nothing,Nothing) . Just <$>)+ _2 = ((Nothing,,Nothing,Nothing,Nothing,Nothing) . Just <$>)+ _3 = ((Nothing,Nothing,,Nothing,Nothing,Nothing) . Just <$>)+ _4 = ((Nothing,Nothing,Nothing,,Nothing,Nothing) . Just <$>)+ _5 = ((Nothing,Nothing,Nothing,Nothing,,Nothing) . Just <$>)+ _6 = ((Nothing,Nothing,Nothing,Nothing,Nothing,) . Just <$>)+ coalesce = foldr f ([], [], [], [], [], [])+ where+ f (Just a, _, _, _, _, _) (as, bs, cs, ds, es, fs)+ = (a:as, bs, cs, ds, es, fs)+ f (_, Just b, _, _, _, _) (as, bs, cs, ds, es, fs)+ = (as, b:bs, cs, ds, es, fs)+ f (_, _, Just c, _, _, _) (as, bs, cs, ds, es, fs)+ = (as, bs, c:cs, ds, es, fs)+ f (_, _, _, Just d, _, _) (as, bs, cs, ds, es, fs)+ = (as, bs, cs, d:ds, es, fs)+ f (_, _, _, _, Just e, _) (as, bs, cs, ds, es, fs)+ = (as, bs, cs, ds, e:es, fs)+ f (_, _, _, _, _, Just f) (as, bs, cs, ds, es, fs)+ = (as, bs, cs, ds, es, f:fs)+ f _ stuff = stuff++blockSize :: ArgsParser Word+blockSize = do arg "-b"+ CLTokens.sizeBounded <@> tokCL Size++outputFile :: ArgsParser IOStream+outputFile = arg "-o" >> ioStream++ioStream :: ArgsParser IOStream+ioStream = STDIO <$ tokCL Dash+ <|> Path <$> tokCL QualifiedPath++qPath :: ArgsParser ByteString+qPath = tokCL QualifiedPath++rm :: ArgsParser (Bool, Bool)+rm = (True, False) <$ arg "-rm0" <|> (False, True) <$ arg "-rm1"+ <|> (False, False) <$ arg "-rm!" <|> (True, True) <$ arg "-rm_"++env :: ArgsParser (Sh.Var, Sh.Val)+env = do+ (var, assignment) <- Char8.break (== '=') <$> tokCL EnvBinding+ case (,) <$> Sh.var var <*> Sh.val (Bytes.drop 1 assignment) of+ Nothing -> mzero+ Just x -> return x++scriptToRun :: ArgsParser ByteSource+scriptToRun = arg "-e" >> IOStream <$> ioStream++cmd :: ByteString -> ArgsParser ByteSource+cmd bars = ByteString . Char8.unwords <$> bracketed bars bars anyArg+ where+ bracketed start end p = arg start >> manyTill p (eof <|> () <$ arg end)+++{-| A byte-oriented store that can be read from or written to in a streaming+ fashion.+ -}+data IOStream = STDIO | Path !ByteString+deriving instance Eq IOStream+deriving instance Ord IOStream+deriving instance Show IOStream++{-| A source of bytes (no writing, only reading).+ -}+data ByteSource = ByteString !ByteString | IOStream !IOStream+deriving instance Eq ByteSource+deriving instance Ord ByteSource+deriving instance Show ByteSource+++type ArgsParser = Parsec [ByteString] ()++satisfy :: (ByteString -> Bool) -> ArgsParser ByteString+satisfy p = argPrim test+ where+ test b = guard (p b) >> Just b++anyArg :: ArgsParser ByteString+anyArg = argPrim Just++arg :: ByteString -> ArgsParser ByteString+arg b = satisfy (== b)++argPrim :: (ByteString -> Maybe t) -> ArgsParser t+argPrim = tokenPrim show next+ where+ next pos _ _ = incSourceLine pos 1++(<@>) :: Data.Attoparsec.Parser t -> ArgsParser ByteString -> ArgsParser t+atto <@> parsec = do+ res <- Data.Attoparsec.parseOnly atto <$> parsec+ case res of Left _ -> mzero+ Right x -> return x+infixl 4 <@>++tokCL :: Class -> ArgsParser ByteString+tokCL tokenClass = satisfy (CLTokens.match tokenClass)++slashes :: ArgsParser (Maybe ByteString)+slashes = listToMaybe . longestFirst . catMaybes <$> manyTill classify eof+ where+ classify = Just <$> satisfy slashRun <|> Nothing <$ anyArg+ longestFirst = sortBy (comparing (negate . Bytes.length))+ slashRun s = Char8.all (== '/') s && Bytes.length s > 1+
+ System/Posix/ARX/HEREDat.hs view
@@ -0,0 +1,302 @@+{-# LANGUAGE OverloadedStrings+ , TupleSections+ , StandaloneDeriving #-}++{-| Utilities for encoding arbitrary data as Bourne shell fragments that+ stream the data to standard output, using HERE documents and simple shell+ decoders.+ -}+module System.Posix.ARX.HEREDat where++import Control.Applicative+import Control.Arrow (first)+import Control.Monad+import Data.ByteString (ByteString)+import qualified Data.ByteString as Bytes+import qualified Data.ByteString.Char8+import qualified Data.ByteString.Internal as Bytes (c2w)+import qualified Data.List as List+import Data.Monoid+import Data.Ord+import Data.String+import Data.Word+import Numeric (showOct, showHex)++import qualified Blaze.ByteString.Builder as Blaze+import qualified Blaze.ByteString.Builder.Char8 as Blaze+import qualified Data.ByteString.Nums.Careless as Bytes+import Data.Vector.Unboxed (Vector)+import qualified Data.Vector.Unboxed as Vector+import qualified Data.Vector.Unboxed.Mutable as Vector+import qualified Data.Vector.Algorithms.Intro as Vector++import System.Posix.ARX.BlazeIsString+++{-| A chunk describes a block of binary data ready for inclusion in a shell+ script. For many data blocks, no encoding or decoding is necessary; these+ are stored in a 'SafeChunk'. Those blocks needing byte-translation are+ stored in an 'EncodedChunk'.+ -}+data Chunk = SafeChunk !ByteString+ | EncodedChunk !ByteString -- Encoded data.+ !Int -- Original length.+ !EscapeChar -- Null replacer.+ !EscapeChar -- Escaper.+deriving instance Show Chunk+instance IsString Chunk where+ fromString = chunk . Data.ByteString.Char8.pack++{-| Converts a 'ByteString' into a string safe for inclusion in a shell HERE+ document and annotates with information to construct a shell decoder for+ that document, if necessary.++ A 'ByteString' with nulls is rewritten in a complicated way. Two escape+ characters are chosen from a class of ASCII printable characters that look+ like reasonable escape characters; the two that show up least frequently+ in the document (including 0 times) become the null replacer and the+ escaper. All instances of these two characters are rewritten to escape+ sequences formed with the escaper, while nulls are rewritten to the null+ replacer. Given the two characters thus chosen, a command line with @tr@+ and @sed@ in sequence can be constructed to decode the document.++ This encoding doubles the amount of space consumed by the escape+ characters. In the worst case, where the data is made of all 20 potential+ escapes, evenly distributed, and one null (so we can't punt on escaping),+ the data will grow in size by 10 percent. For data that is more evenly+ distributed over the bytes -- as we might expect of compressed tarballs --+ we expect a size growth of two 256ths, or less than 0.8 percent.+ -}+chunk :: ByteString -> Chunk+chunk block = EncodedChunk (encode nW eW block)+ (Bytes.length block) nEsc eEsc+-- | safeForHereDoc block = SafeChunk block+-- | otherwise = EncodedChunk (encode nW eW block)+-- (Bytes.length block) nEsc eEsc+ where+ nEsc@(EscapeChar nW _ _ _) :+ eEsc@(EscapeChar eW _ _ _) : _ = snd <$> List.sortBy (comparing cmp) counts+ cmp (count, EscapeChar w _ _ _) = (count, w)+ counts = countAndBundle <$> escapes+ where+ countAndBundle e@(EscapeChar w _ _ _) = (Bytes.count w block, e)++{-| Given a byte to replace nulls and an escape byte, rewrites the data such+ that nulls are mapped to the replace byte, replace bytes are mapped to a+ pair of escape bytes and the escape byte is is mapped to an escape byte+ followed by an underscore. For example, if the null replace byte is @!@+ and the escape byte is @\#@ then all nulls become @!@, any @!@ become+ @\#\#@ and all @\#@ become @\#_@.++ This escaping scheme is dictated by the needs of our Sed decoder, which is+ just two global substitions, one after another. If the escaping were such+ that, with our characters above, @\#@ escaped to @\#\#@ and @!@ to @\#_@,+ then @\#_@ in the input becomes @\#\#_@. We want to run the subsitution+ for @\#@ first, to catch this; it produces @\#_@; then Sed feeds the input+ to the second substitution which unfortunately renders @!@. In the+ alternate scheme, the input is encoded @\#__@, the @!@ decoder runs first+ and ignores it, then the @\#@ decoder runs and catches it. When using a+ pipeline of stream processors to interpret escape sequences, it seems best+ to ensure that only the very last processor inserts escape characters, to+ prevent their further interpretation.+ -}+encode :: Word8 -> Word8 -> ByteString -> ByteString+encode nullReplaceByte escapeByte bytes =+ fst $ Bytes.unfoldrN len f (Nothing, bytes)+ where+ -- The encoding should introduce at most 10% overhead; we allocate a little+ -- more just to be safe. This allows us to make use of the somewhat faster+ -- unfoldrN function (which probably pre-allocates).+ len = ceiling (fromIntegral (Bytes.length bytes) * 1.25)+ -- The worker sometimes floats up a byte, sometimes escapes a byte and+ -- introduces a byte to be 'carried' (like carryies in arithmetic) and+ -- sometimes floats up the carried byte.+ f (Just carried, bytes) = Just (carried, (Nothing, bytes))+ f (Nothing , bytes) = do+ ((b, carry), t) <- first rewrite <$> Bytes.uncons bytes+ Just (b, (carry, t))+ rewrite b+ | b == 0x00 = (nullReplaceByte, Nothing)+ | b == escapeByte = (escapeByte , Just underscore)+ | b == nullReplaceByte = (escapeByte , Just escapeByte)+ | otherwise = (b , Nothing)+ underscore = Bytes.c2w '_'++{-| Given the byte used to replace nulls and the escape byte, undoes the result+ of the encode operation -- rewriting null replacers to literal nulls and+ escape patterns to the original bytes. This function is not intended to be+ used in practice -- it will be shell commands that unpack the data -- but+ serves to document the ideas behind decoding as well as offering a way to+ check the encoder.+ -}+decode :: Word8 -> Word8 -> ByteString -> ByteString+decode nullReplaceByte escapeByte = (unEscape . Bytes.map unReplace)+ where+ unReplace b+ | b == nullReplaceByte = 0x00+ | otherwise = b+ unEscape = Bytes.concat . List.reverse . fst+ . List.foldl' f ([], False)+ . Bytes.split escapeByte+ where+ nS = Bytes.singleton nullReplaceByte+ f (strings, True) "" = (nS:strings , False)+ f (strings, False) "" = (strings , True)+ f (strings, False) s = (s:strings , True)+ f (strings, True) s+ | underscore = (eSt:strings, True)+ | otherwise = (s:strings , True)+ where+ underscore = Bytes.head s == Bytes.c2w '_'+ eSt = Bytes.cons escapeByte (Bytes.tail s)+ {- The second field of the tuple is the "escaped" flag and the reasoning+ - behind it's setting and unsetting is tricky. We start unescaped. If a+ - string follows another string in the list of splits, there must have+ - been an escape character to make us split it; therefore, seeing a string+ - makes us set escaping to True. However, if we see an empty string, it+ - means there were two escape characters next to one another. We+ - interpret the double escape sequence and unset the escape flag.+ -}++data EscapeChar = EscapeChar !Word8 !ByteString -- For @tr@ char list.+ !ByteString -- For @sed@ pattern.+ !ByteString -- For @sed@ replacement.+deriving instance Show EscapeChar++{-| The candidate escape characters, with the forms to be used in constructed+ @tr@ and @sed@ commands.+ -}+escapes :: [EscapeChar]+escapes = [EscapeChar 0x21 "!" "!" "!",+ EscapeChar 0x22 "\"" "\"" "\"",+ EscapeChar 0x23 "#" "#" "#",+ EscapeChar 0x24 "$" "[$]" "$",+ EscapeChar 0x25 "%" "%" "%",+ EscapeChar 0x26 "&" "&" "\\&",++ EscapeChar 0x2a "*" "[*]" "*",+ EscapeChar 0x2b "+" "[+]" "+",+ EscapeChar 0x2c "," "," ",",+ EscapeChar 0x2d "-" "-" "-",+ EscapeChar 0x2e "." "[.]" ".",+ EscapeChar 0x2f "/" "/" "/",++ EscapeChar 0x3a ":" ":" ":",+ EscapeChar 0x3b ";" ";" ";",++ EscapeChar 0x3d "=" "=" "=",++ EscapeChar 0x3f "?" "[?]" "?",+ EscapeChar 0x40 "@" "@" "@",++ EscapeChar 0x5c "\\\\" "\\\\" "\\\\",++ EscapeChar 0x60 "`" "`" "`",++ EscapeChar 0x7e "~" "~" "~"]+{- We use character classes instead of \ for many characters on the pattern+ - side because \ turns special behaviour on in basic mode and off in extended+ - mode, an ambiguity that, I feel, is best not to have to think about.+ -}++{-| Many binary strings can be embedded as-is in a HEREDOC, without escaping.+ -}+safeForHereDoc :: ByteString -> Bool+safeForHereDoc = not . Bytes.any (== 0x00)++{-| Predicate to determine whether data is represented as an encoded chunk or+ is unencoded.+ -}+encoded :: Chunk -> Bool+encoded (SafeChunk _) = False+encoded (EncodedChunk _ _ _ _) = True++{-| + -}+script chunk = mconcat $ case chunk of+ SafeChunk bytes -> [clip len, dataSection eof bytes]+ where+ len = Bytes.length bytes+ eof = blz (leastStringNotIn bytes)+ EncodedChunk bytes len+ (EscapeChar _ trN _ sedRN) (EscapeChar b _ sedPE sedRE) ->+ [ "{ ", mconcat tr, " | ", mconcat sed, " | ", clip len, " ;}",+ dataSection (Blaze.fromWord8 b) bytes ]+ where+ tr = ["tr '", blz trN, "' '\\000'"]+ (e, e', n) = (blz sedPE, blz sedRE, blz sedRN)+ sed = ["sed '","s|",e, e, "|",n, "|g",+ " ; ","s|",e,"_","|",e',"|g","'"]+ where+ blz = Blaze.fromByteString+ nl = Blaze.fromChar '\n'+ dataSection eof bytes = mconcat [" <<\\", eof, nl, blz bytes, nl, eof, nl]+ clip len = "head -c " `mappend` Blaze.fromShow len++{-| Finds a short hexadecimal string that is not in the input.++ A string of length @n@ has at most @n - (k - 1)@ substrings of some fixed,+ positive length @k@ -- the substring starting at the first byte and+ extending for @k@, the substring starting at the second byte and extending+ for @k@ and so on, on until the end where we have to stop @k - 1@ short of+ the last byte. We choose @k@ such that it contains enough hexadecimal+ digits to enumerate all the substrings; for a 4M input, we want @k = 6@.++ We can take all the hex substrings of length @k@ in the input, sort them,+ and then find the gaps. We take the least substring in the first gap for+ our chosen substring. This gives us an O(n log n) algorithm.++ The measurable length of a 'ByteString' is at most the maximum 'Word'+ (since the length function results in an 'Int'); this is one less than 2+ to the bit width of a 'Word' (because there is a 0 'Word'). Thus a 'Word'+ suffices to enumerate all the possible substrings in a 'ByteString'; and+ one more. (Substrings are zero-indexed and the length is 1-indexed.) We+ can leverage this fact to translate all substrings to 'Word' and store+ them in an unboxed vector, using integer operations to find the least+ subtring in the first gap. Space usage is linear in the length of the+ input string; for a 4M string, the sorted vector could consume 32M on 64+ bit machines.+ -}+leastStringNotIn :: ByteString -> ByteString+leastStringNotIn bytes = hex+ where+ len = Bytes.length bytes+ digits = 1 + floor (logBase 16 (fromIntegral len))+ substrings = [ s | s <- Bytes.take digits <$> Bytes.tails bytes, isHex s ]+ sortedWords :: Vector Word+ sortedWords = Vector.create $ do+ v <- Vector.new len+ zipWithM_ (Vector.write v) [0..] (Bytes.hex <$> substrings)+ Vector.sort v+ return v+ isHex "" = False+ isHex s = Bytes.all (`Bytes.elem` "0123456789ABCDEF") s+ -- Find the smallest number not in the list, assuming it is sorted.+ minW = f 0 (Vector.toList sortedWords)+ where+ f candidate l = case l of [ ] -> candidate+ h:t | candidate < h -> candidate+ | otherwise -> f (h+1) t+ padded = "0000000000000000" `mappend`+ Data.ByteString.Char8.pack (showHex minW "")+ (_, hex) = Bytes.splitAt (Bytes.length padded - digits) padded+++ {- Catting a tarball escaped this way to a shell behind a TTY won't work very+ - well: a ^C or ^Z is passed literally and would cause the TTY to kill or+ - suspend the shell.+ -+ - One reason users might care about this is the 'requiretty' option in+ - sudoers, an option set by default on many systems. It prevents one from+ - running `sudo ...' over SSH without a TTY (enabled through the -t flag to+ - SSH).+ -+ - There are 33 control characters, counting delete with the leading 32. Some+ - don't need to be escaped at all -- for example, newline -- whereas for+ - others, it's unclear (like carriage return). We can trust, I think, that+ - bytes higher than 127 don't need to be escaped. In principle, we have a+ - base-222 alphabet in which to encode the data so it should still be more+ - more compact than base 64; but whether shell decoders can effectively+ - realize this efficiency is another matter.+ -}+
+ System/Posix/ARX/Programs.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE OverloadedStrings+ , StandaloneDeriving+ , FlexibleInstances+ , MultiParamTypeClasses+ , FunctionalDependencies #-}++module System.Posix.ARX.Programs where++import Control.Applicative+import Control.Monad+import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as Bytes+import qualified Data.ByteString.Lazy as LazyB+import Data.Monoid+import Data.Word++import qualified Blaze.ByteString.Builder as Blaze++import System.Posix.ARX.BlazeIsString -- Most string literals are builders.+import System.Posix.ARX.HEREDat+import qualified System.Posix.ARX.Sh as Sh+import qualified System.Posix.ARX.TMPXTools as TMPXTools+import System.Posix.ARX.Tar+++{-| ARX subprograms process some input to produce a script.+ -}+class ARX program input | program -> input where+ interpret :: program -> input -> Blaze.Builder+++{-| An 'SHDAT' program processes byte streams with the specified chunking to+ produce a script.+ -}+newtype SHDAT = SHDAT Word -- Chunk size.+instance ARX SHDAT LazyB.ByteString where+ interpret (SHDAT w) bytes = mconcat (chunked bytes)+ where+ chunkSize = min (fromIntegral w) maxBound+ chunked input = case LazyB.splitAt chunkSize input of+ ("", "") -> []+ (a , "") -> [chunkIt a]+ (a , b) -> chunkIt a : chunked b+ where + chunkIt = script . chunk . mconcat . LazyB.toChunks+++{-| A 'TMPX' program archives streams to produce a script that unpacks the+ file data in a temporary location and runs the command with the attached+ environment information in that location. The command may be any+ executable file contents, modulo architectural compatibility. It is+ written along side the temporary work location, to ensure it does not+ collide with any files in the archive. The two boolean flags determine+ when to delete the temporary directory. The first flag determines whether+ or not to delete successful (exit code zero) runs; the second determines+ whether or not to delete failed (exit code non-zero) runs.+ -}++data TMPX = TMPX SHDAT LazyB.ByteString -- Code of task to run.+ [(Sh.Var, Sh.Val)] -- Environment mapping.+ Bool -- Destroy tmp if task runs successfully.+ Bool -- Destroy tmp if task exits with an error code.+instance ARX TMPX [(Tar, LazyB.ByteString)] where+ interpret (TMPX encoder run env rm0 rm1) stuff = TMPXTools.render+ (TMPXTools.Template rm0 rm1 env' run' archives)+ where+ archives = mconcat (uncurry archive <$> stuff)+ archive tar bytes = mconcat+ ["{\n", shdat bytes, "} | tar ", flags tar, "\n"]+ flags TAR = "-x"+ flags TGZ = "-x -z"+ flags TBZ = "-x -j"+ run' = shdat run+ env' = (shdat . Blaze.toLazyByteString . Sh.render) env+ shdat = interpret encoder+
+ System/Posix/ARX/Sh.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE OverloadedStrings+ , FlexibleInstances+ , StandaloneDeriving #-}+{-| Utilities for working with shell script.+ -}+module System.Posix.ARX.Sh ( Val(), val, Var(), var,+ setEU, Render(..), Raw(..) ) where++import Control.Monad+import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as Bytes+import Data.Monoid++import qualified Blaze.ByteString.Builder as Blaze+import qualified Text.ShellEscape as Esc++import System.Posix.ARX.BlazeIsString+++setEU :: Blaze.Builder+setEU = "set -e -u\n"++{-| Valid shell string values contain any byte but null.+ -}+newtype Val = Val ByteString+deriving instance Eq Val+deriving instance Ord Val+deriving instance Show Val+instance Render Val where+ render (Val bytes) = (Blaze.fromByteString . Esc.bytes . Esc.sh) bytes+instance Raw Val where+ raw (Val bytes) = bytes++val :: ByteString -> Maybe Val+val bytes = guard (Bytes.all (/= '\0') bytes) >> Just (Val bytes)++{-| Valid shell variable names consist of a leading letter or underscore and+ then any number of letters, underscores or digits.+ -}+newtype Var = Var ByteString+deriving instance Eq Var+deriving instance Ord Var+deriving instance Show Var+instance Render Var where+ render (Var bytes) = Blaze.fromByteString bytes+instance Raw Var where+ raw (Var bytes) = bytes++var :: ByteString -> Maybe Var+var "" = Nothing+var bytes = guard (leading h && Bytes.all body t) >> Just (Var bytes)+ where+ (h, t) = (Bytes.head bytes, Bytes.tail bytes)+ body c = leading c || (c >= '0' && c <= '9')+ leading c = (c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z') || c == '_'++instance Render [(Var, Val)] where+ render [ ] = mempty+ render ((k,v):t) = exportStatement `mappend` render t+ where+ exportStatement = mconcat ["export ", render k, "=", render v, "\n"]++instance Render [Val] where+ render = mconcat . map (mappend " " . render)++class Render t where+ render :: t -> Blaze.Builder++class Raw t where+ raw :: t -> ByteString+
+ System/Posix/ARX/TMPXTools.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE TemplateHaskell+ , OverloadedStrings+ , RecordWildCards+ , PatternGuards #-}++module System.Posix.ARX.TMPXTools where++import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as Bytes+import Data.List+import Data.Maybe+import Data.Monoid++import qualified Blaze.ByteString.Builder as Blaze+import Data.FileEmbed++import System.Posix.ARX.BlazeIsString+++data Template = Template { rm0 :: Bool, {-^ Remove tmp on run success? -}+ rm1 :: Bool, {-^ Remove tmp on run error? -}+ env :: Blaze.Builder, {-^ Stream for env text. -}+ run :: Blaze.Builder, {-^ Stream for run text. -}+ dat :: Blaze.Builder {-^ Data unpacking text. -} }+instance Show Template where+ show Template{..} =+ "Template { rm0=" ++ tf rm0 ++ " rm1=" ++ tf rm1 ++ " ... }"+ where+ tf True = "true"+ tf False = "false"++render :: Template -> Blaze.Builder+render Template{..} = mconcat [ blaze a,+ flags, + blaze b,+ env,+ blaze c,+ run,+ blaze d,+ dat,+ blaze e ]+ where+ flags = mconcat ["rm0=",tf rm0," ; ","rm1=",tf rm1,"\n"]+ blaze = Blaze.fromByteString+ tf True = "true"+ tf False = "false"+ a : b : c : d : e : [] = findChunks $(embedFile "./model-scripts/tmpx.sh")++findChunks :: ByteString -> [ByteString]+findChunks = coalesce . markHoles++coalesce :: [Maybe ByteString] -> [ByteString]+coalesce = reverse . catMaybes . foldl' f []+ where+ f [ ] item = [item]+ f (Just a : t) (Just b) = Just (Bytes.append a b) : t+ f (Nothing : t) (Just b) = Just b : Nothing : t+ f (Just a : t) (Nothing) = Nothing : Just a : t+ f (Nothing : t) (Nothing) = Nothing : t++markHoles :: ByteString -> [Maybe ByteString]+markHoles = map f . Bytes.lines+ where+ f l | isHole l = Nothing+ | otherwise = Just (l `Bytes.snoc` '\n')++isHole :: ByteString -> Bool+isHole line = "# To be set by tool." `Bytes.isSuffixOf` line+
+ System/Posix/ARX/Tar.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE OverloadedStrings+ , StandaloneDeriving #-}++module System.Posix.ARX.Tar where++import Prelude hiding (drop, take)+import Data.ByteString.Lazy.Char8+++{-| Handled styles of Tar archive.+ -}+data Tar = TAR | TGZ | TBZ+deriving instance Eq Tar+deriving instance Ord Tar+deriving instance Show Tar+++{-| Scan a lazy ByteString for file magic.+ -}+magic :: ByteString -> Maybe Tar+magic b | bzMagic b = Just TBZ+ | gzMagic b = Just TGZ+ | tarMagic b = Just TAR+ | otherwise = Nothing++bzMagic = (== "BZh") . take 3++gzMagic = (== "\x1F\x8b") . take 2++tarMagic = (== "ustar") . take 5 . drop 257+
+ arx.cabal view
@@ -0,0 +1,110 @@+name : arx+version : 0.0.0+category : Text+license : BSD3+license-file : LICENSE+author : Jason Dusek+maintainer : oss@solidsnack.be+homepage : http://github.com/solidsnack/arx/+synopsis : Archive execution tool.+description :+ The @ARX@ system provides services for packaging, deploying and running+ source code. No particular format or framework is needed -- a directory of+ code and a command to run are enough. The system has no in-built notion of+ remote connections, job servers or clusters; all automation is captured as+ Bourne compatible scripts.+ .+ An archive of the source code, a command and optionally an environment are+ encoded together in a Bourne shell script that uses a small number of UNIX+ utilities in a broadly portable way. The generated scripts can be run+ directly or fed to @sh@ on STDIN. This latter feature is useful when one+ would like to use @ssh@ and @sudo@ to set an appropriate executation+ context, for example running: @ssh user\@example.com sudo sh@.+ .+ The shell tools used are @head@, @sed@, @tr@ and @tar@. The calls to @tar@+ sometimes use @-j@ and @-z@; these calls to @tar@ may result in calls to+ @bzip2@ and @gzip@. Scripts have been tested with @dash@ and the GNU tools+ as well as the @sh@ and tools that are part of @busybox@.+ .+ The @arx@ command line tool provides the @tmpx@ subcommand for preparing+ jobs to run and the @shdat@ subcommand for access to the low-level shell+ encoder. The @System.Posix.ARX@ module provides access to the routines used+ for constructing commands and environments, describing archives and building+ Bourne shell scripts.++cabal-version : >= 1.6+build-type : Simple+extra-source-files : README+ , LICENSE+ , docs/blessed/arx.man+ , docs/blessed/arx.txt+ , model-scripts/tmpx.sh+ , System/Posix/ARX/BlazeIsString.hs++source-repository head+ type : git+ location : http://github.com/solidsnack/arx.git+++flag no-cli+ description : Disable command line tool.+ default : False+++library+ build-depends : base >= 2 && <= 5+ , bytestring >= 0.9+ , containers+ , attoparsec >= 0.9.1.2+ , blaze-builder >= 0.3+ , bytestring-nums >= 0.3.3+ , file-embed >= 0.0.4.1+ , parsec >= 3.1.2+ , process >= 1.0+ , shell-escape >= 0.1.1+ , template-haskell+ , vector >= 0.9+ , vector-algorithms >= 0.5.3+ exposed-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.Tar+ System.Posix.ARX.TMPXTools+ extensions : FlexibleInstances+ FunctionalDependencies+ MultiParamTypeClasses+ OverloadedStrings+ StandaloneDeriving+ TupleSections+++executable arx+ main-is : arx.hs+ if flag(no-cli)+ buildable : False+ else+ buildable : True+ build-depends : base >= 2 && <= 5+ , bytestring >= 0.9+ , containers+ , attoparsec >= 0.9.1.2+ , blaze-builder >= 0.3+ , bytestring-nums >= 0.3.3+ , file-embed >= 0.0.4.1+ , parsec >= 3.1.2+ , process >= 1.0+ , shell-escape >= 0.1.1+ , template-haskell+ , vector >= 0.9+ , vector-algorithms >= 0.5.3+ extensions : FlexibleInstances+ FunctionalDependencies+ MultiParamTypeClasses+ OverloadedStrings+ StandaloneDeriving+ TupleSections+
+ arx.hs view
@@ -0,0 +1,31 @@+#!/usr/bin/env runhaskell+{-# LANGUAGE TemplateHaskell #-}++import Control.Applicative+import Data.ByteString (ByteString)+import qualified Data.ByteString+import System.Environment+import System.Exit+import System.IO+import System.Process++import Data.FileEmbed++import qualified System.Posix.ARX.CLI+++main :: IO ()+main = do+ helpFlag <- checkHelp+ if helpFlag then sendHelp+ else System.Posix.ARX.CLI.main+++checkHelp = any (`elem` ["-h", "-?", "--help"]) <$> getArgs+++txt = $(embedFile "./docs/blessed/arx.txt")++sendHelp = do Data.ByteString.putStr txt+ exitSuccess+
+ docs/blessed/arx.man view
@@ -0,0 +1,218 @@+.TH "ARX" "1" "2011-11-19" "0.0.0" "arx"+.SH NAME+arx \- archived execution+.+.nr rst2man-indent-level 0+.+.de1 rstReportMargin+\\$1 \\n[an-margin]+level \\n[rst2man-indent-level]+level margin: \\n[rst2man-indent\\n[rst2man-indent-level]]+-+\\n[rst2man-indent0]+\\n[rst2man-indent1]+\\n[rst2man-indent2]+..+.de1 INDENT+.\" .rstReportMargin pre:+. RS \\$1+. nr rst2man-indent\\n[rst2man-indent-level] \\n[an-margin]+. nr rst2man-indent-level +1+.\" .rstReportMargin post:+..+.de UNINDENT+. RE+.\" indent \\n[an-margin]+.\" old: \\n[rst2man-indent\\n[rst2man-indent-level]]+.nr rst2man-indent-level -1+.\" new: \\n[rst2man-indent\\n[rst2man-indent-level]]+.in \\n[rst2man-indent\\n[rst2man-indent-level]]u+..+.\" Man page generated from reStructeredText.+.+.SH SYNOPSIS+.sp+.nf+.ft C+arx ... (\-h|\-[?]|\-\-help)? ...+arx shdat (\-b <size>)? (\-o <output file>)? < input+arx shdat (\-b <size>)? (\-o <output file>)? <input file>++arx tmpx <option,archive>* (//+ <command> (//+ <option,archive>*)?)?+.ft P+.fi+.SH DESCRIPTION+.sp+The \fIarx\fP tool automates a common task in the world of operations automation:+packing code, sending it to a remote machine, unpacking in a temporary+directory, running a task therein and then removing the temporary directory.+One might do this when setting up a moderately complicated back\-up script,+installing a new version of nginx or even just to run jobs across ones+infrastructure.+.sp+The \fIarx\fP tool has no in\-built notion of remote connections or server+clusters; all automation is captured as Bourne compatible scripts that use a+small number of UNIX utilities in a broadly portable way. At present, the+utilities used are \fIsed\fP, \fItr\fP, \fIhead\fP, and \fItar\fP. The calls to \fItar\fP+sometimes use \fI\-j\fP and \fI\-z\fP; these calls to \fItar\fP may result in calls to+\fIbzip2\fP and \fIgzip\fP. Scripts have been tested with \fIdash\fP and the GNU tools as+well as the \fIsh\fP and tools that are part of \fIbusybox\fP.+.sp+The \fItmpx\fP subcommand of \fIarx\fP offers a variety of options for bundling code+and a task to run. The \fIshdat\fP subcommand exposes the lower\-level+functionality of encoding binary data in a shell script that outputs that+binary data, using HERE documents and some odd replacement rules for nulls.+.sp+Scripts generated by \fItmpx\fP and \fIshdat\fP may be fed to \fIsh\fP over \fISTDIN\fP to+execute them. This can be helpful when using \fIssh\fP and \fIsudo\fP to set up an+execution context; for example:+.sp+.nf+.ft C+arx tmpx ... | ssh user@host.com sudo sh+.ft P+.fi+.sp+For all subcommands, when options overlap in their effect \-\- for example,+setting the output with \fB\-o\fP \-\- the rightmost option takes precedence.+Whenever \fB\-h\fP, \fB\-?\fP or \fB\-\-help\fP is present on the command line, help is+displayed and the program exits.+.sp+When paths are specified on an \fBarx\fP command line, they must be qualified,+starting with \fB/\fP, \fB./\fP or \fB../\fP. This simplifies the command line+syntax, overall, without introducing troublesome ambiguities.+.SH TMPX+.sp+The \fItmpx\fP subcommand bundles together archives, environment settings and an+executable or shell command in to a Bourne\-compatible script that runs the+command or executable in a temporary directory, after having unpacked the+archives and set the environment.+.sp+Any number of file path arguments may be specified; they will be interpreted+as tar archives to include in bundled script. If no archives are specified, or+\fB\-\fP is given, then STDIN will be included.+.sp+The temporary directory created by the script is different for each+invocation, with a name of the form \fB/tmp/tmpx.<timestamp>.<pid>\fP. The+timestamp used is a UTC, ISO 8601 format timestamp. One happy consequence of+this is that earlier jobs sort ASCIIbetically before later jobs. After+execution, the temporary directory is removed (or not, depending on the+\fB\-rm[10!_]\fP family of options).+.INDENT 0.0+.INDENT 3.5+.INDENT 0.0+.TP+.B \fB\-rm0\fP, \fB\-rm1\fP, \fB\-rm_\fP, \fB\-rm!\fP+.sp+By default, the temporary directory created by the script will be deleted+no matter the exit status status of the task. These options cause a script+to be generated that deletes the temporary directory only on success, only+on failure, always (the default) or never.+.TP+.B \fB\-b <size>\fP+.sp+Please see the documentation for this option, shared with \fIshdat\fP, below.+.TP+.B \fB\-o <path>\fP+.sp+By default, the generated script is sent to STDOUT. With \fB\-o\fP, output is+redirected to the given path.+.TP+.B \fB\-e <path>\fP+.sp+Causes the file specified to be packaged as the task to be run. A binary+executable, a Ruby script or a longish shell script all fit here.+.UNINDENT+.UNINDENT+.UNINDENT+.sp+In addition to these options, arguments of the form \fBVAR=VALUE\fP are+recognized as environment mappings and stored away in the script, to be+sourced on execution.+.sp+Without \fB\-e\fP, the \fItmpx\fP subcommand tries to find the task to be run as a+sequence of arguments delimited by a run of slashes. The following forms are+all recognized:+.sp+.nf+.ft C+arx tmpx ...some args... // ...command...+arx tmpx ...some args... // ...command... // ...more args...+arx tmpx // ...command... // ...some args...+.ft P+.fi+.sp+The slash runs must have the same number of slashes and must be the longest+continuous runs of slashes on the command line. The command will be included+as is in a Bourne shell script.+.SH SHDAT+.sp+The \fIshdat\fP subcommand translates binary data in to a shell script which+outputs the binary data. The data is encoded in HERE documents in such a way+that data without NULs is not changed and that data with NULs is minimally+expanded: about 1% for randomish data like compressed tarballs and about 10%+in pathological cases.+.sp+The \fIshdat\fP subcommand can be given any number of paths, which will be+concatenated in the order given. If no path is given, or if \fB\-\fP is given,+then STDIN will be read.+.INDENT 0.0+.INDENT 3.5+.INDENT 0.0+.TP+.B \fB\-b <size>\fP+.sp+The size of data chunks to place in each HERE document. The argument is a+positive integer followed by suffixes like \fBB\fP, \fBK\fP, \fBKiB\fP, \fBM\fP+and \fBMiB\fP, in the manner of \fBdd\fP, \fBhead\fP and many other tools. The+default is 4MiB. This is unlikely to make a difference for you unless the+generated script is intended to be run on a memory\-constrained system.+.TP+.B \fB\-o <path>\fP+.sp+By default, the generated script is sent to STDOUT. With \fB\-o\fP, output is+redirected to the given path.+.UNINDENT+.UNINDENT+.UNINDENT+.SH EXAMPLES+.sp+.nf+.ft C+# Installer script that preserves failed builds.+git archive HEAD | bzip2 | arx tmpx \-rm0 // make install > go.sh+# Now install as root; but don\(aqt log in as root.+cat ./go.sh | ssh joey@hostname sudo /bin/sh++# Variation of the above.+git archive HEAD | bzip2 | arx tmpx \-rm0 \-e ./build\-script.py++# Bundle an instance of an application with DB credentials and run it.+arx tmpx \-rm! ./app.tbz ./stage\-info.tgz // rake start | ssh ...++# Get dump of linking info for build that works here but not there.+arx tmpx ./server\-build.tgz LD_DEBUG=files // ./bin/start | ssh ...++# Test out Cabal source distribution of this package:+arx tmpx // \(aqcd arx\-* && cabal configure && cabal build\(aq // \e+ \-rm0 ./dist/arx\-0.0.0.tar.gz | sh+.ft P+.fi+.SH BUGS+.sp+The command line parser offers no hints or help of any kind; it fails with the+simple message "argument error". The two most common mistakes I make are:+.INDENT 0.0+.IP \(bu 2+.+Not qualifying paths with \fB/\fP, \fB./\fP or \fB../\fP.+.IP \(bu 2+.+Not specifying a subcommand (\fItmpx\fP or \fIshdat\fP).+.UNINDENT+.SH AUTHOR+Jason Dusek+.SH COPYRIGHT+2011, Jason Dusek+.\" Generated by docutils manpage writer.+.\" +.
+ docs/blessed/arx.txt view
@@ -0,0 +1,153 @@+SYNOPSIS+ arx ... (-h|-[?]|--help)? ...+ arx shdat (-b <size>)? (-o <output file>)? < input+ arx shdat (-b <size>)? (-o <output file>)? <input file>++ arx tmpx <option,archive>* (//+ <command> (//+ <option,archive>*)?)?++DESCRIPTION+ The arx tool automates a common task in the world of operations automa‐+ tion: packing code, sending it to a remote machine, unpacking in a tem‐+ porary directory, running a task therein and then removing the tempo‐+ rary directory. One might do this when setting up a moderately compli‐+ cated back-up script, installing a new version of nginx or even just to+ run jobs across ones infrastructure.++ The arx tool has no in-built notion of remote connections or server+ clusters; all automation is captured as Bourne compatible scripts that+ use a small number of UNIX utilities in a broadly portable way. At+ present, the utilities used are sed, tr, head, and tar. The calls to+ tar sometimes use -j and -z; these calls to tar may result in calls to+ bzip2 and gzip. Scripts have been tested with dash and the GNU tools as+ well as the sh and tools that are part of busybox.++ The tmpx subcommand of arx offers a variety of options for bundling+ code and a task to run. The shdat subcommand exposes the lower-level+ functionality of encoding binary data in a shell script that outputs+ that binary data, using HERE documents and some odd replacement rules+ for nulls.++ Scripts generated by tmpx and shdat may be fed to sh over STDIN to exe‐+ cute them. This can be helpful when using ssh and sudo to set up an+ execution context; for example:++ arx tmpx ... | ssh user@host.com sudo sh++ For all subcommands, when options overlap in their effect -- for exam‐+ ple, setting the output with -o -- the rightmost option takes prece‐+ dence. Whenever -h, -? or --help is present on the command line, help+ is displayed and the program exits.++ When paths are specified on an arx command line, they must be quali‐+ fied, starting with /, ./ or ../. This simplifies the command line syn‐+ tax, overall, without introducing troublesome ambiguities.++TMPX+ The tmpx subcommand bundles together archives, environment settings and+ an executable or shell command in to a Bourne-compatible script that+ runs the command or executable in a temporary directory, after having+ unpacked the archives and set the environment.++ Any number of file path arguments may be specified; they will be inter‐+ preted as tar archives to include in bundled script. If no archives are+ specified, or - is given, then STDIN will be included.++ The temporary directory created by the script is different for each+ invocation, with a name of the form /tmp/tmpx.<timestamp>.<pid>. The+ timestamp used is a UTC, ISO 8601 format timestamp. One happy conse‐+ quence of this is that earlier jobs sort ASCIIbetically before later+ jobs. After execution, the temporary directory is removed (or not,+ depending on the -rm[10!_] family of options).++ -rm0, -rm1, -rm_, -rm!++ By default, the temporary directory created by the script+ will be deleted no matter the exit status status of the task.+ These options cause a script to be generated that deletes the+ temporary directory only on success, only on failure, always+ (the default) or never.++ -b <size>++ Please see the documentation for this option, shared with+ shdat, below.++ -o <path>++ By default, the generated script is sent to STDOUT. With -o,+ output is redirected to the given path.++ -e <path>++ Causes the file specified to be packaged as the task to be+ run. A binary executable, a Ruby script or a longish shell+ script all fit here.++ In addition to these options, arguments of the form VAR=VALUE are rec‐+ ognized as environment mappings and stored away in the script, to be+ sourced on execution.++ Without -e, the tmpx subcommand tries to find the task to be run as a+ sequence of arguments delimited by a run of slashes. The following+ forms are all recognized:++ arx tmpx ...some args... // ...command...+ arx tmpx ...some args... // ...command... // ...more args...+ arx tmpx // ...command... // ...some args...++ The slash runs must have the same number of slashes and must be the+ longest continuous runs of slashes on the command line. The command+ will be included as is in a Bourne shell script.++SHDAT+ The shdat subcommand translates binary data in to a shell script which+ outputs the binary data. The data is encoded in HERE documents in such+ a way that data without NULs is not changed and that data with NULs is+ minimally expanded: about 1% for randomish data like compressed tar‐+ balls and about 10% in pathological cases.++ The shdat subcommand can be given any number of paths, which will be+ concatenated in the order given. If no path is given, or if - is given,+ then STDIN will be read.++ -b <size>++ The size of data chunks to place in each HERE document. The+ argument is a positive integer followed by suffixes like B,+ K, KiB, M and MiB, in the manner of dd, head and many other+ tools. The default is 4MiB. This is unlikely to make a dif‐+ ference for you unless the generated script is intended to be+ run on a memory-constrained system.++ -o <path>++ By default, the generated script is sent to STDOUT. With -o,+ output is redirected to the given path.++EXAMPLES+ # Installer script that preserves failed builds.+ git archive HEAD | bzip2 | arx tmpx -rm0 // make install > go.sh+ # Now install as root; but don't log in as root.+ cat ./go.sh | ssh joey@hostname sudo /bin/sh++ # Variation of the above.+ git archive HEAD | bzip2 | arx tmpx -rm0 -e ./build-script.py++ # Bundle an instance of an application with DB credentials and run it.+ arx tmpx -rm! ./app.tbz ./stage-info.tgz // rake start | ssh ...++ # Get dump of linking info for build that works here but not there.+ arx tmpx ./server-build.tgz LD_DEBUG=files // ./bin/start | ssh ...++ # Test out Cabal source distribution of this package:+ arx tmpx // 'cd arx-* && cabal configure && cabal build' // \+ -rm0 ./dist/arx-0.0.0.tar.gz | sh++BUGS+ The command line parser offers no hints or help of any kind; it fails+ with the simple message "argument error". The two most common mistakes+ I make are:++ · Not qualifying paths with /, ./ or ../.++ · Not specifying a subcommand (tmpx or shdat).+
+ model-scripts/tmpx.sh view
@@ -0,0 +1,50 @@+#!/bin/sh+set -e -u+unset rm_ dir+tmp=true ; run=true+rm0=true ; rm1=true # To be set by tool.+for arg in "$@"+do+ case "$arg" in+ --no-rm) rm_=false ;;+ --no-run) run=false ;;+ --extract) rm_=false ; tmp=false ; run=false ;;+ esac+done+if $tmp+then+ dir=/tmp/tmpx.`date -u +%FT%TZ`.$$+ rm -rf $dir+ : ${rm_:=true}+ if $rm_+ then+ trap "case \$?/$rm0/$rm1 in+ 0/true/*) rm -rf $dir ;;+ [1-9]*/*/true) rm -rf $dir ;;+ esac" EXIT+ trap "exit 2" HUP INT QUIT BUS SEGV PIPE TERM+ fi+ mkdir $dir+ cd $dir+fi+go () {+ unpack_env > ./env+ unpack_run > ./run ; chmod ug+x ./run+ mkdir dat+ cd dat+ unpack_dat+ if $run+ then+ ( . ../env && ../run )+ fi+}+unpack_env () { : # NOOP+ # To be set by tool.+}+unpack_run () { : # NOOP+ # To be set by tool.+}+unpack_dat () { : # NOOP+ # To be set by tool.+}+go