From 4b902e9e5a1242b2844a3449a21c85f13b8860bd Mon Sep 17 00:00:00 2001 From: Saku Laesvuori Date: Fri, 22 Dec 2023 22:02:55 +0200 Subject: [PATCH] =?UTF-8?q?Lis=C3=A4=C3=A4=20komento=20tietokantaversioide?= =?UTF-8?q?n=20arkistointiin?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/Main.hs | 16 +++++++++++++--- 1 file changed, 13 insertions(+), 3 deletions(-) diff --git a/src/Main.hs b/src/Main.hs index d1c9d34..7273da6 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -8,7 +8,7 @@ import Control.Concurrent (forkIO, threadDelay) import Control.Exception (onException) import Control.Exception (throwIO) import Control.Monad (void, forever) -import Data.Acid (openLocalState, createCheckpoint) +import Data.Acid (AcidState(..), openLocalState, createCheckpoint, createArchive) import Data.Acid.Remote (skipAuthenticationCheck, acidServerSockAddr, openRemoteStateSockAddr, skipAuthenticationPerform) import Data.IMF (Mailbox, parse, mailbox) import Data.MIME.Charset (defaultCharsets) @@ -59,8 +59,16 @@ printStateMain socket = do `onException` exitWith codeTempFail printState acid +archiveMain :: SockAddr -> IO () +archiveMain socket = do + acid <- openRemoteStateSockAddr skipAuthenticationPerform socket + `onException` openLocalState emptyState + `onException` exitWith codeTempFail + createCheckpoint (acid :: AcidState State) + createArchive acid + data Config = Config { socketPath :: FilePath, mail :: Mailbox, sendmailCommand :: String, runMode :: RunMode } deriving Show -data RunMode = Server { repoPath :: FilePath, portNumber :: Int, checkpointDelay :: Int } | Receive | Print deriving Show +data RunMode = Server { repoPath :: FilePath, portNumber :: Int, checkpointDelay :: Int } | Receive | Print | Archive deriving Show config :: Maybe Mailbox -> Parser Config config mail = Config @@ -69,7 +77,8 @@ config mail = Config <*> strOption (long "sendmail" <> short 'm' <> metavar "FILE" <> value "sendmail" <> help "Sendmail command") <*> hsubparser (command "server" (info serverCommand (progDesc "Run the server")) <> command "receive" (info (pure Receive) (progDesc "Receive an email")) - <> command "state" (info (pure Print) (progDesc "Print the server's current state"))) + <> command "state" (info (pure Print) (progDesc "Print the server's current state")) + <> command "archive" (info (pure Archive) (progDesc "Archive old versions of the database"))) serverCommand :: Parser RunMode serverCommand = Server @@ -92,4 +101,5 @@ main = do case args of Config {runMode = Receive, ..} -> clientMain (SockAddrUnix socketPath) mail sendmailPath Config {runMode = Print, ..} -> printStateMain (SockAddrUnix socketPath) + Config {runMode = Archive, ..} -> archiveMain (SockAddrUnix socketPath) Config {runMode = Server {..}, ..} -> serverMain (SockAddrUnix socketPath) mail repoPath sendmailPath checkpointDelay portNumber