content: {-# LANGUAGE DeriveGeneric #-}
  {-# LANGUAGE TupleSections #-}
  
  -- |
  -- Module    : Aura.Pkgbuild.Security
  -- Copyright : (c) Colin Woodbury, 2012 - 2024
  -- License   : GPL3
  -- Maintainer: Colin Woodbury <colin@fosskers.ca>
  --
  -- Analyse PKGBUILDs for potentially malicious bash code.
  
  module Aura.Pkgbuild.Security
    ( BannedTerm(..), BanCategory(..)
    , parsedPB, bannedTerms
    , reportExploit
    ) where
  
  import           Aura.Languages
  import           Aura.Types (Language, Pkgbuild(..))
  import           Aura.Utils (hush)
  import           Language.Bash.Parse (parse)
  import           Language.Bash.Syntax
  import           Language.Bash.Word
  import           Prettyprinter
  import           Prettyprinter.Render.Terminal
  import           RIO hiding (Word)
  import           RIO.Lens (_Just, each)
  import qualified RIO.Map as M
  import qualified RIO.Text as T
  
  ---
  
  -- | A bash term which should never appear in a PKGBUILD. If one does, it's
  -- either a sign of maintainer negligence or malicious behaviour.
  data BannedTerm = BannedTerm !Text !BanCategory
    deriving (Eq, Ord, Show, Generic)
  
  banCatL :: Lens' BannedTerm BanCategory
  banCatL f (BannedTerm t bc) = BannedTerm t <$> f bc
  
  -- | The reason why the bash term is black-listed.
  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"]
  
  -- TODO wasteful conversion!
  -- | Attempt to parse a PKGBUILD. Should succeed for all reasonable PKGBUILDs.
  parsedPB :: Pkgbuild -> Maybe List
  parsedPB (Pkgbuild pb) = hush . parse "PKGBUILD" . T.unpack $ decodeUtf8Lenient pb
  
  -- | Discover any banned terms lurking in a parsed PKGBUILD, paired with
  -- the surrounding context lines.
  bannedTerms :: List -> [(ShellCommand, BannedTerm)]
  bannedTerms = simpleCommands >=> bannedCommand
  
  banned :: Word -> Maybe BannedTerm
  banned w = M.lookup (T.pack $ unquote w) blacklist
  
  -- | Extract all `SimpleCommand`s from a parsed bash AST.
  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 _ = []
  
  ------------
  -- REPORTING
  ------------
  
  -- | Dispatch different error messages depending on the category of a `BannedTerm`.
  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
  
  --------
  -- UTILS
  --------
  
  rValueL :: Lens' Assign RValue
  rValueL f (Assign p ao r) = Assign p ao <$> f r
  