> {-# LANGUAGE DeriveDataTypeable, PatternGuards #-}

A Walk Through "Config.hs"

==========================

:Author: Peter Simons <simons@cryp.to>

:Date:   2008-02-20

:Note:   This text is *nowhere* near being complete.

.. contents::

Welcome To The Real World

-------------------------

The purpose of this document is to provide a hands-on

introduction to the Postmaster ESMTP server. Naturally, it

is written as a literate Haskell `source code`_, so you can

load it into ``ghci`` and run any of the examples in the

interactive development environment while reading the text.

Note that Postmaster must be linked to the system libraries

``-ladns -lcrypto``, so you'll have to start the interpreter

with those flags given on the command-line. (If you run

``ghci`` from Emacs this should be configured

automatically.)

I have decided against explaining the internals of the

daemon. I'll write this text treating the functions

Postmaster provides just like any other Haskell library. I

think it is better to do it this way because you, as the

user, probably don't care how Postmaster works. You only

care how to configure a real bad-ass MTA. So I'll do just

that and refer you to the `reference documentation`_ for

the details.

::

> module Main where

>

> import System.Time

> import System.Posix.User

> import Network.Socket ( SockAddr(..) )

> import Data.Char

> import Postmaster hiding ( main )

> ioBufferSize :: Capacity

> ioBufferSize = 1024

> port :: PortID

> port = PortNumber 2525

> run :: EventT -> IO ()

> run f = main' ioBufferSize port f

You have a working SMTP daemon now. Just start it with ``run

id`` and ``telnet`` to the server::

  $ telnet localhost 2525

  Trying 127.0.0.1...

  Connected to localhost.

  Escape character is '^]'.

  220 peti.cryp.to Postmaster ESMTP Server

  NOOP

  250 Massive system failure. Just kidding ... OK.

  QUIT

  221 peti.cryp.to closing connection

  Connection closed by foreign host.

The default configuration will ...

- accept every HELO and EHLO command,

- accept every MAIL command,

- refuse every RCPT command;

- thus, refuse DATA commands for lack of recipients.

Writing Event Handlers

''''''''''''''''''''''

::

> debugEH :: String -> EventT

> debugEH name f e = do

>   yell (StartEventHandler name e)

>   r@(Reply rc _) <- f e

>   yell (EventHandlerResult name e rc)

>   return r

The constructors ``StartEventHandler`` etc. are defined by

Postmaster; it's one of many ``LogEvents`` you may trigger

whenever you think it's appropriate. By wrapping any event

handler with this combinator, we can trace its input and

output values. With two little helper functions, we can try

it out right away::

> mainDebug :: IO ()

> mainDebug = run (debugEH "default")

If you speak with Postmaster now, you should notice the new

log messages that show up on your ``ghci`` terminal (and in

the system log file you've configured for ``syslog(3)``)::

  SID 1: StartEventHandler "default" Greeting

  SID 1: EventHandlerResult "default" Greeting 220

Standard Unix Configuration

'''''''''''''''''''''''''''

Let's configure a real MTA that actually does something. As

a simple example, let us reimplement the way MTAs have

worked traditionally under Unix: (1) The MTA has a list of

"local hostnames". Any recipient which is not in one of

these domains is refused. (2) Recipients *in* the local

domains are delivered to the Unix user with the same name as

the local part. (3) All system users are valid e-mail

recipients. (4) Everything else needs an manual entry a.k.a.

"alias".

One straightforward way to implement this scheme is by

splitting these requirements into the three functions: The

first one checks whether the address of the ``AddRcptTo``

event is a local hostname; the second checks the system

users database, and the third one unconditionally delivers

to the local-part. By wrapping these functions around each

other in the right order, we get exactly the behavior

described above.

The implementation is trivial::

> localHosts :: [HostName] -> EventT

> localHosts lhosts _ (AddRcptTo (Mailbox _ _ host)) = do

>   if (map toLower host) `elem` lhosts

>      then say 2 5 0 "TODO: We accept everything right now"

>      else say 5 5 3 "unknown recipient"

> localHosts _ f e = f e

For it to work, the list you give the function must contain

the local hostnames in all lower-case, obviously. Note that

this combinator works differently than the earlier ones: It

doesn't use ``f`` as a fallback but *guards* access to ``f``!

Our database lookup isn't complicated either: [5]_ ::

> exposePasswd :: EventT

> exposePasswd f e@(AddRcptTo (Mailbox _ lpart _)) = do

>   pwdentry <- liftIO (getUserEntryForName lpart)

>   if userName pwdentry == lpart   -- kludge for ghc

>      then f e

>      else say 5 5 3 "unknown recipient"

> exposePasswd f e = f e

Another function that guards access to ``f`` on the

``AddRcptTo`` event. And our local mailer is::

 TODO: broken with spooler

 | localProcmail :: EventT

 | localProcmail _ (AddRcptTo mbox@(Mailbox _ lpart _)) =

 |   procmail [mbox] lpart []

 | localProcmail f e = f e

Done. ::

> stdConfig :: EventT

> stdConfig =

>   localHosts myHostNames . exposePasswd -- TODO: . localProcmail

The code is point-free, so it must be good. Now edit the

list of local hostnames to suit your system's setup ... ::

> myHostNames :: [HostName]

> myHostNames = [ "localhost"

>               , "change-me.example.org"

>               ]

and run your MTA::

> stdMTA :: IO ()

> stdMTA = run stdConfig

 | runStdMTA :: [String] -> IO ()

 | runStdMTA = runTest stdConfig

A good test session should be::

> stdTest :: [String]

> stdTest =

>   [ "EHLO [127.0.0.1]"

>   , "MAIL FROM:<\"foo\\\".bar\"@example.net>"

>   , "RCPT TO:<non.existent@localhost>"

>   , "RCPT TO:<root@example.com>"

>   , "RCPT TO:<root@localhost>"

>   , "DATA"

>   , "From: simons@cryp.to (Peter Simons)"

>   , "Subject: Testing Postmaster"

>   , ""

>   , "Won't work anyway."

>   , "."

>   ]

If you run ``testStdMTA stdTest``, you'll most likely find

the e-mail in the file ``/var/mail/root`` now. Procmail,

which we used for local delivery, doesn't care about any

``/etc/mail/aliases`` you might have. Which is good, because

we want to determine the aliases in Postmaster, not

somewhere else.

Aliases and Exploders

'''''''''''''''''''''

Aliases ... phew. That ought to be difficult? ::

> alias :: [(Mailbox, Mailbox)] -> EventT

> alias theDB f e

>   | AddRcptTo mbox <- e

>   , Just mbox' <- lookup mbox theDB

>       = trigger (AddRcptTo mbox')

>   | otherwise  = f e

Why do we need ``trigger``? Instead of that definition, we

could equally well have used::

  alias theDB f e

    | ...

        = alias theDB f (AddRcptTo mbox')

The semantics differ insofar as that this variant will

properly recurse, but it will bypass the access checks that

might have run *before* ``alias`` was even called. We don't

know how deeply nested we are in the event transformer

chain! The function ``triggers`` allows us to call the

entire chain from the beginning.

By-passing the checks might be what you want in some cases,

actually. But I'd rather define an explicit handler for

addresses like that. ``alias`` rewrites addresses; nothing

more, nothing less. Here is a short demo function::

 | runAliasTest :: IO ()

 | runAliasTest = runTest (myalias . stdConfig) stdTest

 |   where

 |   lhs     = read "non.existent@localhost"

 |   rhs     = read "root@localhost"

 |   myalias = alias [(lhs,rhs)]

You will have noticed that the mechanism doesn't look like

the usual aliases file. It maps addresses one-to-one, not

one-to-many. In fact, it is more similar to Sendmail's

``virtusertable``. because our left handside of the rewrite

is a full e-mail address, not just a local part. If we want

to have one-to-many mappings, this a simple way to do it::

> explode :: Mailbox -> Smtpd SmtpReply -> EventT

> explode lhs mkRhs f e

>   | AddRcptTo mbox <- e,  lhs == mbox

>                = mkRhs

>   | otherwise  = f e

 | runExploderTest :: IO ()

 | runExploderTest = runTest (expl . stdConfig) stdTest

 |   where

 |   expl = explode (read "non.existent@localhost")

 |            (do shell [] "cat >/dev/null"

 |                shell [] "cat >/dev/null"

 |                -- add more

 |                say 2 5 0 "great")

Cooler Event Handlers

---------------------

The Generic Environment

'''''''''''''''''''''''

Which brings us to the question of how we write a stateful

handler then? What if we want to keep transient information

for a session -- or beyond the life-time of a session?

For that purpose Postmaster features two finite-map

environments: a global one, and a per-TCP-session one. These

environments work almost exactly the like Shell variables

under Unix do. ::

  local  :: EnvT a -> Smtpd a

  global :: EnvT a -> Smtpd a

Disallow Routing Addresses

''''''''''''''''''''''''''

::

> noRouteAddr :: EventT

> noRouteAddr _ (SetMailFrom (Mailbox (_:_) _ _))

>   = say 5 0 4 "You are kidding, right?"

> noRouteAddr _ (AddRcptTo   (Mailbox (_:_) _ _))

>   = say 5 0 4 "no source routing"

> noRouteAddr f e = f e

Dynamic Blacklisting

''''''''''''''''''''

::

> data (Typeable a) => TimeStamped a = TS ClockTime a

>     deriving (Typeable, Show)

>

> type Blacklist = [TimeStamped HostAddress]

>

> blacklist :: TimeDiff -> EventT

> blacklist ttl f e = do

>   r <- f e

>   if e /= Greeting || isFailure r then return r else do

>     peer <- getPeerAddr

>     case peer of

>       Nothing                       -> return r

>       Just (SockAddrUnix _)         -> return r

>       Just sa@(SockAddrInet _ addr) -> do

>         now <- liftIO getClockTime

>         let delta  = addToClockTime ttl

>             stale  = \(TS ts _) -> delta ts < now

>             clean  = reverse . dropWhile stale . reverse

>             expire = (\bl -> (bl,bl)) . maybe [] clean

>         blackl <- global (modifyVar (mkVar "blacklist") expire)

>         if all (\(TS _ a) -> a /= addr) blackl

>             then return r

>             else do yell (Msg (msg sa))

>                     say 5 5 4 "no SMTP service here"

>       Just (SockAddrInet6 _ _ _ _) -> return r

>   where

>   msg = showString "blacklist: refuse peer " . show

Now we need a function to add a peer to the blacklist

whenever we feel like it::

> ban :: Smtpd ()

> ban = do

>   peer <- getPeerAddr

>   case peer of

>     Nothing                      -> return ()

>     Just (SockAddrUnix _)        -> return ()

>     Just (SockAddrInet6 _ _ _ _) -> return ()

>     Just sa@(SockAddrInet _ a) -> do

>       yell (Msg (msg sa))

>       now <- liftIO getClockTime

>       let a'     = TS now a

>           append = maybe [a'] (\as -> a' : as)

>       global (modifyVar_ (mkVar "blacklist") append)

>       return ()

>   where

>   msg = showString "black-listing peer: " . show

An SMTP reply code of 221 or 421 from the event handler

causes Postmaster to drop the connection after the reply::

> bye :: Smtpd SmtpReply

> bye = do

>   whoami <- myHeloName

>   say 4 2 1 (showString whoami " Hasta la vista, baby.")

::

> impatient :: Int -> EventT

> impatient permFailBound f e = do

>   r@(Reply (Code rc _ _) _) <- f e

>   case rc of

>     PermanentFailure -> do

>       c <- local (tick (mkVar "permFailures"))

>       if c >= permFailBound

>          then ban >> bye

>          else return r

>     _ -> return r

> badass :: EventT

> badass = blacklist ttl . impatient maxPF . noRouteAddr

>   where

>   ttl   = noTimeDiff { tdMin = 30 }

>   maxPF = 3

The Rules Of RFC2821

--------------------

In all of the text I assume you are familiar with

[RFC2821]_. So I'll just explain a few minor details

concerning `how the RFC is implemented <Rfc2821.html>`_ in

Postmaster.

Mailboxes

'''''''''

The data type ``Mailbox`` is of a certain importance in this

text. It is defined like this::

  data Mailbox = Mailbox [String] String String

The most general e-mail address defined in the RFC has the

form ``<[@route,...:]user@domain>``, and ``Mailbox`` mirrors

that exactly. You'll find that the first field, the optional

routing information, is rather unpopular these days. But

what can I do? It is part of an e-mail address.

``Mailbox`` is an instance of ``Read`` and ``Shown``, so you

can use the text-representation to create mailboxes in a

comfortable way. Just use ``read "user@domain.tld"`` and

that's it. In case of mailboxes, ``read . show = id`` holds,

but ``show . read = id`` does *not*, because a mailbox

returned by ``show`` will always be enclosed in angular

brackets. Mailbox is also in class ``Eq``, and ``(mb ==

mb')`` will treat the hostname as case-insensitive, as the

RFC requires.

There are two special mailboxes  defined for the SMTP dialogue::

  nullPath, postmaster :: Mailbox

  nullPath   = Mailbox [] [] []

  postmaster = Mailbox [] "postmaster" []

Don't forget to do something with those. ``MAIL FROM:<>``

and ``RCPT TO:<postmaster>`` must always be valid commands.

SMTP Reply Codes by Function Groups

''''''''''''''''''''''''''''''''''''

These reply codes are suggested in the RFC. You ultimately,

you can do what you want because nobody cares for more than

the first digit anyway.

``500``

  Syntax error, command unrecognized

``501``

  Syntax error in parameters or arguments

``502``

  Command not implemented

``503``

  Bad sequence of commands

``504``

  Command parameter not implemented

``211``

  System status, or system help reply

``214``

  Help message

  (Information on how to use the receiver or the meaning of a

  particular non-standard command; this reply is useful only

  to the human user)

``220``

  <domain> Service ready

``221``

  <domain> Service closing transmission channel. See 421.

``421``

  <domain> Service not available. This may be a reply to any

  command if the service knows it must shut down. When the

  event handler returns this code (or 221), Postmaster will

  drop the connection after handling it.

``250``

  Requested mail action okay, completed

``251``

  User not local; will forward to <forward-path>

``252``

  Cannot VRFY user, but will accept message and attempt

  delivery

``450``

  Requested mail action not taken: mailbox unavailable

``550``

  Requested action not taken: mailbox unavailable

``451``

  Requested action aborted: error in processing

``551``

  User not local; please try <forward-path>

``452``

  Requested action not taken: insufficient system storage

``552``

  Requested mail action aborted: exceeded storage allocation

``553``

  Requested action not taken: mailbox name not allowed

  (e.g., mailbox syntax incorrect)

``554``

  Transaction failed (Or, in the case of a connection-opening

  response, "No SMTP service here")

Notes

-----

.. [1] The port-number argument doesn't have enough

       granularity. I'll soon change that API to expect a

       socket, so that you can specify on which IP address

       to listen, too.

.. [2] I wonder whether I should change that to ``Doc``, to

       allow pretty-printing. Opinions are welcome.

.. [3] In fact, the ``relay`` target is implemented on top

       of ``pipe`` at the moment. Postmaster doesn't have a

       mail queue yet, so it can't relay itself. (That will

       change.) ``relay`` uses the field ``sendmailPath``

       from the configuration and just pipes the message

       into Sendmail with appropriate arguments.

.. [4] Yes, the call to ``sed`` in ``shell`` is not nice.

       That will change. Postmaster does support re-writing

       of the data section already, I just wanted to keep

       the internal structure as simple as possible for the

       time being.

.. [5] GHC seems to have a bug in ``getUserEntryForName``

       which causes it to return an incorrect entry when the

       requested one doesn't exist. Until that's fixed, we

       use the comparison for equality of the user names to

       determine success, rather than catching the exception

       we were supposed to get in case of failure.

.. [6] Mostly because I'll replace it with

     ``Data.Dynamic.Dynamic`` soon anyway.

Change me::

> main :: IO ()

> main = run (badass . stdConfig)

References

----------

.. [RFC2821] Simple Mail Transfer Protocol: http://www.faqs.org/rfcs/rfc2821.html

.. [Postmaster] Homepage: http://postmaster.cryp.to/

.. [Haskell] The Haskell Homepage: http://www.haskell.org/

.. [GHC] The Glorious Haskell Compiler: http://www.haskell.org/ghc/

.. [Sendmail] Sendmail Homepage: http://sendmail.org/

.. [Procmail] Procmail Homepage: http://www.procmail.org/

.. _source code: http://postmaster.cryp.to/tutorial.lhs

.. _reference documentation: index.html

.. _events: Rfc2821.html#t%3AEvent

.. ----- Configure Emacs -----

..

.. Local Variables: ***

.. haskell-program-name: "ghci -ladns -lcrypto" ***

.. End: ***