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/Language/Bash.hs b/Language/Bash.hs new file mode 100644 --- /dev/null +++ b/Language/Bash.hs @@ -0,0 +1,38 @@ +{-| Types and functions for generation of Bash scripts, with safe escaping + and composition of a large subset of Bash statements and expressions. + + This module is meant to be imported qualified -- perhaps as @Bash@ -- and + contains everything you need to build and render Bash scripts. For + examples of usage, look at "Language.Bash.Lib". + + -} +module Language.Bash + ( Language.Bash.Syntax.Statement(..) + , Language.Bash.Syntax.Annotated(..) + , Language.Bash.Syntax.Expression(..) + , Language.Bash.Syntax.literal + , Language.Bash.Syntax.Identifier() + , Language.Bash.Syntax.identifier + , Language.Bash.Syntax.SpecialVar() + , Language.Bash.Syntax.specialVar + , Language.Bash.Syntax.Redirection(..) + , Language.Bash.Syntax.FileDescriptor(..) + , Language.Bash.PrettyPrinter.PP(..) + , Language.Bash.PrettyPrinter.bytes + , Language.Bash.PrettyPrinter.builder + , Language.Bash.PrettyPrinter.State.PPState() + , Language.Bash.PrettyPrinter.State.render + , Language.Bash.PrettyPrinter.State.nlCol + , Language.Bash.Script.script + , Language.Bash.Script.script_sha1 + , module Language.Bash.Annotations + , module Language.Bash.Lib + ) where + +import Language.Bash.Syntax +import Language.Bash.PrettyPrinter +import Language.Bash.PrettyPrinter.State +import Language.Bash.Annotations +import Language.Bash.Script +import Language.Bash.Lib + diff --git a/Language/Bash/Annotations.hs b/Language/Bash/Annotations.hs new file mode 100644 --- /dev/null +++ b/Language/Bash/Annotations.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE OverloadedStrings + , StandaloneDeriving + #-} +{-| Some convenient annotations for Bash scripts, provided with example + pretty printer typeclass instances. + -} +module Language.Bash.Annotations where + +import Control.Monad +import Data.ByteString.Char8 + +import Language.Bash.Syntax (Statement(..)) +import Language.Bash.PrettyPrinter (PP(..), Annotation(..)) +import Language.Bash.PrettyPrinter.State + + +{-| Append some raw lines, in flow, above and below a statement. + -} +data Lines = Lines [ByteString] + [ByteString] +deriving instance Eq Lines +deriving instance Ord Lines +deriving instance Show Lines +instance Annotation Lines where + annotate (Lines above below) stmt = do unlines above + pp stmt + when ([] /= below) + (nl >> unlines below) + where + unlines = mapM_ (\x -> word x >> nl) + + +{-| Annotate a statement with statements of different types, with special + rules for empty 'NoOp' statements -- as long as the 'ByteString' + \"comment\" in the 'NoOp' is empty, the 'NoOp' is simply elided. + -} +data Statements a b = Statements (Statement a) + (Statement b) +deriving instance (Eq a, Eq b) => Eq (Statements a b) +deriving instance (Ord a, Ord b) => Ord (Statements a b) +deriving instance (Show a, Show b) => Show (Statements a b) +instance (Annotation a, Annotation b) => Annotation (Statements a b) where + annotate (Statements above below) stmt = pp' above >> pp' stmt >> pp' below + where + pp' (NoOp b) | b == "" = return () + pp' x = pp x + + +instance (PP t, PP t') => Annotation (t, t') where + annotate (above, below) stmt = pp above >> pp stmt >> pp below + diff --git a/Language/Bash/Lib.hs b/Language/Bash/Lib.hs new file mode 100644 --- /dev/null +++ b/Language/Bash/Lib.hs @@ -0,0 +1,69 @@ +{-# LANGUAGE OverloadedStrings + , NoMonomorphismRestriction + #-} +{-| Shortcuts for Bash generation that also demonstrate use of the library. + -} +module Language.Bash.Lib where + +import Data.Monoid +import Data.ByteString.Char8 (ByteString, pack) + +import Language.Bash.Syntax + + +{-| Create a simple command from expressions. + -} +cmd :: Expression t -> [Expression t] -> Statement t +cmd expr exprs = SimpleCommand expr exprs + + +{-| Declare or assign an array to a @sed@ command line that will use extended + regular expressions, checking for GNU or BSD @sed@. The 'Bool' argument + determines whether to insert the declaration or not. + -} +esed :: (Monoid m) => Identifier -> Bool -> Annotated m +esed ident d | not d = setGNUorBSD + | otherwise = ann_ (Sequence decl setGNUorBSD) + where + [sed, fgrep, decl, setr, setE, checkGNU, setGNUorBSD] = fmap ann_ + [ cmd "sed" ["--version"] + , cmd "fgrep" ["-q", "GNU"] + , ArrayDecl ident [] + , ArrayAssign ident ["sed", "-r"] + , ArrayAssign ident ["sed", "-E"] + , Pipe sed fgrep + , IfThenElse checkGNU setr setE ] + + +{-| Perform a statement for integer values ranging from the first integral + parameter to the second, using @seq@. + -} +for + :: (Monoid m, Integral i) + => Identifier -> i -> i -> Annotated m -> Statement m +for ident a z ann = For ident [EvalUnquoted (ann_ (seqAZ a z))] ann + + +{-| Evaluate @seq@ for the given arguments. + -} +seqAZ :: (Integral i) => i -> i -> Statement t +seqAZ a z = SimpleCommand "seq" [lshow a, lshow z] + where + lshow = literal . pack . show + + +{-| A set statement that covers a few error handling options, setting + @errexit@, @nounset@ and @pipefail@. + -} +setSafe :: Statement t +setSafe = SimpleCommand "set" [ "-o", "errexit" + , "-o", "nounset" + , "-o", "pipefail" ] + + +{-| Annotate a statement with the 0 value of a monoid. + -} +ann_ :: (Monoid m) => Statement m -> Annotated m +ann_ = Annotated mempty + + diff --git a/Language/Bash/PrettyPrinter.hs b/Language/Bash/PrettyPrinter.hs new file mode 100644 --- /dev/null +++ b/Language/Bash/PrettyPrinter.hs @@ -0,0 +1,204 @@ +{-# LANGUAGE OverloadedStrings + , StandaloneDeriving + , RecordWildCards + , NamedFieldPuns + , NoMonomorphismRestriction + , GeneralizedNewtypeDeriving + , UndecidableInstances + #-} +{-| Pretty printer for Bash. + -} +module Language.Bash.PrettyPrinter where + +import qualified Data.List as List +import Data.Word (Word8) +import Data.ByteString.Char8 +import Data.Binary.Builder (Builder) +import Prelude hiding (concat, length, replicate, lines, drop, null) +import Control.Monad.State.Strict + +import qualified Text.ShellEscape as Esc + +import Language.Bash.Syntax +import Language.Bash.PrettyPrinter.State + + +bytes :: (PP t) => t -> ByteString +bytes = renderBytes (nlCol 0) . pp + +builder :: (PP t) => t -> Builder +builder = render (nlCol 0) . pp + +bytes_state = renderBytes (nlCol 0) + + +class Annotation t where + annotate :: t -> Statement t -> State PPState () +instance Annotation () where + annotate _ stmt = pp stmt + +class PP t where + pp :: t -> State PPState () +instance PP Identifier where + pp (Identifier b) = word b +instance PP SpecialVar where + pp = word . specialVarBytes +instance PP FileDescriptor where + pp (FileDescriptor w) = (word . pack . show) w +instance (Annotation t) => PP (Expression t) where + pp (Literal lit) = word (Esc.bytes lit) + pp Asterisk = word "*" + pp QuestionMark = word "?" + pp (ReadVar var) = (word . quote . ('$' `cons`) . identpart) var + pp (ReadVarSafe var) = (word . quote . braces0 . identpart) var + pp (ReadArray ident expr) = (word . braces) + (bytes ident `append` brackets (bytes expr)) + pp (ReadArraySafe ident expr) = (word . braces0) + (bytes ident `append` brackets (bytes expr)) + -- Examples that all work for nasty arguments containing brackets: + -- echo "${array[$1]}" + -- echo "${array["$1"]}" + -- echo "${array["$1""$2"]}" + -- Looks like we can get away with murder here. + pp (ARGVElements) = word "\"$@\"" + pp (ARGVLength) = word "$#" + pp (Elements ident) = (word . quote . braces) + (bytes ident `append` "[@]") + pp (Length ident) = (word . quote . braces) + ('#' `cons` identpart ident) + pp (ArrayLength ident) = (word . quote . braces) + ('#' `cons` bytes ident `append` "[@]") + pp (Concat expr0 expr1) = wordcat [bytes expr0, bytes expr1] + pp (Eval ann) = inlineEvalPrinter "\"$(" ")\"" ann + pp (EvalUnquoted ann) = inlineEvalPrinter "$(" ")" ann + pp (ProcessIn ann) = inlineEvalPrinter "<(" ")" ann + pp (ProcessOut ann) = inlineEvalPrinter ">(" ")" ann +instance (Annotation t) => PP (Annotated t) where + pp (Annotated t stmt) = annotate t stmt +instance (Annotation t) => PP (Statement t) where + pp term = case term of + SimpleCommand cmd args -> do hangMultiline cmd + mapM_ breakline args + outdent + NoOp msg | null msg -> word ":" + | otherwise -> word ":" >> (word . Esc.bytes . Esc.bash) msg + Bang t -> hang "!" >> binGrp t >> outdent + AndAnd t t' -> binGrp t >> word "&&" >> nl >> binGrp t' + OrOr t t' -> binGrp t >> word "||" >> nl >> binGrp t' + Pipe t t' -> binGrp t >> word "|" >> nl >> binGrp t' + Sequence t t' -> pp t >> nl >> pp t' + Background t t' -> binGrp t >> word "&" >> nl >> pp t' + Group t -> curlyOpen >> pp t >> curlyClose >> outdent + Subshell t -> roundOpen >> pp t >> roundClose >> outdent + Function ident t -> do wordcat ["function ", bytes ident] + inword " {" >> pp t >> outword "}" + IfThen t t' -> do hang "if" >> pp t >> outdent >> nl + inword "then" >> pp t' >> outword "fi" + IfThenElse t t' t'' -> do hang "if" >> pp t >> outdent >> nl + inword "then" >> pp t' >> outdent + nl + inword "else" >> pp t'' + outword "fi" + For var vals t -> do hang (concat ["for ", bytes var, " in"]) + mapM_ breakline vals + outdent >> nl + inword "do" >> pp t >> outword "done" + Case expr cases -> do word "case" >> pp expr >> inword "in" + mapM_ case_clause cases + outword "esac" + While t t' -> do hang "while" >> pp t >> outdent >> nl + inword "do" >> pp t' >> outword "done" + Until t t' -> do hang "until" >> pp t >> outdent >> nl + inword "do" >> pp t' >> outword "done" +-- BraceBrace _ -> error "[[ ]]" + VarAssign var val -> pp var >> word "=" >> pp val + ArrayDecl var exprs -> do hangcat ["declare -a ", bytes var, "=("] + array_pp pp exprs >> word ")" + nl >> outdent + ArrayUpdate var key val -> pp (DictUpdate var key val) + ArrayAssign var exprs -> do hangcat [bytes var, "=("] + array_pp pp exprs >> word ")" + nl >> outdent + DictDecl var pairs -> do hangcat ["declare -A ", bytes var, "=("] + array_pp keyset pairs >> word ")" + nl >> outdent + DictUpdate var key val -> do hangcat [bytes var, "[", bytes key, "]="] + pp val >> outdent + DictAssign var pairs -> do hangcat [bytes var, "=("] + array_pp keyset pairs + nl >> outdent >> word ")" + Redirect stmt d fd t -> do redirectGrp stmt + word (render_redirect d fd t) + +hangcat = hang . concat + +array_pp ppF [ ] = return () +array_pp ppF (h:t) = ppF h >> mapM_ ppFNL t + where + ppFNL x = nl >> ppF x + +keyset (key, val) = word "[" >> pp key >> word "]=" >> pp val + +case_clause (ptrn, stmt) = do hang (bytes ptrn `append` ") ") + pp stmt >> word ";;" >> outdent >> nl + +render_redirect direction fd target = + concat [ bytes fd, case direction of In -> "<" + Out -> ">" + Append -> ">>" + , case target of Left expr -> bytes expr + Right fd' -> '&' `cons` bytes fd' ] + +quote b = '"' `cons` b `snoc` '"' + +braces b = "${" `append` b `snoc` '}' + +braces0 b = "${" `append` b `append` ":-}" + +brackets b = '[' `cons` b `snoc` ']' + +identpart (Left special) = (drop 1 . bytes) special +identpart (Right ident) = bytes ident + +binGrp a@(Annotated _ stmt) = case stmt of + Bang _ -> curlyOpen >> pp a >> curlyClose + AndAnd _ _ -> curlyOpen >> pp a >> curlyClose + OrOr _ _ -> curlyOpen >> pp a >> curlyClose + Pipe _ _ -> curlyOpen >> pp a >> curlyClose + Sequence _ _ -> curlyOpen >> pp a >> curlyClose + Background _ _ -> curlyOpen >> pp a >> curlyClose + _ -> pp a + +redirectGrp a@(Annotated _ stmt) = case stmt of + Redirect _ _ _ _ -> curlyOpen >> pp a >> curlyClose + _ -> binGrp a + +breakline :: (PP t) => t -> State PPState () +breakline printable = do + PPState{..} <- get + when (columns + maxLineLength printed + 1 > 79 && columns /= sum indents) + (opM [Word "\\", Newline]) + pp printable + where + printed = bytes printable + +hangMultiline printable = do + pp printable + opM [Indent (finalLineLength printed + 1)] + where + printed = bytes printable + +maxLineLength = fromIntegral . List.foldl' max 0 . fmap length . lines + +finalLineLength b = case lines b of + [ ] -> 0 + h:t -> (fromIntegral . length . List.last) (h:t) + +inlineEvalPrinter open close ann = do + indentPadToNextWord + hang open + pp ann + word close + outdent >> outdent + + diff --git a/Language/Bash/PrettyPrinter/State.hs b/Language/Bash/PrettyPrinter/State.hs new file mode 100644 --- /dev/null +++ b/Language/Bash/PrettyPrinter/State.hs @@ -0,0 +1,126 @@ +{-# LANGUAGE OverloadedStrings + , RecordWildCards + , NamedFieldPuns + , NoMonomorphismRestriction + #-} +{-| Pretty printer state, used within a state monad computation. + -} +module Language.Bash.PrettyPrinter.State where + +import qualified Data.List as List +import Data.Monoid +import Prelude hiding (lines, round, concat, length, replicate) +import Data.Binary.Builder (Builder, toLazyByteString) +import qualified Data.Binary.Builder as Builder +import Data.ByteString.Char8 hiding (null) +import Data.ByteString.Lazy (toChunks) +import Data.Word +import Control.Monad.State.Strict + + +{-| State of pretty printing -- string being built, indent levels, present + column, brace nesting. + -} +data PPState = PPState { indents :: [Word] + , curly :: [()] + , round :: [()] + , columns :: Word + , string :: Builder } +instance Show PPState where + show PPState{..} = "PPState { indents=" ++ show indents + ++ " curly=" ++ show curly + ++ " round=" ++ show round + ++ " columns=" ++ show columns + ++ " string=" ++ "..." ++ " }" + +{-| Produce a builder from a pretty printer state computation. + -} +render :: PPState -> State PPState () -> Builder +render init computation = string $ execState computation init + +renderBytes :: PPState -> State PPState () -> ByteString +renderBytes = ((concat . toChunks . toLazyByteString) .) . render + +{-| Pretty printer state starting on a new line indented to the given column. + -} +nlCol :: Word -> PPState +nlCol w = PPState [w] [()] [()] 0 Builder.empty + + +{-| Operations we can perform while pretty printing. + -} +data PPOp = Indent Word -- ^ Indent by N spaces. + | Outdent -- ^ Remove and indentation level. + | Word ByteString -- ^ Add a word to a line. + | Newline -- ^ Move to newline. + | Curly Bool -- ^ Introduce a level of braces. + | Round Bool -- ^ Introduce a level of parens. + + +{-| Apply an operation to a state. + -} +op :: PPState -> PPOp -> PPState +op state@PPState{..} x = case x of + Indent w -> state { indents = w:indents } + Outdent -> state { indents = tSafe indents } + Curly f | f -> state { indents = 2:indents, curly = ():curly + , string = curly_s, columns = columns+2 } + | otherwise -> state { indents = tSafe indents + , curly = tSafe curly, string = s_curly } + Round f | f -> state { indents = 2:indents, round = ():round + , string = round_s, columns = columns+2 } + | otherwise -> state { indents = tSafe indents + , round = tSafe round, string = s_round } + Newline | columns == 0 -> state + | otherwise -> state { string = sNL, columns = 0 } + Word b -> state { string = s', columns = c' } + where + c' = columns + cast (length padded) + s' = string `mappend` Builder.fromByteString padded + dent = cast (sum indents) + padded | columns == 0 = replicate dent ' ' `append` b + | otherwise = ' ' `cons` b + where + tSafe list = if null list then [] else List.tail list + sNL = string `mappend` Builder.fromByteString "\n" + curly_s = Builder.fromByteString "{" `mappend` string + s_curly = string `mappend` Builder.fromByteString " ;}" + round_s = Builder.fromByteString "(" `mappend` string + s_round = string `mappend` Builder.fromByteString " )" + +opM :: [PPOp] -> State PPState () +opM = mapM_ (modify . flip op) + +nl :: State PPState () +nl = opM [Newline] +hang :: ByteString -> State PPState () +hang b = opM [Word b, Indent (cast (length b) + 1)] +word :: ByteString -> State PPState () +word b = opM [Word b] +wordcat :: [ByteString] -> State PPState () +wordcat = word . concat +outdent :: State PPState () +outdent = opM [Outdent] +inword :: ByteString -> State PPState () +inword b = opM [Word b, Indent 2, Newline] +outword :: ByteString -> State PPState () +outword b = opM [Newline, Outdent, Word b] +curlyOpen :: State PPState () +curlyOpen = opM [Curly True] +curlyClose :: State PPState () +curlyClose = opM [Curly False] +roundOpen :: State PPState () +roundOpen = opM [Round True] +roundClose :: State PPState () +roundClose = opM [Round False] +indentPadToNextWord :: State PPState () +indentPadToNextWord = do + PPState{..} <- get + let x = sum indents + columns' = columns + 1 + indent | columns' > x = columns' - x + | otherwise = 0 + opM [Indent indent] + +cast = fromIntegral + diff --git a/Language/Bash/Script.hs b/Language/Bash/Script.hs new file mode 100644 --- /dev/null +++ b/Language/Bash/Script.hs @@ -0,0 +1,108 @@ +{-# LANGUAGE OverloadedStrings + , ScopedTypeVariables + #-} +{-| Utilities for turning statements into full scripts. + -} +module Language.Bash.Script where + +import Data.Binary.Builder (Builder, fromByteString) +import Data.ByteString.Char8 (ByteString, append) +import qualified Data.ByteString.Char8 +import qualified Data.ByteString.Lazy +import Data.Foldable +import Data.Monoid + +import qualified Data.Digest.Pure.SHA + +import Language.Bash.Syntax +import Language.Bash.Lib +import Language.Bash.Annotations +import Language.Bash.PrettyPrinter +import Language.Bash.PrettyPrinter.State + + +{-| Produce a script beginning with @#!\/bin\/bash@ and a safe set statement. + -} +script :: (Annotation t) => Statement t -> Builder +script statement = mconcat [ fromByteString "#!/bin/bash\n" + , builder (setSafe :: Statement ()) + , fromByteString "\n\n" + , builder statement ] + + +{-| Produce a script beginning with @#!\/bin\/bash@ and some (optional) + documentation. Cause the script to be scanned for SHA-1 hash of the setup + (first statement argument) and main (second statement argument) before + running the safe set statement and running the second argument. + -} +script_sha1 + :: forall t t'. (Annotation t, Annotation t') + => ByteString -> Statement t -> Statement t' -> Builder +script_sha1 docs setup main = mconcat [ fromByteString "#!/bin/bash\n\n" + , remarks + , fromByteString "######## Setup." + , fromByteString "\n\n" + , fromByteString setup' + , fromByteString "\n\n" + , fromByteString "######## Main." + , fromByteString "\n\n" + , builder tokenCheck' ] + where + setup' = bytes setup + main' = bytes main + mainSafe = Sequence (dance setSafe) (dance main) + token = sha1 (append setup' main') + tokenCheck' :: Statement (Statements (Statements t' ()) ()) + tokenCheck' = tokenCheck token mainSafe + remarks | docs == mempty = fromByteString "" + | otherwise = fromByteString (docs `mappend` "\n\n") + + +{-| Scan @$0@ for the token before running, producing a statement annotated + with the initial statement. This is a bit clumsy but is used internally. + -} +tokenCheck :: ByteString -> Statement t -> Statement (Statements t t') +tokenCheck token stmt = + IfThen (Annotated (Statements noop noop) (tokenFGREPq token)) + (dance stmt) + +{-| Scan @$0@ for the token before running, correctly producing monoidal + annotations. The function argument provides an annotation for the @fgrep@ + check generated to search for the token. (@const mempty@ would be + appropriate in most cases.) + -} +mtokenCheck :: (Monoid t) => ByteString + -> (Statement t -> t) -> Statement t + -> Statement t +mtokenCheck token f statement = IfThen (Annotated (f check) check) + (Annotated (fold statement) statement) + where + check = tokenFGREPq token + +tokenFGREPq :: ByteString -> Statement t +tokenFGREPq token + = SimpleCommand "fgrep" ["-q", literal token, ReadVar (Left Dollar0)] + +{-| Scan @$0@ the SHA1 of the statement before running. + -} +sha1Check :: (Annotation t, Annotation t') + => Statement t -> Statement (Statements t t') +sha1Check stmt = tokenCheck ((sha1 . bytes) stmt) stmt + + +sha1 :: ByteString -> ByteString +sha1 = Data.ByteString.Char8.pack + . Data.Digest.Pure.SHA.showDigest + . Data.Digest.Pure.SHA.sha1 + . Data.ByteString.Lazy.fromChunks + . (:[]) + +{-| The noop dance -- annotate a 'NoOp' with a statement, essentially as a + type coercion. + -} +dance :: Statement t -> Annotated (Statements t t') +dance stmt = Annotated (Statements stmt noop) noop + +noop :: Statement any +noop = NoOp "" + diff --git a/Language/Bash/Syntax.hs b/Language/Bash/Syntax.hs new file mode 100644 --- /dev/null +++ b/Language/Bash/Syntax.hs @@ -0,0 +1,339 @@ +{-# LANGUAGE EmptyDataDecls + , OverloadedStrings + , StandaloneDeriving + , GeneralizedNewtypeDeriving + , NoMonomorphismRestriction + #-} +{-| Bash statements and expressions. The statement tree is a functor, + supporting arbitrary annotations; this is intended to support analysis of + effects and privilege levels as well as commenting and arbitrary code + inclusion. + -} +module Language.Bash.Syntax where + +import Prelude hiding (all) +import Control.Arrow ((***)) +import Data.Char +import Data.String +import Data.Maybe +import Data.Word (Word8) +import Data.ByteString.Char8 +import Data.Foldable hiding (all) +import Data.Monoid + +import qualified Text.ShellEscape as Esc + + +{-| The 'Annotated' type captures the annotatedness of a tree of Bash + statements. It is 'Foldable' and a 'Functor'. + -} +data Annotated t = Annotated { annotation :: t + , statement :: Statement t } +deriving instance (Eq t) => Eq (Annotated t) +deriving instance (Ord t) => Ord (Annotated t) +deriving instance (Show t) => Show (Annotated t) +instance Functor Annotated where + fmap f (Annotated t stmt) = Annotated (f t) (fmap f stmt) +instance Foldable Annotated where + foldMap f (Annotated t stmt) = f t `mappend` foldMap f stmt + +{-| The 'Statement' type captures the different kind of statements that may + exist in a Bash statement tree. It is mutually recursive with 'Annotated'. + It is a 'Foldable' and a 'Functor'. + -} +data Statement t + = SimpleCommand (Expression t) [Expression t] + | NoOp ByteString + | Bang (Annotated t) + | AndAnd (Annotated t) (Annotated t) + | OrOr (Annotated t) (Annotated t) + | Pipe (Annotated t) (Annotated t) + | Sequence (Annotated t) (Annotated t) + | Background (Annotated t) (Annotated t) + | Group (Annotated t) + | Subshell (Annotated t) + | Function Identifier (Annotated t) + | IfThen (Annotated t) (Annotated t) + | IfThenElse (Annotated t) (Annotated t) (Annotated t) + | For Identifier [Expression t] (Annotated t) + | Case (Expression t) [(Expression t, Annotated t)] + | While (Annotated t) (Annotated t) + | Until (Annotated t) (Annotated t) +-- BraceBrace (ConditionalExpression t) + | VarAssign Identifier (Expression t) + | ArrayDecl Identifier [Expression t] + | ArrayUpdate Identifier (Expression t) (Expression t) + | ArrayAssign Identifier [Expression t] + | DictDecl Identifier [(Identifier, Expression t)] + | DictUpdate Identifier (Expression t) (Expression t) + | DictAssign Identifier [(Expression t, Expression t)] + | Redirect (Annotated t) Redirection + FileDescriptor (Either (Expression t) FileDescriptor) +deriving instance (Eq t) => Eq (Statement t) +deriving instance (Ord t) => Ord (Statement t) +deriving instance (Show t) => Show (Statement t) +instance Functor Statement where + fmap f stmt = case stmt of + SimpleCommand cmd args -> SimpleCommand (f' cmd) (fmap f' args) + NoOp b -> NoOp b + Bang ann -> Bang (f' ann) + AndAnd ann ann' -> AndAnd (f' ann) (f' ann') + OrOr ann ann' -> OrOr (f' ann) (f' ann') + Pipe ann ann' -> Pipe (f' ann) (f' ann') + Sequence ann ann' -> Sequence (f' ann) (f' ann') + Background ann ann' -> Background (f' ann) (f' ann') + Group ann -> Group (f' ann) + Subshell ann -> Subshell (f' ann) + Function ident ann -> Function ident (f' ann) + IfThen ann ann' -> IfThen (f' ann) (f' ann') + IfThenElse a a' a'' -> IfThenElse (f' a) (f' a') (f' a'') + For ident args ann -> For ident (fmap f' args) (f' ann) + Case expr cases -> Case (f' expr) (fmap (f' *** f') cases) + While ann ann' -> While (f' ann) (f' ann') + Until ann ann' -> Until (f' ann) (f' ann') +-- BraceBrace (ConditionalExpression t) + VarAssign ident expr -> VarAssign ident (f' expr) + ArrayDecl ident assigns -> ArrayDecl ident (fmap f' assigns) + ArrayUpdate ident a b -> ArrayUpdate ident (f' a) (f' b) + ArrayAssign ident assigns -> ArrayAssign ident (fmap f' assigns) + DictDecl ident assigns -> DictDecl ident (fmap (id *** f') assigns) + DictUpdate ident a b -> DictUpdate ident (f' a) (f' b) + DictAssign ident assigns -> DictAssign ident (fmap (f' *** f') assigns) + Redirect ann r fd chan -> Redirect (f' ann) r fd (fmapExprFD chan) + where + f' = fmap f + fmapExprFD (Left expr) = Left (f' expr) + fmapExprFD (Right fd) = Right fd +instance Foldable Statement where + foldMap f stmt = case stmt of + SimpleCommand cmd args -> f' cmd `mappend` foldMap f' args + NoOp _ -> mempty + Bang ann -> f' ann + AndAnd ann ann' -> f' ann `mappend` f' ann' + OrOr ann ann' -> f' ann `mappend` f' ann' + Pipe ann ann' -> f' ann `mappend` f' ann' + Sequence ann ann' -> f' ann `mappend` f' ann' + Background ann ann' -> f' ann `mappend` f' ann' + Group ann -> f' ann + Subshell ann -> f' ann + Function _ ann -> f' ann + IfThen ann ann' -> f' ann `mappend` f' ann' + IfThenElse a a' a'' -> foldMap f' [a, a', a''] + For _ args ann -> foldMap f' args `mappend` f' ann + Case expr cases -> f' expr `mappend` foldMap foldMapPair cases + While ann ann' -> f' ann `mappend` f' ann' + Until ann ann' -> f' ann `mappend` f' ann' +-- BraceBrace ConditionalExpression + VarAssign _ expr -> f' expr + ArrayDecl _ assigns -> foldMap f' assigns + ArrayUpdate _ a b -> f' a `mappend` f' b + ArrayAssign _ assigns -> foldMap f' assigns + DictDecl _ assigns -> foldMap (f' . snd) assigns + DictUpdate _ a b -> f' a `mappend` f' b + DictAssign _ assigns -> foldMap foldMapPair assigns + Redirect ann _ _ chan -> f' ann `mappend` foldMapExprFD chan + where + f' = foldMap f + foldMapExprFD (Left expr) = f' expr + foldMapExprFD (Right _) = mempty + foldMapPair (x, y) = f' x `mappend` f' y + +{-| The type of Bash expressions, handling many kinds of variable reference as + well as eval and process substitution. It is 'Foldable' and a 'Functor'. + -} +data Expression t = Literal Esc.Bash + | Asterisk + | QuestionMark + | ReadVar (Either SpecialVar Identifier) + | ReadVarSafe (Either SpecialVar Identifier) + | ReadArray Identifier (Expression t) + | ReadArraySafe Identifier (Expression t) + | ARGVElements + | ARGVLength + | Elements Identifier + | Length (Either SpecialVar Identifier) + | ArrayLength Identifier + | Concat (Expression t) (Expression t) + | Eval (Annotated t) + | EvalUnquoted (Annotated t) + | ProcessIn (Annotated t) + | ProcessOut (Annotated t) +-- TODO | IndirectExpansion Identifier +-- TODO | Substring, Replacement, &c. +deriving instance (Eq t) => Eq (Expression t) +deriving instance (Ord t) => Ord (Expression t) +deriving instance (Show t) => Show (Expression t) +instance IsString (Expression t) where + fromString = literal . fromString +instance Functor Expression where + fmap f expr = case expr of + Literal esc -> Literal esc + Asterisk -> Asterisk + QuestionMark -> QuestionMark + ReadVar v -> ReadVar v + ReadVarSafe v -> ReadVarSafe v + ReadArray ident expr -> ReadArray ident (fmap f expr) + ReadArraySafe ident expr -> ReadArraySafe ident (fmap f expr) + ARGVElements -> ARGVElements + ARGVLength -> ARGVLength + Elements ident -> Elements ident + Length ident -> Length ident + ArrayLength ident -> ArrayLength ident + Concat expr expr' -> Concat (fmap f expr) (fmap f expr') + Eval ann -> Eval (fmap f ann) + EvalUnquoted ann -> EvalUnquoted (fmap f ann) + ProcessIn ann -> ProcessIn (fmap f ann) + ProcessOut ann -> ProcessOut (fmap f ann) +instance Foldable Expression where + foldMap f expr = case expr of + Literal _ -> mempty + Asterisk -> mempty + QuestionMark -> mempty + ReadVar _ -> mempty + ReadVarSafe _ -> mempty + ReadArray _ expr -> foldMap f expr + ReadArraySafe _ expr -> foldMap f expr + ARGVElements -> mempty + ARGVLength -> mempty + Elements _ -> mempty + Length _ -> mempty + ArrayLength _ -> mempty + Concat expr expr' -> foldMap f expr `mappend` foldMap f expr' + Eval ann -> foldMap f ann + EvalUnquoted ann -> foldMap f ann + ProcessIn ann -> foldMap f ann + ProcessOut ann -> foldMap f ann + +{-| Escape a 'ByteString' to produce a literal expression. + -} +literal :: ByteString -> Expression t +literal = Literal . Esc.bash + +{-| The type of legal Bash identifiers, strings beginning with letters or @_@ + and containing letters, @_@ and digits. + -} +newtype Identifier = Identifier ByteString +deriving instance Eq Identifier +deriving instance Ord Identifier +deriving instance Show Identifier +instance IsString Identifier where + fromString = fromJust . identifier . fromString + +{-| Produce an 'Identifier' from a 'ByteString' of legal format. + -} +identifier :: ByteString -> Maybe Identifier +identifier bytes = do + (c, bytes') <- uncons bytes + if okayHead c && all okayTail bytes' + then Just (Identifier bytes) + else Nothing + where + okayTail c = (isAlphaNum c || c == '_') && isAscii c + okayHead c = (isAlpha c || c == '_') && isAscii c + +{-| A file descriptor in Bash is simply a number between 0 and 255. + -} +newtype FileDescriptor = FileDescriptor Word8 +deriving instance Eq FileDescriptor +deriving instance Ord FileDescriptor +deriving instance Num FileDescriptor +deriving instance Show FileDescriptor + +{-| Redirection \"directions\". + -} +data Redirection = In -- ^ Input redirection, @<@. + | Out -- ^ Output redirection, @>@. + | Append -- ^ Appending output, @>>@. +deriving instance Eq Redirection +deriving instance Ord Redirection +deriving instance Show Redirection + +{-| Unused at present. + -} +data ConditionalExpression t + = File_a (Expression t) + | File_b (Expression t) + | File_c (Expression t) + | File_d (Expression t) + | File_e (Expression t) + | File_f (Expression t) + | File_g (Expression t) + | File_h (Expression t) + | File_k (Expression t) + | File_p (Expression t) + | File_r (Expression t) + | File_s (Expression t) + | File_t (Expression t) + | File_u (Expression t) + | File_w (Expression t) + | File_x (Expression t) + | File_O (Expression t) + | File_G (Expression t) + | File_L (Expression t) + | File_S (Expression t) + | File_N (Expression t) + | File_nt (Expression t) (Expression t) + | File_ot (Expression t) (Expression t) + | File_ef (Expression t) (Expression t) + | OptSet (Expression t) + | StringEmpty (Expression t) + | StringNonempty (Expression t) + | StringEq (Expression t) (Expression t) + | StringNotEq (Expression t) (Expression t) + | StringLT (Expression t) (Expression t) + | StringGT (Expression t) (Expression t) + | StringRE (Expression t) (Expression t) + | NumEq (Expression t) (Expression t) + | NumNotEq (Expression t) (Expression t) + | NumLT (Expression t) (Expression t) + | NumLEq (Expression t) (Expression t) + | NumGT (Expression t) (Expression t) + | NumGEq (Expression t) (Expression t) + | Not (Expression t) (Expression t) + | And (Expression t) (Expression t) + | Or (Expression t) (Expression t) +deriving instance (Eq t) => Eq (ConditionalExpression t) +deriving instance (Ord t) => Ord (ConditionalExpression t) +deriving instance (Show t) => Show (ConditionalExpression t) + +{-| The names of special variables, with otherwise illegal identifiers, are + represented by this type. + -} +data SpecialVar + = DollarQuestion | Dollar0 | Dollar1 | Dollar2 | Dollar3 | Dollar4 + | Dollar5 | Dollar6 | Dollar7 | Dollar8 | Dollar9 +deriving instance Eq SpecialVar +deriving instance Ord SpecialVar +deriving instance Show SpecialVar +instance IsString SpecialVar where + fromString = fromJust . specialVar . fromString + +{-| Try to render a 'SpecialVar' from a 'ByteString'. + -} +specialVar :: ByteString -> Maybe SpecialVar +specialVar b | "$?" == b = Just DollarQuestion + | "$0" == b = Just Dollar0 + | "$1" == b = Just Dollar1 + | "$2" == b = Just Dollar2 + | "$3" == b = Just Dollar3 + | "$4" == b = Just Dollar4 + | "$5" == b = Just Dollar5 + | "$6" == b = Just Dollar6 + | "$7" == b = Just Dollar7 + | "$8" == b = Just Dollar8 + | "$9" == b = Just Dollar9 + | otherwise = Nothing + +specialVarBytes :: SpecialVar -> ByteString +specialVarBytes DollarQuestion = "$?" +specialVarBytes Dollar0 = "$0" +specialVarBytes Dollar1 = "$1" +specialVarBytes Dollar2 = "$2" +specialVarBytes Dollar3 = "$3" +specialVarBytes Dollar4 = "$4" +specialVarBytes Dollar5 = "$5" +specialVarBytes Dollar6 = "$6" +specialVarBytes Dollar7 = "$7" +specialVarBytes Dollar8 = "$8" +specialVarBytes Dollar9 = "$9" + diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,6 @@ + Language.Bash allows for high-level, safe construction of a subset of valid + Bash scripts. Escaping, nesting and composition of script statements and + expressions is handled automatically. + + Please read tests.bash to see some examples, along with their output. + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/bash.cabal b/bash.cabal new file mode 100644 --- /dev/null +++ b/bash.cabal @@ -0,0 +1,45 @@ +name : bash +version : 0.0.0 +category : Language +license : BSD3 +license-file : LICENSE +author : Jason Dusek +maintainer : oss@solidsnack.be +homepage : http://github.com/solidsnack/bash +synopsis : Bash generation library. +description : + A library for generation of Bash scripts, handling escaping, statement + grouping and expression formation at a high level. + . + The top-level module, Language.Bash, is all you need to import to access the + package's functionality. The module Language.Bash.Lib contains some + examples, as does the test script, tests.bash, included with the source + distribution. + +cabal-version : >= 1.6 +build-type : Simple +extra-source-files : README + , tests.bash + +flag split-base + +library + if flag(split-base) + build-depends : base >= 4 && < 5 + else + build-depends : base < 4 + build-depends : containers + , bytestring >= 0.9 + , shell-escape >= 0.1.1 + , binary >= 0.5.0.2 + , hxt-regex-xmlschema >= 9.0.0 + , mtl >= 2.0.1.0 + , SHA >= 1.4.1.3 + exposed-modules : Language.Bash + Language.Bash.Syntax + Language.Bash.Script + Language.Bash.PrettyPrinter + Language.Bash.PrettyPrinter.State + Language.Bash.Annotations + Language.Bash.Lib + diff --git a/tests.bash b/tests.bash new file mode 100644 --- /dev/null +++ b/tests.bash @@ -0,0 +1,255 @@ +#!/bin/bash +# This script is literate Bashkell. Lines beginning with #> are passed to +# GHCi during the test. +## Sketching quine-style test script. +## let set = SimpleCommand "set" +## let set' = set ["-o", "nounset", "-o", "errexit", "-o", "pipefail"] +set -o nounset -o errexit -o pipefail + +declare -a esed=() +if sed --version | fgrep -q GNU &>/dev/null +then + esed=(sed -r) +else + esed=(sed -E) +fi + +function body { + "${esed[@]}" '1,/^exit 0$/ d' +} + +function ghci_commands { + "${esed[@]}" -n '/^#> (.+)$/ { s//\1/ ; p ;} ; /^$/ { p ;}' +} + +function results_filter { + "${esed[@]}" -n '/^########!/,/^########-/ { + /^########[!-]/ { s/^.+$// ;} + p + }' "$@" +} + +case "${1:-}" in + commands) cat "$0" | body | ghci_commands ;; + ''|tests) cat "$0" | body ;; + filter) results_filter "$@" ;; + ghci) cat "$0" | body | ghci_commands | ghci ;; + test) "$0" ghci 2>/dev/null | results_filter ;; + *) echo "Arugment error." 1>&2 ;; +esac + +exit 0 + +#> :set prompt "#>\n" +#> :set -XOverloadedStrings +#> :set -XNoMonomorphismRestriction +#> :set -XScopedTypeVariables +#> :load ./Language/Bash.hs +#> let start = "\n########!\n" +#> let end = "\n########-\n" +#> let concatB = Data.ByteString.Char8.concat +#> let bookend b = Data.ByteString.Char8.putStr (concatB [start, b, end]) +#> let render = bookend . bytes +#> let unlazy = concatB . Data.ByteString.Lazy.toChunks +#> let unbuilder = unlazy . Data.Binary.Builder.toLazyByteString +#> let buildrender = bookend . unbuilder + +#> let ls = Annotated () . SimpleCommand "ls" . (:[]) +#> let echo = Annotated () . SimpleCommand "echo" +#> let commented a b = Annotated (Lines a b) + +#> let ifStmt = Annotated () (IfThenElse (ls ".") (ls ".") (ls "/")) +#> let whileStmt = Annotated () (While ifStmt (echo ["ok"])) +#> let redirectStmt = Annotated () (Redirect whileStmt Append 1 (Left "fo&o")) +#> render redirectStmt +while if ls . + then + ls . + else + ls / + fi +do + echo ok +done 1>>$'fo&o' + +#> let sqnc = Annotated () (Sequence (echo ["-n","hello "]) (echo ["dudes."])) +#> let redirectStmt = Annotated () (Redirect sqnc Out 1 (Left "msg")) +#> render redirectStmt +{ echo -n $'hello ' + echo dudes. ;} 1>msg + +#> let (varX :: Identifier) = "x" +#> let readX = ReadVarSafe (Right varX) +#> let lsX = Annotated () (SimpleCommand "ls" [readX]) +#> let lsMsg = Annotated () (SimpleCommand "echo" ["Failed to `ls':", readX]) +#> let lsErr = Annotated () (Redirect lsMsg Out 1 (Right 2)) +#> let lsOr = Annotated () (lsX `OrOr` lsErr) +#> let apacheLogs = "/var/log/apache2/" `Concat` Concat Asterisk ".log" +#> let for = For varX [apacheLogs, "/var/log/httpd"] lsOr +#> let forStmt = Annotated () for +#> render forStmt +for x in /var/log/apache2/*.log /var/log/httpd +do + ls "${x:-}" || + { echo $'Failed to `ls\':' "${x:-}" 1>&2 ;} +done + +#> let cdApache = Annotated () $ SimpleCommand "cd" ["/var/www"] +#> let cdWhile = Annotated () (Sequence cdApache whileStmt) +#> let lsWWW = Redirect cdWhile Append 2 (Left "/err") +#> let wfStmt = Annotated () lsWWW `AndAnd` forStmt +#> render wfStmt +{ cd /var/www + while if ls . + then + ls . + else + ls / + fi + do + echo ok + done ;} 2>>/err && +for x in /var/log/apache2/*.log /var/log/httpd +do + ls "${x:-}" || + echo $'Failed to `ls\':' "${x:-}" 1>&2 +done + +#> let redirected = Annotated () $ Redirect whileStmt Out 2 (Left "/err") +#> render $ OrOr redirected forStmt +while if ls . + then + ls . + else + ls / + fi +do + echo ok +done 2>/err || +for x in /var/log/apache2/*.log /var/log/httpd +do + ls "${x:-}" || + echo $'Failed to `ls\':' "${x:-}" 1>&2 +done + +#> let rem = Annotated (Lines ["# Remark."] []) +#> let noRem = Annotated (Lines [] []) +#> let echoRem = Annotated (Lines ["#+echo"] ["#-echo"]) . SimpleCommand "echo" +#> let echoCase = echoRem ["-n", "case: "] +#> let clause ex = (ex, rem (Sequence echoCase (echoRem [ex]))) +#> let clause0 = clause "first" +#> let clause1 = clause "second" +#> let clause_ = (Asterisk, echoRem ["?"]) +#> let clauses = [clause0, clause1, clause_] +#> let caseStmt = noRem $ Case (ReadVarSafe (Left Dollar1)) clauses +#> render caseStmt +case "${1:-}" in + first) # Remark. + #+echo + echo -n $'case: ' + #-echo + #+echo + echo first + #-echo + ;; + second) # Remark. + #+echo + echo -n $'case: ' + #-echo + #+echo + echo second + #-echo + ;; + *) #+echo + echo $'?' + #-echo + ;; +esac + +#> let a = SimpleCommand "echo" ["a"] :: Statement () +#> let b = SimpleCommand "echo" ["b"] :: Statement () +#> let pre = script_sha1 "# Silly script." a b +#> buildrender pre +#!/bin/bash + +# Silly script. + +######## Setup. + +echo a + +######## Main. + +if fgrep -q f4b85e070cfe2c7990b5fa6b0603182921430d56 "$0" +then + set -o errexit -o nounset -o pipefail + echo b +fi + +#> let remWhile = fmap (const (Lines ["# Comment."] ["# Comment."])) whileStmt +#> let processWhile = ProcessIn remWhile +#> let evalWhile = Eval remWhile +#> let evalEcho = Eval (echoRem ["before"]) +#> let echoWhile = echoRem [evalEcho, evalWhile, "mid", processWhile, "after"] +#> render echoWhile +#+echo +echo "$( #+echo + echo before + #-echo + )" "$( # Comment. + while # Comment. + if # Comment. + ls . + # Comment. + then + # Comment. + ls . + # Comment. + else + # Comment. + ls / + # Comment. + fi + # Comment. + do + # Comment. + echo ok + # Comment. + done + # Comment. + )" mid <( # Comment. + while # Comment. + if # Comment. + ls . + # Comment. + then + # Comment. + ls . + # Comment. + else + # Comment. + ls / + # Comment. + fi + # Comment. + do + # Comment. + echo ok + # Comment. + done + # Comment. + ) after +#-echo + +#> let (varX :: Identifier) = "x" +#> let readX = ReadVar (Right varX) +#> let lengthX = Length (Right varX) +#> let echoX = Annotated () (SimpleCommand "echo" [readX, "----", lengthX]) +#> let seq4 = Annotated () (SimpleCommand "seq" ["1","4"]) +#> let forSeq = For varX [Eval seq4, EvalUnquoted seq4] echoX +#> render (Annotated () forSeq) +for x in "$( seq 1 4 )" $( seq 1 4 ) +do + echo "$x" ---- "${#x}" +done +