From fa9f719c49a1e30f95e9a386df98fee6ab7ef591 Mon Sep 17 00:00:00 2001 From: Vehbi Sinan Tunalioglu Date: Sat, 30 Mar 2024 04:56:45 +0800 Subject: [PATCH 1/6] fix: fix how authorized SSH public keys are streamed from host Closes #38. --- src/scripts/ssh-keys.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/scripts/ssh-keys.sh b/src/scripts/ssh-keys.sh index 9036aca..819c0f1 100644 --- a/src/scripts/ssh-keys.sh +++ b/src/scripts/ssh-keys.sh @@ -18,7 +18,7 @@ find \ 2>/dev/null | sort -u | xargs -I{} cat {} | - xargs -L1 echo | + xargs -I{} echo {} | grep -vE "^#" | sort -u | tr -s ' ' From 6093b8bd8e046e9fce2d3e400bcb7cb53627d0c2 Mon Sep 17 00:00:00 2001 From: Vehbi Sinan Tunalioglu Date: Sat, 30 Mar 2024 15:43:32 +0800 Subject: [PATCH 2/6] fix: change the type of CPU count Int16 should be sufficient for practical purposes. Let's make the application future-proof :) --- src/Lhp/Types.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Lhp/Types.hs b/src/Lhp/Types.hs index ea3cc5c..6c18a05 100644 --- a/src/Lhp/Types.hs +++ b/src/Lhp/Types.hs @@ -8,6 +8,7 @@ module Lhp.Types where import qualified Autodocodec as ADC import qualified Data.Aeson as Aeson +import Data.Int (Int32) import Data.Scientific (Scientific) import qualified Data.Text as T import qualified Data.Time as Time @@ -120,7 +121,7 @@ instance ADC.HasCodec Cloud where -- | Data definition for host's rudimentary hardware information. data Hardware = Hardware - { _hardwareCpuCount :: !Int + { _hardwareCpuCount :: !Int32 -- :) , _hardwareRamTotal :: !Scientific , _hardwareDiskRoot :: !Scientific } From cbceb8696613099af60b212f17a4a653080c7656 Mon Sep 17 00:00:00 2001 From: Vehbi Sinan Tunalioglu Date: Sat, 30 Mar 2024 15:46:18 +0800 Subject: [PATCH 3/6] feat: enrich SSH public key data definition --- src/Lhp/Remote.hs | 42 +++++++++++++++++++++++++++++++++++++++++- src/Lhp/Types.hs | 31 ++++++++++++++++++++++++++++++- src/Zamazingo/Text.hs | 5 +++++ 3 files changed, 76 insertions(+), 2 deletions(-) diff --git a/src/Lhp/Remote.hs b/src/Lhp/Remote.hs index 26edec0..1611675 100644 --- a/src/Lhp/Remote.hs +++ b/src/Lhp/Remote.hs @@ -19,6 +19,8 @@ import qualified Data.Scientific as S import qualified Data.Text as T import Lhp.Types (Report (_reportSystemdServices)) import qualified Lhp.Types as Types +import System.Exit (ExitCode (..)) +import qualified System.Process.Typed as TP import Text.Read (readEither) import qualified Zamazingo.Ssh as Z.Ssh import qualified Zamazingo.Text as Z.Text @@ -42,7 +44,7 @@ compileReport h@Types.Host {..} = do _reportKernel <- _mkKernel _hostName kvs _reportDistribution <- _mkDistribution _hostName kvs _reportDockerContainers <- _fetchHostDockerContainers _hostName - _reportSshAuthorizedKeys <- _fetchHostSshAuthorizedKeys _hostName + _reportSshAuthorizedKeys <- _fetchHostSshAuthorizedKeys _hostName >>= mapM parseSshPublicKey _reportSystemdServices <- _fetchHostSystemdServices _hostName _reportSystemdTimers <- _fetchHostSystemdTimers _hostName pure Types.Report {..} @@ -56,12 +58,14 @@ compileReport h@Types.Host {..} = do data LhpError = LhpErrorSsh Z.Ssh.Destination Z.Ssh.SshError | LhpErrorParse Z.Ssh.Destination T.Text + | LhpErrorUnknown T.Text deriving (Eq, Show) instance Aeson.ToJSON LhpError where toJSON (LhpErrorSsh h err) = Aeson.object [("type", "ssh"), "host" Aeson..= h, "error" Aeson..= err] toJSON (LhpErrorParse h err) = Aeson.object [("type", "parse"), "host" Aeson..= h, "error" Aeson..= err] + toJSON (LhpErrorUnknown err) = Aeson.object [("type", "unknown"), "error" Aeson..= err] -- * Internal @@ -354,3 +358,39 @@ _toSshError -> m a _toSshError h = _modifyError (LhpErrorSsh h) + + +-- | Creates 'Types.SshPublicKey' from given 'T.Text' using ssh-keygen. +-- +-- >>> runExceptT $ parseSshPublicKey "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAILdd2ubdTn5LPsN0zaxylrpkQTW+1Vr/uWQaEQXoGkd3" +-- Right (SshPublicKey {_sshPublicKeyData = "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAILdd2ubdTn5LPsN0zaxylrpkQTW+1Vr/uWQaEQXoGkd3", _sshPublicKeyType = "ED25519", _sshPublicKeyLength = 256, _sshPublicKeyComment = "no comment", _sshPublicKeyFingerprint = "MD5:ec:4b:ff:8d:c7:43:a9:ab:16:9f:0d:fa:8f:e2:6f:6c"}) +-- >>> runExceptT $ parseSshPublicKey "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAILdd2ubdTn5LPsN0zaxylrpkQTW+1Vr/uWQaEQXoGkd3 comment" +-- Right (SshPublicKey {_sshPublicKeyData = "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAILdd2ubdTn5LPsN0zaxylrpkQTW+1Vr/uWQaEQXoGkd3 comment", _sshPublicKeyType = "ED25519", _sshPublicKeyLength = 256, _sshPublicKeyComment = "comment", _sshPublicKeyFingerprint = "MD5:ec:4b:ff:8d:c7:43:a9:ab:16:9f:0d:fa:8f:e2:6f:6c"}) +-- >>> runExceptT $ parseSshPublicKey "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAILdd2ubdTn5LPsN0zaxylrpkQTW+1Vr/uWQaEQXoGkd3 some more comment" +-- Right (SshPublicKey {_sshPublicKeyData = "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAILdd2ubdTn5LPsN0zaxylrpkQTW+1Vr/uWQaEQXoGkd3 some more comment", _sshPublicKeyType = "ED25519", _sshPublicKeyLength = 256, _sshPublicKeyComment = "some more comment", _sshPublicKeyFingerprint = "MD5:ec:4b:ff:8d:c7:43:a9:ab:16:9f:0d:fa:8f:e2:6f:6c"}) +-- >>> runExceptT $ parseSshPublicKey "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAILdd2ubdTn5LPsN0zaxylrpkQTW+1Vr/uWQaEQXoGkd3 some more comment" +-- Right (SshPublicKey {_sshPublicKeyData = "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAILdd2ubdTn5LPsN0zaxylrpkQTW+1Vr/uWQaEQXoGkd3 some more comment", _sshPublicKeyType = "ED25519", _sshPublicKeyLength = 256, _sshPublicKeyComment = "some more comment", _sshPublicKeyFingerprint = "MD5:ec:4b:ff:8d:c7:43:a9:ab:16:9f:0d:fa:8f:e2:6f:6c"}) +parseSshPublicKey + :: MonadError LhpError m + => MonadIO m + => T.Text + -> m Types.SshPublicKey +parseSshPublicKey s = do + (ec, out, err) <- TP.readProcess process + case ec of + ExitFailure _ -> throwUnknown (Z.Text.unsafeTextFromBL err) + ExitSuccess -> case T.words (Z.Text.unsafeTextFromBL out) of + (l : fp : r) -> + pure $ + Types.SshPublicKey + { _sshPublicKeyData = s + , _sshPublicKeyType = T.init . T.tail $ List.last r + , _sshPublicKeyLength = read (T.unpack l) + , _sshPublicKeyComment = T.unwords (filter (not . T.null) (List.init r)) + , _sshPublicKeyFingerprint = fp + } + _ -> throwUnknown "Could not parse ssh-keygen output." + where + throwUnknown = throwError . LhpErrorUnknown + stdin = TP.byteStringInput (Z.Text.blFromText s) + process = TP.setStdin stdin (TP.proc "ssh-keygen" ["-E", "md5", "-l", "-f", "-"]) diff --git a/src/Lhp/Types.hs b/src/Lhp/Types.hs index 6c18a05..a5d7ec1 100644 --- a/src/Lhp/Types.hs +++ b/src/Lhp/Types.hs @@ -51,7 +51,7 @@ data Report = Report , _reportKernel :: !Kernel , _reportDistribution :: !Distribution , _reportDockerContainers :: !(Maybe [DockerContainer]) - , _reportSshAuthorizedKeys :: ![T.Text] + , _reportSshAuthorizedKeys :: ![SshPublicKey] , _reportSystemdServices :: ![T.Text] , _reportSystemdTimers :: ![T.Text] } @@ -230,3 +230,32 @@ instance ADC.HasCodec DockerContainer where <*> ADC.requiredField "image" "Image the container is created from." ADC..= _dockerContainerImage <*> ADC.requiredField "created" "Date/time when the container is created at." ADC..= _dockerContainerCreated <*> ADC.requiredField "running" "Indicates if the container is running." ADC..= _dockerContainerRunning + + +-- * SSH Public Key Information + + +-- | Data definition for SSH public key information. +data SshPublicKey = SshPublicKey + { _sshPublicKeyData :: !T.Text + , _sshPublicKeyType :: !T.Text + , _sshPublicKeyLength :: !Int32 + , _sshPublicKeyComment :: !T.Text + , _sshPublicKeyFingerprint :: !T.Text + } + deriving (Eq, Generic, Show) + deriving (Aeson.FromJSON, Aeson.ToJSON) via (ADC.Autodocodec SshPublicKey) + + +instance ADC.HasCodec SshPublicKey where + codec = + _codec ADC. "SSH Public Key Information" + where + _codec = + ADC.object "SshPublicKey" $ + SshPublicKey + <$> ADC.requiredField "data" "Original information." ADC..= _sshPublicKeyData + <*> ADC.requiredField "type" "Type of the public key." ADC..= _sshPublicKeyType + <*> ADC.requiredField "length" "Length of the public key." ADC..= _sshPublicKeyLength + <*> ADC.requiredField "comment" "Comment on the public key." ADC..= _sshPublicKeyComment + <*> ADC.requiredField "fingerprint" "Fingerprint of the public key." ADC..= _sshPublicKeyFingerprint diff --git a/src/Zamazingo/Text.hs b/src/Zamazingo/Text.hs index c39ffad..97ba488 100644 --- a/src/Zamazingo/Text.hs +++ b/src/Zamazingo/Text.hs @@ -48,3 +48,8 @@ nonempty x = Just x -- May throw encoding error, hence the @unsafe@. unsafeTextFromBL :: BL.ByteString -> T.Text unsafeTextFromBL = TL.toStrict . TLE.decodeUtf8 + + +-- | Converts a given strict text to lazy bytestring. +blFromText :: T.Text -> BL.ByteString +blFromText = TLE.encodeUtf8 . TL.fromStrict From 10ea880c940c1a6efae7e19bed1fcda38a6d9197 Mon Sep 17 00:00:00 2001 From: Vehbi Sinan Tunalioglu Date: Sat, 30 Mar 2024 18:18:24 +0800 Subject: [PATCH 4/6] refactor: change report format, CLI command Now, we have a top-level report format definition. --- README.md | 14 +++++----- src/Lhp/Cli.hs | 37 ++++++++++---------------- src/Lhp/Remote.hs | 57 +++++++++++++++++++++++++++++----------- src/Lhp/Types.hs | 67 +++++++++++++++++++++++++++++++---------------- 4 files changed, 107 insertions(+), 68 deletions(-) diff --git a/README.md b/README.md index ab04bbb..a9febe7 100644 --- a/README.md +++ b/README.md @@ -74,12 +74,14 @@ You can pass hosts via CLI arguments: lhp compile --host my-host-1 --host my-host-2 > /tmp/lhp-report.json ``` -This command connects to hosts in parallel. If any of the hosts cause -an error, entire operation will fail. To ignore failed hosts, you can -use `--stream` mode: +This command connects to hosts sequentially and ignores problematic +hosts in the output. + +To use parallel mode, use `--parallel` flag. In this case, if any of +the hosts cause an error, entire operation will fail: ```sh -lhp compile --stream --host my-host-1 --host my-host-2 | jq --slurp . > /tmp/lhp-report.json +lhp compile --parallel --host my-host-1 --host my-host-2 > /tmp/lhp-report.json ``` Alternatively, you can use a configuration file which has additional @@ -112,10 +114,10 @@ individually on the command-line: lhp compile --config config.yaml > /tmp/lhp-report.json ``` -..., or: +..., or mix with `--host` option: ```sh -lhp compile --stream --config config.yaml | jq --slurp . > /tmp/lhp-report.json +lhp compile --config config.yaml --host a-host --host b-host > /tmp/lhp-report.json ``` Users can process/analyse the JSON output themselves or use [Website] diff --git a/src/Lhp/Cli.hs b/src/Lhp/Cli.hs index a7f48fc..5ac5a2a 100644 --- a/src/Lhp/Cli.hs +++ b/src/Lhp/Cli.hs @@ -1,5 +1,4 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeApplications #-} -- | This module provides top-level definitions for the CLI program. @@ -9,7 +8,6 @@ import qualified Autodocodec.Schema as ADC.Schema import Control.Applicative ((<**>)) import Control.Monad (join) import Control.Monad.Except (runExceptT) -import qualified Control.Monad.Parallel as MP import qualified Data.Aeson as Aeson import qualified Data.ByteString.Lazy.Char8 as BLC import qualified Data.Text as T @@ -21,7 +19,7 @@ import qualified Lhp.Types as Types import Options.Applicative ((<|>)) import qualified Options.Applicative as OA import System.Exit (ExitCode (..)) -import System.IO (hPutStrLn, stderr) +import System.IO (stderr) -- * Entrypoint @@ -65,30 +63,23 @@ commandCompile = OA.hsubparser (OA.command "compile" (OA.info parser infomod) <> doCompile <$> OA.optional (OA.strOption (OA.short 'c' <> OA.long "config" <> OA.action "file" <> OA.help "Path to the configuration file.")) <*> OA.many (OA.strOption (OA.short 'h' <> OA.long "host" <> OA.help "Remote host (in SSH destination format).")) - <*> OA.switch (OA.short 's' <> OA.long "stream" <> OA.help "Streaming results.") + <*> OA.switch (OA.short 'p' <> OA.long "parallel" <> OA.help "Hit remote hosts in parallel.") -- | @compile@ CLI command program. doCompile :: Maybe FilePath -> [T.Text] -> Bool -> IO ExitCode -doCompile cpath dests stream = do - config <- maybe (pure (Config.Config [])) Config.readConfigFile cpath - let hosts = Config._configHosts config <> fmap (\d -> Types.Host {Types._hostName = d, Types._hostUrl = Nothing, Types._hostTags = []}) dests - case stream of - False -> do - res <- runExceptT (MP.mapM compileReport hosts) - case res of - Left err -> BLC.hPutStrLn stderr (Aeson.encode err) >> pure (ExitFailure 1) - Right sr -> BLC.putStrLn (Aeson.encode sr) >> pure ExitSuccess - True -> do - mapM_ go hosts - pure ExitSuccess - where - go h@Types.Host {..} = do - hPutStrLn stderr ("Patrolling " <> T.unpack _hostName) - res <- runExceptT (compileReport h) - case res of - Left err -> BLC.hPutStrLn stderr (Aeson.encode err) - Right sr -> BLC.putStrLn (Aeson.encode sr) +doCompile cpath dests par = do + baseConfig <- maybe (pure (Config.Config [])) Config.readConfigFile cpath + let config = + baseConfig + { Config._configHosts = Config._configHosts baseConfig <> fmap _mkHost dests + } + res <- runExceptT (compileReport par config) + case res of + Left err -> BLC.hPutStrLn stderr (Aeson.encode err) >> pure (ExitFailure 1) + Right sr -> BLC.putStrLn (Aeson.encode sr) >> pure ExitSuccess + where + _mkHost d = Types.Host {Types._hostName = d, Types._hostUrl = Nothing, Types._hostTags = []} -- ** schema diff --git a/src/Lhp/Remote.hs b/src/Lhp/Remote.hs index 1611675..810264f 100644 --- a/src/Lhp/Remote.hs +++ b/src/Lhp/Remote.hs @@ -8,18 +8,22 @@ module Lhp.Remote where import Control.Monad.Except (ExceptT, MonadError (..), runExceptT) -import Control.Monad.IO.Class (MonadIO) +import Control.Monad.IO.Class (MonadIO (liftIO)) +import qualified Control.Monad.Parallel as MP import qualified Data.Aeson as Aeson import qualified Data.Aeson.Combinators.Decode as ACD +import Data.Bool (bool) import qualified Data.ByteString.Lazy as BL +import qualified Data.ByteString.Lazy.Char8 as BLC import Data.FileEmbed (embedStringFile) import qualified Data.List as List -import Data.Maybe (fromMaybe) +import Data.Maybe (catMaybes, fromMaybe) import qualified Data.Scientific as S import qualified Data.Text as T -import Lhp.Types (Report (_reportSystemdServices)) +import qualified Lhp.Config as Config import qualified Lhp.Types as Types import System.Exit (ExitCode (..)) +import System.IO (hPutStrLn, stderr) import qualified System.Process.Typed as TP import Text.Read (readEither) import qualified Zamazingo.Ssh as Z.Ssh @@ -29,25 +33,46 @@ import qualified Zamazingo.Text as Z.Text -- * Report +-- | Attempts to compile host patrol report for a given configuration. +compileReport + :: MonadError LhpError m + => MP.MonadParallel m + => MonadIO m + => Bool + -> Config.Config + -> m Types.Report +compileReport par Config.Config {..} = do + _reportHosts <- reporter _configHosts + pure Types.Report {..} + where + reporter = bool (fmap catMaybes . mapM go) (MP.mapM compileHostReport) par + go h@Types.Host {..} = do + liftIO (hPutStrLn stderr ("Patrolling " <> T.unpack _hostName)) + res <- runExceptT (compileHostReport h) + case res of + Left err -> liftIO (BLC.hPutStrLn stderr (Aeson.encode err) >> pure Nothing) + Right sr -> pure (Just sr) + + -- | Attempts to retrieve remote host information and produce a host -- report. -compileReport +compileHostReport :: MonadIO m => MonadError LhpError m => Types.Host - -> m Types.Report -compileReport h@Types.Host {..} = do + -> m Types.HostReport +compileHostReport h@Types.Host {..} = do kvs <- (++) <$> _fetchHostInfo _hostName <*> _fetchHostCloudInfo _hostName - let _reportHost = h - _reportCloud <- _mkCloud _hostName kvs - _reportHardware <- _mkHardware _hostName kvs - _reportKernel <- _mkKernel _hostName kvs - _reportDistribution <- _mkDistribution _hostName kvs - _reportDockerContainers <- _fetchHostDockerContainers _hostName - _reportSshAuthorizedKeys <- _fetchHostSshAuthorizedKeys _hostName >>= mapM parseSshPublicKey - _reportSystemdServices <- _fetchHostSystemdServices _hostName - _reportSystemdTimers <- _fetchHostSystemdTimers _hostName - pure Types.Report {..} + let _hostReportHost = h + _hostReportCloud <- _mkCloud _hostName kvs + _hostReportHardware <- _mkHardware _hostName kvs + _hostReportKernel <- _mkKernel _hostName kvs + _hostReportDistribution <- _mkDistribution _hostName kvs + _hostReportDockerContainers <- _fetchHostDockerContainers _hostName + _hostReportSshAuthorizedKeys <- _fetchHostSshAuthorizedKeys _hostName >>= mapM parseSshPublicKey + _hostReportSystemdServices <- _fetchHostSystemdServices _hostName + _hostReportSystemdTimers <- _fetchHostSystemdTimers _hostName + pure Types.HostReport {..} -- * Errors diff --git a/src/Lhp/Types.hs b/src/Lhp/Types.hs index a5d7ec1..0a9f93f 100644 --- a/src/Lhp/Types.hs +++ b/src/Lhp/Types.hs @@ -15,6 +15,27 @@ import qualified Data.Time as Time import GHC.Generics (Generic) +-- * Report + + +-- | Data definition for host patrol report. +newtype Report = Report + { _reportHosts :: [HostReport] + } + deriving (Eq, Generic, Show) + deriving (Aeson.FromJSON, Aeson.ToJSON) via (ADC.Autodocodec Report) + + +instance ADC.HasCodec Report where + codec = + _codec ADC. "Host Patrol Report" + where + _codec = + ADC.object "Report" $ + Report + <$> ADC.requiredField "hosts" "List of host reports." ADC..= _reportHosts + + -- * Host @@ -40,41 +61,41 @@ instance ADC.HasCodec Host where <*> ADC.optionalFieldWithDefault "tags" [] "Arbitrary tags for the host." ADC..= _hostTags --- * Report +-- * Host Report -- | Data definition for host patrol report. -data Report = Report - { _reportHost :: !Host - , _reportCloud :: !Cloud - , _reportHardware :: !Hardware - , _reportKernel :: !Kernel - , _reportDistribution :: !Distribution - , _reportDockerContainers :: !(Maybe [DockerContainer]) - , _reportSshAuthorizedKeys :: ![SshPublicKey] - , _reportSystemdServices :: ![T.Text] - , _reportSystemdTimers :: ![T.Text] +data HostReport = HostReport + { _hostReportHost :: !Host + , _hostReportCloud :: !Cloud + , _hostReportHardware :: !Hardware + , _hostReportKernel :: !Kernel + , _hostReportDistribution :: !Distribution + , _hostReportDockerContainers :: !(Maybe [DockerContainer]) + , _hostReportSshAuthorizedKeys :: ![SshPublicKey] + , _hostReportSystemdServices :: ![T.Text] + , _hostReportSystemdTimers :: ![T.Text] } deriving (Eq, Generic, Show) - deriving (Aeson.FromJSON, Aeson.ToJSON) via (ADC.Autodocodec Report) + deriving (Aeson.FromJSON, Aeson.ToJSON) via (ADC.Autodocodec HostReport) -instance ADC.HasCodec Report where +instance ADC.HasCodec HostReport where codec = _codec ADC. "Host Patrol Report" where _codec = ADC.object "Report" $ - Report - <$> ADC.requiredField "host" "Host descriptor." ADC..= _reportHost - <*> ADC.requiredField "cloud" "Cloud information." ADC..= _reportCloud - <*> ADC.requiredField "hardware" "Hardware information." ADC..= _reportHardware - <*> ADC.requiredField "kernel" "Kernel information." ADC..= _reportKernel - <*> ADC.requiredField "distribution" "Distribution information." ADC..= _reportDistribution - <*> ADC.requiredField "dockerContainers" "List of Docker containers if the host is a Docker host." ADC..= _reportDockerContainers - <*> ADC.requiredField "sshAuthorizedKeys" "List of SSH authorized keys found on host." ADC..= _reportSshAuthorizedKeys - <*> ADC.requiredField "systemdServices" "List of systemd services found on host." ADC..= _reportSystemdServices - <*> ADC.requiredField "systemdTimers" "List of systemd timers found on host." ADC..= _reportSystemdTimers + HostReport + <$> ADC.requiredField "host" "Host descriptor." ADC..= _hostReportHost + <*> ADC.requiredField "cloud" "Cloud information." ADC..= _hostReportCloud + <*> ADC.requiredField "hardware" "Hardware information." ADC..= _hostReportHardware + <*> ADC.requiredField "kernel" "Kernel information." ADC..= _hostReportKernel + <*> ADC.requiredField "distribution" "Distribution information." ADC..= _hostReportDistribution + <*> ADC.requiredField "dockerContainers" "List of Docker containers if the host is a Docker host." ADC..= _hostReportDockerContainers + <*> ADC.requiredField "sshAuthorizedKeys" "List of SSH authorized keys found on host." ADC..= _hostReportSshAuthorizedKeys + <*> ADC.requiredField "systemdServices" "List of systemd services found on host." ADC..= _hostReportSystemdServices + <*> ADC.requiredField "systemdTimers" "List of systemd timers found on host." ADC..= _hostReportSystemdTimers -- * Cloud Information From 06411411657fb85a5994c63646257c489695adf8 Mon Sep 17 00:00:00 2001 From: Vehbi Sinan Tunalioglu Date: Sat, 30 Mar 2024 18:50:27 +0800 Subject: [PATCH 5/6] feat: add known SSH public keys This is actually a noop feature: This allows the app to consume some SSH public keys in the configuration, parse them and put into the output for further analysis. Also property $host.sshAuthorizedKeys is renamed to $host.authorizedSshKeys. --- README.md | 8 ++++++++ config.yaml | 8 ++++++++ src/Lhp/Cli.hs | 2 +- src/Lhp/Config.hs | 7 +++++-- src/Lhp/Remote.hs | 7 ++++--- src/Lhp/Types.hs | 10 ++++++---- 6 files changed, 32 insertions(+), 10 deletions(-) diff --git a/README.md b/README.md index a9febe7..c02a767 100644 --- a/README.md +++ b/README.md @@ -91,6 +91,14 @@ follows: ```yaml ## config.yaml +## List of known SSH public keys to be added to the report. +## +## These can be then used by external programs of lhp Web UI to +## highlight if a host has an unknown authorized SSH public key. +knownSshKeys: + - ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIKq9bpy0IIfDnlgaTCQk0YhKyKFqInRjoqeIPlBuiFwS testing + +## List of hosts to patrol hosts: - ## Name of the host (required) name: somehost diff --git a/config.yaml b/config.yaml index cadbd81..f371173 100644 --- a/config.yaml +++ b/config.yaml @@ -1,3 +1,11 @@ +## List of known SSH public keys to be added to the report. +## +## These can be then used by external programs of lhp Web UI to +## highlight if a host has an unknown authorized SSH public key. +knownSshKeys: + - ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIKq9bpy0IIfDnlgaTCQk0YhKyKFqInRjoqeIPlBuiFwS testing + +## List of hosts to patrol hosts: - ## Name of the host (required) name: somehost diff --git a/src/Lhp/Cli.hs b/src/Lhp/Cli.hs index 5ac5a2a..5d7ae74 100644 --- a/src/Lhp/Cli.hs +++ b/src/Lhp/Cli.hs @@ -69,7 +69,7 @@ commandCompile = OA.hsubparser (OA.command "compile" (OA.info parser infomod) <> -- | @compile@ CLI command program. doCompile :: Maybe FilePath -> [T.Text] -> Bool -> IO ExitCode doCompile cpath dests par = do - baseConfig <- maybe (pure (Config.Config [])) Config.readConfigFile cpath + baseConfig <- maybe (pure (Config.Config [] [])) Config.readConfigFile cpath let config = baseConfig { Config._configHosts = Config._configHosts baseConfig <> fmap _mkHost dests diff --git a/src/Lhp/Config.hs b/src/Lhp/Config.hs index 61868b6..5f42703 100644 --- a/src/Lhp/Config.hs +++ b/src/Lhp/Config.hs @@ -8,14 +8,16 @@ module Lhp.Config where import qualified Autodocodec as ADC import qualified Data.Aeson as Aeson +import qualified Data.Text as T import qualified Data.Yaml as Yaml import GHC.Generics (Generic) import qualified Lhp.Types as Types -- | Data definition for application configuration. -newtype Config = Config - { _configHosts :: [Types.Host] +data Config = Config + { _configHosts :: ![Types.Host] + , _configKnownSshKeys :: ![T.Text] } deriving (Eq, Generic, Show) deriving (Aeson.FromJSON, Aeson.ToJSON) via (ADC.Autodocodec Config) @@ -29,6 +31,7 @@ instance ADC.HasCodec Config where ADC.object "Config" $ Config <$> ADC.optionalFieldWithDefault "hosts" [] "List of hosts." ADC..= _configHosts + <*> ADC.optionalFieldWithDefault "knownSshKeys" [] "List of hosts." ADC..= _configKnownSshKeys -- | Attempts to read a configuration file and return 'Config'. diff --git a/src/Lhp/Remote.hs b/src/Lhp/Remote.hs index 810264f..4837ccb 100644 --- a/src/Lhp/Remote.hs +++ b/src/Lhp/Remote.hs @@ -43,6 +43,7 @@ compileReport -> m Types.Report compileReport par Config.Config {..} = do _reportHosts <- reporter _configHosts + _reportKnownSshKeys <- mapM parseSshPublicKey _configKnownSshKeys pure Types.Report {..} where reporter = bool (fmap catMaybes . mapM go) (MP.mapM compileHostReport) par @@ -69,7 +70,7 @@ compileHostReport h@Types.Host {..} = do _hostReportKernel <- _mkKernel _hostName kvs _hostReportDistribution <- _mkDistribution _hostName kvs _hostReportDockerContainers <- _fetchHostDockerContainers _hostName - _hostReportSshAuthorizedKeys <- _fetchHostSshAuthorizedKeys _hostName >>= mapM parseSshPublicKey + _hostReportAuthorizedSshKeys <- _fetchHostAuthorizedSshKeys _hostName >>= mapM parseSshPublicKey _hostReportSystemdServices <- _fetchHostSystemdServices _hostName _hostReportSystemdTimers <- _fetchHostSystemdTimers _hostName pure Types.HostReport {..} @@ -139,12 +140,12 @@ _fetchHostDockerContainers h = -- | Attempts to find and return all SSH authorized keys on the remote -- host. -_fetchHostSshAuthorizedKeys +_fetchHostAuthorizedSshKeys :: MonadIO m => MonadError LhpError m => Z.Ssh.Destination -> m [T.Text] -_fetchHostSshAuthorizedKeys h = +_fetchHostAuthorizedSshKeys h = filter (not . T.null) . fmap T.strip . T.lines . Z.Text.unsafeTextFromBL <$> prog where prog = _toSshError h (Z.Ssh.runScript h $(embedStringFile "src/scripts/ssh-keys.sh") ["bash"]) diff --git a/src/Lhp/Types.hs b/src/Lhp/Types.hs index 0a9f93f..819f080 100644 --- a/src/Lhp/Types.hs +++ b/src/Lhp/Types.hs @@ -19,8 +19,9 @@ import GHC.Generics (Generic) -- | Data definition for host patrol report. -newtype Report = Report - { _reportHosts :: [HostReport] +data Report = Report + { _reportHosts :: ![HostReport] + , _reportKnownSshKeys :: ![SshPublicKey] } deriving (Eq, Generic, Show) deriving (Aeson.FromJSON, Aeson.ToJSON) via (ADC.Autodocodec Report) @@ -34,6 +35,7 @@ instance ADC.HasCodec Report where ADC.object "Report" $ Report <$> ADC.requiredField "hosts" "List of host reports." ADC..= _reportHosts + <*> ADC.requiredField "knownSshKeys" "List of known SSH public keys." ADC..= _reportKnownSshKeys -- * Host @@ -72,7 +74,7 @@ data HostReport = HostReport , _hostReportKernel :: !Kernel , _hostReportDistribution :: !Distribution , _hostReportDockerContainers :: !(Maybe [DockerContainer]) - , _hostReportSshAuthorizedKeys :: ![SshPublicKey] + , _hostReportAuthorizedSshKeys :: ![SshPublicKey] , _hostReportSystemdServices :: ![T.Text] , _hostReportSystemdTimers :: ![T.Text] } @@ -93,7 +95,7 @@ instance ADC.HasCodec HostReport where <*> ADC.requiredField "kernel" "Kernel information." ADC..= _hostReportKernel <*> ADC.requiredField "distribution" "Distribution information." ADC..= _hostReportDistribution <*> ADC.requiredField "dockerContainers" "List of Docker containers if the host is a Docker host." ADC..= _hostReportDockerContainers - <*> ADC.requiredField "sshAuthorizedKeys" "List of SSH authorized keys found on host." ADC..= _hostReportSshAuthorizedKeys + <*> ADC.requiredField "authorizedSshKeys" "List of authorized SSH public keys found on host." ADC..= _hostReportAuthorizedSshKeys <*> ADC.requiredField "systemdServices" "List of systemd services found on host." ADC..= _hostReportSystemdServices <*> ADC.requiredField "systemdTimers" "List of systemd timers found on host." ADC..= _hostReportSystemdTimers From 17b17ba084365b117c95dd857801716c80784dee Mon Sep 17 00:00:00 2001 From: Vehbi Sinan Tunalioglu Date: Sat, 30 Mar 2024 19:41:45 +0800 Subject: [PATCH 6/6] refactor(website): adopt new lhp patrol report data definition --- website/src/components/app/-app.tsx | 52 ++-- website/src/components/app/-data.tsx | 349 ++++++++++++++++----------- website/src/components/app/index.tsx | 4 +- 3 files changed, 237 insertions(+), 168 deletions(-) diff --git a/website/src/components/app/-app.tsx b/website/src/components/app/-app.tsx index d93746f..2ae8c88 100644 --- a/website/src/components/app/-app.tsx +++ b/website/src/components/app/-app.tsx @@ -8,17 +8,17 @@ import Link from 'next/link'; import { Just, Maybe, Nothing } from 'purify-ts/Maybe'; import { useEffect, useState } from 'react'; import { toast } from 'react-toastify'; -import { LhpData } from './-data'; +import { LhpHostReport, LhpPatrolReport } from './-data'; import { KVBox } from './-ui'; -export function App({ data, onFlushRequest }: { data: LhpData[]; onFlushRequest: () => void }) { - const [host, setHost] = useState>(Nothing); +export function App({ data, onFlushRequest }: { data: LhpPatrolReport; onFlushRequest: () => void }) { + const [host, setHost] = useState>(Nothing); return (
setHost(Just(x))} onFlushRequest={onFlushRequest} onTabulateRequest={() => { @@ -29,7 +29,7 @@ export function App({ data, onFlushRequest }: { data: LhpData[]; onFlushRequest:
{host.caseOf({ - Nothing: () => setHost(Just(x))} />, + Nothing: () => setHost(Just(x))} />, Just: (x) => , })}
@@ -38,8 +38,8 @@ export function App({ data, onFlushRequest }: { data: LhpData[]; onFlushRequest: } export interface SidebarProps { - data: LhpData[]; - onHostSelect: (host: LhpData) => void; + data: LhpHostReport[]; + onHostSelect: (host: LhpHostReport) => void; onFlushRequest: () => void; onTabulateRequest: () => void; } @@ -100,9 +100,15 @@ export function cloudIcon(x: string) { } } -export function TabulateHosts({ hosts, onHostSelect }: { hosts: LhpData[]; onHostSelect: (host: LhpData) => void }) { - const [filters, setFilters] = useState boolean>>({}); - const [filteredHosts, setFilteredHosts] = useState(hosts); +export function TabulateHosts({ + hosts, + onHostSelect, +}: { + hosts: LhpHostReport[]; + onHostSelect: (host: LhpHostReport) => void; +}) { + const [filters, setFilters] = useState boolean>>({}); + const [filteredHosts, setFilteredHosts] = useState(hosts); useEffect(() => { setFilteredHosts(hosts.filter((host) => Object.values(filters).reduce((acc, f) => acc && f(host), true))); @@ -236,20 +242,20 @@ export function TabulateHosts({ hosts, onHostSelect }: { hosts: LhpData[]; onHos sshkeys: x === 'all' || x.size === 0 ? () => true - : (h) => h.sshAuthorizedKeys.reduce((acc, t) => acc || x.has(t), false), + : (h) => h.authorizedSshKeys.reduce((acc, t) => acc || x.has(t.fingerprint), false), }); }} > {hosts - .map((h) => h.sshAuthorizedKeys || []) + .map((h) => h.authorizedSshKeys || []) .reduce((acc, tags) => [...acc, ...tags], []) .sort() .filter(function (el, i, a) { return i === a.indexOf(el); }) .map((n) => ( - - {n} + + {n.data} ))} @@ -451,7 +457,7 @@ export function TabulateHosts({ hosts, onHostSelect }: { hosts: LhpData[]; onHos ? '❌' : `${host.dockerContainers.filter((x) => x.running).length} / ${host.dockerContainers.length}`} - {host.sshAuthorizedKeys.length} + {host.authorizedSshKeys.length} {host.systemdServices.length} / {host.systemdTimers.length} @@ -470,9 +476,7 @@ export function TabulateHosts({ hosts, onHostSelect }: { hosts: LhpData[]; onHos ); } -export function HostDetails({ host }: { host: LhpData }) { - const sshkeys = host.sshAuthorizedKeys.map((x) => [x, ...x.split(' ')]); - +export function HostDetails({ host }: { host: LhpHostReport }) { return (

@@ -544,19 +548,19 @@ export function HostDetails({ host }: { host: LhpData }) { No authorized SSH keys are found. Sounds weird?} > - {([sshkey, sshkeyType, _sshkeyContent, ...sshkeyComment]) => ( + {({ length, type, fingerprint, data, comment }) => ( { - navigator.clipboard.writeText(sshkey); + navigator.clipboard.writeText(data); toast('SSH Key is copied to clipboard.'); }} > - {`${sshkeyType} ${sshkeyComment.join(' ') || ''}`} + {`${type} (${length}) - ${fingerprint} - ${comment || ''}`} )} diff --git a/website/src/components/app/-data.tsx b/website/src/components/app/-data.tsx index f4e954d..619989d 100644 --- a/website/src/components/app/-data.tsx +++ b/website/src/components/app/-data.tsx @@ -11,146 +11,218 @@ import { Centered } from './-ui'; export const LHP_PATROL_REPORT_SCHEMA = { $comment: 'Host Patrol Report\nReport', properties: { - cloud: { - $comment: 'Cloud information.\nCloud Information\nCloud', - properties: { - hostAvailabilityZone: { $comment: 'Host availability zone.', anyOf: [{ type: 'null' }, { type: 'string' }] }, - hostLocalAddress: { $comment: 'Local address of the host.', anyOf: [{ type: 'null' }, { type: 'string' }] }, - hostLocalHostname: { $comment: 'Local hostname of the host.', anyOf: [{ type: 'null' }, { type: 'string' }] }, - hostRegion: { $comment: 'Host region.', anyOf: [{ type: 'null' }, { type: 'string' }] }, - hostRemoteAddress: { $comment: 'Remote address of the host.', anyOf: [{ type: 'null' }, { type: 'string' }] }, - hostRemoteHostname: { $comment: 'Remote hostname of the host.', anyOf: [{ type: 'null' }, { type: 'string' }] }, - hostReservedAddress: { - $comment: 'Reserved address of the host.', - anyOf: [{ type: 'null' }, { type: 'string' }], - }, - hostType: { $comment: 'Host type.', anyOf: [{ type: 'null' }, { type: 'string' }] }, - id: { $comment: 'Host identifier.', anyOf: [{ type: 'null' }, { type: 'string' }] }, - name: { $comment: 'Cloud name.', type: 'string' }, - }, - required: [ - 'hostReservedAddress', - 'hostRemoteAddress', - 'hostRemoteHostname', - 'hostLocalAddress', - 'hostLocalHostname', - 'hostAvailabilityZone', - 'hostRegion', - 'hostType', - 'id', - 'name', - ], - type: 'object', - }, - distribution: { - $comment: 'Distribution information.\nDistribution Information\nDistribution', - properties: { - codename: { - $comment: "Distribution codename (cat /etc/os-release | grep 'VERSION_CODENAME=').", - anyOf: [{ type: 'null' }, { type: 'string' }], - }, - description: { - $comment: "Distribution description (cat /etc/os-release | grep 'PRETTY_NAME=').", - type: 'string', - }, - id: { $comment: "Distribution ID (cat /etc/os-release | grep 'ID=').", type: 'string' }, - name: { $comment: "Distribution name (cat /etc/os-release | grep 'NAME=')).", type: 'string' }, - release: { $comment: "Distribution release (cat /etc/os-release | grep 'VERSION_ID=').", type: 'string' }, - version: { $comment: "Distribution version (cat /etc/os-release | grep 'VERSION=').", type: 'string' }, - }, - required: ['description', 'codename', 'release', 'version', 'name', 'id'], - type: 'object', - }, - dockerContainers: { - $comment: 'List of Docker containers if the host is a Docker host.', - anyOf: [ - { type: 'null' }, - { - items: { - $comment: 'Docker Container Information\nDockerContainer', + hosts: { + $comment: 'List of host reports.', + items: { + $comment: 'Host Patrol Report\nReport', + properties: { + authorizedSshKeys: { + $comment: 'List of authorized SSH public keys found on host.', + items: { + $comment: 'SSH Public Key Information\nSshPublicKey', + properties: { + comment: { $comment: 'Comment on the public key.', type: 'string' }, + data: { $comment: 'Original information.', type: 'string' }, + fingerprint: { $comment: 'Fingerprint of the public key.', type: 'string' }, + length: { + $comment: 'Length of the public key.', + maximum: 2147483647, + minimum: -2147483648, + type: 'number', + }, + type: { $comment: 'Type of the public key.', type: 'string' }, + }, + required: ['fingerprint', 'comment', 'length', 'type', 'data'], + type: 'object', + }, + type: 'array', + }, + cloud: { + $comment: 'Cloud information.\nCloud Information\nCloud', properties: { - created: { $comment: 'Date/time when the container is created at.\nLocalTime', type: 'string' }, - id: { $comment: 'ID of the container..', type: 'string' }, - image: { $comment: 'Image the container is created from.', type: 'string' }, - name: { $comment: 'Name of the container.', type: 'string' }, - running: { $comment: 'Indicates if the container is running.', type: 'boolean' }, + hostAvailabilityZone: { + $comment: 'Host availability zone.', + anyOf: [{ type: 'null' }, { type: 'string' }], + }, + hostLocalAddress: { + $comment: 'Local address of the host.', + anyOf: [{ type: 'null' }, { type: 'string' }], + }, + hostLocalHostname: { + $comment: 'Local hostname of the host.', + anyOf: [{ type: 'null' }, { type: 'string' }], + }, + hostRegion: { $comment: 'Host region.', anyOf: [{ type: 'null' }, { type: 'string' }] }, + hostRemoteAddress: { + $comment: 'Remote address of the host.', + anyOf: [{ type: 'null' }, { type: 'string' }], + }, + hostRemoteHostname: { + $comment: 'Remote hostname of the host.', + anyOf: [{ type: 'null' }, { type: 'string' }], + }, + hostReservedAddress: { + $comment: 'Reserved address of the host.', + anyOf: [{ type: 'null' }, { type: 'string' }], + }, + hostType: { $comment: 'Host type.', anyOf: [{ type: 'null' }, { type: 'string' }] }, + id: { $comment: 'Host identifier.', anyOf: [{ type: 'null' }, { type: 'string' }] }, + name: { $comment: 'Cloud name.', type: 'string' }, }, - required: ['running', 'created', 'image', 'name', 'id'], + required: [ + 'hostReservedAddress', + 'hostRemoteAddress', + 'hostRemoteHostname', + 'hostLocalAddress', + 'hostLocalHostname', + 'hostAvailabilityZone', + 'hostRegion', + 'hostType', + 'id', + 'name', + ], type: 'object', }, - type: 'array', - }, - ], - }, - hardware: { - $comment: 'Hardware information.\nRudimentary Hardware Information\nHardware', - properties: { - cpuCount: { - $comment: 'Number of (v)CPU cores.', - // maximum: 9223372036854775807, - // minimum: -9223372036854775808, - type: 'number', + distribution: { + $comment: 'Distribution information.\nDistribution Information\nDistribution', + properties: { + codename: { + $comment: "Distribution codename (cat /etc/os-release | grep 'VERSION_CODENAME=').", + anyOf: [{ type: 'null' }, { type: 'string' }], + }, + description: { + $comment: "Distribution description (cat /etc/os-release | grep 'PRETTY_NAME=').", + type: 'string', + }, + id: { $comment: "Distribution ID (cat /etc/os-release | grep 'ID=').", type: 'string' }, + name: { $comment: "Distribution name (cat /etc/os-release | grep 'NAME=')).", type: 'string' }, + release: { $comment: "Distribution release (cat /etc/os-release | grep 'VERSION_ID=').", type: 'string' }, + version: { $comment: "Distribution version (cat /etc/os-release | grep 'VERSION=').", type: 'string' }, + }, + required: ['description', 'codename', 'release', 'version', 'name', 'id'], + type: 'object', + }, + dockerContainers: { + $comment: 'List of Docker containers if the host is a Docker host.', + anyOf: [ + { type: 'null' }, + { + items: { + $comment: 'Docker Container Information\nDockerContainer', + properties: { + created: { $comment: 'Date/time when the container is created at.\nLocalTime', type: 'string' }, + id: { $comment: 'ID of the container..', type: 'string' }, + image: { $comment: 'Image the container is created from.', type: 'string' }, + name: { $comment: 'Name of the container.', type: 'string' }, + running: { $comment: 'Indicates if the container is running.', type: 'boolean' }, + }, + required: ['running', 'created', 'image', 'name', 'id'], + type: 'object', + }, + type: 'array', + }, + ], + }, + hardware: { + $comment: 'Hardware information.\nRudimentary Hardware Information\nHardware', + properties: { + cpuCount: { + $comment: 'Number of (v)CPU cores.', + maximum: 2147483647, + minimum: -2147483648, + type: 'number', + }, + diskRoot: { $comment: 'Total disk space of root (`/`) filesystem (in GB).', type: 'number' }, + ramTotal: { $comment: 'Total RAM (in GB).', type: 'number' }, + }, + required: ['diskRoot', 'ramTotal', 'cpuCount'], + type: 'object', + }, + host: { + $comment: 'Host descriptor.\nHost Descriptor\nHost', + properties: { + name: { $comment: 'Name of the host.', type: 'string' }, + tags: { $comment: 'Arbitrary tags for the host.', items: { type: 'string' }, type: 'array' }, + url: { $comment: 'URL to external host information.', type: 'string' }, + }, + required: ['name'], + type: 'object', + }, + kernel: { + $comment: 'Kernel information.\nKernel Information\nKernel', + properties: { + machine: { $comment: 'Architecture the kernel is running on (uname -m).', type: 'string' }, + name: { $comment: 'Kernel name (uname -s).', type: 'string' }, + node: { $comment: 'Name of the node kernel is running on (uname -n).', type: 'string' }, + os: { $comment: 'Operating system the kernel is driving (uname -o).', type: 'string' }, + release: { $comment: 'Kernel release (uname -r).', type: 'string' }, + version: { $comment: 'Kernel version (uname -v).', type: 'string' }, + }, + required: ['os', 'machine', 'version', 'release', 'name', 'node'], + type: 'object', + }, + systemdServices: { + $comment: 'List of systemd services found on host.', + items: { type: 'string' }, + type: 'array', + }, + systemdTimers: { + $comment: 'List of systemd timers found on host.', + items: { type: 'string' }, + type: 'array', + }, }, - diskRoot: { $comment: 'Total disk space of root (`/`) filesystem (in GB).', type: 'number' }, - ramTotal: { $comment: 'Total RAM (in GB).', type: 'number' }, + required: [ + 'systemdTimers', + 'systemdServices', + 'authorizedSshKeys', + 'dockerContainers', + 'distribution', + 'kernel', + 'hardware', + 'cloud', + 'host', + ], + type: 'object', }, - required: ['diskRoot', 'ramTotal', 'cpuCount'], - type: 'object', - }, - host: { - $comment: 'Host descriptor.\nHost Descriptor\nHost', - properties: { - name: { $comment: 'Name of the host.', type: 'string' }, - tags: { $comment: 'Arbitrary tags for the host.', items: { type: 'string' }, type: 'array' }, - url: { $comment: 'URL to external host information.', type: 'string' }, - }, - required: ['name'], - type: 'object', + type: 'array', }, - kernel: { - $comment: 'Kernel information.\nKernel Information\nKernel', - properties: { - machine: { $comment: 'Architecture the kernel is running on (uname -m).', type: 'string' }, - name: { $comment: 'Kernel name (uname -s).', type: 'string' }, - node: { $comment: 'Name of the node kernel is running on (uname -n).', type: 'string' }, - os: { $comment: 'Operating system the kernel is driving (uname -o).', type: 'string' }, - release: { $comment: 'Kernel release (uname -r).', type: 'string' }, - version: { $comment: 'Kernel version (uname -v).', type: 'string' }, + knownSshKeys: { + $comment: 'List of known SSH public keys.', + items: { + $comment: 'SSH Public Key Information\nSshPublicKey', + properties: { + comment: { $comment: 'Comment on the public key.', type: 'string' }, + data: { $comment: 'Original information.', type: 'string' }, + fingerprint: { $comment: 'Fingerprint of the public key.', type: 'string' }, + length: { $comment: 'Length of the public key.', maximum: 2147483647, minimum: -2147483648, type: 'number' }, + type: { $comment: 'Type of the public key.', type: 'string' }, + }, + required: ['fingerprint', 'comment', 'length', 'type', 'data'], + type: 'object', }, - required: ['os', 'machine', 'version', 'release', 'name', 'node'], - type: 'object', - }, - sshAuthorizedKeys: { - $comment: 'List of SSH authorized keys found on host.', - items: { type: 'string' }, type: 'array', }, - systemdServices: { $comment: 'List of systemd services found on host.', items: { type: 'string' }, type: 'array' }, - systemdTimers: { $comment: 'List of systemd timers found on host.', items: { type: 'string' }, type: 'array' }, }, - required: [ - 'systemdTimers', - 'systemdServices', - 'sshAuthorizedKeys', - 'dockerContainers', - 'distribution', - 'kernel', - 'hardware', - 'cloud', - 'host', - ], + required: ['knownSshKeys', 'hosts'], type: 'object', } as const satisfies JSONSchema; -export type LhpData = FromSchema; +export type LhpPatrolReport = FromSchema; + +export type ArrayElement = ArrayType extends readonly (infer ElementType)[] + ? ElementType + : never; + +export type LhpHostReport = ArrayElement; const AJV = new Ajv(); -const LHP_PATROL_REPORT_VALIDATOR = AJV.compile(LHP_PATROL_REPORT_SCHEMA); +const LHP_PATROL_REPORT_VALIDATOR = AJV.compile(LHP_PATROL_REPORT_SCHEMA); const _LOCAL_STORAGE_KEY_DATA = 'LHP_DATA'; -export function loadData(): Either> { +export function loadData(): Either> { const data = localStorage.getItem(_LOCAL_STORAGE_KEY_DATA); if (data === null) { @@ -160,29 +232,14 @@ export function loadData(): Either> { return parseData(data).map(Just); } -export function saveData(x: LhpData[]): void { - localStorage.setItem(_LOCAL_STORAGE_KEY_DATA, JSON.stringify(x)); -} - -export function deleteData(): void { - localStorage.removeItem(_LOCAL_STORAGE_KEY_DATA); -} - -export function parseData(raw: string): Either { +export function parseData(data: string): Either { try { - const parsed = JSON.parse(raw); + const parsed = JSON.parse(data); + const result = LHP_PATROL_REPORT_VALIDATOR(parsed); - if (!Array.isArray(parsed)) { - return Left('Data is expected to be an array of host information objects.'); - } - - for (const elem of parsed) { - const result = LHP_PATROL_REPORT_VALIDATOR(elem); - - if (!result) { - console.error(elem, LHP_PATROL_REPORT_VALIDATOR.errors); - return Left('Invalid host information object.'); - } + if (!result) { + console.error(LHP_PATROL_REPORT_VALIDATOR.errors); + return Left('Invalid lhp patrol report object.'); } return Right(parsed); @@ -191,7 +248,15 @@ export function parseData(raw: string): Either { } } -export function DataLoader({ onLoadData }: { onLoadData: (x: LhpData[]) => void }) { +export function saveData(x: LhpPatrolReport): void { + localStorage.setItem(_LOCAL_STORAGE_KEY_DATA, JSON.stringify(x)); +} + +export function deleteData(): void { + localStorage.removeItem(_LOCAL_STORAGE_KEY_DATA); +} + +export function DataLoader({ onLoadData }: { onLoadData: (x: LhpPatrolReport) => void }) { const [error, setError] = useState(); const changeHandler = (e: ChangeEvent) => { diff --git a/website/src/components/app/index.tsx b/website/src/components/app/index.tsx index 71d094b..9f02e39 100644 --- a/website/src/components/app/index.tsx +++ b/website/src/components/app/index.tsx @@ -3,11 +3,11 @@ import { Just, Maybe, Nothing } from 'purify-ts/Maybe'; import { useEffect, useState } from 'react'; import { App } from './-app'; -import { DataLoader, LhpData, deleteData, loadData } from './-data'; +import { DataLoader, LhpPatrolReport, deleteData, loadData } from './-data'; import { BigSpinner } from './-ui'; export function AppMain() { - const [data, setAppData] = useState>>(Nothing); + const [data, setAppData] = useState>>(Nothing); useEffect(() => { loadData().caseOf({