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

Lisää kätevämmät valitsimet lähetysosoitteelle

Browse Source 
Aiemmin lähetysosoite piti kirjoittaa kometoriville muodossa, jossa
kaikki merkit on koodattu ASCIIksi. Nyt lähetysosoitteen nimen voi
määrittää --sender-name valitsimella, joka hyväksyy kaikki merkit
suoraan.
This commit is contained in:
Saku Laesvuori 2024-01-04 12:44:02 +02:00
parent e3fcaee0bf
commit c4c9acc966
Signed by: slaesvuo
GPG Key ID: 257D284A2A1D3A32
1 changed files with 11 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
src/Main.hs
View File

@ -4,13 +4,14 @@
module Main where
import Control.Applicative (optional)
import Control.Concurrent (forkIO, threadDelay)
import Control.Exception (onException)
import Control.Exception (throwIO)
import Control.Monad (void, forever)
import Data.Acid (AcidState(..), openLocalState, createCheckpoint, createArchive)
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.Text.Encoding (encodeUtf8)
import Network.HostName (getHostName)
@ -73,7 +74,7 @@ data RunMode = Server { repoPath :: FilePath, portNumber :: Int, checkpointDelay
config :: Maybe Mailbox -> Parser Config
config mail = Config
<$> strOption (long "socket" <> short 's' <> metavar "FILE" <> value "/run/tiedote.md/acid.socket" <> showDefault <> help "Path for database socket")
<*> option readMailbox (long "address" <> short 'a' <> metavar "EMAIL" <> maybe mempty value mail <> help "Email address to send and receive mail")
<*> mailboxOption mail
<*> 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"))
@ -86,6 +87,14 @@ serverCommand = Server
<*> option auto (long "port" <> short 'p' <> metavar "PORT" <> value 3000 <> showDefault <> help "TCP port number to listen on for webhook notifications")
<*> option auto (long "checkpoint-delay" <> metavar "MINUTES" <> value (60 * 24 * 7) <> help "Number of minutes to wait between creating snapshots.")
mailboxOption :: Maybe Mailbox -> Parser Mailbox
mailboxOption mail = Mailbox
<$> optional (strOption (long "sender-name" <> metavar "NAME" <> help "Name to display as the mail's sender"))
-- XXX Data.IMF (as of purebred-email-0.6.0.2, 2023-10) doesn't expose the
-- addrSpec parser so we have to use this workaround
<*> ((\(Mailbox _ addrSpec) -> addrSpec) <$>
option readMailbox (long "address" <> short 'a' <> metavar "EMAIL" <> maybe mempty value mail <> help "Email address to send and receive mail"))
readMailbox :: ReadM Mailbox
readMailbox = eitherReader $ parse (mailbox defaultCharsets) . encodeUtf8 . T.pack