Compare commits

..

3 Commits

2 changed files with 8 additions and 13 deletions

View File

@ -76,24 +76,21 @@ the tiedote.md user on this system.")
"--sender-name" #$sender-name
"--sendmail" #$sendmail-path
"--socket" #$socket-path
"server"
"--repository" repo-path
"--port" #$(number->string port)
"--remote-url" #$remote-url
;,@(if #$(maybe-value-set? remote-branch)
; (list "--remote-branch" #$remote-branch)
; '())
)
"server")
#:user "tiedote.md"
#:group "tiedote.md"
#:environment (cons "GIT_SSL_CAINFO=/etc/ssl/certs/ca-certificates.crt"
(default-environment-variable))
#:directory #$state-directory))))
(stop #~(make-kill-destructor))))))
(define (tiedote.md-activation config)
(match-record config <tiedote.md-configuration>
(state-directory email-address sender-name sendmail-path socket-path)
(state-directory)
(let* ((receive-exec (list (file-append tiedote-md "/bin/tiedote.md") ; file to exec
(file-append tiedote-md "/bin/tiedote.md") ; arg $0
"--address" email-address
@ -102,11 +99,9 @@ the tiedote.md user on this system.")
"--socket" socket-path))
(receive-script (program-file "tiedote.md-receive"
#~(apply execl #$receive-exec)))
(forward-file (mixed-text-file "dot-forward" "|" receive-script)))
#~(let ((.forward (string-append #$state-directory "/.forward")))
(if (file-exists? .forward)
(delete-file .forward))
(symlink #$forward-file .forward)))))
(forward-file (mixed-text-file ".forward" "|" receive-script)))
#~(symlink #$forward-file
(string-append #$state-directory "/.forward")))))
(define tiedote.md-service-type
(service-type

View File

@ -6,12 +6,12 @@ module Main where
import Control.Applicative (optional)
import Control.Concurrent (forkIO, threadDelay)
import Control.Exception (onException, catch)
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.FileStore (gitFileStore, initialize, FileStoreError(RepositoryExists))
import Data.FileStore (gitFileStore, initialize)
import Data.IMF (Mailbox(..), parse, mailbox)
import Data.MIME.Charset (defaultCharsets)
import Data.Text.Encoding (encodeUtf8)
@ -36,7 +36,7 @@ import TiedoteMD.Debug
serverMain :: SockAddr -> Mailbox -> FilePath -> GitOrigin -> FilePath -> Int -> Int -> IO ()
serverMain socket mail repoPath origin sendmailPath checkpointDelay port = do
initialize (gitFileStore repoPath) `catch` \RepositoryExists -> pure ()
initialize $ gitFileStore repoPath
acid <- openLocalState $ emptyState
_ <- forkIO $ acidServerSockAddr skipAuthenticationCheck socket acid
queueMessages acid