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 (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