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
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