OMS/tiedote.md
3
0
Fork 0
Code Issues 14 Pull Requests Projects Releases Wiki Activity

Lisää komento tietokantaversioiden arkistointiin

Browse Source
This commit is contained in:
Saku Laesvuori 2023-12-22 22:02:55 +02:00
parent f3a58b0bbb
commit 4b902e9e5a
Signed by: slaesvuo
GPG Key ID: 257D284A2A1D3A32
1 changed files with 13 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
src/Main.hs
View File

@ -8,7 +8,7 @@ import Control.Concurrent (forkIO, threadDelay)
import Control.Exception (onException) import Control.Exception (onException)
import Control.Exception (throwIO) import Control.Exception (throwIO)
import Control.Monad (void, forever) 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.Acid.Remote (skipAuthenticationCheck, acidServerSockAddr, openRemoteStateSockAddr, skipAuthenticationPerform)
import Data.IMF (Mailbox, parse, mailbox) import Data.IMF (Mailbox, parse, mailbox)
import Data.MIME.Charset (defaultCharsets) import Data.MIME.Charset (defaultCharsets)
@ -59,8 +59,16 @@ printStateMain socket = do
`onException` exitWith codeTempFail `onException` exitWith codeTempFail
printState acid 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 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 :: Maybe Mailbox -> Parser Config
config mail = Config config mail = Config
@ -69,7 +77,8 @@ config mail = Config
<*> strOption (long "sendmail" <> short 'm' <> metavar "FILE" <> value "sendmail" <> help "Sendmail command") <*> strOption (long "sendmail" <> short 'm' <> metavar "FILE" <> value "sendmail" <> help "Sendmail command")
<*> hsubparser (command "server" (info serverCommand (progDesc "Run the server")) <*> hsubparser (command "server" (info serverCommand (progDesc "Run the server"))
<> command "receive" (info (pure Receive) (progDesc "Receive an email")) <> 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 :: Parser RunMode
serverCommand = Server serverCommand = Server
@ -92,4 +101,5 @@ main = do
case args of case args of
Config {runMode = Receive, ..} -> clientMain (SockAddrUnix socketPath) mail sendmailPath Config {runMode = Receive, ..} -> clientMain (SockAddrUnix socketPath) mail sendmailPath
Config {runMode = Print, ..} -> printStateMain (SockAddrUnix socketPath) Config {runMode = Print, ..} -> printStateMain (SockAddrUnix socketPath)
Config {runMode = Archive, ..} -> archiveMain (SockAddrUnix socketPath)
Config {runMode = Server {..}, ..} -> serverMain (SockAddrUnix socketPath) mail repoPath sendmailPath checkpointDelay portNumber Config {runMode = Server {..}, ..} -> serverMain (SockAddrUnix socketPath) mail repoPath sendmailPath checkpointDelay portNumber