postmaster (empty) → 0.1

raw patch · 24 files changed

+2848/−0 lines, 24 filesdep +basedep +bytestringdep +containerssetup-changed

Dependencies added: base, bytestring, containers, directory, haskell98, hopenssl, hsdns, hsemail, hsyslog, mtl, network, old-time, parsec, unix

Files

• .ghci +1/−0
• COPYING +674/−0
• Postmaster.hs +44/−0
• Postmaster/Base.hs +208/−0
• Postmaster/Env.hs +112/−0
• Postmaster/FSM.hs +118/−0
• Postmaster/FSM/Announce.hs +28/−0
• Postmaster/FSM/DNSResolver.hs +42/−0
• Postmaster/FSM/DataHandler.hs +30/−0
• Postmaster/FSM/EhloPeer.hs +31/−0
• Postmaster/FSM/EventHandler.hs +39/−0
• Postmaster/FSM/HeloName.hs +35/−0
• Postmaster/FSM/MailFrom.hs +36/−0
• Postmaster/FSM/MailID.hs +36/−0
• Postmaster/FSM/PeerAddr.hs +23/−0
• Postmaster/FSM/PeerHelo.hs +37/−0
• Postmaster/FSM/SessionState.hs +30/−0
• Postmaster/FSM/Spooler.hs +123/−0
• Postmaster/IO.hs +230/−0
• Postmaster/Main.hs +187/−0
• README +205/−0
• Setup.lhs +8/−0
• postmaster.cabal +26/−0
• tutorial.lhs +545/−0

@@ -0,0 +1,1 @@+:set -Wall

