-- |
-- Module    : Aura.Security
-- Copyright : (c) Colin Woodbury, 2012 - 2020
-- License   : GPL3
-- Maintainer: Colin Woodbury <colin@fosskers.ca>
--
-- Code common to the analysis and display of PKGBUILD security issues.

module Aura.Security where

import           Aura.Core
import           Aura.IO
import           Aura.Languages
import           Aura.Pkgbuild.Security
import           Aura.Settings
import           Aura.Types
import           Language.Bash.Pretty (prettyText)
import           Language.Bash.Syntax
import           RIO
import qualified RIO.Text as T

---

-- | Determine if a package's PKGBUILD might contain malicious bash code.
analysePkgbuild :: Buildable -> RIO Env ()
analysePkgbuild :: Buildable -> RIO Env ()
analysePkgbuild Buildable
b = do
  Settings
ss <- (Env -> Settings) -> RIO Env Settings
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env -> Settings
settings
  let f :: RIO Env ()
f = do
        Bool
yes <- IO Bool -> RIO Env Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> RIO Env Bool) -> IO Bool -> RIO Env Bool
forall a b. (a -> b) -> a -> b
$ Settings -> (Language -> Doc AnsiStyle) -> IO Bool
optionalPrompt Settings
ss Language -> Doc AnsiStyle
security_6
        Bool -> RIO Env () -> RIO Env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
yes (RIO Env () -> RIO Env ())
-> (FailMsg -> RIO Env ()) -> FailMsg -> RIO Env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Failure -> RIO Env ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Failure -> RIO Env ())
-> (FailMsg -> Failure) -> FailMsg -> RIO Env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FailMsg -> Failure
Failure (FailMsg -> RIO Env ()) -> FailMsg -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ (Language -> Doc AnsiStyle) -> FailMsg
FailMsg Language -> Doc AnsiStyle
security_7
  case Pkgbuild -> Maybe List
parsedPB (Pkgbuild -> Maybe List) -> Pkgbuild -> Maybe List
forall a b. (a -> b) -> a -> b
$ Buildable -> Pkgbuild
bPkgbuild Buildable
b of
    Maybe List
Nothing -> Settings -> (Language -> Doc AnsiStyle) -> RIO Env ()
forall (m :: * -> *).
MonadIO m =>
Settings -> (Language -> Doc AnsiStyle) -> m ()
warn Settings
ss (PkgName -> Language -> Doc AnsiStyle
security_1 (PkgName -> Language -> Doc AnsiStyle)
-> PkgName -> Language -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ Buildable -> PkgName
bName Buildable
b) RIO Env () -> RIO Env () -> RIO Env ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RIO Env ()
f
    Just List
l  -> case List -> [(ShellCommand, BannedTerm)]
bannedTerms List
l of
      []  -> () -> RIO Env ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      [(ShellCommand, BannedTerm)]
bts -> do
        Settings -> (Language -> Doc AnsiStyle) -> RIO Env ()
forall (m :: * -> *).
MonadIO m =>
Settings -> (Language -> Doc AnsiStyle) -> m ()
scold Settings
ss ((Language -> Doc AnsiStyle) -> RIO Env ())
-> (PkgName -> Language -> Doc AnsiStyle) -> PkgName -> RIO Env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgName -> Language -> Doc AnsiStyle
security_5 (PkgName -> RIO Env ()) -> PkgName -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ Buildable -> PkgName
bName Buildable
b
        IO () -> RIO Env ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO Env ()) -> IO () -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ ((ShellCommand, BannedTerm) -> IO ())
-> [(ShellCommand, BannedTerm)] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Settings -> (ShellCommand, BannedTerm) -> IO ()
displayBannedTerms Settings
ss) [(ShellCommand, BannedTerm)]
bts
        RIO Env ()
f

displayBannedTerms :: Settings -> (ShellCommand, BannedTerm) -> IO ()
displayBannedTerms :: Settings -> (ShellCommand, BannedTerm) -> IO ()
displayBannedTerms Settings
ss (ShellCommand
stmt, BannedTerm
b) = do
  Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn (Text -> IO ()) -> (String -> Text) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"\n    " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ShellCommand -> String
forall a. Pretty a => a -> String
prettyText ShellCommand
stmt String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n"
  Settings -> (Language -> Doc AnsiStyle) -> IO ()
forall (m :: * -> *).
MonadIO m =>
Settings -> (Language -> Doc AnsiStyle) -> m ()
warn Settings
ss ((Language -> Doc AnsiStyle) -> IO ())
-> (Language -> Doc AnsiStyle) -> IO ()
forall a b. (a -> b) -> a -> b
$ BannedTerm -> Language -> Doc AnsiStyle
reportExploit BannedTerm
b