postmaster 0.1 → 0.2
raw patch · 12 files changed
+67/−294 lines, 12 filesdep ~base
Dependency ranges changed: base
Files
- .ghci +0/−1
- Postmaster/Base.hs +1/−46
- Postmaster/Env.hs +0/−1
- Postmaster/FSM.hs +2/−2
- Postmaster/FSM/DNSResolver.hs +0/−1
- Postmaster/FSM/PeerHelo.hs +0/−1
- Postmaster/FSM/Spooler.hs +6/−6
- Postmaster/IO.hs +18/−14
- Postmaster/Main.hs +2/−2
- README +0/−205
- postmaster.cabal +38/−13
- tutorial.lhs +0/−2
− .ghci
@@ -1,1 +0,0 @@-:set -Wall
Postmaster/Base.hs view
@@ -17,7 +17,6 @@ import Prelude hiding ( catch ) import Foreign-import System.IO import Network.Socket hiding ( listen, shutdown ) import Control.Exception import Control.Monad.State@@ -135,7 +134,7 @@ | AcceptConn SockAddr | DropConn SockAddr | UserShutdown- | CaughtException Exception+ | CaughtException SomeException | CaughtIOError IOException | StartEventHandler String Event | EventHandlerResult String Event SmtpCode@@ -162,47 +161,3 @@ tell w put st' return r---- |Like bracket, but only performs the final action if--- there was an exception raised by the in-between--- computation. GHC 6.5 provides this function in--- "Control.Exception".--bracketOnError- :: IO a -- ^ computation to run first (\"acquire resource\")- -> (a -> IO b) -- ^ computation to run last (\"release resource\")- -> (a -> IO c) -- ^ computation to run in-between- -> IO c -- returns the value from the in-between computation-bracketOnError before after thing =- block (do- a <- before- catch- (unblock (thing a))- (\e -> do { after a; throw e })- )---- * Resource Management---- |Convert 'bracket'-style resource management to--- allocate\/free style. We need this, because we have to--- acquire resources that leave the scope in which they were--- allocated. Yeah, callback-driven I\/O does that to--- functional programs. Anyway, the resource will be /gone/--- once you empty the 'MVar' (or when it falls out of--- scope). So use only 'withMVar' and friends to access the--- value.--acquire :: ((a -> IO b) -> IO b) -> IO (MVar a)-acquire f = do- sync <- newEmptyMVar- let hold r = do putMVar sync r- yield- putMVar sync r- return undefined- forkIO (f hold >> return ())- return sync---- |Let go of a resource allocated with 'acquire'.--release :: MVar a -> IO ()-release a = takeMVar a >> yield >> return ()
Postmaster/Env.hs view
@@ -13,7 +13,6 @@ module Postmaster.Env where import Control.Monad.State-import Control.Monad.Reader import Data.Char import Data.Dynamic import Data.ByteString.Char8 ( ByteString, pack )
Postmaster/FSM.hs view
@@ -98,7 +98,7 @@ say 5 0 4 "I don't implement HELP with parameters." event (SayHelo _) = do- trigger ResetState+ _ <- trigger ResetState whoami <- myHeloName say 2 5 0 (showString whoami " Postmaster; pleased to meet you.") @@ -107,7 +107,7 @@ event (SayEhloAgain peer) = event (SayHelo peer) event (SetMailFrom mbox) = do- trigger ResetState+ _ <- trigger ResetState say 2 5 0 (mbox `shows` " ... sender ok") event (AddRcptTo mbox) =
Postmaster/FSM/DNSResolver.hs view
@@ -15,7 +15,6 @@ import ADNS import Data.Typeable import Postmaster.Base-import Control.Monad.Trans newtype DNSR = DNSR Resolver deriving (Typeable)
Postmaster/FSM/PeerHelo.hs view
@@ -10,7 +10,6 @@ module Postmaster.FSM.PeerHelo where -import Control.Monad import Network ( HostName ) import Postmaster.Base import Text.ParserCombinators.Parsec.Rfc2821
Postmaster/FSM/Spooler.hs view
@@ -57,10 +57,10 @@ assert (p' == Nothing) $ assert (h' == Nothing) $ assert (c' == nullPtr) $- Postmaster.Base.bracketOnError+ bracketOnError (openBinaryFile path WriteMode) (hClose)- (\h -> Postmaster.Base.bracketOnError ctxCreate ctxDestroy $ \ctx -> do+ (\h -> bracketOnError ctxCreate ctxDestroy $ \ctx -> do hSetBuffering h NoBuffering when (ctx == nullPtr) (fail "can't initialize SHA1 digest context") md <- toMDEngine SHA1@@ -103,12 +103,12 @@ buf' <- liftIO . withMVar st $ \(S _ (Just h) ctx@(DST c)) -> assert (c /= nullPtr) $ do hPutBuf h ptr i'- execStateT (update' (ptr, i')) ctx+ _ <- execStateT (update' (ptr, i')) ctx flush i buf if not eod then return (Nothing, buf') else do r <- trigger Deliver- trigger ResetState -- TODO: this doesn't really- setSessionState HaveHelo -- belong here+ _ <- trigger ResetState -- TODO: this doesn't really+ setSessionState HaveHelo -- belong here return (Just r, buf') clearState :: Smtpd ()@@ -116,7 +116,7 @@ st <- getState liftIO . modifyMVar_ st $ \(S path h (DST ctx)) -> do let clean Nothing _ = return ()- clean (Just x) f = try (f x) >> return ()+ clean (Just x) f = (try (f x) :: IO (Either SomeException ())) >> return () clean h hClose clean path removeFile when (ctx /= nullPtr) (ctxDestroy ctx)
Postmaster/IO.hs view
@@ -12,7 +12,6 @@ module Postmaster.IO where import Data.List-import Data.Maybe import Data.Dynamic ( Typeable ) import Control.Concurrent ( forkIO ) import Control.Exception@@ -59,14 +58,14 @@ -- |If there is space, read and append more octets; then -- return the modified buffer. In case of 'hIsEOF', -- 'Nothing' is returned. If the buffer is full already,--- 'throwDyn' a 'BufferOverflow' exception. When the timeout+-- 'throw' a 'BufferOverflow' exception. When the timeout -- exceeds, 'ReadTimeout' is thrown. slurp :: Timeout -> ReadHandle -> Buffer -> IO (Maybe Buffer) slurp to h b@(Buf cap ptr len) = do- when (cap <= len) (throwDyn (BufferOverflow h b))+ when (cap <= len) (throw (BufferOverflow h b)) timeout to (handleEOF wrap) >>=- maybe (throwDyn (ReadTimeout to h b)) return+ maybe (throw (ReadTimeout to h b)) return where wrap = do let ptr' = ptr `plusPtr` (fromIntegral len) n = cap - len@@ -87,13 +86,13 @@ -- |Our main I\/O driver. runLoopNB- :: (st -> Timeout) -- ^ user state provides timeout- -> (Exception -> st -> IO st) -- ^ user provides I\/O error handler- -> ReadHandle -- ^ the input source- -> Capacity -- ^ I\/O buffer size- -> BlockHandler st -- ^ callback- -> st -- ^ initial callback state- -> IO st -- ^ return final callback state+ :: (st -> Timeout) -- ^ user state provides timeout+ -> (SomeException -> st -> IO st) -- ^ user provides I\/O error handler+ -> ReadHandle -- ^ the input source+ -> Capacity -- ^ I\/O buffer size+ -> BlockHandler st -- ^ callback+ -> st -- ^ initial callback state+ -> IO st -- ^ return final callback state runLoopNB mkTO errH hIn cap f initST = withBuffer cap (flip ioloop $ initST) where ioloop buf st = buf `seq` st `seq`@@ -129,11 +128,14 @@ data BufferOverflow = BufferOverflow ReadHandle Buffer deriving (Show, Typeable) +instance Exception BufferOverflow where+ -- |Thrown by 'slurp'. data ReadTimeout = ReadTimeout Timeout ReadHandle Buffer deriving (Show, Typeable) +instance Exception ReadTimeout where -- * Internal Helper Functions @@ -142,7 +144,7 @@ handleEOF :: IO a -> IO (Maybe a) handleEOF f =- catchJust ioErrors+ catchJust fromException (fmap Just f) (\e -> if isEOFError e then return Nothing else ioError e) @@ -183,7 +185,7 @@ acceptor :: SocketHandler -> Socket -> IO () acceptor h ls = do- Postmaster.Base.bracketOnError+ bracketOnError (accept ls) (sClose . fst) (\peer@(s,_) -> fork $ h peer `finally` sClose s)@@ -206,6 +208,8 @@ data WriteTimeout = WriteTimeout Timeout deriving (Typeable, Show) +instance Exception WriteTimeout where+ setReadTimeout :: Timeout -> Smtpd () setReadTimeout = local . setVar (mkVar "ReadTimeout") @@ -221,7 +225,7 @@ safeWrite :: IO a -> Smtpd a safeWrite f = do to <- getWriteTimeout- liftIO $ timeout to f >>= maybe (throwDyn (WriteTimeout to)) return+ liftIO $ timeout to f >>= maybe (throw (WriteTimeout to)) return safeReply :: WriteHandle -> SmtpReply -> Smtpd () safeReply hOut r = safeWrite (hPutStr hOut (show r))
Postmaster/Main.hs view
@@ -154,8 +154,8 @@ main' :: Capacity -> PortID -> EventT -> IO () main' cap port eventT = do- installHandler sigPIPE Ignore Nothing- installHandler sigCHLD (Catch (return ())) Nothing+ _ <- installHandler sigPIPE Ignore Nothing+ _ <- installHandler sigCHLD (Catch (return ())) Nothing whoami <- getHostName withSocketsDo $ withSyslog "postmaster" [PID, PERROR] MAIL $
− README
@@ -1,205 +0,0 @@-Postmaster ESMTP Server-=======================--:Latest Release: postmaster-0.1.tar.gz_-:Darcs: darcs_ get http://postmaster.cryp.to/ postmaster--.. contents::--The Sales Pitch------------------ Postmaster is the mail transport agent of choice for the- discriminating hacker. Or, to be more accurate: for the- discriminating Haskell_ hacker, because if you don't know- any Haskell, you have about zero chance of running this- software right now. I plan on turning Postmaster into- something an end-user can run, but that's a long road.-- So why yet *another* MTA? Aren't Sendmail, Qmail, Postfix,- and Exim enough already?-- No, unfortunately they are not, because none of those- programs comes even close to the degree of configurability- I need. Postmaster allows you to configure *anything*. I- really mean it. You'd like to configure your MTA to do- mail relaying for the site ``example.org`` only on- Saturdays in a leap year? No problem at all. You'd like to- put your entire mail configuration into a DNS zone and- distribute it through the domain name system to your mail- exchangers? Be my guest. You'd like to rewrite the word- "no" to "yes" in any e-mail you receive which has- "Michelle" in the ``From:`` header and was sent between- 8am and 10am CET? Sure thing.-- Postmaster is not really an MTA, it is a framework in- which you can easily write your own, custom-built MTA!- This means that Postmaster contains everything *except- for* the routine ``main``. That's what you have to write.--What can it do?-'''''''''''''''-- Postmaster implements an ESMTP server. Given a- configuration, it starts up and listens for incoming SMTP- connections, handles them, and pipes the accepted e-mail- messages into an arbitrary local mailer of your choice. A- good local mailer is Procmail_.-- Beyond that, you can configure and modify every little- step of the SMTP transaction. All the real work is done- through a call-back function. Postmaster triggers an- "event" every time a state change is required, and hopes- that the call-back does whatever is necessary. Among the- known events, this one is popular::-- AddRcptTo Mailbox-- So by writing a handler function for this event, you can- configure what user addresses the server will accept. For- example::-- joe, jane :: Mailbox- joe = Mailbox [] "joe" "example.net"- jane = Mailbox [] "jane" "example.net"-- admin :: Mailbox- admin = Mailbox [] "janes.husband" "example.com"-- event :: Event -> Smtpd SmtpReply- event (AddRcptTo mbox)- | mbox == joe = procmail mbox "joe" []- | mbox == jane = do- from <- gets mailFrom- when (from == joe)- (relay [admin] >> return ())- procmail mbox "jane" []- | otherwise = say 5 5 3 "unknown recipient"-- You could also read that configuration from a file, query- the DNS for that recipient, or accept / refuse addresses- randomly. It's entirely up to you.-- Postmaster provides a wealth of SMTP-related functions you- can use. You can (asynchronously) resolve ``A``, ``PTR``,- or ``MX`` records. There is a generic, type-safe Unix-like- environment for each session and a global one for the- entire daemon in which you can store any data your event- handler needs. Postmaster provides a framework for logging- messages through ``syslog(3)``. And, last but not least,- there is a rapidly growing collection of re-usable event- handlers which you can plug together to configure complex- setups in a few lines of code.--What can it *not* do?-'''''''''''''''''''''-- At the moment, Postmaster has no mail queue. Until that is- implemented, there is no way to deliver outbound messages- via SMTP. If you have to relay e-mail for others, you will- need another MTA installed to do that. Sendmail_ is- particularly well suited for the task. Just modify your- ``sendmail.mc`` file to contain the lines ::-- FEATURE(no_default_msa)- dnl DAEMON_OPTIONS(`Port=25, Name=MTA')- DAEMON_OPTIONS(`Port=587, Name=MSA, M=E')-- and your ``submit.mc`` file to contain::-- FEATURE(`msp', `', `MSA')-- This configures Sendmail to act as a "mail submission- agent". Meaning that it will not listen on port 25 but on- port 587 instead. Correspondingly, your local mail system- will not inject messages via ``localhost:25`` but- ``localhost:587``. You'll effectively use Postmaster as- your MTA to the outside world, and Sendmail as your MTA on- the inside. It's not beautiful, but it will work very- reliably until Postmaster's own delivery agent is ready.--Documentation---------------- `Postmaster Tutorial`_- A walk through "Config.hs" -- this is work in progress.-- `Reference Documentation`_- Haddock-generated reference of all exported functions.--Building Postmaster---------------------- To compile the software, you need GHC_ version 6.6 or- later (only tested with GHC 6.8.x). Furthermore, you'll- need the `GNU adns`_ and OpenSSL_ C libraries installed.-- You can install through your distro, if it provides postmaster,- or from source. The source can be gotten from the Darcs repo or- Hackage.-- Once you've fetched the sources, do the following:-- 1) Build and install through Cabal as for other Haskell packages:-- runhaskell Setup configure --user --prefix=$HOME- runhaskell Setup build- runhaskell Setup install --user-- (You may want to remove the --user flag when installing as root.)-- You can also install via the GNU Autotools.-- 1) Edit ``GNUmakefile`` to fit your system. You'll have to- adapt the variable ``HDI_PATH`` to point to the base- directory where the Haddock interface files for your- compiler are installed or the documentation won't- (re-)build.-- 2) Say ``make``. You need GNU make to build Postmaster, so- if you're running a BSD Unix, ``gmake`` should be used- instead.-- 3) If you get this compiler error::-- .objs/Digest.o(.text+0x357): In function `spyU_info':- : undefined reference to `EVP_mdc2'-- then your OpenSSL version doesn't contain the MDC2 hash- algorithm yet. That's no problem ... just comment out- the (three or so) references to it in- ``hopenssl/Digest.hs`` -- or upgrade to OpenSSL 0.9.7e- or later.---Copyleft----------- Copyright (c) 2008 Peter Simons <simons@cryp.to>. All- rights reserved. This software is released under the terms- of the `GNU General Public License- <http://www.gnu.org/licenses/gpl.html>`_.---------------------------------------------------------------------`[Homepage] <http://cryp.to/>`_--.. _Haskell: http://haskell.org/--.. _darcs: http://darcs.net/--.. _Reference Documentation: docs/index.html--.. _Procmail: http://www.procmail.org/--.. _Sendmail: http://sendmail.org/--.. _postmaster-0.1.tar.gz: http://postmaster.cryp.to/postmaster-0.1.tar.gz--.. _GHC: http://haskell.org/ghc/--.. _GNU adns: http://www.gnu.org/software/adns/--.. _OpenSSL: http://www.openssl.org/--.. _Postmaster Tutorial: docs/tutorial.html
postmaster.cabal view
@@ -1,5 +1,12 @@ Name: postmaster-Version: 0.1+Version: 0.2+Copyright: (c) 2004-2010 Peter Simons+License: GPL+License-File: COPYING+Author: Peter Simons <simons@cryp.to>+Maintainer: Peter Simons <simons@cryp.to>+Homepage: http://gitorious.org/postmaster+Category: Network Synopsis: Postmaster ESMTP Server Description: Postmaster implements an ESMTP server. Given a configuration, it starts up and listens for incoming SMTP connections, handles@@ -8,19 +15,37 @@ Beyond that, you can configure and modify every little step of the SMTP transaction. All the real work is done through call-back functions.-Homepage: http://postmaster.cryp.to/-Category: Network-License: GPL-License-File: COPYING-Author: Peter Simons-Maintainer: Peter Simons <simons@cryp.to>-Data-Files: README+Cabal-Version: >= 1.6 Build-Type: Simple+Tested-With: GHC == 6.12.1 -Executable: postmaster-Main-Is: tutorial.lhs-GHC-Options: -Wall -threaded-Extra-Libraries: adns crypto-Build-Depends: base, haskell98, directory, mtl, network, unix, parsec,+Extra-Source-Files: Postmaster/Base.hs+ Postmaster/FSM/HeloName.hs+ Postmaster/FSM/PeerAddr.hs+ Postmaster/FSM/EhloPeer.hs+ Postmaster/FSM/Announce.hs+ Postmaster/FSM/DNSResolver.hs+ Postmaster/FSM/EventHandler.hs+ Postmaster/FSM/MailID.hs+ Postmaster/FSM/PeerHelo.hs+ Postmaster/FSM/MailFrom.hs+ Postmaster/FSM/SessionState.hs+ Postmaster/FSM/Spooler.hs+ Postmaster/FSM/DataHandler.hs+ Postmaster/Env.hs+ Postmaster/Main.hs+ Postmaster/FSM.hs+ Postmaster/IO.hs+ Postmaster.hs++Source-Repository head+ Type: git+ Location: git://gitorious.org/postmaster/mainline.git++Executable postmaster+ Main-Is: tutorial.lhs+ GHC-Options: -Wall -threaded+ Extra-Libraries: adns crypto+ Build-Depends: base >=3 && <5, haskell98, directory, mtl, network, unix, parsec, containers, bytestring, old-time, hsyslog, hsdns, hsemail, hopenssl
tutorial.lhs view
@@ -36,12 +36,10 @@ > module Main where >-> import System.IO > import System.Time > import System.Posix.User > import Network.Socket ( SockAddr(..) ) > import Data.Char-> import Data.List > import Postmaster hiding ( main ) > ioBufferSize :: Capacity