@@ -0,0 +1,674 @@+                    GNU GENERAL PUBLIC LICENSE+                       Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++                            Preamble++  The GNU General Public License is a free, copyleft license for+software and other kinds of works.++  The licenses for most software and other practical works are designed+to take away your freedom to share and change the works.  By contrast,+the GNU General Public License is intended to guarantee your freedom to+share and change all versions of a program--to make sure it remains free+software for all its users.  We, the Free Software Foundation, use the+GNU General Public License for most of our software; it applies also to+any other work released this way by its authors.  You can apply it to+your programs, too.++  When we speak of free software, we are referring to freedom, not+price.  Our General Public Licenses are designed to make sure that you+have the freedom to distribute copies of free software (and charge for+them if you wish), that you receive source code or can get it if you+want it, that you can change the software or use pieces of it in new+free programs, and that you know you can do these things.++  To protect your rights, we need to prevent others from denying you+these rights or asking you to surrender the rights.  Therefore, you have+certain responsibilities if you distribute copies of the software, or if+you modify it: responsibilities to respect the freedom of others.++  For example, if you distribute copies of such a program, whether+gratis or for a fee, you must pass on to the recipients the same+freedoms that you received.  You must make sure that they, too, receive+or can get the source code.  And you must show them these terms so they+know their rights.++  Developers that use the GNU GPL protect your rights with two steps:+(1) assert copyright on the software, and (2) offer you this License+giving you legal permission to copy, distribute and/or modify it.++  For the developers' and authors' protection, the GPL clearly explains+that there is no warranty for this free software.  For both users' and+authors' sake, the GPL requires that modified versions be marked as+changed, so that their problems will not be attributed erroneously to+authors of previous versions.++  Some devices are designed to deny users access to install or run+modified versions of the software inside them, although the manufacturer+can do so.  This is fundamentally incompatible with the aim of+protecting users' freedom to change the software.  The systematic+pattern of such abuse occurs in the area of products for individuals to+use, which is precisely where it is most unacceptable.  Therefore, we+have designed this version of the GPL to prohibit the practice for those+products.  If such problems arise substantially in other domains, we+stand ready to extend this provision to those domains in future versions+of the GPL, as needed to protect the freedom of users.++  Finally, every program is threatened constantly by software patents.+States should not allow patents to restrict development and use of+software on general-purpose computers, but in those that do, we wish to+avoid the special danger that patents applied to a free program could+make it effectively proprietary.  To prevent this, the GPL assures that+patents cannot be used to render the program non-free.++  The precise terms and conditions for copying, distribution and+modification follow.++                       TERMS AND CONDITIONS++  0. Definitions.++  "This License" refers to version 3 of the GNU General Public License.++  "Copyright" also means copyright-like laws that apply to other kinds of+works, such as semiconductor masks.++  "The Program" refers to any copyrightable work licensed under this+License.  Each licensee is addressed as "you".  "Licensees" and+"recipients" may be individuals or organizations.++  To "modify" a work means to copy from or adapt all or part of the work+in a fashion requiring copyright permission, other than the making of an+exact copy.  The resulting work is called a "modified version" of the+earlier work or a work "based on" the earlier work.++  A "covered work" means either the unmodified Program or a work based+on the Program.++  To "propagate" a work means to do anything with it that, without+permission, would make you directly or secondarily liable for+infringement under applicable copyright law, except executing it on a+computer or modifying a private copy.  Propagation includes copying,+distribution (with or without modification), making available to the+public, and in some countries other activities as well.++  To "convey" a work means any kind of propagation that enables other+parties to make or receive copies.  Mere interaction with a user through+a computer network, with no transfer of a copy, is not conveying.++  An interactive user interface displays "Appropriate Legal Notices"+to the extent that it includes a convenient and prominently visible+feature that (1) displays an appropriate copyright notice, and (2)+tells the user that there is no warranty for the work (except to the+extent that warranties are provided), that licensees may convey the+work under this License, and how to view a copy of this License.  If+the interface presents a list of user commands or options, such as a+menu, a prominent item in the list meets this criterion.++  1. Source Code.++  The "source code" for a work means the preferred form of the work+for making modifications to it.  "Object code" means any non-source+form of a work.++  A "Standard Interface" means an interface that either is an official+standard defined by a recognized standards body, or, in the case of+interfaces specified for a particular programming language, one that+is widely used among developers working in that language.++  The "System Libraries" of an executable work include anything, other+than the work as a whole, that (a) is included in the normal form of+packaging a Major Component, but which is not part of that Major+Component, and (b) serves only to enable use of the work with that+Major Component, or to implement a Standard Interface for which an+implementation is available to the public in source code form.  A+"Major Component", in this context, means a major essential component+(kernel, window system, and so on) of the specific operating system+(if any) on which the executable work runs, or a compiler used to+produce the work, or an object code interpreter used to run it.++  The "Corresponding Source" for a work in object code form means all+the source code needed to generate, install, and (for an executable+work) run the object code and to modify the work, including scripts to+control those activities.  However, it does not include the work's+System Libraries, or general-purpose tools or generally available free+programs which are used unmodified in performing those activities but+which are not part of the work.  For example, Corresponding Source+includes interface definition files associated with source files for+the work, and the source code for shared libraries and dynamically+linked subprograms that the work is specifically designed to require,+such as by intimate data communication or control flow between those+subprograms and other parts of the work.++  The Corresponding Source need not include anything that users+can regenerate automatically from other parts of the Corresponding+Source.++  The Corresponding Source for a work in source code form is that+same work.++  2. Basic Permissions.++  All rights granted under this License are granted for the term of+copyright on the Program, and are irrevocable provided the stated+conditions are met.  This License explicitly affirms your unlimited+permission to run the unmodified Program.  The output from running a+covered work is covered by this License only if the output, given its+content, constitutes a covered work.  This License acknowledges your+rights of fair use or other equivalent, as provided by copyright law.++  You may make, run and propagate covered works that you do not+convey, without conditions so long as your license otherwise remains+in force.  You may convey covered works to others for the sole purpose+of having them make modifications exclusively for you, or provide you+with facilities for running those works, provided that you comply with+the terms of this License in conveying all material for which you do+not control copyright.  Those thus making or running the covered works+for you must do so exclusively on your behalf, under your direction+and control, on terms that prohibit them from making any copies of+your copyrighted material outside their relationship with you.++  Conveying under any other circumstances is permitted solely under+the conditions stated below.  Sublicensing is not allowed; section 10+makes it unnecessary.++  3. Protecting Users' Legal Rights From Anti-Circumvention Law.++  No covered work shall be deemed part of an effective technological+measure under any applicable law fulfilling obligations under article+11 of the WIPO copyright treaty adopted on 20 December 1996, or+similar laws prohibiting or restricting circumvention of such+measures.++  When you convey a covered work, you waive any legal power to forbid+circumvention of technological measures to the extent such circumvention+is effected by exercising rights under this License with respect to+the covered work, and you disclaim any intention to limit operation or+modification of the work as a means of enforcing, against the work's+users, your or third parties' legal rights to forbid circumvention of+technological measures.++  4. Conveying Verbatim Copies.++  You may convey verbatim copies of the Program's source code as you+receive it, in any medium, provided that you conspicuously and+appropriately publish on each copy an appropriate copyright notice;+keep intact all notices stating that this License and any+non-permissive terms added in accord with section 7 apply to the code;+keep intact all notices of the absence of any warranty; and give all+recipients a copy of this License along with the Program.++  You may charge any price or no price for each copy that you convey,+and you may offer support or warranty protection for a fee.++  5. Conveying Modified Source Versions.++  You may convey a work based on the Program, or the modifications to+produce it from the Program, in the form of source code under the+terms of section 4, provided that you also meet all of these conditions:++    a) The work must carry prominent notices stating that you modified+    it, and giving a relevant date.++    b) The work must carry prominent notices stating that it is+    released under this License and any conditions added under section+    7.  This requirement modifies the requirement in section 4 to+    "keep intact all notices".++    c) You must license the entire work, as a whole, under this+    License to anyone who comes into possession of a copy.  This+    License will therefore apply, along with any applicable section 7+    additional terms, to the whole of the work, and all its parts,+    regardless of how they are packaged.  This License gives no+    permission to license the work in any other way, but it does not+    invalidate such permission if you have separately received it.++    d) If the work has interactive user interfaces, each must display+    Appropriate Legal Notices; however, if the Program has interactive+    interfaces that do not display Appropriate Legal Notices, your+    work need not make them do so.++  A compilation of a covered work with other separate and independent+works, which are not by their nature extensions of the covered work,+and which are not combined with it such as to form a larger program,+in or on a volume of a storage or distribution medium, is called an+"aggregate" if the compilation and its resulting copyright are not+used to limit the access or legal rights of the compilation's users+beyond what the individual works permit.  Inclusion of a covered work+in an aggregate does not cause this License to apply to the other+parts of the aggregate.++  6. Conveying Non-Source Forms.++  You may convey a covered work in object code form under the terms+of sections 4 and 5, provided that you also convey the+machine-readable Corresponding Source under the terms of this License,+in one of these ways:++    a) Convey the object code in, or embodied in, a physical product+    (including a physical distribution medium), accompanied by the+    Corresponding Source fixed on a durable physical medium+    customarily used for software interchange.++    b) Convey the object code in, or embodied in, a physical product+    (including a physical distribution medium), accompanied by a+    written offer, valid for at least three years and valid for as+    long as you offer spare parts or customer support for that product+    model, to give anyone who possesses the object code either (1) a+    copy of the Corresponding Source for all the software in the+    product that is covered by this License, on a durable physical+    medium customarily used for software interchange, for a price no+    more than your reasonable cost of physically performing this+    conveying of source, or (2) access to copy the+    Corresponding Source from a network server at no charge.++    c) Convey individual copies of the object code with a copy of the+    written offer to provide the Corresponding Source.  This+    alternative is allowed only occasionally and noncommercially, and+    only if you received the object code with such an offer, in accord+    with subsection 6b.++    d) Convey the object code by offering access from a designated+    place (gratis or for a charge), and offer equivalent access to the+    Corresponding Source in the same way through the same place at no+    further charge.  You need not require recipients to copy the+    Corresponding Source along with the object code.  If the place to+    copy the object code is a network server, the Corresponding Source+    may be on a different server (operated by you or a third party)+    that supports equivalent copying facilities, provided you maintain+    clear directions next to the object code saying where to find the+    Corresponding Source.  Regardless of what server hosts the+    Corresponding Source, you remain obligated to ensure that it is+    available for as long as needed to satisfy these requirements.++    e) Convey the object code using peer-to-peer transmission, provided+    you inform other peers where the object code and Corresponding+    Source of the work are being offered to the general public at no+    charge under subsection 6d.++  A separable portion of the object code, whose source code is excluded+from the Corresponding Source as a System Library, need not be+included in conveying the object code work.++  A "User Product" is either (1) a "consumer product", which means any+tangible personal property which is normally used for personal, family,+or household purposes, or (2) anything designed or sold for incorporation+into a dwelling.  In determining whether a product is a consumer product,+doubtful cases shall be resolved in favor of coverage.  For a particular+product received by a particular user, "normally used" refers to a+typical or common use of that class of product, regardless of the status+of the particular user or of the way in which the particular user+actually uses, or expects or is expected to use, the product.  A product+is a consumer product regardless of whether the product has substantial+commercial, industrial or non-consumer uses, unless such uses represent+the only significant mode of use of the product.++  "Installation Information" for a User Product means any methods,+procedures, authorization keys, or other information required to install+and execute modified versions of a covered work in that User Product from+a modified version of its Corresponding Source.  The information must+suffice to ensure that the continued functioning of the modified object+code is in no case prevented or interfered with solely because+modification has been made.++  If you convey an object code work under this section in, or with, or+specifically for use in, a User Product, and the conveying occurs as+part of a transaction in which the right of possession and use of the+User Product is transferred to the recipient in perpetuity or for a+fixed term (regardless of how the transaction is characterized), the+Corresponding Source conveyed under this section must be accompanied+by the Installation Information.  But this requirement does not apply+if neither you nor any third party retains the ability to install+modified object code on the User Product (for example, the work has+been installed in ROM).++  The requirement to provide Installation Information does not include a+requirement to continue to provide support service, warranty, or updates+for a work that has been modified or installed by the recipient, or for+the User Product in which it has been modified or installed.  Access to a+network may be denied when the modification itself materially and+adversely affects the operation of the network or violates the rules and+protocols for communication across the network.++  Corresponding Source conveyed, and Installation Information provided,+in accord with this section must be in a format that is publicly+documented (and with an implementation available to the public in+source code form), and must require no special password or key for+unpacking, reading or copying.++  7. Additional Terms.++  "Additional permissions" are terms that supplement the terms of this+License by making exceptions from one or more of its conditions.+Additional permissions that are applicable to the entire Program shall+be treated as though they were included in this License, to the extent+that they are valid under applicable law.  If additional permissions+apply only to part of the Program, that part may be used separately+under those permissions, but the entire Program remains governed by+this License without regard to the additional permissions.++  When you convey a copy of a covered work, you may at your option+remove any additional permissions from that copy, or from any part of+it.  (Additional permissions may be written to require their own+removal in certain cases when you modify the work.)  You may place+additional permissions on material, added by you to a covered work,+for which you have or can give appropriate copyright permission.++  Notwithstanding any other provision of this License, for material you+add to a covered work, you may (if authorized by the copyright holders of+that material) supplement the terms of this License with terms:++    a) Disclaiming warranty or limiting liability differently from the+    terms of sections 15 and 16 of this License; or++    b) Requiring preservation of specified reasonable legal notices or+    author attributions in that material or in the Appropriate Legal+    Notices displayed by works containing it; or++    c) Prohibiting misrepresentation of the origin of that material, or+    requiring that modified versions of such material be marked in+    reasonable ways as different from the original version; or++    d) Limiting the use for publicity purposes of names of licensors or+    authors of the material; or++    e) Declining to grant rights under trademark law for use of some+    trade names, trademarks, or service marks; or++    f) Requiring indemnification of licensors and authors of that+    material by anyone who conveys the material (or modified versions of+    it) with contractual assumptions of liability to the recipient, for+    any liability that these contractual assumptions directly impose on+    those licensors and authors.++  All other non-permissive additional terms are considered "further+restrictions" within the meaning of section 10.  If the Program as you+received it, or any part of it, contains a notice stating that it is+governed by this License along with a term that is a further+restriction, you may remove that term.  If a license document contains+a further restriction but permits relicensing or conveying under this+License, you may add to a covered work material governed by the terms+of that license document, provided that the further restriction does+not survive such relicensing or conveying.++  If you add terms to a covered work in accord with this section, you+must place, in the relevant source files, a statement of the+additional terms that apply to those files, or a notice indicating+where to find the applicable terms.++  Additional terms, permissive or non-permissive, may be stated in the+form of a separately written license, or stated as exceptions;+the above requirements apply either way.++  8. Termination.++  You may not propagate or modify a covered work except as expressly+provided under this License.  Any attempt otherwise to propagate or+modify it is void, and will automatically terminate your rights under+this License (including any patent licenses granted under the third+paragraph of section 11).++  However, if you cease all violation of this License, then your+license from a particular copyright holder is reinstated (a)+provisionally, unless and until the copyright holder explicitly and+finally terminates your license, and (b) permanently, if the copyright+holder fails to notify you of the violation by some reasonable means+prior to 60 days after the cessation.++  Moreover, your license from a particular copyright holder is+reinstated permanently if the copyright holder notifies you of the+violation by some reasonable means, this is the first time you have+received notice of violation of this License (for any work) from that+copyright holder, and you cure the violation prior to 30 days after+your receipt of the notice.++  Termination of your rights under this section does not terminate the+licenses of parties who have received copies or rights from you under+this License.  If your rights have been terminated and not permanently+reinstated, you do not qualify to receive new licenses for the same+material under section 10.++  9. Acceptance Not Required for Having Copies.++  You are not required to accept this License in order to receive or+run a copy of the Program.  Ancillary propagation of a covered work+occurring solely as a consequence of using peer-to-peer transmission+to receive a copy likewise does not require acceptance.  However,+nothing other than this License grants you permission to propagate or+modify any covered work.  These actions infringe copyright if you do+not accept this License.  Therefore, by modifying or propagating a+covered work, you indicate your acceptance of this License to do so.++  10. Automatic Licensing of Downstream Recipients.++  Each time you convey a covered work, the recipient automatically+receives a license from the original licensors, to run, modify and+propagate that work, subject to this License.  You are not responsible+for enforcing compliance by third parties with this License.++  An "entity transaction" is a transaction transferring control of an+organization, or substantially all assets of one, or subdividing an+organization, or merging organizations.  If propagation of a covered+work results from an entity transaction, each party to that+transaction who receives a copy of the work also receives whatever+licenses to the work the party's predecessor in interest had or could+give under the previous paragraph, plus a right to possession of the+Corresponding Source of the work from the predecessor in interest, if+the predecessor has it or can get it with reasonable efforts.++  You may not impose any further restrictions on the exercise of the+rights granted or affirmed under this License.  For example, you may+not impose a license fee, royalty, or other charge for exercise of+rights granted under this License, and you may not initiate litigation+(including a cross-claim or counterclaim in a lawsuit) alleging that+any patent claim is infringed by making, using, selling, offering for+sale, or importing the Program or any portion of it.++  11. Patents.++  A "contributor" is a copyright holder who authorizes use under this+License of the Program or a work on which the Program is based.  The+work thus licensed is called the contributor's "contributor version".++  A contributor's "essential patent claims" are all patent claims+owned or controlled by the contributor, whether already acquired or+hereafter acquired, that would be infringed by some manner, permitted+by this License, of making, using, or selling its contributor version,+but do not include claims that would be infringed only as a+consequence of further modification of the contributor version.  For+purposes of this definition, "control" includes the right to grant+patent sublicenses in a manner consistent with the requirements of+this License.++  Each contributor grants you a non-exclusive, worldwide, royalty-free+patent license under the contributor's essential patent claims, to+make, use, sell, offer for sale, import and otherwise run, modify and+propagate the contents of its contributor version.++  In the following three paragraphs, a "patent license" is any express+agreement or commitment, however denominated, not to enforce a patent+(such as an express permission to practice a patent or covenant not to+sue for patent infringement).  To "grant" such a patent license to a+party means to make such an agreement or commitment not to enforce a+patent against the party.++  If you convey a covered work, knowingly relying on a patent license,+and the Corresponding Source of the work is not available for anyone+to copy, free of charge and under the terms of this License, through a+publicly available network server or other readily accessible means,+then you must either (1) cause the Corresponding Source to be so+available, or (2) arrange to deprive yourself of the benefit of the+patent license for this particular work, or (3) arrange, in a manner+consistent with the requirements of this License, to extend the patent+license to downstream recipients.  "Knowingly relying" means you have+actual knowledge that, but for the patent license, your conveying the+covered work in a country, or your recipient's use of the covered work+in a country, would infringe one or more identifiable patents in that+country that you have reason to believe are valid.++  If, pursuant to or in connection with a single transaction or+arrangement, you convey, or propagate by procuring conveyance of, a+covered work, and grant a patent license to some of the parties+receiving the covered work authorizing them to use, propagate, modify+or convey a specific copy of the covered work, then the patent license+you grant is automatically extended to all recipients of the covered+work and works based on it.++  A patent license is "discriminatory" if it does not include within+the scope of its coverage, prohibits the exercise of, or is+conditioned on the non-exercise of one or more of the rights that are+specifically granted under this License.  You may not convey a covered+work if you are a party to an arrangement with a third party that is+in the business of distributing software, under which you make payment+to the third party based on the extent of your activity of conveying+the work, and under which the third party grants, to any of the+parties who would receive the covered work from you, a discriminatory+patent license (a) in connection with copies of the covered work+conveyed by you (or copies made from those copies), or (b) primarily+for and in connection with specific products or compilations that+contain the covered work, unless you entered into that arrangement,+or that patent license was granted, prior to 28 March 2007.++  Nothing in this License shall be construed as excluding or limiting+any implied license or other defenses to infringement that may+otherwise be available to you under applicable patent law.++  12. No Surrender of Others' Freedom.++  If conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License.  If you cannot convey a+covered work so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you may+not convey it at all.  For example, if you agree to terms that obligate you+to collect a royalty for further conveying from those to whom you convey+the Program, the only way you could satisfy both those terms and this+License would be to refrain entirely from conveying the Program.++  13. Use with the GNU Affero General Public License.++  Notwithstanding any other provision of this License, you have+permission to link or combine any covered work with a work licensed+under version 3 of the GNU Affero General Public License into a single+combined work, and to convey the resulting work.  The terms of this+License will continue to apply to the part which is the covered work,+but the special requirements of the GNU Affero General Public License,+section 13, concerning interaction through a network will apply to the+combination as such.++  14. Revised Versions of this License.++  The Free Software Foundation may publish revised and/or new versions of+the GNU General Public License from time to time.  Such new versions will+be similar in spirit to the present version, but may differ in detail to+address new problems or concerns.++  Each version is given a distinguishing version number.  If the+Program specifies that a certain numbered version of the GNU General+Public License "or any later version" applies to it, you have the+option of following the terms and conditions either of that numbered+version or of any later version published by the Free Software+Foundation.  If the Program does not specify a version number of the+GNU General Public License, you may choose any version ever published+by the Free Software Foundation.++  If the Program specifies that a proxy can decide which future+versions of the GNU General Public License can be used, that proxy's+public statement of acceptance of a version permanently authorizes you+to choose that version for the Program.++  Later license versions may give you additional or different+permissions.  However, no additional obligations are imposed on any+author or copyright holder as a result of your choosing to follow a+later version.++  15. Disclaimer of Warranty.++  THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY+APPLICABLE LAW.  EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY+OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR+PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM+IS WITH YOU.  SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF+ALL NECESSARY SERVICING, REPAIR OR CORRECTION.++  16. Limitation of Liability.++  IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS+THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY+GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE+USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF+DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD+PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),+EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF+SUCH DAMAGES.++  17. Interpretation of Sections 15 and 16.++  If the disclaimer of warranty and limitation of liability provided+above cannot be given local legal effect according to their terms,+reviewing courts shall apply local law that most closely approximates+an absolute waiver of all civil liability in connection with the+Program, unless a warranty or assumption of liability accompanies a+copy of the Program in return for a fee.++                     END OF TERMS AND CONDITIONS++            How to Apply These Terms to Your New Programs++  If you develop a new program, and you want it to be of the greatest+possible use to the public, the best way to achieve this is to make it+free software which everyone can redistribute and change under these terms.++  To do so, attach the following notices to the program.  It is safest+to attach them to the start of each source file to most effectively+state the exclusion of warranty; and each file should have at least+the "copyright" line and a pointer to where the full notice is found.++    <one line to give the program's name and a brief idea of what it does.>+    Copyright (C) <year>  <name of author>++    This program is free software: you can redistribute it and/or modify+    it under the terms of the GNU General Public License as published by+    the Free Software Foundation, either version 3 of the License, or+    (at your option) any later version.++    This program is distributed in the hope that it will be useful,+    but WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+    GNU General Public License for more details.++    You should have received a copy of the GNU General Public License+    along with this program.  If not, see <http://www.gnu.org/licenses/>.++Also add information on how to contact you by electronic and paper mail.++  If the program does terminal interaction, make it output a short+notice like this when it starts in an interactive mode:++    <program>  Copyright (C) <year>  <name of author>+    This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.+    This is free software, and you are welcome to redistribute it+    under certain conditions; type `show c' for details.++The hypothetical commands `show w' and `show c' should show the appropriate+parts of the General Public License.  Of course, your program's commands+might be different; for a GUI interface, you would use an "about box".++  You should also get your employer (if you work as a programmer) or school,+if any, to sign a "copyright disclaimer" for the program, if necessary.+For more information on this, and how to apply and follow the GNU GPL, see+<http://www.gnu.org/licenses/>.++  The GNU General Public License does not permit incorporating your program+into proprietary programs.  If your program is a subroutine library, you+may consider it more useful to permit linking proprietary applications with+the library.  If this is what you want to do, use the GNU Lesser General+Public License instead of this License.  But first, please read+<http://www.gnu.org/philosophy/why-not-lgpl.html>.

