From 9ab34bca7d706339c7c0733aebbd2dab96a3c17c Mon Sep 17 00:00:00 2001 From: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com> Date: Fri, 16 Feb 2024 12:56:54 +0200 Subject: [PATCH] cli: add cert command to xftp and ntf servers (#991) Co-authored-by: Evgeny Poberezkin --- src/Simplex/FileTransfer/Server/Main.hs | 6 ++ .../Messaging/Notifications/Server/Main.hs | 6 ++ src/Simplex/Messaging/Server/CLI.hs | 58 ++++++++++++++++++ src/Simplex/Messaging/Server/Main.hs | 60 +------------------ 4 files changed, 73 insertions(+), 57 deletions(-) diff --git a/src/Simplex/FileTransfer/Server/Main.hs b/src/Simplex/FileTransfer/Server/Main.hs index 4f5d0558c..9d55f250d 100644 --- a/src/Simplex/FileTransfer/Server/Main.hs +++ b/src/Simplex/FileTransfer/Server/Main.hs @@ -42,6 +42,10 @@ xftpServerCLI cfgPath logPath = do doesFileExist iniFile >>= \case True -> exitError $ "Error: server is already initialized (" <> iniFile <> " exists).\nRun `" <> executableName <> " start`." _ -> initializeServer opts + OnlineCert certOpts -> + doesFileExist iniFile >>= \case + True -> genOnline cfgPath certOpts + _ -> exitError $ "Error: server is not initialized (" <> iniFile <> " does not exist).\nRun `" <> executableName <> " init`." Start -> doesFileExist iniFile >>= \case True -> readIniFile iniFile >>= either exitError runServer @@ -179,6 +183,7 @@ xftpServerCLI cfgPath logPath = do data CliCommand = Init InitOptions + | OnlineCert CertOptions | Start | Delete @@ -196,6 +201,7 @@ 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 <$> certOptionsP) (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")) ) diff --git a/src/Simplex/Messaging/Notifications/Server/Main.hs b/src/Simplex/Messaging/Notifications/Server/Main.hs index 53d134abd..f3d47e5c3 100644 --- a/src/Simplex/Messaging/Notifications/Server/Main.hs +++ b/src/Simplex/Messaging/Notifications/Server/Main.hs @@ -42,6 +42,10 @@ ntfServerCLI 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 cfgPath certOpts + _ -> exitError $ "Error: server is not initialized (" <> iniFile <> " does not exist).\nRun `" <> executableName <> " init`." Start -> doesFileExist iniFile >>= \case True -> readIniFile iniFile >>= either exitError runServer @@ -143,6 +147,7 @@ ntfServerCLI cfgPath logPath = data CliCommand = Init InitOptions + | OnlineCert CertOptions | Start | Delete @@ -158,6 +163,7 @@ 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 <$> certOptionsP) (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")) ) diff --git a/src/Simplex/Messaging/Server/CLI.hs b/src/Simplex/Messaging/Server/CLI.hs index f9dcc945a..9531a2ca5 100644 --- a/src/Simplex/Messaging/Server/CLI.hs +++ b/src/Simplex/Messaging/Server/CLI.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-} @@ -10,6 +11,7 @@ module Simplex.Messaging.Server.CLI where import Control.Monad +import Data.ASN1.Types (asn1CharacterToString) import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B import Data.Either (fromRight) @@ -17,6 +19,8 @@ import Data.Ini (Ini, lookupValue) import Data.Text (Text) 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 Data.X509.Validation (Fingerprint (..)) import Network.Socket (HostName, ServiceName) import Options.Applicative @@ -32,6 +36,7 @@ import System.Exit (exitFailure) import System.FilePath (combine) import System.IO (IOMode (..), hFlush, hGetLine, stdout, withFile) import System.Process (readCreateProcess, shell) +import Text.Read (readMaybe) exitError :: String -> IO a exitError msg = putStrLn msg >> exitFailure @@ -136,6 +141,59 @@ createServerX509_ createCA cfgPath x509cfg = do withFile (c fingerprintFile) WriteMode (`B.hPutStrLn` strEncode fp) pure fp +data CertOptions = CertOptions + { signAlgorithm_ :: Maybe SignAlgorithm, + commonName_ :: Maybe HostName + } + deriving (Show) + +certOptionsP :: Parser CertOptions +certOptionsP = do + signAlgorithm_ <- + optional $ + option + (maybeReader readMaybe) + ( long "sign-algorithm" + <> short 'a' + <> help "Set new signature algorithm used for TLS certificates: ED25519, ED448" + <> metavar "ALG" + ) + commonName_ <- + optional $ + strOption + ( long "cn" + <> help + "Set new Common Name for TLS online certificate" + <> metavar "FQDN" + ) + pure CertOptions {signAlgorithm_, commonName_} + +genOnline :: FilePath -> CertOptions -> IO () +genOnline cfgPath 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} + void $ 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 + warnCAPrivateKeyFile :: FilePath -> X509Config -> IO () warnCAPrivateKeyFile cfgPath X509Config {caKeyFile} = putStrLn $ diff --git a/src/Simplex/Messaging/Server/Main.hs b/src/Simplex/Messaging/Server/Main.hs index f52f0311b..13b2af4a3 100644 --- a/src/Simplex/Messaging/Server/Main.hs +++ b/src/Simplex/Messaging/Server/Main.hs @@ -10,15 +10,12 @@ 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 @@ -46,7 +43,7 @@ smpServerCLI cfgPath logPath = _ -> initializeServer opts OnlineCert certOpts -> doesFileExist iniFile >>= \case - True -> genOnline certOpts + True -> genOnline cfgPath certOpts _ -> exitError $ "Error: server is not initialized (" <> iniFile <> " does not exist).\nRun `" <> executableName <> " init`." Start -> doesFileExist iniFile >>= \case @@ -143,30 +140,6 @@ 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 @@ -259,17 +232,11 @@ 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 "cert" (info (OnlineCert <$> certOptionsP) (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")) ) @@ -332,27 +299,6 @@ 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 +