{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TupleSections #-}
module Aura.Pkgbuild.Security
( BannedTerm(..), BanCategory(..)
, parsedPB, bannedTerms
, reportExploit
) where
import Aura.Languages
import Aura.Types (Language, Pkgbuild(..))
import Aura.Utils (hush)
import Data.Text.Prettyprint.Doc (Doc)
import Data.Text.Prettyprint.Doc.Render.Terminal (AnsiStyle)
import Language.Bash.Parse (parse)
import Language.Bash.Syntax
import Language.Bash.Word
import RIO hiding (Word)
import RIO.Lens (each, _Just)
import qualified RIO.Map as M
import qualified RIO.Text as T
data BannedTerm = BannedTerm !Text !BanCategory
deriving (Eq, Ord, Show, Generic)
banCatL :: Lens' BannedTerm BanCategory
banCatL f (BannedTerm t bc) = BannedTerm t <$> f bc
data BanCategory = Downloading
| ScriptRunning
| Permissions
| InlinedBash
| StrangeBashism
| CleverRedirect
deriving (Eq, Ord, Show)
blacklist :: Map Text BannedTerm
blacklist = M.fromList $ downloading <> running <> permissions
where
downloading = map (\t -> (t, BannedTerm t Downloading)) ["curl", "wget", "rsync", "scp"]
running = map (\t -> (t, BannedTerm t ScriptRunning)) ["sh", "bash", "eval", "zsh", "fish"]
permissions = map (\t -> (t, BannedTerm t Permissions)) ["sudo", "ssh"]
parsedPB :: Pkgbuild -> Maybe List
parsedPB (Pkgbuild pb) = hush . parse "PKGBUILD" . T.unpack $ decodeUtf8Lenient pb
bannedTerms :: List -> [(ShellCommand, BannedTerm)]
bannedTerms = simpleCommands >=> bannedCommand
banned :: Word -> Maybe BannedTerm
banned w = M.lookup (T.pack $ unquote w) blacklist
simpleCommands :: List -> [ShellCommand]
simpleCommands (List ss) = ss >>= statements >>= p
where
p :: ShellCommand -> [ShellCommand]
p sc@(SimpleCommand _ _) = [sc]
p sc = lists sc >>= simpleCommands
statements :: Statement -> [ShellCommand]
statements (Statement ao _) = andor ao
andor :: AndOr -> [ShellCommand]
andor (Last pl) = pipeline pl
andor (And pl ao) = pipeline pl <> andor ao
andor (Or pl ao) = pipeline pl <> andor ao
pipeline :: Pipeline -> [ShellCommand]
pipeline (Pipeline _ _ _ cs) = map command cs
command :: Command -> ShellCommand
command (Command sc _) = sc
lists :: ShellCommand -> [List]
lists (SimpleCommand _ _) = []
lists (AssignBuiltin _ _) = []
lists (FunctionDef _ l) = [l]
lists (Coproc _ c) = lists $ command c
lists (Subshell l) = [l]
lists (Group l) = [l]
lists (Arith _) = []
lists (Cond _) = []
lists (For _ _ l) = [l]
lists (ArithFor _ l) = [l]
lists (Select _ _ l) = [l]
lists (Case _ ccs) = map caseClause ccs
lists (If l1 l2 ml) = l1 : l2 : maybeToList ml
lists (Until l1 l2) = [l1, l2]
lists (While l1 l2) = [l1, l2]
caseClause :: CaseClause -> List
caseClause (CaseClause _ l _) = l
bannedCommand :: ShellCommand -> [(ShellCommand, BannedTerm)]
bannedCommand s@(SimpleCommand [] (g:c:_))
| g == [Char 'g', Char 'i', Char 't'] &&
c == [Char 'c', Char 'l', Char 'o', Char 'n', Char 'e'] = [(s, BannedTerm "git" Downloading)]
bannedCommand s@(SimpleCommand [] (c:_)) = maybeToList $ (s,) <$> banned c
bannedCommand s@(SimpleCommand as _) = as ^.. each . rValueL . to r . each
where
r rv@(RValue w) = maybeToList ((s,) <$> (banned w & _Just . banCatL .~ CleverRedirect)) <> q rv
r rv = q rv
q :: RValue -> [(ShellCommand, BannedTerm)]
q rv = map (s,) $ join (rWords rv) >>= p
p :: Span -> [BannedTerm]
p (CommandSubst str) = maybeToList (hush $ parse "CommandSubst" str) >>= simpleCommands >>= map snd . bannedCommand
p (ArithSubst str) = [BannedTerm (T.pack str) StrangeBashism]
p (ProcessSubst _ str) = [BannedTerm (T.pack str) StrangeBashism]
p sp = join (sWords sp) >>= p
rWords :: RValue -> [Word]
rWords (RValue w) = [w]
rWords (RArray ws) = ws >>= \(mw, w) -> w : maybeToList mw
sWords :: Span -> [Word]
sWords (Single w) = [w]
sWords (Double w) = [w]
sWords (ANSIC w) = [w]
sWords (Locale w) = [w]
sWords (Backquote w) = [w]
sWords (ParamSubst ps) = subWords ps
sWords _ = []
subWords :: ParamSubst -> [Word]
subWords (Bare (Parameter _ mw)) = maybeToList mw
subWords (Brace _ (Parameter _ mw)) = maybeToList mw
subWords (Alt _ (Parameter _ mw) _ _ w) = w : maybeToList mw
subWords (Substring _ (Parameter _ mw) w1 w2) = w1 : w2 : maybeToList mw
subWords (Prefix _ _) = []
subWords (Indices (Parameter _ mw)) = maybeToList mw
subWords (Length (Parameter _ mw)) = maybeToList mw
subWords (Delete _ (Parameter _ mw) _ _ w) = w : maybeToList mw
subWords (Replace _ (Parameter _ mw) _ _ w1 w2) = w1 : w2 : maybeToList mw
subWords (LetterCase _ (Parameter _ mw) _ _ w) = w : maybeToList mw
bannedCommand _ = []
reportExploit :: BannedTerm -> (Language -> Doc AnsiStyle)
reportExploit (BannedTerm t bc) = case bc of
Downloading -> security_2 t
ScriptRunning -> security_3 t
Permissions -> security_4 t
InlinedBash -> security_8 t
StrangeBashism -> security_9 t
CleverRedirect -> security_10 t
rValueL :: Lens' Assign RValue
rValueL f (Assign p ao r) = Assign p ao <$> f r