@@ -0,0 +1,44 @@+{- |+   Module      :  Postmaster+   Copyright   :  (c) 2004-2008 by Peter Simons+   License     :  GPL2++   Maintainer  :  simons@cryp.to+   Stability   :  provisional+   Portability :  Haskell 2-pre++   The Postmaster ESMTP Server. See+   <http://postmaster.cryp.to/docs/tutorial.html> for an+   introduction.+ -}++module Postmaster+  ( module Postmaster.Base+  , module Postmaster.FSM+  , module Postmaster.IO+  , module Postmaster.Main+  , module Control.Monad.RWS+  , module Data.Typeable+  , module Network+  , module ADNS+  , module Text.ParserCombinators.Parsec.Rfc2821+  , module System.Posix.Syslog+  )+  where++import Network ( PortID(..) )+import Control.Monad.RWS hiding ( local )+import ADNS hiding ( Debug, queryMX, queryA, queryPTR )+import Data.Typeable+import Text.ParserCombinators.Parsec.Rfc2821 hiding ( path )+import System.Posix.Syslog+import Postmaster.Base+import Postmaster.FSM+import Postmaster.IO+import Postmaster.Main++-- ----- Configure Emacs -----+--+-- Local Variables: ***+-- haskell-program-name: "ghci -ladns -lcrypto" ***+-- End: ***

@@ -0,0 +1,208 @@+{-# LANGUAGE Rank2Types, DeriveDataTypeable #-}+{- |+   Module      :  Postmaster.Base+   Copyright   :  (c) 2004-2008 by Peter Simons+   License     :  GPL2++   Maintainer  :  simons@cryp.to+   Stability   :  provisional+   Portability :  Haskell 2-pre+ -}++module Postmaster.Base+  ( module Postmaster.Base+  , module Postmaster.Env+  )+  where++import Prelude hiding ( catch )+import Foreign+import System.IO+import Network.Socket hiding ( listen, shutdown )+import Control.Exception+import Control.Monad.State+import Control.Monad.RWS hiding ( local )+import Control.Concurrent+import Data.Typeable+import Text.ParserCombinators.Parsec.Rfc2821 hiding ( path )+import Postmaster.Env++-- * The @Smtpd@ Monad++type GlobalEnv  = MVar Env+type SmtpdState = Env+type Smtpd a    = RWST GlobalEnv [LogMsg] SmtpdState IO a++-- |@say a b c msg = return ('reply' a b c [msg])@+--+-- The 'SmtpReply' codes returned the event handler returns+-- determine what Postmaster will do:+--+-- [@1xx@, @2xx@, @3xx@] make the 'SessionState' transition+-- determined determined by 'smtpdFSM'.+--+-- [@4xx@, @5xx@] Do /not/ make the transition.+--+-- [@221@, @421@] Drop the connection after this reply.+--+-- The reply for the 'Greeting' event (the first event+-- triggered when a session starts up) is interpreted as+-- follows: @2xx@ accepts the connection, everything else+-- refuses the connection.++say :: Int -> Int -> Int -> String -> Smtpd SmtpReply+say a b c msg = return (reply a b c [msg])++-- ** Environment++global :: EnvT a -> Smtpd a+global f = do+  mv <- ask+  liftIO . modifyMVar mv $ return . swap . runState f+    where swap (a,e) = (e,a)++local :: EnvT a -> Smtpd a+local f = do+  (a, st) <- gets (runState f)+  put st+  return a++type SmtpdVariable = forall a. Typeable a => (Variable -> EnvT a) -> Smtpd a++defineLocal :: String -> SmtpdVariable+defineLocal n = \f -> local (f (mkVar n))++defineGlobal :: String -> SmtpdVariable+defineGlobal n = \f -> global (f (mkVar n))++-- ** Generating Unique Identifiers.++type ID = Int++-- |Produce an unique 'ID' using a global counter.++getUniqueID :: Smtpd ID+getUniqueID = global $ tick (mkVar "UniqueID")++-- |Provides an unique 'ID' for every (TCP) session.++mySessionID :: Smtpd ID+mySessionID = do+  let key = mkVar "SessionID"+  sid' <- local $ getVar key+  case sid' of+    Just sid -> return sid+    _        -> do sid <- getUniqueID+                   local $ setVar key sid+                   return sid++-- ** Event Handler++type EventHandler = Event -> Smtpd SmtpReply++type EventT  = EventHandler -> EventHandler++-- ** Data Handler++type ByteCount = Word16+type Capacity  = Word16+data Buffer    = Buf !Capacity !(Ptr Word8) !ByteCount+                 deriving (Eq, Show, Typeable)++type DataHandler = Buffer -> Smtpd (Maybe SmtpReply, Buffer)++-- ** Logging++data LogMsg = LogMsg ID SmtpdState LogEvent+            deriving (Show)++-- |Given a log event, construct a 'LogMsg' and write it to+-- the monad's log stream with 'tell'. Every log event+-- contains the current 'SmtpdState' and the \"SessionID\".++yell :: LogEvent -> Smtpd ()+yell e = do+  sid <- mySessionID+  st <- get+  tell [LogMsg sid st e]++data LogEvent+  = Msg String+  | StartSession+  | EndSession+  | Input String+  | Output String+  | AcceptConn SockAddr+  | DropConn SockAddr+  | UserShutdown+  | CaughtException Exception+  | CaughtIOError IOException+  | StartEventHandler String Event+  | EventHandlerResult String Event SmtpCode+  | CurrentState+  | AssignMailID ID+  deriving (Show)++-- * Exception Handling++-- |Run a computation and fall back to the second if the+-- first throws an exception. The error is logged. An+-- exception in the second computation will propagate.++fallback+  :: Smtpd a                    -- ^ computation to run+  -> Smtpd a                    -- ^ fallback function+  -> Smtpd a+fallback f g = do+  cfg <- ask+  st <- get+  (r, st', w) <- liftIO $ catch+      (runRWST f cfg st)+      (\e -> runRWST (yell (CaughtException e) >> g) cfg st)+  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 ()

@@ -0,0 +1,112 @@+{- |+   Module      :  Postmaster.Env+   Copyright   :  (c) 2004-2008 by Peter Simons+   License     :  GPL2++   Maintainer  :  simons@cryp.to+   Stability   :  provisional+   Portability :  Haskell 2-pre++   A generic environment.+-}++module Postmaster.Env where++import Control.Monad.State+import Control.Monad.Reader+import Data.Char+import Data.Dynamic+import Data.ByteString.Char8 ( ByteString, pack )+import qualified Data.Map as FM++-- |Variables are stored in all-uppercase internally. Thus,+-- the environment is case-less.++newtype Variable = Var ByteString+  deriving (Eq, Ord)++instance Show Variable where+  showsPrec _ (Var str) = shows str++-- |Construct a variable.++mkVar :: String -> Variable+mkVar = Var . pack . map toUpper++-- |An environment maps from 'Variable's to any 'Typeable'+-- value. The 'toDyn' and 'fromDynamic' casts are done by+-- the /environment/; the API does not expose 'Dynamic'.++type Env = FM.Map Variable Dynamic++-- |The empty environment.++emptyEnv :: Env+emptyEnv = FM.empty++-- |The environment is accessed through a monadic interface.++type EnvT a = State Env a++-- |Test whether a variable is set.++isVar :: Variable -> EnvT Bool+isVar = gets . FM.member++-- |Set a variable.++setVar :: (Typeable a) => Variable -> a -> EnvT ()+setVar key val = unsetVar key >> modify (FM.insert key (toDyn val))++-- |Erase an entry from the environment.++unsetVar :: Variable -> EnvT ()+unsetVar = modify . FM.delete++-- |This function does not distinguish between the two+-- potential cases of failure we have: (1) value does not+-- exist and (2) value does exist but 'fromDynamic' failed.+-- Accurate type signatures should prevent the latter case+-- from happening anyway.++getVar :: (Typeable a) => Variable -> EnvT (Maybe a)+getVar key = do+  res <- gets $ FM.lookup key+  case res of+    Nothing -> return Nothing+    Just a  -> return (fromDynamic a)++-- |Wrapper that will 'fail' when the variable is unset.++getVar_ :: (Typeable a) => Variable -> EnvT a+getVar_ key = getVar key >>= maybe badluck return+  where badluck = fail ("variable " ++ show key ++ " is unset!")++-- |Wrapper that will return a default when the variable is+-- unset.++getVarDef :: (Typeable a) => Variable -> a -> EnvT a+getVarDef key def = getVar key >>= return . maybe def id++-- |Modify a variable in the environment and return it.+-- 'Nothing' may signify that the value wasn't set or that+-- conversion from 'Dynamic' failed; it's not+-- differentiated.++modifyVar :: (Typeable a) => Variable -> (Maybe a -> (b, a)) -> EnvT b+modifyVar key f = do+  (b, a) <- fmap f (getVar key)+  setVar key a+  return b++-- |Variant that returns @()@. Comes in handy on the occasion.++modifyVar_ :: (Typeable a) => Variable -> (Maybe a -> a) -> EnvT ()+modifyVar_ key f = getVar key >>= setVar key . f++-- |Convenience wrapper to implement counters. Starts+-- counting with @0@ in case the variable doesn't exist or+-- doesn't contain an 'Int'.++tick :: Variable -> EnvT Int+tick key = modifyVar key (maybe (0, 1) (\i -> (i, i+1)))

@@ -0,0 +1,118 @@+{- |+   Module      :  Postmaster.FSM+   Copyright   :  (c) 2004-2008 by Peter Simons+   License     :  GPL2++   Maintainer  :  simons@cryp.to+   Stability   :  provisional+   Portability :  Haskell 2-pre+ -}++module Postmaster.FSM+  ( mkEvent+  , announce+  , queryA, queryPTR, queryMX+  , feed+  , isEhloPeer+  , trigger+  , myHeloName+  , getMailFrom+  , getMailID+  , getPeerAddr+  , getPeerHelo+  , getSessionState+  )+  where++import Network ( HostName )+import Postmaster.Base+import Postmaster.FSM.Announce+import Postmaster.FSM.DNSResolver+import Postmaster.FSM.DataHandler+import Postmaster.FSM.EhloPeer+import Postmaster.FSM.EventHandler+import Postmaster.FSM.HeloName+import Postmaster.FSM.MailFrom+import Postmaster.FSM.MailID+import Postmaster.FSM.PeerAddr+import Postmaster.FSM.PeerHelo+import Postmaster.FSM.SessionState+import Postmaster.FSM.Spooler+import Text.ParserCombinators.Parsec.Rfc2821++-- |Generate the standard ESMTP event handler. The+-- parameters are the path to the spool directory and our+-- @HELO@ name.++mkEvent :: HostName -> FilePath -> EventHandler+mkEvent heloname spooldir+  = announce "PIPELINING"+  . initHeloName heloname+  . handleMailID+  . handleMailFrom+  . handleEhloPeer+  . handlePeerHelo+  . handlePayload spooldir+  $ event++-- |The Standard Bad-Ass Event Handler++event :: EventHandler++event Greeting = do+  whoami <- myHeloName+  say 2 2 0 (showString whoami " Postmaster ESMTP Server")++event Shutdown = do+  whoami <- myHeloName+  say 2 2 1 (showString whoami " closing connection")++event NotImplemened =+  say 5 0 2 "command not implemented"++event (Unrecognized _) =+  say 5 0 0 "unrecognized command"++event (SyntaxErrorIn cmd) =+  say 5 0 1 (showString "syntax error in parameters or arguments of " cmd)++event (SayOK) =+  say 2 5 0 "Massive system failure. Just kidding ... ok."++event (NeedHeloFirst) =+  say 5 0 3 "You should say HELO first."++event (NeedMailFromFirst) =+  say 5 0 3 "What MAIL are you talking about?"++event (NeedRcptToFirst) =+  say 5 0 3 "Care to tell me where I should send it to?"++event (ResetState) =+  say 2 5 0 "state reset"++event (SeeksHelp []) =+  say 5 0 2 "Why don't you ask about something specific?"++event (SeeksHelp _) =+  say 5 0 4 "I don't implement HELP with parameters."++event (SayHelo _) = do+  trigger ResetState+  whoami <- myHeloName+  say 2 5 0 (showString whoami " Postmaster; pleased to meet you.")++event (SayEhlo peer)      = event (SayHelo peer)+event (SayHeloAgain peer) = event (SayHelo peer)+event (SayEhloAgain peer) = event (SayHelo peer)++event (SetMailFrom mbox) = do+  trigger ResetState+  say 2 5 0 (mbox `shows` " ... sender ok")++event (AddRcptTo mbox) =+  say 5 5 3 (mbox `shows` " ... unknown recipient")++event StartData = event NotImplemened++event Deliver   = event NotImplemened

@@ -0,0 +1,28 @@+{- |+   Module      :  Postmaster.FSM.Announce+   Copyright   :  (c) 2004-2008 by Peter Simons+   License     :  GPL2++   Maintainer  :  simons@cryp.to+   Stability   :  provisional+   Portability :  Haskell 2-pre++   Announce ESMTP Capability.+ -}++module Postmaster.FSM.Announce where++import Postmaster.Base+import Text.ParserCombinators.Parsec.Rfc2821++-- |Append the given ESMTP keyword to the reply produced+-- during 'SayEhlo'.++announce :: String -> EventT+announce keyword f e@(SayEhlo _) = do+  Reply rc msg <- f e+  let msg' = msg ++ [keyword]+  case rc of+    Code Success _ _ -> return (Reply rc msg')+    _                -> return (Reply rc msg)+announce _ f e = f e

@@ -0,0 +1,42 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-}+{- |+   Module      :  Postmaster.FSM.DNSResolver+   Copyright   :  (c) 2004-2008 by Peter Simons+   License     :  GPL2++   Maintainer  :  simons@cryp.to+   Stability   :  provisional+   Portability :  Haskell 2-pre+ -}++module Postmaster.FSM.DNSResolver where++import Control.Monad.RWS hiding ( local )+import ADNS+import Data.Typeable+import Postmaster.Base+import Control.Monad.Trans++newtype DNSR = DNSR Resolver+             deriving (Typeable)++dnsResolver :: Variable+dnsResolver = mkVar "dnsresolver"++setDNSResolver :: Resolver -> EnvT ()+setDNSResolver f = setVar dnsResolver (DNSR f)++getDNSResolver :: Smtpd Resolver+getDNSResolver = do+  DNSR f <- local (getVar dnsResolver)+        >>= maybe (global $ getVar_ dnsResolver) return+  return f++queryA :: HostName -> Smtpd (Maybe [HostAddress])+queryA h = getDNSResolver >>= \r -> liftIO $ ADNS.queryA r h++queryPTR :: HostAddress -> Smtpd (Maybe [HostName])+queryPTR h = getDNSResolver >>= \r -> liftIO $ ADNS.queryPTR r h++queryMX :: HostName -> Smtpd (Maybe [(HostName, HostAddress)])+queryMX h = getDNSResolver >>= \r -> liftIO $ ADNS.queryMX r h

