From 57e7c8ef6b73c007384ee3b07edc1fb5615c6300 Mon Sep 17 00:00:00 2001 From: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com> Date: Mon, 12 Feb 2024 12:17:08 -0800 Subject: [PATCH] smp-server: add cert CLI command to rotate online certificate (#984) * smp-server: add gen-online CLI command * use CN and algo from old certificate * add cert checks to test * rename command * fix test * cert --------- Co-authored-by: Evgeny Poberezkin --- src/Simplex/Messaging/Server/CLI.hs | 16 +++--- src/Simplex/Messaging/Server/Main.hs | 73 +++++++++++++++++++++++++--- tests/CLITests.hs | 23 +++++++++ 3 files changed, 100 insertions(+), 12 deletions(-) diff --git a/src/Simplex/Messaging/Server/CLI.hs b/src/Simplex/Messaging/Server/CLI.hs index 249e9dcc0..26e3dfa42 100644 --- a/src/Simplex/Messaging/Server/CLI.hs +++ b/src/Simplex/Messaging/Server/CLI.hs @@ -32,7 +32,7 @@ import System.FilePath (combine) import System.IO (IOMode (..), hFlush, hGetLine, stdout, withFile) import System.Process (readCreateProcess, shell) -exitError :: String -> IO () +exitError :: String -> IO a exitError msg = putStrLn msg >> exitFailure confirmOrExit :: String -> IO () @@ -84,14 +84,18 @@ getCliCommand' cmdP version = versionOption = infoOption version (long "version" <> short 'v' <> help "Show version") createServerX509 :: FilePath -> X509Config -> IO ByteString -createServerX509 cfgPath x509cfg = do - createOpensslCaConf - createOpensslServerConf +createServerX509 = createServerX509_ True + +createServerX509_ :: Bool -> FilePath -> X509Config -> IO ByteString +createServerX509_ createCA cfgPath x509cfg = do let alg = show $ signAlgorithm (x509cfg :: X509Config) -- CA certificate (identity/offline) - run $ "openssl genpkey -algorithm " <> alg <> " -out " <> c caKeyFile - run $ "openssl req -new -x509 -days 999999 -config " <> c opensslCaConfFile <> " -extensions v3 -key " <> c caKeyFile <> " -out " <> c caCrtFile + when createCA $ do + createOpensslCaConf + run $ "openssl genpkey -algorithm " <> alg <> " -out " <> c caKeyFile + run $ "openssl req -new -x509 -days 999999 -config " <> c opensslCaConfFile <> " -extensions v3 -key " <> c caKeyFile <> " -out " <> c caCrtFile -- server certificate (online) + createOpensslServerConf run $ "openssl genpkey -algorithm " <> alg <> " -out " <> c serverKeyFile run $ "openssl req -new -config " <> c opensslServerConfFile <> " -reqexts v3 -key " <> c serverKeyFile <> " -out " <> c serverCsrFile run $ "openssl x509 -req -days 999999 -extfile " <> c opensslServerConfFile <> " -extensions v3 -in " <> c serverCsrFile <> " -CA " <> c caCrtFile <> " -CAkey " <> c caKeyFile <> " -CAcreateserial -out " <> c serverCrtFile diff --git a/src/Simplex/Messaging/Server/Main.hs b/src/Simplex/Messaging/Server/Main.hs index e02256aab..f52f0311b 100644 --- a/src/Simplex/Messaging/Server/Main.hs +++ b/src/Simplex/Messaging/Server/Main.hs @@ -10,12 +10,15 @@ module Simplex.Messaging.Server.Main where import Control.Concurrent.STM import Control.Monad (void) +import Data.ASN1.Types.String (asn1CharacterToString) import qualified Data.ByteString.Char8 as B import Data.Functor (($>)) import Data.Ini (lookupValue, readIniFile) import Data.Maybe (fromMaybe) import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8) +import qualified Data.X509 as X +import qualified Data.X509.File as XF import Network.Socket (HostName) import Options.Applicative import qualified Simplex.Messaging.Crypto as C @@ -41,6 +44,10 @@ smpServerCLI cfgPath logPath = doesFileExist iniFile >>= \case True -> exitError $ "Error: server is already initialized (" <> iniFile <> " exists).\nRun `" <> executableName <> " start`." _ -> initializeServer opts + OnlineCert certOpts -> + doesFileExist iniFile >>= \case + True -> genOnline certOpts + _ -> exitError $ "Error: server is not initialized (" <> iniFile <> " does not exist).\nRun `" <> executableName <> " init`." Start -> doesFileExist iniFile >>= \case True -> readIniFile iniFile >>= either exitError runServer @@ -56,8 +63,8 @@ smpServerCLI cfgPath logPath = defaultServerPort = "5223" executableName = "smp-server" storeLogFilePath = combine logPath "smp-server-store.log" - initializeServer opts - | scripted opts = initialize opts + initializeServer opts@InitOptions {ip, fqdn, scripted} + | scripted = initialize opts | otherwise = do putStrLn "Use `smp-server init -h` for available options." void $ withPrompt "SMP server will be initialized (press Enter)" getLine @@ -65,9 +72,9 @@ smpServerCLI cfgPath logPath = logStats <- onOffPrompt "Enable logging daily statistics" False putStrLn "Require a password to create new messaging queues?" password <- withPrompt "'r' for random (default), 'n' - no password, or enter password: " serverPassword - let host = fromMaybe (ip opts) (fqdn opts) + let host = fromMaybe ip fqdn host' <- withPrompt ("Enter server FQDN or IP address for certificate (" <> host <> "): ") getLine - initialize opts {enableStoreLog, logStats, fqdn = if null host' then fqdn opts else Just host', password} + initialize opts {enableStoreLog, logStats, fqdn = if null host' then fqdn else Just host', password} where serverPassword = getLine >>= \case @@ -78,7 +85,7 @@ smpServerCLI cfgPath logPath = case strDecode $ encodeUtf8 $ T.pack s of Right auth -> pure . Just $ ServerPassword auth _ -> putStrLn "Invalid password. Only latin letters, digits and symbols other than '@' and ':' are allowed" >> serverPassword - initialize InitOptions {enableStoreLog, logStats, signAlgorithm, ip, fqdn, password} = do + initialize InitOptions {enableStoreLog, logStats, signAlgorithm, password} = do clearDirIfExists cfgPath clearDirIfExists logPath createDirectoryIfMissing True cfgPath @@ -136,6 +143,30 @@ smpServerCLI cfgPath logPath = \disconnect: off\n" <> ("# ttl: " <> show (ttl defaultInactiveClientExpiration) <> "\n") <> ("# check_interval: " <> show (checkInterval defaultInactiveClientExpiration) <> "\n") + genOnline CertOptions {signAlgorithm_, commonName_} = do + (signAlgorithm, commonName) <- + case (signAlgorithm_, commonName_) of + (Just alg, Just cn) -> pure (alg, cn) + _ -> + XF.readSignedObject certPath >>= \case + [old] -> either exitError pure . fromX509 . X.signedObject $ X.getSigned old + [] -> exitError $ "No certificate found at " <> certPath + _ -> exitError $ "Too many certificates at " <> certPath + let x509cfg = defaultX509Config {signAlgorithm, commonName} + createServerX509_ False cfgPath x509cfg + putStrLn "Generated new server credentials" + warnCAPrivateKeyFile cfgPath x509cfg + where + certPath = combine cfgPath $ serverCrtFile defaultX509Config + fromX509 X.Certificate {certSignatureAlg, certSubjectDN} = (,) <$> maybe oldAlg Right signAlgorithm_ <*> maybe oldCN Right commonName_ + where + oldAlg = case certSignatureAlg of + X.SignatureALG_IntrinsicHash X.PubKeyALG_Ed448 -> Right ED448 + X.SignatureALG_IntrinsicHash X.PubKeyALG_Ed25519 -> Right ED25519 + alg -> Left $ "Unexpected signature algorithm " <> show alg + oldCN = case X.getDnElement X.DnCommonName certSubjectDN of + Nothing -> Left "Certificate subject has no CN element" + Just cn -> maybe (Left "Certificate subject CN decoding failed") Right $ asn1CharacterToString cn runServer ini = do hSetBuffering stdout LineBuffering hSetBuffering stderr LineBuffering @@ -210,6 +241,7 @@ smpServerCLI cfgPath logPath = data CliCommand = Init InitOptions + | OnlineCert CertOptions | Start | Delete @@ -227,10 +259,17 @@ data InitOptions = InitOptions data ServerPassword = ServerPassword BasicAuth | SPRandom deriving (Show) +data CertOptions = CertOptions + { signAlgorithm_ :: Maybe SignAlgorithm, + commonName_ :: Maybe HostName + } + deriving (Show) + cliCommandP :: FilePath -> FilePath -> FilePath -> Parser CliCommand cliCommandP cfgPath logPath iniFile = hsubparser ( command "init" (info (Init <$> initP) (progDesc $ "Initialize server - creates " <> cfgPath <> " and " <> logPath <> " directories and configuration files")) + <> command "cert" (info (OnlineCert <$> certP) (progDesc $ "Generate new online TLS server credentials (configuration: " <> iniFile <> ")")) <> command "start" (info (pure Start) (progDesc $ "Start server (configuration: " <> iniFile <> ")")) <> command "delete" (info (pure Delete) (progDesc "Delete configuration and log files")) ) @@ -255,7 +294,7 @@ cliCommandP cfgPath logPath iniFile = ( long "sign-algorithm" <> short 'a' <> help "Signature algorithm used for TLS certificates: ED25519, ED448" - <> value ED448 + <> value ED25519 <> showDefault <> metavar "ALG" ) @@ -293,5 +332,27 @@ cliCommandP cfgPath logPath iniFile = <> help "Non-interactive initialization using command-line options" ) pure InitOptions {enableStoreLog, logStats, signAlgorithm, ip, fqdn, password, scripted} + certP :: Parser CertOptions + certP = do + signAlgorithm_ <- + optional $ + option + (maybeReader readMaybe) + ( long "sign-algorithm" + <> short 'a' + <> help "Set new signature algorithm used for TLS certificates: ED25519, ED448" + <> showDefault + <> metavar "ALG" + ) + commonName_ <- + optional $ + strOption + ( long "cn" + <> help + "Set new Common Name for TLS online certificate" + <> showDefault + <> metavar "FQDN" + ) + pure CertOptions {signAlgorithm_, commonName_} parseBasicAuth :: ReadM ServerPassword parseBasicAuth = eitherReader $ fmap ServerPassword . strDecode . B.pack diff --git a/tests/CLITests.hs b/tests/CLITests.hs index 40915515b..032c1f748 100644 --- a/tests/CLITests.hs +++ b/tests/CLITests.hs @@ -1,9 +1,12 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} module CLITests where import Data.Ini (lookupValue, readIniFile) import Data.List (isPrefixOf) +import qualified Data.X509 as X +import qualified Data.X509.File as XF import Simplex.FileTransfer.Server.Main (xftpServerCLI, xftpServerVersion) import Simplex.Messaging.Notifications.Server.Main import Simplex.Messaging.Server.Main @@ -11,6 +14,7 @@ import Simplex.Messaging.Transport (simplexMQVersion) import Simplex.Messaging.Util (catchAll_) import System.Directory (doesFileExist) import System.Environment (withArgs) +import System.FilePath (()) import System.IO.Silently (capture_) import System.Timeout (timeout) import Test.Hspec @@ -51,6 +55,7 @@ cliTests = do smpServerTest :: Bool -> Bool -> IO () smpServerTest storeLog basicAuth = do + -- init capture_ (withArgs (["init", "-y"] <> ["-l" | storeLog] <> ["--no-password" | not basicAuth]) $ smpServerCLI cfgPath logPath) >>= (`shouldSatisfy` (("Server initialized, you can modify configuration in " <> cfgPath <> "/smp-server.ini") `isPrefixOf`)) Right ini <- readIniFile $ cfgPath <> "/smp-server.ini" @@ -61,12 +66,30 @@ smpServerTest storeLog basicAuth = do lookupValue "AUTH" "new_queues" ini `shouldBe` Right "on" lookupValue "INACTIVE_CLIENTS" "disconnect" ini `shouldBe` Right "off" doesFileExist (cfgPath <> "/ca.key") `shouldReturn` True + -- start r <- lines <$> capture_ (withArgs ["start"] $ (100000 `timeout` smpServerCLI cfgPath logPath) `catchAll_` pure (Just ())) r `shouldContain` ["SMP server v" <> simplexMQVersion] r `shouldContain` (if storeLog then ["Store log: " <> logPath <> "/smp-server-store.log"] else ["Store log disabled."]) r `shouldContain` ["Listening on port 5223 (TLS)..."] r `shouldContain` ["not expiring inactive clients"] r `shouldContain` (if basicAuth then ["creating new queues requires password"] else ["creating new queues allowed"]) + -- cert + let certPath = cfgPath "server.crt" + oldCrt@X.Certificate {} <- + XF.readSignedObject certPath >>= \case + [cert] -> pure . X.signedObject $ X.getSigned cert + _ -> error "bad crt format" + r' <- lines <$> capture_ (withArgs ["cert"] $ (100000 `timeout` smpServerCLI cfgPath logPath) `catchAll_` pure (Just ())) + r' `shouldContain` ["Generated new server credentials"] + newCrt <- + XF.readSignedObject certPath >>= \case + [cert] -> pure . X.signedObject $ X.getSigned cert + _ -> error "bad crt format after cert" + X.certSignatureAlg oldCrt `shouldBe` X.certSignatureAlg newCrt + X.certSubjectDN oldCrt `shouldBe` X.certSubjectDN newCrt + X.certSerial oldCrt `shouldNotBe` X.certSerial newCrt + X.certPubKey oldCrt `shouldNotBe` X.certPubKey newCrt + -- delete capture_ (withStdin "Y" . withArgs ["delete"] $ smpServerCLI cfgPath logPath) >>= (`shouldSatisfy` ("WARNING: deleting the server will make all queues inaccessible" `isPrefixOf`)) doesFileExist (cfgPath <> "/ca.key") `shouldReturn` False