Lisää komento palvelimen tilan tulostamiseen
This commit is contained in:
parent
a1fb59a5ad
commit
5862f87add
14
src/Main.hs
14
src/Main.hs
@ -30,6 +30,7 @@ import TiedoteMD.Review
|
|||||||
import TiedoteMD.Send
|
import TiedoteMD.Send
|
||||||
import TiedoteMD.State
|
import TiedoteMD.State
|
||||||
import TiedoteMD.Types
|
import TiedoteMD.Types
|
||||||
|
import TiedoteMD.Debug
|
||||||
|
|
||||||
serverMain :: SockAddr -> Mailbox -> FilePath -> FilePath -> IO ()
|
serverMain :: SockAddr -> Mailbox -> FilePath -> FilePath -> IO ()
|
||||||
serverMain socket mail repoPath sendmailPath = do
|
serverMain socket mail repoPath sendmailPath = do
|
||||||
@ -50,8 +51,15 @@ clientMain socket mail sendmailPath = do
|
|||||||
`onException` exitWith codeTempFail
|
`onException` exitWith codeTempFail
|
||||||
manageIncomingEmail acid mail sendmailPath
|
manageIncomingEmail acid mail sendmailPath
|
||||||
|
|
||||||
|
printStateMain :: SockAddr -> IO ()
|
||||||
|
printStateMain socket = do
|
||||||
|
acid <- openRemoteStateSockAddr skipAuthenticationPerform socket
|
||||||
|
`onException` openLocalState emptyState
|
||||||
|
`onException` exitWith codeTempFail
|
||||||
|
printState 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 } | Recieve deriving Show
|
data RunMode = Server { repoPath :: FilePath } | Recieve | Print deriving Show
|
||||||
|
|
||||||
config :: Maybe Mailbox -> Parser Config
|
config :: Maybe Mailbox -> Parser Config
|
||||||
config mail = Config
|
config mail = Config
|
||||||
@ -59,7 +67,8 @@ config mail = Config
|
|||||||
<*> option readMailbox (long "address" <> short 'a' <> metavar "EMAIL" <> maybe mempty value mail <> help "Email address to send and recieve mail")
|
<*> option readMailbox (long "address" <> short 'a' <> metavar "EMAIL" <> maybe mempty value mail <> help "Email address to send and recieve mail")
|
||||||
<*> 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 "recieve" (info (pure Recieve) (progDesc "Recieve an email")))
|
<> command "recieve" (info (pure Recieve) (progDesc "Recieve an email"))
|
||||||
|
<> command "state" (info (pure Print) (progDesc "Print the server's current state")))
|
||||||
|
|
||||||
serverCommand :: Parser RunMode
|
serverCommand :: Parser RunMode
|
||||||
serverCommand = Server <$> strOption (long "repository" <> short 'r' <> metavar "DIRECTORY" <> value "/var/lib/tiedote.md/git-repo" <> showDefault <> help "Path to git repository")
|
serverCommand = Server <$> strOption (long "repository" <> short 'r' <> metavar "DIRECTORY" <> value "/var/lib/tiedote.md/git-repo" <> showDefault <> help "Path to git repository")
|
||||||
@ -78,4 +87,5 @@ main = do
|
|||||||
findExecutable (sendmailCommand args)
|
findExecutable (sendmailCommand args)
|
||||||
case args of
|
case args of
|
||||||
Config {runMode = Recieve, ..} -> clientMain (SockAddrUnix socketPath) mail sendmailPath
|
Config {runMode = Recieve, ..} -> clientMain (SockAddrUnix socketPath) mail sendmailPath
|
||||||
|
Config {runMode = Print, ..} -> printStateMain (SockAddrUnix socketPath)
|
||||||
Config {runMode = Server {..}, ..} -> serverMain (SockAddrUnix socketPath) mail repoPath sendmailPath
|
Config {runMode = Server {..}, ..} -> serverMain (SockAddrUnix socketPath) mail repoPath sendmailPath
|
||||||
|
8
src/TiedoteMD/Debug.hs
Normal file
8
src/TiedoteMD/Debug.hs
Normal file
@ -0,0 +1,8 @@
|
|||||||
|
module TiedoteMD.Debug where
|
||||||
|
|
||||||
|
import Data.Acid (AcidState, query)
|
||||||
|
|
||||||
|
import TiedoteMD.State
|
||||||
|
|
||||||
|
printState :: AcidState State -> IO ()
|
||||||
|
printState acid = query acid GetState >>= print
|
@ -55,6 +55,7 @@ executable tiedote.md
|
|||||||
utf8-string
|
utf8-string
|
||||||
main-is: Main.hs
|
main-is: Main.hs
|
||||||
other-modules:
|
other-modules:
|
||||||
|
TiedoteMD.Debug
|
||||||
TiedoteMD.Git
|
TiedoteMD.Git
|
||||||
TiedoteMD.Read
|
TiedoteMD.Read
|
||||||
TiedoteMD.Review
|
TiedoteMD.Review
|
||||||
|
Loading…
Reference in New Issue
Block a user