@@ -0,0 +1,30 @@+{-# LANGUAGE DeriveDataTypeable #-}+{- |+   Module      :  Postmaster.FSM.DataHandler+   Copyright   :  (c) 2004-2008 by Peter Simons+   License     :  GPL2++   Maintainer  :  simons@cryp.to+   Stability   :  provisional+   Portability :  Haskell 2-pre+ -}++module Postmaster.FSM.DataHandler where++import Data.Typeable+import Postmaster.Base++newtype DH = DH DataHandler+           deriving (Typeable)++dataHandler :: SmtpdVariable+dataHandler = defineLocal "datahandler"++setDataHandler :: DataHandler -> Smtpd ()+setDataHandler f = dataHandler (`setVar` DH f)++getDataHandler :: Smtpd DataHandler+getDataHandler = dataHandler getVar_ >>= \(DH f) -> return f++feed :: DataHandler+feed buf = getDataHandler >>= ($ buf)

@@ -0,0 +1,31 @@+{- |+   Module      :  Postmaster.FSM.EhloPeer+   Copyright   :  (c) 2004-2008 by Peter Simons+   License     :  GPL2++   Maintainer  :  simons@cryp.to+   Stability   :  provisional+   Portability :  Haskell 2-pre+ -}++module Postmaster.FSM.EhloPeer where++import Postmaster.Base+import Text.ParserCombinators.Parsec.Rfc2821++-- |Local Variable: @EHLOPEER :: 'Bool'@++ehloPeer :: SmtpdVariable+ehloPeer = defineLocal "ehlopeer"++handleEhloPeer :: EventT+handleEhloPeer f e = do+  r <- f e+  case (e, isSuccess r) of+    (SayEhlo _, True) -> ehloPeer (`setVar` True)+    (SayHelo _, True) -> ehloPeer (`setVar` False)+    (_, _)            -> return ()+  return r++isEhloPeer :: Smtpd Bool+isEhloPeer = ehloPeer (`getVarDef` False)

@@ -0,0 +1,39 @@+{-# LANGUAGE DeriveDataTypeable #-}+{- |+   Module      :  Postmaster.FSM.EventHandler+   Copyright   :  (c) 2004-2008 by Peter Simons+   License     :  GPL2++   Maintainer  :  simons@cryp.to+   Stability   :  provisional+   Portability :  Haskell 2-pre+ -}++module Postmaster.FSM.EventHandler where++import Data.Typeable+import Postmaster.Base+import Text.ParserCombinators.Parsec.Rfc2821++newtype EH = EH EventHandler+           deriving (Typeable)++-- |This variable /must/ be initialized in the global+-- environment or Postmaster won't do much.++eventHandler :: Variable+eventHandler = mkVar "eventhandler"++setEventHandler :: EventHandler -> EnvT ()+setEventHandler = setVar eventHandler . EH++getEventHandler :: Smtpd EventHandler+getEventHandler = do+  EH f <- local (getVar eventHandler)+      >>= maybe (global $ getVar_ eventHandler) return+  return f++-- |Trigger the given event.++trigger :: Event -> Smtpd SmtpReply+trigger e = getEventHandler >>= ($ e)

@@ -0,0 +1,35 @@+{- |+   Module      :  Postmaster.FSM.HeloName+   Copyright   :  (c) 2004-2008 by Peter Simons+   License     :  GPL2++   Maintainer  :  simons@cryp.to+   Stability   :  provisional+   Portability :  Haskell 2-pre+ -}++module Postmaster.FSM.HeloName where++import Control.Monad+import Network ( HostName )+import Postmaster.Base+import Text.ParserCombinators.Parsec.Rfc2821++-- |Local Variable: @HELONAME :: 'HostName'@++heloName :: SmtpdVariable+heloName = defineLocal "heloname"++-- |Initialized during the 'Greeting' event; will not+-- overwrite the variable if it does exist already.++initHeloName :: HostName -> EventT+initHeloName n f e = do+  when (e == Greeting) (heloName (`modifyVar_` maybe n id))+  f e++-- |Will 'fail' when @HELONAME@ is not set.++myHeloName :: Smtpd HostName+myHeloName = heloName getVar_+

@@ -0,0 +1,36 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-}+{- |+   Module      :  Postmaster.FSM.MailFrom+   Copyright   :  (c) 2004-2008 by Peter Simons+   License     :  GPL2++   Maintainer  :  simons@cryp.to+   Stability   :  provisional+   Portability :  Haskell 2-pre+ -}++module Postmaster.FSM.MailFrom where++import Postmaster.Base+import Text.ParserCombinators.Parsec.Rfc2821+import Data.Typeable++newtype SmtpMailbox = SMB Mailbox+                      deriving (Typeable)++-- |Local Variable: @MAILFROM :: 'Mailbox'@++mailFrom :: SmtpdVariable+mailFrom = defineLocal "mailfrom"++handleMailFrom :: EventT+handleMailFrom f e = do+  r <- f e+  case (e, isSuccess r) of+    (SetMailFrom x, True) -> mailFrom (`setVar` (SMB x))+    (ResetState, _)       -> mailFrom unsetVar+    (_, _)                -> return ()+  return r++getMailFrom :: Smtpd Mailbox+getMailFrom = mailFrom getVar_ >>= \(SMB x) -> return x

@@ -0,0 +1,36 @@+{- |+   Module      :  Postmaster.FSM.MailID+   Copyright   :  (c) 2004-2008 by Peter Simons+   License     :  GPL2++   Maintainer  :  simons@cryp.to+   Stability   :  provisional+   Portability :  Haskell 2-pre+ -}++module Postmaster.FSM.MailID where++import Postmaster.Base+import Text.ParserCombinators.Parsec.Rfc2821++-- |Local Variable: @MAILID :: 'ID'@++mailID :: SmtpdVariable+mailID = defineLocal "mailid"++-- |Set when 'SetMailFrom' succeeds; unset during+-- 'ResetState'.++handleMailID :: EventT+handleMailID f e = do+  r <- f e+  case (e, isSuccess r) of+    (SetMailFrom _, True) -> getUniqueID >>= \x -> mailID (`setVar` x)+    (ResetState   ,  _  ) -> mailID unsetVar+    (_, _)                -> return ()+  return r++-- |Will 'fail' when @MailID@ is not set.++getMailID :: Smtpd ID+getMailID = mailID getVar_

@@ -0,0 +1,23 @@+{- |+   Module      :  Postmaster.FSM.PeerAddr+   Copyright   :  (c) 2004-2008 by Peter Simons+   License     :  GPL2++   Maintainer  :  simons@cryp.to+   Stability   :  provisional+   Portability :  Haskell 2-pre+ -}++module Postmaster.FSM.PeerAddr where++import Postmaster.Base+import Network.Socket ( SockAddr )++peerAddr :: Variable+peerAddr = mkVar "peeradr"++setPeerAddr :: SockAddr -> EnvT ()+setPeerAddr = setVar peerAddr++getPeerAddr :: Smtpd (Maybe SockAddr)+getPeerAddr = local (getVar peerAddr)

@@ -0,0 +1,37 @@+{- |+   Module      :  Postmaster.FSM.PeerHelo+   Copyright   :  (c) 2004-2008 by Peter Simons+   License     :  GPL2++   Maintainer  :  simons@cryp.to+   Stability   :  provisional+   Portability :  Haskell 2-pre+ -}++module Postmaster.FSM.PeerHelo where++import Control.Monad+import Network ( HostName )+import Postmaster.Base+import Text.ParserCombinators.Parsec.Rfc2821++-- |Local Variable: @PEERHELO :: 'HostName'@++peerHelo :: SmtpdVariable+peerHelo = defineLocal "peerhelo"++-- |Set when 'SayHelo' or 'SayEhlo' succeed.++handlePeerHelo :: EventT+handlePeerHelo f e = do+  r <- f e+  case (e, isSuccess r) of+    (SayEhlo peer, True) -> peerHelo (`setVar` peer)+    (SayHelo peer, True) -> peerHelo (`setVar` peer)+    (_, _)               -> return ()+  return r++-- |Will 'fail' when @PEERHELO@ is not set.++getPeerHelo :: Smtpd HostName+getPeerHelo = peerHelo getVar_

@@ -0,0 +1,30 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-}+{- |+   Module      :  Postmaster.FSM.SessionState+   Copyright   :  (c) 2004-2008 by Peter Simons+   License     :  GPL2++   Maintainer  :  simons@cryp.to+   Stability   :  provisional+   Portability :  Haskell 2-pre+ -}++module Postmaster.FSM.SessionState where++import Postmaster.Base+import Text.ParserCombinators.Parsec.Rfc2821+import Data.Typeable++newtype SmtpSessionState = SSST SessionState+                           deriving (Typeable)++-- |Local Variable: @SESSIONSTATE :: 'SessionState'@++sessionState :: SmtpdVariable+sessionState = defineLocal "sessionstate"++setSessionState :: SessionState -> Smtpd ()+setSessionState sst = sessionState (`setVar` (SSST sst))++getSessionState :: Smtpd SessionState+getSessionState = sessionState (`getVarDef` (SSST Unknown)) >>= \(SSST sst) -> return sst

