Merge pull request #41 from vst/vst/sshkey-fixes-and-improvements

SSH Public Key Fixes, Improvements

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
@@ -89,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
@@ -112,10 +122,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]

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

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

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

src/Lhp/Remote.hs

@@ -8,17 +8,23 @@
 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
 import qualified Zamazingo.Text as Z.Text
@@ -27,25 +33,47 @@ 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
+  _reportKnownSshKeys <- mapM parseSshPublicKey _configKnownSshKeys
+  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
-  _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
+  _hostReportAuthorizedSshKeys <- _fetchHostAuthorizedSshKeys _hostName >>= mapM parseSshPublicKey
+  _hostReportSystemdServices <- _fetchHostSystemdServices _hostName
+  _hostReportSystemdTimers <- _fetchHostSystemdTimers _hostName
+  pure Types.HostReport {..}
 
 
 -- * Errors
@@ -56,12 +84,14 @@ compileReport [email protected] {..} = 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
@@ -110,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"])
@@ -354,3 +384,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", "-"])