diff --git a/apps/smp-server/Main.hs b/apps/smp-server/Main.hs index 76beddb88..c0802a66b 100644 --- a/apps/smp-server/Main.hs +++ b/apps/smp-server/Main.hs @@ -7,36 +7,41 @@ module Main where -import Control.Monad (forM_, unless, when) +import Control.Monad.Except +import Control.Monad.Trans.Except import qualified Crypto.Store.PKCS8 as S import Data.ByteString.Base64 (encode) import qualified Data.ByteString.Char8 as B import Data.Char (toLower) -import Data.Functor (($>)) -import Data.Ini (lookupValue, readIniFile) +import Data.Ini (Ini, lookupValue, readIniFile) +import Data.Text (Text) import qualified Data.Text as T import Data.X509 (PrivKey (PrivKeyRSA)) +import Network.Socket (ServiceName) import Options.Applicative import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Server (runSMPServer) import Simplex.Messaging.Server.Env.STM -import Simplex.Messaging.Server.StoreLog (StoreLog, openReadStoreLog) +import Simplex.Messaging.Server.StoreLog (StoreLog, openReadStoreLog, storeLogFilePath) import Simplex.Messaging.Transport (ATransport (..), TCP, Transport (..)) import Simplex.Messaging.Transport.WebSockets (WS) -import System.Directory (createDirectoryIfMissing, doesFileExist) +import System.Directory (createDirectoryIfMissing, doesFileExist, removeFile) import System.Exit (exitFailure) import System.FilePath (combine) import System.IO (IOMode (..), hFlush, stdout) -cfg :: ServerConfig -cfg = +defaultServerPort :: ServiceName +defaultServerPort = "5223" + +serverConfig :: ServerConfig +serverConfig = ServerConfig - { transports = [("5223", transport @TCP), ("80", transport @WS)], - tbqSize = 16, + { tbqSize = 16, queueIdBytes = 12, msgIdBytes = 6, - storeLog = Nothing, - -- key is loaded from the file server_key in /etc/opt/simplex directory + -- below parameters are set based on ini file /etc/opt/simplex/smp-server.ini + transports = undefined, + storeLog = undefined, serverPrivateKey = undefined } @@ -52,77 +57,162 @@ logDir = "/var/opt/simplex" defaultStoreLogFile :: FilePath defaultStoreLogFile = combine logDir "smp-server-store.log" +iniFile :: FilePath +iniFile = combine cfgDir "smp-server.ini" + +defaultKeyFile :: FilePath +defaultKeyFile = combine cfgDir "server_key" + main :: IO () main = do opts <- getServerOpts - putStrLn "SMP Server (-h for help)" - ini <- readCreateIni opts - storeLog <- openStoreLog ini - pk <- readCreateKey - B.putStrLn $ "transport key hash: " <> serverKeyHash pk + case serverCommand opts of + ServerInit -> + runExceptT (getConfig opts) >>= \case + Right cfg -> do + putStrLn "Error: server is already initialized. Start it with `smp-server start` command" + printConfig cfg + exitFailure + Left _ -> do + cfg <- initializeServer opts + putStrLn "Server was initialized. Start it with `smp-server start` command" + printConfig cfg + ServerStart -> + runExceptT (getConfig opts) >>= \case + Right cfg -> runServer cfg + Left e -> do + putStrLn $ "Server is not initialized: " <> e + putStrLn "Initialize server with `smp-server init` command" + exitFailure + ServerDelete -> do + deleteServer + putStrLn "Server key, config file and store log deleted" + +getConfig :: ServerOpts -> ExceptT String IO ServerConfig +getConfig opts = do + ini <- readIni + pk <- readKey ini + storeLog <- liftIO $ openStoreLog opts ini + pure $ makeConfig ini pk storeLog + +makeConfig :: IniOpts -> C.FullPrivateKey -> Maybe (StoreLog 'ReadMode) -> ServerConfig +makeConfig IniOpts {serverPort, enableWebsockets} pk storeLog = + let transports = (serverPort, transport @TCP) : [("80", transport @WS) | enableWebsockets] + in serverConfig {serverPrivateKey = pk, storeLog, transports} + +printConfig :: ServerConfig -> IO () +printConfig ServerConfig {serverPrivateKey, storeLog} = do + B.putStrLn $ "transport key hash: " <> serverKeyHash serverPrivateKey + putStrLn $ case storeLog of + Just s -> "store log: " <> storeLogFilePath s + Nothing -> "store log disabled" + +initializeServer :: ServerOpts -> IO ServerConfig +initializeServer opts = do + ini <- createIni opts + pk <- createKey ini + storeLog <- openStoreLog opts ini + pure $ makeConfig ini pk storeLog + +runServer :: ServerConfig -> IO () +runServer cfg = do + printConfig cfg forM_ (transports cfg) $ \(port, ATransport t) -> putStrLn $ "listening on port " <> port <> " (" <> transportName t <> ")" - runSMPServer cfg {serverPrivateKey = pk, storeLog} + runSMPServer cfg + +deleteServer :: IO () +deleteServer = do + ini <- runExceptT readIni + deleteIfExists iniFile + case ini of + Right IniOpts {storeLogFile, serverKeyFile} -> do + deleteIfExists storeLogFile + deleteIfExists serverKeyFile + Left _ -> do + deleteIfExists defaultKeyFile + deleteIfExists defaultStoreLogFile data IniOpts = IniOpts { enableStoreLog :: Bool, - storeLogFile :: FilePath + storeLogFile :: FilePath, + serverKeyFile :: FilePath, + serverPort :: ServiceName, + enableWebsockets :: Bool } -readCreateIni :: ServerOpts -> IO IniOpts -readCreateIni ServerOpts {configFile} = do - createDirectoryIfMissing True cfgDir - doesFileExist configFile >>= (`unless` createIni) - readIni +readIni :: ExceptT String IO IniOpts +readIni = do + fileExists iniFile + ini <- ExceptT $ readIniFile iniFile + let enableStoreLog = (== Right "on") $ lookupValue "STORE_LOG" "enable" ini + storeLogFile = opt defaultStoreLogFile "STORE_LOG" "file" ini + serverKeyFile = opt defaultKeyFile "TRANSPORT" "key_file" ini + serverPort = opt defaultServerPort "TRANSPORT" "port" ini + enableWebsockets = (== Right "on") $ lookupValue "TRANSPORT" "websockets" ini + pure IniOpts {enableStoreLog, storeLogFile, serverKeyFile, serverPort, enableWebsockets} where - readIni :: IO IniOpts - readIni = do - ini <- either exitError pure =<< readIniFile configFile - let enableStoreLog = (== Right "on") $ lookupValue "STORE_LOG" "enable" ini - storeLogFile = either (const defaultStoreLogFile) T.unpack $ lookupValue "STORE_LOG" "file" ini - pure IniOpts {enableStoreLog, storeLogFile} - exitError e = do - putStrLn $ "error reading config file " <> configFile <> ": " <> e - exitFailure - createIni :: IO () - createIni = do - confirm $ "Save default ini file to " <> configFile - writeFile - configFile - "[STORE_LOG]\n\ - \# The server uses STM memory to store SMP queues and messages,\n\ - \# that will be lost on restart (e.g., as with redis).\n\ - \# This option enables saving SMP queues to append only log,\n\ - \# and restoring them when the server is started.\n\ - \# Log is compacted on start (deleted queues are removed).\n\ - \# The messages in the queues are not logged.\n\ - \\n\ - \# enable: on\n\ - \# file: /var/opt/simplex/smp-server-store.log\n" + opt :: String -> Text -> Text -> Ini -> String + opt def section key ini = either (const def) T.unpack $ lookupValue section key ini -readCreateKey :: IO C.FullPrivateKey -readCreateKey = do - createDirectoryIfMissing True cfgDir - let path = combine cfgDir "server_key" - hasKey <- doesFileExist path - (if hasKey then readKey else createKey) path +createIni :: ServerOpts -> IO IniOpts +createIni ServerOpts {enableStoreLog} = do + writeFile iniFile $ + "[STORE_LOG]\n\ + \# The server uses STM memory to store SMP queues and messages,\n\ + \# that will be lost on restart (e.g., as with redis).\n\ + \# This option enables saving SMP queues to append only log,\n\ + \# and restoring them when the server is started.\n\ + \# Log is compacted on start (deleted queues are removed).\n\ + \# The messages in the queues are not logged.\n\n" + <> (if enableStoreLog then "" else "# ") + <> "enable: on\n\ + \# file: " + <> defaultStoreLogFile + <> "\n\n\ + \[TRANSPORT]\n\n\ + \# key_file: " + <> defaultKeyFile + <> "\n\ + \# port: " + <> defaultServerPort + <> "\n\ + \websockets: on\n" + pure + IniOpts + { enableStoreLog, + storeLogFile = defaultStoreLogFile, + serverKeyFile = defaultKeyFile, + serverPort = defaultServerPort, + enableWebsockets = True + } + +readKey :: IniOpts -> ExceptT String IO C.FullPrivateKey +readKey IniOpts {serverKeyFile} = do + fileExists serverKeyFile + liftIO (S.readKeyFile serverKeyFile) >>= \case + [S.Unprotected (PrivKeyRSA pk)] -> pure $ C.FullPrivateKey pk + [_] -> err "not RSA key" + [] -> err "invalid key file format" + _ -> err "more than one key" where - createKey :: FilePath -> IO C.FullPrivateKey - createKey path = do - confirm "Generate new server key pair" - (_, pk) <- C.generateKeyPair newKeySize - S.writeKeyFile S.TraditionalFormat path [PrivKeyRSA $ C.rsaPrivateKey pk] - pure pk - readKey :: FilePath -> IO C.FullPrivateKey - readKey path = do - S.readKeyFile path >>= \case - [S.Unprotected (PrivKeyRSA pk)] -> pure $ C.FullPrivateKey pk - [_] -> errorExit "not RSA key" - [] -> errorExit "invalid key file format" - _ -> errorExit "more than one key" - where - errorExit :: String -> IO b - errorExit e = putStrLn (e <> ": " <> path) >> exitFailure + err :: String -> ExceptT String IO b + err e = throwE $ e <> ": " <> serverKeyFile + +createKey :: IniOpts -> IO C.FullPrivateKey +createKey IniOpts {serverKeyFile} = do + createDirectoryIfMissing True cfgDir + (_, pk) <- C.generateKeyPair newKeySize + S.writeKeyFile S.TraditionalFormat serverKeyFile [PrivKeyRSA $ C.rsaPrivateKey pk] + pure pk + +fileExists :: FilePath -> ExceptT String IO () +fileExists path = do + exists <- liftIO $ doesFileExist path + unless exists . throwE $ "file " <> path <> " not found" + +deleteIfExists :: FilePath -> IO () +deleteIfExists path = doesFileExist path >>= (`when` removeFile path) confirm :: String -> IO () confirm msg = do @@ -134,38 +224,41 @@ confirm msg = do serverKeyHash :: C.FullPrivateKey -> B.ByteString serverKeyHash = encode . C.unKeyHash . C.publicKeyHash . C.publicKey -openStoreLog :: IniOpts -> IO (Maybe (StoreLog 'ReadMode)) -openStoreLog IniOpts {enableStoreLog, storeLogFile = f} - | enableStoreLog = do +openStoreLog :: ServerOpts -> IniOpts -> IO (Maybe (StoreLog 'ReadMode)) +openStoreLog ServerOpts {enableStoreLog = l} IniOpts {enableStoreLog = l', storeLogFile = f} + | l || l' = do createDirectoryIfMissing True logDir - putStrLn ("store log: " <> f) Just <$> openReadStoreLog f - | otherwise = putStrLn "store log disabled" $> Nothing + | otherwise = pure Nothing -newtype ServerOpts = ServerOpts - { configFile :: FilePath +data ServerOpts = ServerOpts + { serverCommand :: ServerCommand, + enableStoreLog :: Bool } +data ServerCommand = ServerInit | ServerStart | ServerDelete + serverOpts :: Parser ServerOpts serverOpts = ServerOpts - <$> strOption - ( long "config" - <> short 'c' - <> metavar "INI_FILE" - <> help ("config file (" <> defaultIniFile <> ")") - <> value defaultIniFile + <$> subparser + ( command "init" (info (pure ServerInit) (progDesc "Initialize server: generate server key and ini file")) + <> command "start" (info (pure ServerStart) (progDesc "Start server (ini: /etc/opt/simplex/smp-server.ini)")) + <> command "delete" (info (pure ServerDelete) (progDesc "Delete server key, ini file and store log")) + ) + <*> switch + ( long "store-log" + <> short 'l' + <> help "enable store log for SMP queues persistence" ) - where - defaultIniFile = combine cfgDir "smp-server.ini" getServerOpts :: IO ServerOpts -getServerOpts = execParser opts +getServerOpts = customExecParser p opts where + p = prefs showHelpOnEmpty opts = info (serverOpts <**> helper) ( fullDesc <> header "Simplex Messaging Protocol (SMP) Server" - <> progDesc "Start server with INI_FILE (created on first run)" ) diff --git a/src/Simplex/Messaging/Server/StoreLog.hs b/src/Simplex/Messaging/Server/StoreLog.hs index 5841b23c5..8dd468442 100644 --- a/src/Simplex/Messaging/Server/StoreLog.hs +++ b/src/Simplex/Messaging/Server/StoreLog.hs @@ -10,6 +10,7 @@ module Simplex.Messaging.Server.StoreLog ( StoreLog, -- constructors are not exported openWriteStoreLog, openReadStoreLog, + storeLogFilePath, closeStoreLog, logCreateQueue, logSecureQueue, @@ -88,6 +89,11 @@ openReadStoreLog f = do doesFileExist f >>= (`unless` writeFile f "") ReadStoreLog f <$> openFile f ReadMode +storeLogFilePath :: StoreLog a -> FilePath +storeLogFilePath = \case + WriteStoreLog f _ -> f + ReadStoreLog f _ -> f + closeStoreLog :: StoreLog a -> IO () closeStoreLog = \case WriteStoreLog _ h -> hClose h