@@ -0,0 +1,123 @@+{-# LANGUAGE DeriveDataTypeable #-}+{- |+   Module      :  Postmaster.FSM.Spooler+   Copyright   :  (c) 2004-2008 by Peter Simons+   License     :  GPL2++   Maintainer  :  simons@cryp.to+   Stability   :  provisional+   Portability :  Haskell 2-pre+ -}++module Postmaster.FSM.Spooler where++import Foreign+import Control.Exception+import Control.Concurrent.MVar+import Control.Monad.State+import System.Directory+import System.IO+import Postmaster.Base+import Postmaster.IO+import Postmaster.FSM.EventHandler+import Postmaster.FSM.SessionState+import Postmaster.FSM.DataHandler+import Postmaster.FSM.MailID+import Text.ParserCombinators.Parsec.Rfc2821 hiding ( path )+import OpenSSL.Digest+import Data.Typeable++data Spooler = S (Maybe FilePath) (Maybe WriteHandle) DigestState+             deriving (Typeable)++spoolerState :: SmtpdVariable+spoolerState = defineLocal "spoolerstate"++getState :: Smtpd (MVar Spooler)+getState = spoolerState getVar_++setState :: MVar Spooler -> Smtpd ()+setState st = spoolerState (`setVar` st)++-- |The Standard Bad-Ass Payload Handler. Needs the path to+-- the spool directory.++handlePayload :: FilePath -> EventT++handlePayload _ f Greeting = do+  liftIO (newMVar (S Nothing Nothing (DST nullPtr))) >>= setState+  setDataHandler feeder+  f Greeting++handlePayload spool _ StartData =+  do st <- getState+     mid <- getMailID+     let path = spool ++ "/temp." ++ show mid+     liftIO . modifyMVar_ st $ \(S p' h' (DST c')) ->+       assert (p' == Nothing) $+       assert (h' == Nothing) $+       assert (c' == nullPtr) $+       Postmaster.Base.bracketOnError+         (openBinaryFile path WriteMode)+         (hClose)+         (\h -> Postmaster.Base.bracketOnError ctxCreate ctxDestroy $ \ctx -> do+            hSetBuffering h NoBuffering+            when (ctx == nullPtr) (fail "can't initialize SHA1 digest context")+            md <- toMDEngine SHA1+            when (md == nullPtr) (fail "can't initialize SHA1 digest engine")+            rc <- digestInit ctx md+            when (rc == 0) (fail "can't initialize SHA1 digest")+            return (S (Just path) (Just h) (DST ctx)))+     say 3 5 4 "terminate data with <CRLF>.<CRLF>"+  `fallback`+     say 4 5 1 "requested action aborted: error in processing"++handlePayload spool _ Deliver =+  do st <- getState+     sha1 <- liftIO $+       modifyMVar st $ \(S (Just p) (Just h) ctx@(DST c)) ->+         assert (c /= nullPtr) $ do+           hClose h+           sha1 <- fmap (>>= toHex) (evalStateT final ctx)+           let fname = spool ++ "/" ++ sha1+           renameFile p fname+           return (S Nothing Nothing ctx, sha1)+     say 2 5 0 (sha1 ++ " message accepted for delivery")+  `fallback`+     say 4 5 1 "requested action aborted: error in processing"++handlePayload _ f ResetState = clearState >> f ResetState+handlePayload _ f Shutdown   = clearState >> f Shutdown+handlePayload _ f e = f e++feeder :: DataHandler+feeder buf@(Buf _ _ 0) = return (Nothing, buf)+feeder buf@(Buf _ ptr n) = do+  xs <- liftIO (peekArray (fromIntegral n) ptr)+  let theEnd   = map (toEnum . fromEnum) "\r\n.\r\n"+      (eod, i) = case strstr theEnd xs of+                   Nothing -> (False, max 0 (n - 4))+                   Just j -> (True, fromIntegral (j-3))+      i'       = fromIntegral i+  st <- getState+  buf' <- liftIO . withMVar st $ \(S _ (Just h) ctx@(DST c)) ->+    assert (c /= nullPtr) $ do+      hPutBuf h ptr i'+      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+    return (Just r, buf')++clearState :: Smtpd ()+clearState = do+  st <- getState+  liftIO . modifyMVar_ st $ \(S path h (DST ctx)) -> do+    let clean Nothing  _ = return ()+        clean (Just x) f = try (f x) >> return ()+    clean h hClose+    clean path removeFile+    when (ctx /= nullPtr) (ctxDestroy ctx)+    return (S Nothing Nothing (DST nullPtr))

@@ -0,0 +1,230 @@+{-# LANGUAGE DeriveDataTypeable #-}+{- |+   Module      :  Postmaster.IO+   Copyright   :  (c) 2004-2008 by Peter Simons+   License     :  GPL2++   Maintainer  :  simons@cryp.to+   Stability   :  provisional+   Portability :  Haskell 2-pre+ -}++module Postmaster.IO where++import Data.List+import Data.Maybe+import Data.Dynamic             ( Typeable )+import Control.Concurrent       ( forkIO )+import Control.Exception+import Control.Monad.RWS hiding ( local )+import System.IO+import System.IO.Error+import System.Timeout+import Network                  ( listenOn, PortID(..) )+import Network.Socket+import Text.ParserCombinators.Parsec.Rfc2821+import Foreign+import Postmaster.Base++-- * Static Buffer I\/O++type ReadHandle  = Handle+type WriteHandle = Handle++-- |Run the given computation with an initialized, empty+-- 'Buffer'. The buffer is gone when the computation+-- returns.++withBuffer :: Capacity -> (Buffer -> IO a) -> IO a+withBuffer 0 = fail "BlockIO.withBuffer with size 0 doesn't make sense"+withBuffer n = bracket cons dest+  where+  cons = mallocArray (fromIntegral n) >>= \p -> return (Buf n p 0)+  dest = \(Buf _ p _) -> free p++-- |Drop the first @n <= size@ octets from the buffer.++flush :: ByteCount -> Buffer -> IO Buffer+flush 0 buf               = return buf+flush n (Buf cap ptr len) = assert (n <= len) $ do+  let ptr' = ptr `plusPtr` (fromIntegral n)+      len' = (fromIntegral len) - (fromIntegral n)+  when (len' > 0) (copyArray ptr ptr' len')+  return (Buf cap ptr (fromIntegral len'))++-- |Timeouts are represented in microseconds.++type Timeout = Int++-- |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+-- 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))+  timeout to (handleEOF wrap) >>=+    maybe (throwDyn (ReadTimeout to h b)) return+  where+  wrap = do let ptr' = ptr `plusPtr` (fromIntegral len)+                n    = cap - len+            rc <- hGetBufNonBlocking h ptr' (fromIntegral n)+            if rc > 0+               then return (Buf cap ptr (len + (fromIntegral rc)))+               else hWaitForInput h (-1) >> wrap++-- * BlockHandler and I\/O Driver++-- |A callback function suitable for use with 'runLoop'+-- takes a buffer and a state, then returns a modified+-- buffer and a modified state. Usually the callback will+-- use 'slurp' to remove data it has processed already.++type BlockHandler st = Buffer -> st -> IO (Buffer, st)++-- |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+runLoopNB mkTO errH hIn cap f initST = withBuffer cap (flip ioloop $ initST)+  where+  ioloop buf st = buf `seq` st `seq`+    handle (\e -> errH e st) $ do+      rc <- slurp (mkTO st) hIn buf+      case rc of+        Nothing   -> return st+        Just buf' -> f buf' st >>= uncurry ioloop++-- |A variant which won't time out and will just 'throw' all+-- exceptions.++runLoop :: ReadHandle -> Capacity -> BlockHandler st -> st -> IO st+runLoop = runLoopNB (const (-1)) (\e _ -> throw e)++-- * Handler Combinators++-- |Signal how many bytes have been consumed from the+-- /front/ of the list; these octets will be dropped.++type StreamHandler st = [Word8] -> st -> IO (ByteCount, st)++handleStream :: StreamHandler st -> BlockHandler st+handleStream f buf@(Buf _ ptr len) st = do+  (i, st') <- peekArray (fromIntegral len) ptr >>= (flip f) st+  buf' <- flush i buf+  return (buf', st')++-- * I\/O Exceptions++-- |Thrown by 'slurp'.++data BufferOverflow = BufferOverflow ReadHandle Buffer+                    deriving (Show, Typeable)++-- |Thrown by 'slurp'.++data ReadTimeout    = ReadTimeout Timeout ReadHandle Buffer+                    deriving (Show, Typeable)+++-- * Internal Helper Functions++-- |Return 'Nothing' if the given computation throws an+-- 'isEOFError' exception. Used by 'slurp'.++handleEOF :: IO a -> IO (Maybe a)+handleEOF f =+  catchJust ioErrors+    (fmap Just f)+    (\e -> if isEOFError e then return Nothing else ioError e)++-- |Our version of C's @strstr(3)@.++strstr :: [Word8] -> [Word8] -> Maybe Int+strstr tok = strstr' 0+  where+  strstr'  _     []       = Nothing+  strstr' pos ls@(_:xs)+    | tok `isPrefixOf` ls = Just (pos + length tok)+    | otherwise           = strstr' (pos + 1) xs++-- |Split a list by some delimiter. Will soon be provided by+-- "Data.List".++splitList :: Eq a => [a] -> [a] -> [[a]]+splitList d' l' =+  unfoldr (\x -> if (null x) then Nothing else Just $ nextToken d' [] (snd $ splitAt (length d') x)) (d'++l')+  where nextToken _ r [] = (r, [])+        nextToken d r l@(h:t) | (d `isPrefixOf` l) = (r, l)+                              | otherwise = nextToken d (r++[h]) t++-- * Socket Handlers++type SocketHandler = (Socket,SockAddr) -> IO ()++-- |Creates a listening socket for the given port, then+-- calls 'acceptor' to start the given computation for every+-- incoming connection.++listener :: PortID -> SocketHandler -> IO ()+listener p h = bracket (listenOn p) (sClose) (acceptor h)++-- |Given a listening socket, this function will loop+-- forever 'accept'ing incoming connections. For each+-- connection a 'SocketHandler' thread is forked.++acceptor :: SocketHandler -> Socket -> IO ()+acceptor h ls = do+  Postmaster.Base.bracketOnError+    (accept ls)+    (sClose . fst)+    (\peer@(s,_) -> fork $ h peer `finally` sClose s)+  acceptor h ls+  where+  fork f = forkIO f >> return ()++type LazyHandler = (Handle, Maybe SockAddr) -> IO ()++handleLazy :: IOMode -> LazyHandler -> SocketHandler+handleLazy m f (s,sa) =+  bracket (socketToHandle s m) (hClose) (\h -> f (h, Just sa))+++-- * Non-blocking I\/O++-- |The exception we throw when writes time out.+-- 'ReadTimeout' is throw by "System.IO.Driver".++data WriteTimeout = WriteTimeout Timeout+                  deriving (Typeable, Show)++setReadTimeout :: Timeout -> Smtpd ()+setReadTimeout = local . setVar (mkVar "ReadTimeout")++getReadTimeout :: Smtpd Timeout+getReadTimeout = local $ getVarDef (mkVar "ReadTimeout") (90 * 1000000)++setWriteTimeout :: Timeout -> Smtpd ()+setWriteTimeout = local . setVar (mkVar "WriteTimeout")++getWriteTimeout :: Smtpd Timeout+getWriteTimeout = local $ getVarDef (mkVar "WriteTimeout") (90 * 1000000)++safeWrite :: IO a -> Smtpd a+safeWrite f = do+  to <- getWriteTimeout+  liftIO $ timeout to f >>= maybe (throwDyn (WriteTimeout to)) return++safeReply :: WriteHandle -> SmtpReply -> Smtpd ()+safeReply hOut r = safeWrite (hPutStr hOut (show r))++safeFlush :: WriteHandle -> Smtpd ()+safeFlush hOut = safeWrite (hFlush hOut)

@@ -0,0 +1,187 @@+{- |+   Module      :  Postmaster.Main+   Copyright   :  (c) 2004-2008 by Peter Simons+   License     :  GPL2++   Maintainer  :  simons@cryp.to+   Stability   :  provisional+   Portability :  Haskell 2-pre++   Postmaster's IO driver and general initialization functions.+-}++module Postmaster.Main where++import Prelude hiding ( catch )+import Data.Maybe+import Control.Concurrent.MVar+import Control.Monad.RWS hiding ( local )+import Control.Monad.State+import System.IO+import System.Posix.Signals+import Network ( PortID(..) )+import Network.Socket+import Network.BSD ( getHostName )+import ADNS+import Foreign+import Postmaster.Base+import Postmaster.FSM+import Postmaster.FSM.DNSResolver  ( setDNSResolver  )+import Postmaster.FSM.EventHandler ( setEventHandler )+import Postmaster.FSM.PeerAddr     ( setPeerAddr     )+import Postmaster.FSM.SessionState ( setSessionState )+import Postmaster.IO+import Text.ParserCombinators.Parsec.Rfc2821+import System.Posix.Syslog++-- * Speaking ESMTP++-- |This function ties it all together to build a+-- 'BlockHandler' for "System.IO.Driver".++smtpdHandler :: WriteHandle -> GlobalEnv -> BlockHandler SmtpdState+smtpdHandler hOut theEnv buf = runSmtpd (smtpd buf >>= handler) theEnv+  where+  handler :: ([SmtpReply], Buffer) -> Smtpd Buffer+  handler (rs, buf') = do+    safeWrite (hPutStr hOut (concatMap show rs) >> hFlush hOut)+    when (any isShutdown rs) (fail "shutdown")+    return buf'++-- |The unified interface to dialog and data section. This+-- function relies on the fact that pipelining ends with+-- @DATA@ commands: dialog and payload must /not/ come in a+-- single buffer. See+-- <http://www.faqs.org/rfcs/rfc2920.html> section 3.1.++smtpd :: Buffer -> Smtpd ([SmtpReply], Buffer)+smtpd buf@(Buf _  _  0) = return ([], buf)+smtpd buf@(Buf _ ptr n) = do+  sst <- getSessionState+  if (sst == HaveData)+      then do (r, buf') <- feed buf+              return (maybeToList r, buf')+      else do xs <- liftIO (peekArray (fromIntegral n) ptr)+              let xs'  = map (toEnum . fromEnum) xs+                  ls'  = splitList "\r\n" xs'+                  ls   = reverse . tail $ reverse ls'+                  rest = head $ reverse ls'+                  i    = length xs - length rest+              rs <- mapM handleDialog ls+              buf' <- liftIO $ flush (fromIntegral i) buf+              return (rs, buf')++handleDialog :: String -> Smtpd SmtpReply+handleDialog line = do+  sst <- getSessionState+  let (e, sst') = runState (smtpdFSM (fixCRLF line)) sst+  r <- trigger e+  case (e, isSuccess r) of+    (_, True)          -> setSessionState sst'+    (StartData, False) -> trigger ResetState >> setSessionState HaveHelo+    _                  -> return ()+  return r+++-- * Running 'Smtpd' Computations++-- |Run the given 'Smtpd' computation and write the logging+-- output via the given 'Logger'. Use 'withGlobalEnv' to+-- create the global environment and 'emptyEnv' to+-- initialize the 'SmtpdState'.++runSmtpd' :: Logger -> Smtpd a -> GlobalEnv -> SmtpdState+          -> IO (a, SmtpdState)+runSmtpd' logger f = runStateT . withLogger logger f++-- |Convenience wrapper for 'runSmtpd'' with 'Logger'+-- hard-coded to 'syslogger'.++runSmtpd :: Smtpd a -> GlobalEnv -> SmtpdState+         -> IO (a, SmtpdState)+runSmtpd = runSmtpd' syslogger++-- |Run the given computation with an initialized global+-- environment for 'Smtpd'. The environment is destroyed+-- when this function returns.++withGlobalEnv :: HostName           -- ^ 'myHeloName'+              -> Resolver+              -> EventT+              -> (GlobalEnv -> IO a)+              -> IO a+withGlobalEnv myHelo dns eventT f = do+  let eventH  = eventT (mkEvent myHelo "/tmp/test-spool")+      initEnv = do setDNSResolver dns+                   setEventHandler eventH+  newMVar (execState initEnv emptyEnv) >>= f+++-- * ESMTP Network Daemon++smtpdServer :: Capacity -> GlobalEnv -> SocketHandler+smtpdServer cap theEnv =+  handleLazy ReadWriteMode $ \(h, Just sa) -> do+    hSetBuffering h (BlockBuffering (Just (fromIntegral cap)))+    let st = execState (setPeerAddr sa) emptyEnv+    smtpdMain cap theEnv h h st >> return ()++smtpdMain :: Capacity+          -> GlobalEnv+          -> ReadHandle+          -> WriteHandle+          -> SmtpdState+          -> IO SmtpdState+smtpdMain cap theEnv hIn hOut initST = do+  let greet = do r <- trigger Greeting+                 safeReply hOut r >> safeFlush hOut+                 to <- getReadTimeout+                 sid <- mySessionID+                 return (r, to, sid)+  ((r, to, sid), st) <- runSmtpd greet theEnv initST+  st' <- case r of+    Reply (Code Success _ _) _  -> do+      let getTO  = evalState (getVarDef (mkVar "ReadTimeout") to)+          yellIO = syslogger . LogMsg sid st+          hMain  = smtpdHandler hOut theEnv+          errH e st' = yellIO (CaughtException e) >> return st'+      runLoopNB getTO errH hIn cap hMain st+    _ -> return st+  let bye = do sst <- getSessionState+               when (sst /= HaveQuit)+                 (trigger Shutdown >> return ())+  fmap snd (runSmtpd bye theEnv st')++main' :: Capacity -> PortID -> EventT -> IO ()+main' cap port eventT = do+  installHandler sigPIPE Ignore Nothing+  installHandler sigCHLD (Catch (return ())) Nothing+  whoami <- getHostName+  withSocketsDo $+    withSyslog "postmaster" [PID, PERROR] MAIL $+      initResolver [NoErrPrint,NoServerWarn] $ \dns ->+        withGlobalEnv whoami dns eventT $+          listener port . smtpdServer cap++main :: IO ()+main = main' 1024 (PortNumber 2525) id++-- ** Logging++type Logger = LogMsg -> IO ()++-- |Bind the logging back-end to demote 'Smtpd' to an+-- ordinary 'StateT' computation.++withLogger :: Logger -> Smtpd a -> GlobalEnv -> StateT SmtpdState IO a+withLogger logger f theEnv = do+  (a, st, w) <- get >>= liftIO . runRWST f theEnv+  liftIO $ mapM_ logger w+  put st+  return a++-- |Our default logging back-end.++syslogger :: Logger+syslogger (LogMsg sid _ e) = syslog Info $+  showString "SID " . shows sid . (':':) . (' ':) $ show e

@@ -0,0 +1,205 @@+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

@@ -0,0 +1,8 @@+#!/usr/bin/env runhaskell++> module Main (main) where+>+> import Distribution.Simple+>+> main :: IO ()+> main = defaultMain

@@ -0,0 +1,26 @@+Name:                   postmaster+Version:                0.1+Synopsis:               Postmaster ESMTP Server+Description:            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+                        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+Build-Type:             Simple++Executable:             postmaster+Main-Is:                tutorial.lhs+GHC-Options:            -Wall -threaded+Extra-Libraries:        adns crypto+Build-Depends:          base, haskell98, directory, mtl, network, unix, parsec,+                        containers, bytestring, old-time, hsyslog, hsdns, hsemail,+                        hopenssl

@@ -0,0 +1,545 @@+> {-# 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.IO+> import System.Time+> import System.Posix.User+> import Network.Socket ( SockAddr(..) )+> import Data.Char+> import Data.List+> 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: ***