diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. + diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,153 @@ +SYNOPSIS + arx ... (-h|-[?]|--help)? ... + arx shdat (-b )? (-o )? < input + arx shdat (-b )? (-o )? + + arx tmpx * (//+ (//+ *)?)? + +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... 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 + + Please see the documentation for this option, shared with + shdat, below. + + -o + + By default, the generated script is sent to STDOUT. With -o, + output is redirected to the given path. + + -e + + 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 + + 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 + + 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). + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,4 @@ +import Distribution.Simple + +main = defaultMain + diff --git a/System/Posix/ARX.hs b/System/Posix/ARX.hs new file mode 100644 --- /dev/null +++ b/System/Posix/ARX.hs @@ -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 + diff --git a/System/Posix/ARX/BlazeIsString.hs b/System/Posix/ARX/BlazeIsString.hs new file mode 100644 --- /dev/null +++ b/System/Posix/ARX/BlazeIsString.hs @@ -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 + diff --git a/System/Posix/ARX/CLI.hs b/System/Posix/ARX/CLI.hs new file mode 100644 --- /dev/null +++ b/System/Posix/ARX/CLI.hs @@ -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 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 + diff --git a/System/Posix/ARX/CLI/CLTokens.hs b/System/Posix/ARX/CLI/CLTokens.hs new file mode 100644 --- /dev/null +++ b/System/Posix/ARX/CLI/CLTokens.hs @@ -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 + -- @=@. 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 + diff --git a/System/Posix/ARX/CLI/Options.hs b/System/Posix/ARX/CLI/Options.hs new file mode 100644 --- /dev/null +++ b/System/Posix/ARX/CLI/Options.hs @@ -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 + diff --git a/System/Posix/ARX/HEREDat.hs b/System/Posix/ARX/HEREDat.hs new file mode 100644 --- /dev/null +++ b/System/Posix/ARX/HEREDat.hs @@ -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. + -} + diff --git a/System/Posix/ARX/Programs.hs b/System/Posix/ARX/Programs.hs new file mode 100644 --- /dev/null +++ b/System/Posix/ARX/Programs.hs @@ -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 + diff --git a/System/Posix/ARX/Sh.hs b/System/Posix/ARX/Sh.hs new file mode 100644 --- /dev/null +++ b/System/Posix/ARX/Sh.hs @@ -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 + diff --git a/System/Posix/ARX/TMPXTools.hs b/System/Posix/ARX/TMPXTools.hs new file mode 100644 --- /dev/null +++ b/System/Posix/ARX/TMPXTools.hs @@ -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 + diff --git a/System/Posix/ARX/Tar.hs b/System/Posix/ARX/Tar.hs new file mode 100644 --- /dev/null +++ b/System/Posix/ARX/Tar.hs @@ -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 + diff --git a/arx.cabal b/arx.cabal new file mode 100644 --- /dev/null +++ b/arx.cabal @@ -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 + diff --git a/arx.hs b/arx.hs new file mode 100644 --- /dev/null +++ b/arx.hs @@ -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 + diff --git a/docs/blessed/arx.man b/docs/blessed/arx.man new file mode 100644 --- /dev/null +++ b/docs/blessed/arx.man @@ -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 )? (\-o )? < input +arx shdat (\-b )? (\-o )? + +arx tmpx * (//+ (//+ *)?)? +.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..\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 \fP +.sp +Please see the documentation for this option, shared with \fIshdat\fP, below. +.TP +.B \fB\-o \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 \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 \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 \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. +.\" +. diff --git a/docs/blessed/arx.txt b/docs/blessed/arx.txt new file mode 100644 --- /dev/null +++ b/docs/blessed/arx.txt @@ -0,0 +1,153 @@ +SYNOPSIS + arx ... (-h|-[?]|--help)? ... + arx shdat (-b )? (-o )? < input + arx shdat (-b )? (-o )? + + arx tmpx * (//+ (//+ *)?)? + +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... 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 + + Please see the documentation for this option, shared with + shdat, below. + + -o + + By default, the generated script is sent to STDOUT. With -o, + output is redirected to the given path. + + -e + + 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 + + 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 + + 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). + diff --git a/model-scripts/tmpx.sh b/model-scripts/tmpx.sh new file mode 100644 --- /dev/null +++ b/model-scripts/tmpx.sh @@ -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