From 182a26546a738fa2c98b0e5de8f93a95e8d12d5f Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sun, 18 Jan 2004 19:44:55 +0000 Subject: [PATCH] Initial revision --- .cvsignore | 1 + LICENSE | 340 +++++++++++++++++++++++++ Makefile | 13 + README | 150 +++++++++++ src/.cvsignore | 2 + src/apache/.cvsignore | 2 + src/apache/README | 64 +++++ src/apache/apache.sig | 23 ++ src/apache/apache.sml | 190 ++++++++++++++ src/apache/config.sample.sml | 47 ++++ src/apache/sources.cm | 4 + src/config.sample.sml | 54 ++++ src/djbdns/.cvsignore | 2 + src/djbdns/README | 43 ++++ src/djbdns/config.sample.sml | 32 +++ src/djbdns/djbdns.sig | 25 ++ src/djbdns/djbdns.sml | 145 +++++++++++ src/djbdns/sources.cm | 4 + src/domtool.cm | 40 +++ src/domtool.sig | 64 +++++ src/domtool.sml | 324 ++++++++++++++++++++++++ src/exim/.cvsignore | 2 + src/exim/README | 41 +++ src/exim/config.sample.sml | 38 +++ src/exim/exim.sig | 24 ++ src/exim/exim.sml | 136 ++++++++++ src/exim/sources.cm | 4 + src/main.sml | 25 ++ src/map.sml | 28 ++ src/postconfig.sml | 25 ++ src/smlnj-lib/.cvsignore | 1 + src/smlnj-lib/binary-map-fn.sml | 435 ++++++++++++++++++++++++++++++++ src/smlnj-lib/binary-set-fn.sml | 418 ++++++++++++++++++++++++++++++ src/smlnj-lib/lib-base-sig.sml | 24 ++ src/smlnj-lib/lib-base.sml | 37 +++ src/smlnj-lib/ord-key-sig.sml | 15 ++ src/smlnj-lib/ord-map-sig.sml | 116 +++++++++ src/smlnj-lib/ord-set-sig.sml | 90 +++++++ src/smlnj-lib/sources.cm | 8 + src/util.sig | 70 +++++ src/util.sml | 115 +++++++++ src/vmail/.cvsignore | 2 + src/vmail/README | 43 ++++ src/vmail/config.sample.sml | 35 +++ src/vmail/main.sml | 20 ++ src/vmail/reloadusers.cm | 6 + src/vmail/reloadusers.main.sml | 20 ++ src/vmail/reloadusers.sig | 23 ++ src/vmail/reloadusers.sml | 69 +++++ src/vmail/vmail.cm | 13 + src/vmail/vmail.sig | 23 ++ src/vmail/vmail.sml | 102 ++++++++ src/webpasswd/config.sml | 25 ++ src/webpasswd/main.sml | 20 ++ src/webpasswd/webpasswd.cm | 8 + src/webpasswd/webpasswd.sig | 23 ++ src/webpasswd/webpasswd.sml | 50 ++++ 57 files changed, 3703 insertions(+) create mode 100644 .cvsignore create mode 100644 LICENSE create mode 100644 Makefile create mode 100644 README create mode 100644 src/.cvsignore create mode 100644 src/apache/.cvsignore create mode 100644 src/apache/README create mode 100644 src/apache/apache.sig create mode 100644 src/apache/apache.sml create mode 100644 src/apache/config.sample.sml create mode 100644 src/apache/sources.cm create mode 100644 src/config.sample.sml create mode 100644 src/djbdns/.cvsignore create mode 100644 src/djbdns/README create mode 100644 src/djbdns/config.sample.sml create mode 100644 src/djbdns/djbdns.sig create mode 100644 src/djbdns/djbdns.sml create mode 100644 src/djbdns/sources.cm create mode 100644 src/domtool.cm create mode 100644 src/domtool.sig create mode 100644 src/domtool.sml create mode 100644 src/exim/.cvsignore create mode 100644 src/exim/README create mode 100644 src/exim/config.sample.sml create mode 100644 src/exim/exim.sig create mode 100644 src/exim/exim.sml create mode 100644 src/exim/sources.cm create mode 100644 src/main.sml create mode 100644 src/map.sml create mode 100644 src/postconfig.sml create mode 100644 src/smlnj-lib/.cvsignore create mode 100644 src/smlnj-lib/binary-map-fn.sml create mode 100644 src/smlnj-lib/binary-set-fn.sml create mode 100644 src/smlnj-lib/lib-base-sig.sml create mode 100644 src/smlnj-lib/lib-base.sml create mode 100644 src/smlnj-lib/ord-key-sig.sml create mode 100644 src/smlnj-lib/ord-map-sig.sml create mode 100644 src/smlnj-lib/ord-set-sig.sml create mode 100644 src/smlnj-lib/sources.cm create mode 100644 src/util.sig create mode 100644 src/util.sml create mode 100644 src/vmail/.cvsignore create mode 100644 src/vmail/README create mode 100644 src/vmail/config.sample.sml create mode 100644 src/vmail/main.sml create mode 100644 src/vmail/reloadusers.cm create mode 100644 src/vmail/reloadusers.main.sml create mode 100644 src/vmail/reloadusers.sig create mode 100644 src/vmail/reloadusers.sml create mode 100644 src/vmail/vmail.cm create mode 100644 src/vmail/vmail.sig create mode 100644 src/vmail/vmail.sml create mode 100644 src/webpasswd/config.sml create mode 100644 src/webpasswd/main.sml create mode 100644 src/webpasswd/webpasswd.cm create mode 100644 src/webpasswd/webpasswd.sig create mode 100644 src/webpasswd/webpasswd.sml diff --git a/.cvsignore b/.cvsignore new file mode 100644 index 0000000..be80172 --- /dev/null +++ b/.cvsignore @@ -0,0 +1 @@ +CM \ No newline at end of file diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..5b6e7c6 --- /dev/null +++ b/LICENSE @@ -0,0 +1,340 @@ + GNU GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1989, 1991 Free Software Foundation, Inc. + 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. This +General Public License applies to most of the Free Software +Foundation's software and to any other program whose authors commit to +using it. (Some other Free Software Foundation software is covered by +the GNU Library General Public License instead.) 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 +this service 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 make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. 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. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that redistributors of a free +program will individually obtain patent licenses, in effect making the +program proprietary. To prevent this, we have made it clear that any +patent must be licensed for everyone's free use or not licensed at all. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License applies to any program or other work which contains +a notice placed by the copyright holder saying it may be distributed +under the terms of this General Public License. The "Program", below, +refers to any such program or work, and a "work based on the Program" +means either the Program or any derivative work under copyright law: +that is to say, a work containing the Program or a portion of it, +either verbatim or with modifications and/or translated into another +language. (Hereinafter, translation is included without limitation in +the term "modification".) Each licensee is addressed as "you". + +Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running the Program is not restricted, and the output from the Program +is covered only if its contents constitute a work based on the +Program (independent of having been made by running the Program). +Whether that is true depends on what the Program does. + + 1. You may copy and distribute 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 and disclaimer of warranty; keep intact all the +notices that refer to this License and to the absence of any warranty; +and give any other recipients of the Program a copy of this License +along with the Program. + +You may charge a fee for the physical act of transferring a copy, and +you may at your option offer warranty protection in exchange for a fee. + + 2. You may modify your copy or copies of the Program or any portion +of it, thus forming a work based on the Program, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) You must cause the modified files to carry prominent notices + stating that you changed the files and the date of any change. + + b) You must cause any work that you distribute or publish, that in + whole or in part contains or is derived from the Program or any + part thereof, to be licensed as a whole at no charge to all third + parties under the terms of this License. + + c) If the modified program normally reads commands interactively + when run, you must cause it, when started running for such + interactive use in the most ordinary way, to print or display an + announcement including an appropriate copyright notice and a + notice that there is no warranty (or else, saying that you provide + a warranty) and that users may redistribute the program under + these conditions, and telling the user how to view a copy of this + License. (Exception: if the Program itself is interactive but + does not normally print such an announcement, your work based on + the Program is not required to print an announcement.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Program, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Program, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Program. + +In addition, mere aggregation of another work not based on the Program +with the Program (or with a work based on the Program) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may copy and distribute the Program (or a work based on it, +under Section 2) in object code or executable form under the terms of +Sections 1 and 2 above provided that you also do one of the following: + + a) Accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of Sections + 1 and 2 above on a medium customarily used for software interchange; or, + + b) Accompany it with a written offer, valid for at least three + years, to give any third party, for a charge no more than your + cost of physically performing source distribution, a complete + machine-readable copy of the corresponding source code, to be + distributed under the terms of Sections 1 and 2 above on a medium + customarily used for software interchange; or, + + c) Accompany it with the information you received as to the offer + to distribute corresponding source code. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form with such + an offer, in accord with Subsection b above.) + +The source code for a work means the preferred form of the work for +making modifications to it. For an executable work, complete source +code means all the source code for all modules it contains, plus any +associated interface definition files, plus the scripts used to +control compilation and installation of the executable. However, as a +special exception, the source code distributed need not include +anything that is normally distributed (in either source or binary +form) with the major components (compiler, kernel, and so on) of the +operating system on which the executable runs, unless that component +itself accompanies the executable. + +If distribution of executable or object code is made by offering +access to copy from a designated place, then offering equivalent +access to copy the source code from the same place counts as +distribution of the source code, even though third parties are not +compelled to copy the source along with the object code. + + 4. You may not copy, modify, sublicense, or distribute the Program +except as expressly provided under this License. Any attempt +otherwise to copy, modify, sublicense or distribute the Program is +void, and will automatically terminate your rights under this License. +However, parties who have received copies, or rights, from you under +this License will not have their licenses terminated so long as such +parties remain in full compliance. + + 5. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Program or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Program (or any work based on the +Program), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Program or works based on it. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the +original licensor to copy, distribute or modify the Program subject to +these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + + 7. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +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 +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Program at all. For example, if a patent +license would not permit royalty-free redistribution of the Program by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Program. + +If any portion of this section is held invalid or unenforceable under +any particular circumstance, the balance of the section is intended to +apply and the section as a whole is intended to apply in other +circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system, which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 8. If the distribution and/or use of the Program is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Program under this License +may add an explicit geographical distribution limitation excluding +those countries, so that distribution is permitted only in or among +countries not thus excluded. In such case, this License incorporates +the limitation as if written in the body of this License. + + 9. The Free Software Foundation may publish revised and/or new versions +of the 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 a version number of this License which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +this License, you may choose any version ever published by the Free Software +Foundation. + + 10. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, 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. + + 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE 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. + + 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 +convey the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + 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 2 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, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) year name of author + Gnomovision 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, the commands you use may +be called something other than `show w' and `show c'; they could even be +mouse-clicks or menu items--whatever suits your program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the program + `Gnomovision' (which makes passes at compilers) written by James Hacker. + + , 1 April 1989 + Ty Coon, President of Vice + +This 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 Library General +Public License instead of this License. diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..bc266ab --- /dev/null +++ b/Makefile @@ -0,0 +1,13 @@ +all: domtool webpasswd vmail reloadusers + +domtool: + mlton -output bin/domtool src/domtool.cm + +webpasswd: + mlton -output bin/webpasswd src/webpasswd/webpasswd.cm + +vmail: + mlton -output bin/vmail src/vmail/vmail.cm + +reloadusers: + mlton -output bin/reloadusers src/vmail/reloadusers.cm \ No newline at end of file diff --git a/README b/README new file mode 100644 index 0000000..2866a7e --- /dev/null +++ b/README @@ -0,0 +1,150 @@ +TOOLS FOR COOPERATIVE INTERNET HOSTING +http://hcoop.sf.net/ + + +Introduction +------------ + +This package collects tools that have been found useful in running +Internet servers cooperatively for the Internet Hosting Cooperative +(http://hcoop.net/). The inclusion of all of them in this package +isn't always particularly well motivated. However, everything here +should be of potential interest to the general sysadminning public. + +The basic goal here is to provide Internet hosting services that meet +the following criteria: + * A group of people share the resources of a server. + * People should be prevented from breaking other people's services. + * It should be easy to administer your own services. + * The base interface should be attractive to expert users, which +includes making it relatively easy to manipulate with scripts. + + +Domtool basics +-------------- + +The central organizing principle of the tools here is to represent all +domains hosted on a machine as parts of a directory tree mirroring the +structure of Internet domain names. Configuration files relevant to +daemons that have per-domain/hostname configuration live in the +directories for the domains whose settings they control. Standard UNIX +filesystem permissions control who is allowed to change the settings +for which domains. + +There are also additional controls related to which users, groups, and +paths may be used in configuration files. Each directory in the domain +tree may contain a .users file which lists UNIX usernames on separate +lines. The union of the users specified in a domain's directory and +all its parent directories in the domain tree specifies which users +administrators of that domain are allowed to delegate for processes to +run as. .groups files are treated analogously for UNIX groups. .paths +files work in the same way for specifying filesystem paths that users +are permitted to use in daemon configuration. Any recursive +subdirectory of a path in .paths is also allowed. + +Obviously this system is useless if domain administrators are +permitted to edit these files themselves. The tools that read config +files will check that such files are owned by a set UNIX user, which +will probably be a special user you create for domtool. + +For convenience, there is also a mechanism for defining +variables. .vars files are treated in the same inheriting fashion, but +they contain lines of variable names separated from their values by +whitespace. Variables are currently intended to be used to give +shorthand names for the IP addresses of particular machines that will +often come up in configuration while avoiding the potential +chicken-and-egg problem of looking up hostnames while configuring DNS. + + +Software organization +--------------------- + +First things first: All of the software here is written in Standard +ML. You can find compilers and educational material on it starting at +http://www.standardml.org/. One of the domtool authors has also +written an SML advocacy page that you can find at +http://www.hprog.org/fhp/MlLanguage. We quite realize that SML is far +from being popular with the general development community, but we hope +you'll see why it's such a great language to use if you give it a try. + +The code in src/ handles the basic structure described above. Actual +interaction with particular daemons is handled by +modules. src/domtool.sig gives the interface that they may use to hook +into the main tool. This transfer of control is based on configuration +file names. Modules register particular configuration file names that +they handle when such files are found in domain directories. There may +also be one default handler registered, which is called for otherwise +unmatched files that are valid Internet hostnames. Currently this is +assumed to be a handler for Web virtual hosts, but it would be easy to +do something else with these files. + +Tweakable configuration options are controlled throughout by SML +source files. Everything is designed to be compiled with the MLton +compiler (http://www.mlton.org/). MLton is a whole-program compiler +and will integrate the settings in the various config files into the +compiled code. If you have a current version of MLton installed, you +should be able to run 'make' in this directory and build everything +fine after you copy all config.sample.sml files to config.sml files +and configure local settings. + +In the subdirectories of src/, you'll find various modules and +additional command line programs. Each of these will typically have a +config.sample.sml file that you should copy to config.sml and modify +to set local options. Each should also contain a README file +explaining the basics of the module or tool. + + +Usage of the command-line tool +------------------------------ + +Running the program that builds in bin/domtool with no parameters will +crawl over the domain tree reading configuration files. As it goes, it +writes temporary versions of the new system configuration files in a +location configured by the scratchDir variable in +src/config.sml. After everything is read, a quick switch-over to the +new files is performed, along with poking any daemons that need to +reload configuration or restart. This change-over is done by running +bin/domtool with the single argument 'publish'. It shouldn't be +necessary to run this manually. Domtool itself will re-run itself with +elevated permissions using sudo, or whatever other means you +configure. (See below) + +The final way to use domtool is as follows: +domtool mkdom domain.name user +This creates the appropriate directory in the domain tree, setting it +up to be administered by the specified UNIX user. It is not necessary +to set up new domains this way. Just creating a directory in the right +place will work fine. Mkdom just does some helpful things like +automatically generating the access control files and chown'ing them +to the right user. + + +Handling permissions +-------------------- + +At hcoop, we make extensive use of sudo +(http://www.courtesan.com/sudo/) to give our members access to +modify system configuration files in safe ways. Here's the basic +setup, which you may or may not want to emulate: + +We have a user 'domains.' + +We have the program that builds in bin/domtool in +/usr/local/bin/domtool.real. + +We have a script in /usr/local/bin/domtool that runs: + sudo -u domains /usr/local/bin/domtool.real + + +In /etc/sudoers, we have: + +A group of users allowed to run domtool: +User_Alias DOMTOOL_USERS = user1,user2,user3 + +Authorization for these users to run domtool as user domains: +DOMTOOL_USERS ALL = (domains) NOPASSWD: +/usr/local/bin/domtool.real + +Authorization for user domains to run domtool publish: +domains ALL = (root) NOPASSWD: +/usr/local/bin/domtool.real publish diff --git a/src/.cvsignore b/src/.cvsignore new file mode 100644 index 0000000..a705707 --- /dev/null +++ b/src/.cvsignore @@ -0,0 +1,2 @@ +CM +config.sml \ No newline at end of file diff --git a/src/apache/.cvsignore b/src/apache/.cvsignore new file mode 100644 index 0000000..a705707 --- /dev/null +++ b/src/apache/.cvsignore @@ -0,0 +1,2 @@ +CM +config.sml \ No newline at end of file diff --git a/src/apache/README b/src/apache/README new file mode 100644 index 0000000..ab05fdf --- /dev/null +++ b/src/apache/README @@ -0,0 +1,64 @@ +APACHE VIRTUAL HOST AND WEBALIZER CONFIGURATION + + +This module handles configuration of Apache 1.3 +(http://httpd.apache.org/) virtual hosts, as well as automatically +setting up Webalizer (http://www.mrunix.net/webalizer/) access +statistics generation for each virtual host. + +Any file in a domain's directory whose name is a valid hostname (i.e., +www, myhost, etc.) is taken to be configuration for an Apache +virtual host. These are separate web sites that Apache serves, +differentiated based on the hostname contained in a request. The +following configuration directives may appear on separate lines in +such files: + + * ServerAdmin email: Set the e-mail address of the vhost's admin to +email. + * User user: Run CGI programs as UNIX user user. The default is +nobody. + * Group group: Run CGI programs with UNIX group group. The +default is nogroup. You are probably not in nogroup, so you +probably want to include Group myuser if you also have User +myuser. + * UserDir: Map requests to http://domain/~user/... to the +corresponding files and directories in user's public_html +directory, if he has one. + * DocumentRoot dir: Use dir as the base directory for site +content. + * RewriteRule ...: These lines are passed verbatim to Apache's +mod_rewrite (http://httpd.apache.org/docs/mod/mod_rewrite.html). + * Alias urldir realdir: Serve requests for things in directory +urldir out of realdir. + * ScriptAlias urldir realdir: Like the above, but for scripts. It's +like the same-named Apache directive. + * SSI: Enable server-side includes. + * ServerAlias hostname: Serve requests for full hostname hostname +with this same vhost. There must exist an appropriate host.aliased +file corresponding to hostname. For example, if hostname is +my.web.site, the file /etc/domains/site/web/my.aliased must exist. + * WebalizerUsers userlist: Only allow users in space-separated +userlist to view the Webalizer statistics for this vhost. + * AbuPrivate: Force visitors to this vhost to log in with their +web accounts. The password file used for this is indicated by +passwdFile in config.sml. Deny access if a correct username and +password are not provided. + * CGI dir: Mark filesystem directory dir as containing executable +CGI scripts/programs. + * Default: Where the configuration file is describing +host.domain, this sets domain by itself as an alternate name for +this vhost. + * ErrorDocument code url: This is the Apache ErrorDocument +directive verbatim. + * HTML realdir: Serve every file in realdir as HTML. + +The src/webpasswd/ directory contains a handy tool for allowing users +to set their own passwords and no one else's in an Apache password +file. It's helpful to use along with the AbuPrivate and WebalizerUsers +options. + + +The module generates a file vhosts.conf containing only virtual host +configuration. It is intended to be included by the standard +httpd.conf after all server-wide configuration and a default virtual +host block. \ No newline at end of file diff --git a/src/apache/apache.sig b/src/apache/apache.sig new file mode 100644 index 0000000..c92a1e8 --- /dev/null +++ b/src/apache/apache.sig @@ -0,0 +1,23 @@ +(* +Domtool (http://hcoop.sf.net/) +Copyright (C) 2004 Adam Chlipala + +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 2 +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, write to the Free Software +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +*) + +signature APACHE = +sig + +end \ No newline at end of file diff --git a/src/apache/apache.sml b/src/apache/apache.sml new file mode 100644 index 0000000..214e005 --- /dev/null +++ b/src/apache/apache.sml @@ -0,0 +1,190 @@ +(* +Domtool (http://hcoop.sf.net/) +Copyright (C) 2004 Adam Chlipala + +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 2 +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, write to the Free Software +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +*) + +(* Apache vhost management module, with Webalizer support *) + +structure Apache :> APACHE = +struct + open Config ApacheConfig Util + + val vhosts = ref (NONE : TextIO.outstream option) + + fun init () = vhosts := SOME (TextIO.openOut (scratchDir ^ "/vhosts.conf")) + fun finish () = (TextIO.closeOut (valOf (!vhosts)); + vhosts := NONE) + + fun handler {path, domain, parent, vars, paths, users, groups} = + let + val _ = Domtool.dprint ("Reading host " ^ path ^ " for " ^ domain ^ "....") + + val vhosts = valOf (!vhosts) + + val hf = TextIO.openIn path + val rewrite = ref false + + val conf = TextIO.openOut (wblConfDir ^ "/" ^ domain ^ ".conf") + val _ = TextIO.output (conf, "LogFile\t" ^ logDir ^ domain ^ "-access.log\n" ^ + "OutputDir\t" ^ wblDocDir ^ "/" ^ domain ^ "\n" ^ + "HostName\t" ^ domain ^ "\n" ^ + "HideSite\t" ^ domain ^ "\n" ^ + "HideReferrer\t" ^ domain ^ "\n") + + val dir = wblDocDir ^ "/" ^ domain + val _ = + if Posix.FileSys.access (dir, []) then + () + else + Posix.FileSys.mkdir (dir, Posix.FileSys.S.flags [Posix.FileSys.S.ixoth, Posix.FileSys.S.irwxu, + Posix.FileSys.S.irgrp, Posix.FileSys.S.iwgrp]) + + val htac = TextIO.openOut (dir ^ "/.htaccess") + val user = ref defaultUser + val group = ref defaultGroup + + fun loop (line, ()) = + (case String.tokens Char.isSpace line of + [] => () + | ["User", user'] => + if StringSet.member (users, user') then + user := user' + else + Domtool.error (path, "not authorized to run as " ^ user') + | ["Group", group'] => + if StringSet.member (groups, group') then + group := group' + else + Domtool.error (path, "not authorized to run as group " ^ group') + | ["ServerAdmin", email] => TextIO.output (vhosts, "\tServerAdmin " ^ email ^ "\n") + | ["UserDir"] => TextIO.output (vhosts, "\tUserDir public_html\n\t\n\t\tAllowOverride None\n\t\tOptions ExecCGI\n\t\tAllow from all\n\t\tSetHandler cgi-script\n\t\n\tScriptAliasMatch ^/~(.*)/cgi-bin/(.*) /home/$1/public_html/cgi-bin/$2\n") + | ["DocumentRoot", p] => + if checkPath (paths, p) then + TextIO.output (vhosts, "\tDocumentRoot " ^ p ^ "\n") + else + print (path ^ ": not authorized to use " ^ p ^ "\n") + | "RewriteRule" :: args => + (if not (!rewrite) then + (rewrite := true; + TextIO.output (vhosts, "\tRewriteEngine on\n")) + else + (); + TextIO.output (vhosts, foldl (fn (a, s) => s ^ " " ^ a) "\tRewriteRule" args ^ "\n")) + | ["Alias", from, to] => + if checkPath (paths, to) then + TextIO.output (vhosts, "\tAlias " ^ from ^ " " ^ to ^ "\n") + else + Domtool.error (path, "not authorized to use " ^ to) + | "ErrorDocument" :: code :: rest => + TextIO.output (vhosts, foldl (fn (a, s) => s ^ " " ^ a) ("\tErrorDocument " ^ code) rest ^ "\n") + | ["ScriptAlias", from, to] => + if checkPath (paths, to) then + TextIO.output (vhosts, "\tScriptAlias " ^ from ^ " \"" ^ to ^ "\"\n") + else + Domtool.error (path, "not authorized to use " ^ to) + | ["SSI"] => + TextIO.output (vhosts, "\t\n\t\tOptions +Includes +IncludesNOEXEC\n\t\n") + | ["ServerAlias", dom] => + if validDomain dom then + let + val file = foldr (fn (c, s) => s ^ "/" ^ c) dataDir (String.fields (fn ch => ch = #".") dom) ^ ".aliased" + in + if Posix.FileSys.access (file, []) then + (TextIO.output (vhosts, "\tServerAlias " ^ dom ^ "\n"); + TextIO.output (conf, "HideSite\t" ^ dom ^ "\n" ^ + "HideReferrer\t" ^ dom ^ "\n")) + else + Domtool.error (path, "not authorized to ServerAlias " ^ dom) + end + else + Domtool.error (path, "bad host: " ^ dom) + | "WebalizerUsers" :: users => + TextIO.output (htac, "AuthType Basic\n" ^ + "AuthName \"Abulafia web account\"\n" ^ + "AuthUserFile " ^ passwdFile ^ "\n" ^ + foldl (fn (u, s) => s ^ " " ^ u) "Require user" users ^ "\n") + | ["AbuPrivate"] => TextIO.output (vhosts, + "\t\n" ^ + "\t\tAuthName \"Abulafia web account\"\n" ^ + "\t\tAuthType basic\n" ^ + "\t\tAuthUserFile " ^ passwdFile ^ "\n" ^ + "\t\tRequire valid-user\n" ^ + "\t\tOrder Deny,Allow\n" ^ + "\t\tDeny from all\n" ^ + "\t\tAllow from 127.0.0.1\n" ^ + "\t\tAllow from 63.246.10.45\n" ^ + "\t\tSatisfy any\n" ^ + "\t\n") + | ["Default"] => (TextIO.output (vhosts, "\tServerAlias " ^ parent ^ "\n"); + TextIO.output (conf, "HideSite\t" ^ parent ^ "\n" ^ + "HideReferrer\t" ^ parent ^ "\n")) + | ["CGI", p] => + if checkPath (paths, p) then + TextIO.output (vhosts, "\t\n" ^ + "\t\tOptions ExecCGI\n" ^ + "\t\tSetHandler cgi-script\n" ^ + "\t\n") + else + Domtool.error (path, "not authorized to use " ^ p) + | ["HTML", p] => + if checkPath (paths, p) then + TextIO.output (vhosts, "\t\n" ^ + "\t\tForceType text/html\n" ^ + "\t\n") + else + Domtool.error (path, "not authorized to use " ^ p) + | cmd::_ => Domtool.error (path, "unknown option: " ^ cmd)) + in + TextIO.output (vhosts, "\n" ^ + "\tServerName " ^ domain ^ "\n" ^ + "\tErrorLog " ^ logDir ^ domain ^ "-error.log\n" ^ + "\tCustomLog " ^ logDir ^ domain ^ "-access.log combined\n" ^ + "\tIndexOptions FancyIndexing FoldersFirst\n"); + ioLoop (fn () => Domtool.inputLine hf) loop (); + TextIO.output (vhosts, "\tUser "); + TextIO.output (vhosts, !user); + TextIO.output (vhosts, "\n\tGroup "); + TextIO.output (vhosts, !group); + TextIO.output (vhosts, "\n\n\n"); + TextIO.closeIn hf; + TextIO.closeOut conf; + TextIO.closeOut htac + end handle Io => Domtool.error (path, "IO error") + + fun publish () = + if OS.Process.isSuccess (OS.Process.system + (diff ^ " " ^ scratchDir ^ "/vhosts.conf " ^ dataFile)) then + OS.Process.success + else if not (OS.Process.isSuccess (OS.Process.system + (cp ^ " " ^ scratchDir ^ "/vhosts.conf " ^ dataFile))) then + (print "Error copying vhosts.conf\n"; + OS.Process.failure) + else if OS.Process.isSuccess (OS.Process.system pubCommand) then + OS.Process.success + else + (print "Error publishing vhosts.conf\n"; + OS.Process.failure) + + fun mkdom _ = OS.Process.success + + val _ = Domtool.setVhostHandler {init = init, + file = handler, + finish = finish, + publish = publish, + mkdom = mkdom} +end + diff --git a/src/apache/config.sample.sml b/src/apache/config.sample.sml new file mode 100644 index 0000000..4c98d2e --- /dev/null +++ b/src/apache/config.sample.sml @@ -0,0 +1,47 @@ +(* +Domtool (http://hcoop.sf.net/) +Copyright (C) 2004 Adam Chlipala + +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 2 +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, write to the Free Software +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +*) + +(* Some options you might want to change *) + +structure ApacheConfig = +struct + val logDir = "/var/log/apache/" + (* Where Apache writes log files *) + + val wblConfDir = "/etc/webalizer" + (* Directory containing Webalizer .conf files *) + + val wblDocDir = "/var/www/users.hcoop.net/html/webalizer" + (* Directory to use for outputting Webalizer results *) + + val passwdFile = "/etc/apache/passwds" + (* Default system web password file *) + + val defaultUser = "www-data" + (* Default UNIX user to allow a vhost to run as *) + + val defaultGroup = "www-data" + (* Default UNIX group to allow a vhost to run as *) + + val dataFile = "/etc/apache/vhosts.conf" + (* Location of real vhosts configuration file *) + + val pubCommand = "/etc/init.d/apache reload" + (* Command to publish changes *) +end diff --git a/src/apache/sources.cm b/src/apache/sources.cm new file mode 100644 index 0000000..562a0b8 --- /dev/null +++ b/src/apache/sources.cm @@ -0,0 +1,4 @@ +Group is + config.sml + apache.sig + apache.sml \ No newline at end of file diff --git a/src/config.sample.sml b/src/config.sample.sml new file mode 100644 index 0000000..aa27061 --- /dev/null +++ b/src/config.sample.sml @@ -0,0 +1,54 @@ +(* +Domtool (http://hcoop.sf.net/) +Copyright (C) 2004 Adam Chlipala + +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 2 +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, write to the Free Software +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +*) + +(* Some options you might want to change *) + +structure Config = +struct + (* Root of domain configuration tree *) + val dataDir = "/etc/domains" + + (* Temporary location for new daemon config files before publishing *) + val scratchDir = "/home/domains" + + (* Name of a directory to create/delete for locking purposes *) + val lockFile = "/home/domains/.lock" + + (* UID of the user as whom domtool will run (used to check authenticity + * of .users, .groups, and .paths files) *) + val uid = 1031 + + (* Path to the config file for the default web vhost for this server. + * Configuration for this host will be ignored, leaving it up to admins to + * set it up manually. + *) + val defaultWebPath = "/etc/domains/net/hcoop/www" + + (* When this is true, extra debug info may be printed. *) + val debug = false + + (* Command to run dompub (probably as root) *) + val dompub = "sudo /usr/local/bin/domtool.real publish" + + (* Paths to standard tools *) + val cp = "/bin/cp" + val diff = "/usr/bin/diff" + val cat = "/bin/cat" + val sudo = "/usr/bin/sudo" +end diff --git a/src/djbdns/.cvsignore b/src/djbdns/.cvsignore new file mode 100644 index 0000000..a705707 --- /dev/null +++ b/src/djbdns/.cvsignore @@ -0,0 +1,2 @@ +CM +config.sml \ No newline at end of file diff --git a/src/djbdns/README b/src/djbdns/README new file mode 100644 index 0000000..c0bb613 --- /dev/null +++ b/src/djbdns/README @@ -0,0 +1,43 @@ +DJBDNS DOMAIN NAME SERVER CONFIGURATION + + +This module interfaces with djbdns (http://cr.yp.to/djbdns.html). + +A .dns file in a domain's directory controls its DNS settings. Such +files consist of a sequence of lines of the following types: + + * Primary host ip: Sets the primary DNS server for the domain to IP +address ip, naming it host.domain + * Secondary host ip: Adds a secondary DNS server for the domain with +IP address ip, naming it host.domain + * Mail host ip: Add a server to process e-mail for the domain with IP +address ip, naming it host.domain. Mail servers will attempt to +deliver mail to the servers you list following the order in which you +list them, starting from the first. + * Default ip: Sets the IP address for domain to ip + * Host host ip: Sets the IP address for host.domain to ip + * Alias host ip: Sets the IP address for host.domain to ip; use this +when this IP address has already been assigned a name in this domain +with Default or Host + * Redir host1 host2: Sets host1.domain to have the same IP address as +host2. This should almost never be used, as it requires every client +resolution of this hostname to follow the chain of redirections, +possibly across different servers. You should usually define a +variable for a commonly used host IP address and use it with Host and +Alias directives. + + +All domains' mappings will be combined into a single file called +data.shared in the domtool scratch directory. To publish, this file +will be copied to the location specified in config.sml. Running make +in the the djbns data root is a good thing to do in pubCommand to get +changes propagated. + +This module tries to copy a default .dns file into new domain +directories when mkdom is used. Be sure to set defaultFile to an +appropriate filename if this is to work. + +When the module sees that a domain has an MX mapping, it can notify +another module that mail for this domain should be accepted locally. A +module that wants to receive this notification should call +Djbdns.setLocalDomainHandler. \ No newline at end of file diff --git a/src/djbdns/config.sample.sml b/src/djbdns/config.sample.sml new file mode 100644 index 0000000..98bbb8f --- /dev/null +++ b/src/djbdns/config.sample.sml @@ -0,0 +1,32 @@ +(* +Domtool (http://hcoop.sf.net/) +Copyright (C) 2004 Adam Chlipala + +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 2 +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, write to the Free Software +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +*) + +(* Some options you might want to change *) + +structure DjbdnsConfig = +struct + val dataFile = "/service/tinydns/root/data" + (* Place to publish djbdns format data *) + + val pubCommand = "cd /service/tinydns/root ; /usr/bin/make" + (* Command to run to publish djbdns data *) + + val defaultFile = "/etc/default.dns" + (* Default .dns file to install for new domains *) +end diff --git a/src/djbdns/djbdns.sig b/src/djbdns/djbdns.sig new file mode 100644 index 0000000..86cd5e0 --- /dev/null +++ b/src/djbdns/djbdns.sig @@ -0,0 +1,25 @@ +(* +Domtool (http://hcoop.sf.net/) +Copyright (C) 2004 Adam Chlipala + +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 2 +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, write to the Free Software +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +*) + +signature DJBDNS = +sig + val setLocalDomainHandler : (string -> unit) -> unit + (* Function to call when a domain is discovered to make an MX delegation to + * this machine. *) +end \ No newline at end of file diff --git a/src/djbdns/djbdns.sml b/src/djbdns/djbdns.sml new file mode 100644 index 0000000..24aedd4 --- /dev/null +++ b/src/djbdns/djbdns.sml @@ -0,0 +1,145 @@ +(* +Domtool (http://hcoop.sf.net/) +Copyright (C) 2004 Adam Chlipala + +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 2 +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, write to the Free Software +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +*) + +(* Djbdns DNS mapping config *) + +structure Djbdns :> DJBDNS = +struct + open Config DjbdnsConfig Util + + val ldHandler = ref (fn _ : string => ()) + fun setLocalDomainHandler f = ldHandler := f + + val dns = ref (NONE : TextIO.outstream option) + + fun init () = dns := SOME (TextIO.openOut (scratchDir ^ "/data.shared")) + fun finish () = (TextIO.closeOut (valOf (!dns)); + dns := NONE) + + fun handler {path, domain, parent, vars, paths, users, groups} = + let + val _ = Domtool.dprint ("Reading dns " ^ path ^ " for " ^ parent ^ "....") + + val dns = valOf (!dns) + + val al = TextIO.openIn path + + val hasEmail = ref false + + fun loop (line, mxnum) = + let + fun err () = (Domtool.error (path, "Invalid entry: " ^ trimLast line); + mxnum) + in + case String.tokens Char.isSpace line of + [] => mxnum + | ["Default", addr] => + (case resolveAddr (vars, addr) of + "" => err () + | addr => (TextIO.output (dns, "=" ^ parent ^ ":" ^ addr ^ "\n"); + mxnum)) + | [ty, host, addr] => + let + val pre = + (case ty of + "Primary" => "." + | "Secondary" => "&" + | "Host" => "=" + | "Alias" => "+" + | "Mail" => "@" + | "Redir" => "C" + | _ => "") + in + if pre = "C" then + (case resolveDomain (vars, addr) of + "" => err () + | host' => + if validHost host then + (TextIO.output (dns, pre ^ host ^ "." ^ parent ^ ":" ^ addr ^ "\n"); + mxnum) + else + err ()) + else case (resolveAddr (vars, addr), pre) of + ("", _) => err () + | (addr, ".") => + if validHost host then + (TextIO.output (dns, pre ^ parent ^ ":" ^ addr ^ ":" ^ host ^ "." ^ parent ^ "\n"); + mxnum) + else + err () + | (addr, "&") => + if validHost host then + (TextIO.output (dns, pre ^ parent ^ ":" ^ addr ^ ":" ^ host ^ "." ^ parent ^ "\n"); + mxnum) + else + err () + | (addr, "@") => + (if not (!hasEmail) then + (hasEmail := true; + !ldHandler parent) + else + (); + if validHost host then + (TextIO.output (dns, pre ^ parent ^ ":" ^ addr ^ ":" ^ host ^ "." ^ parent ^ ":" ^ Int.toString mxnum ^ "\n"); + mxnum+1) + else + err ()) + | (addr, "=") => + if validHost host then + (TextIO.output (dns, pre ^ host ^ "." ^ parent ^ ":" ^ addr ^ "\n"); + mxnum) + else + err () + | (addr, "+") => + if validHost host then + (TextIO.output (dns, pre ^ host ^ "." ^ parent ^ ":" ^ addr ^ "\n"); + mxnum) + else + err () + | _ => err () + end + | _ => err () + end + in + ioLoop (fn () => Domtool.inputLine al) loop 0; + TextIO.closeIn al + end handle Io => Domtool.error (path, "IO error") + + fun publish () = + if OS.Process.isSuccess (OS.Process.system + (diff ^ " " ^ scratchDir ^ "/data.shared " ^ dataFile)) then + OS.Process.success + else if not (OS.Process.isSuccess (OS.Process.system + (cp ^ " " ^ scratchDir ^ "/data.shared " ^ dataFile))) then + (print "Error copying data.shared\n"; + OS.Process.failure) + else if OS.Process.isSuccess (OS.Process.system pubCommand) then + OS.Process.success + else + (print "Error publishing data.shared\n"; + OS.Process.failure) + + fun mkdom {path, ...} = OS.Process.system (cp ^ " " ^ defaultFile ^ " " ^ path ^ "/.dns") + + val _ = Domtool.setHandler (".dns", {init = init, + file = handler, + finish = finish, + publish = publish, + mkdom = mkdom}) +end diff --git a/src/djbdns/sources.cm b/src/djbdns/sources.cm new file mode 100644 index 0000000..be324ab --- /dev/null +++ b/src/djbdns/sources.cm @@ -0,0 +1,4 @@ +Group is + config.sml + djbdns.sig + djbdns.sml \ No newline at end of file diff --git a/src/domtool.cm b/src/domtool.cm new file mode 100644 index 0000000..af81e43 --- /dev/null +++ b/src/domtool.cm @@ -0,0 +1,40 @@ +Group is + (*$/basis.cm*) + + (*smlnj-lib/lib-base-sig.sml + smlnj-lib/lib-base.sml + smlnj-lib/ord-key-sig.sml + smlnj-lib/ord-map-sig.sml + smlnj-lib/binary-map-fn.sml + smlnj-lib/ord-set-sig.sml + smlnj-lib/binary-set-fn.sml*) + smlnj-lib/sources.cm + + config.sml + + map.sml + + util.sig + util.sml + + domtool.sig + domtool.sml + +(* Modules *) + + (*apache/config.sml + apache/apache.sig + apache/apache.sml*) + apache/sources.cm + + (*djbdns/config.sml + djbdns/djbdns.sig + djbdns/djbdns.sml*) + djbdns/sources.cm + + exim/sources.cm + + + postconfig.sml + + main.sml \ No newline at end of file diff --git a/src/domtool.sig b/src/domtool.sig new file mode 100644 index 0000000..ed683b4 --- /dev/null +++ b/src/domtool.sig @@ -0,0 +1,64 @@ +(* +Domtool (http://hcoop.sf.net/) +Copyright (C) 2004 Adam Chlipala + +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 2 +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, write to the Free Software +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +*) + +(* Main domtool structure *) + +signature DOMTOOL = +sig + val dprint : string -> unit + (* If Config.debug, then it prints the argument followed by a newline. *) + val inputLine : TextIO.instream -> string option + (* Like TextIO.inputLine, but skips past lines commented out with #'s. *) + + type map = string StringMap.map + type set = StringSet.set + + + val error : string * string -> unit + (* (error (path, msg)) signals an error about path with description msg. *) + + (* Handlers for configuration files *) + type handlerData = {path : string, (* Path to the config file *) + domain : string, (* Domain in which it lives *) + parent : string, (* Parent of that domain *) + vars : map, (* Current variable values *) + paths : set, (* Authorized filesystem paths *) + users : set, (* Authorized UNIX users *) + groups : set} (* Authorized UNIX groups *) + type mkdomData = {path : string, + domain : string} + type handler = {init : unit -> unit, + file : handlerData -> unit, + finish : unit -> unit, + publish : unit -> OS.Process.status, + mkdom : mkdomData -> OS.Process.status} + + val setVhostHandler : handler -> unit + (* Set the handler for virtual host configuration files *) + val setHandler : string * handler -> unit + (* Set the handler to be used for files with a specific name *) + + + val read : unit -> OS.Process.status + (* Command line domtool entry point *) + val publish : unit -> OS.Process.status + (* Propagate changes to real daemons *) + val mkDom : string * string -> OS.Process.status + (* (mkDom (dom, user)) creates a new domain record *) +end diff --git a/src/domtool.sml b/src/domtool.sml new file mode 100644 index 0000000..15ffd8a --- /dev/null +++ b/src/domtool.sml @@ -0,0 +1,324 @@ +(* +Domtool (http://hcoop.sf.net/) +Copyright (C) 2004 Adam Chlipala + +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 2 +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, write to the Free Software +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +*) + +(* Main domtool structure *) + +structure Domtool = +struct + open Config Util + + val uid = Posix.ProcEnv.wordToUid (SysWord.fromInt uid) + + val dprint = if debug then (fn x => print (x ^ "\n")) else (fn _ => ()) + + fun openIn fname = + ((*dprint ("Open " ^ fname ^ "....");*) + TextIO.openIn fname) + + fun opendir fname = + ((*dprint ("Open dir " ^ fname ^ "....");*) + Posix.FileSys.opendir fname) + + fun inputLine fl = + let + val s = TextIO.inputLine fl + in + if size s = 0 orelse String.sub (s, 0) <> #"#" then + s + else + inputLine fl + end + + fun hd' ([], x) = x + | hd' (h::_, _) = h + + fun domPrep (a, b) = + (case b of + "" => a + | _ => a ^ "." ^ b) + + + type map = string StringMap.map + type set = StringSet.set + + type handlerData = {path : string, + domain : string, + parent : string, + vars : map, + paths : set, + users : set, + groups : set} + type mkdomData = {path : string, + domain : string} + type handler = {init : unit -> unit, + file : handlerData -> unit, + finish : unit -> unit, + publish : unit -> OS.Process.status, + mkdom : mkdomData -> OS.Process.status} + + val nullHandler = {init = fn () => (), + file = fn (_ : handlerData) => (), + finish = fn () => (), + publish = fn () => OS.Process.success, + mkdom = fn (_ : mkdomData) => OS.Process.success} + + val vhostHandler = ref nullHandler + fun setVhostHandler f = vhostHandler := f + + val handlers = ref (StringMap.empty : handler StringMap.map) + fun setHandler (fname, handler) = handlers := StringMap.insert (!handlers, fname, handler) + + fun error (path, msg) = print (path ^ ": " ^ msg ^ "\n") + + fun read () = + let + val vhostHandler = !vhostHandler + + val _ = Posix.FileSys.mkdir (lockFile, Posix.FileSys.S.irwxu) + + fun readDir (path, prefix, vars, paths, users, groups) = + let + val _ = dprint ("readDir: " ^ path) + val dir = opendir path + + val vars = + if Posix.FileSys.access (path ^ "/.vars", []) then + let + val vf = openIn (path ^ "/.vars") + + fun loop vars = + let + val line = inputLine vf + in + case line of + "" => vars + | _ => + (case String.tokens Char.isSpace line of + [n, v] => + if validHost n then + loop (StringMap.insert (vars, n, v)) + else + (error (path ^ "/.vars", "Invalid variable declaration: " ^ + String.substring (line, 0, size line - 1)); + loop vars) + | _ => loop vars) + end + in + loop vars + before TextIO.closeIn vf + end + else + vars + + val pp = path ^ "/.paths" + val paths = + if Posix.FileSys.access (pp, []) then + (if Posix.FileSys.ST.uid (Posix.FileSys.stat pp) = uid then + let + val vf = openIn pp + + fun loop paths = + let + val line = inputLine vf + in + case line of + "" => paths + | _ => + (case String.tokens Char.isSpace line of + [path] => loop (StringSet.add (paths, path)) + | _ => loop paths) + end + in + loop paths + before TextIO.closeIn vf + end + else + (error (pp, "wrong owner to be used"); + paths)) + else + paths + + val up = path ^ "/.users" + val users = + if Posix.FileSys.access (up, []) then + (if Posix.FileSys.ST.uid (Posix.FileSys.stat up) = uid then + let + val vf = openIn up + + fun loop users = + let + val line = inputLine vf + in + case line of + "" => users + | _ => + (case String.tokens Char.isSpace line of + [user] => loop (StringSet.add (users, user)) + | _ => loop users) + end + in + loop users + before TextIO.closeIn vf + end + else + (error (up, ": wrong owner to be used."); + users)) + else + users + + val gp = path ^ "/.groups" + val groups = + if Posix.FileSys.access (gp, []) then + (if Posix.FileSys.ST.uid (Posix.FileSys.stat gp) = uid then + let + val vf = openIn gp + + fun loop groups = + let + val line = inputLine vf + in + case line of + "" => groups + | _ => + (case String.tokens Char.isSpace line of + [group] => loop (StringSet.add (groups, group)) + | _ => loop groups) + end + in + loop groups + before TextIO.closeIn vf + end + else + (error (gp, "wrong owner to be used."); + groups)) + else + groups + + fun loop (name, ()) = + let + val path' = path ^ "/" ^ name + val prefix' = domPrep (name, prefix) + in + if not (Posix.FileSys.access (path', [])) then + () + else if Posix.FileSys.ST.isDir (Posix.FileSys.stat path') then + readDir (path', prefix', vars, paths, users, groups) + else if isTmp name then + () + else case StringMap.find (!handlers, name) of + NONE => if validHost name andalso path' <> defaultWebPath then + #file vhostHandler {path = path', + domain = prefix', + parent = prefix, + vars = vars, + paths = paths, + users = users, + groups = groups} + else + () + | SOME {file, ...} => file {path = path', + domain = prefix', + parent = prefix, + vars = vars, + paths = paths, + users = users, + groups = groups} + end + in + ioOptLoop (fn () => Posix.FileSys.readdir dir) loop (); + Posix.FileSys.closedir dir + end handle Io => error (path, "IO error") + in + #init vhostHandler (); + StringMap.app (fn {init, ...} => init ()) (!handlers); + readDir (dataDir, "", StringMap.empty, + StringSet.empty, StringSet.empty, StringSet.empty); + StringMap.app (fn {finish, ...} => finish ()) (!handlers); + #finish vhostHandler (); + Posix.FileSys.rmdir lockFile; + print "Processing complete.\n"; + OS.Process.system dompub + end handle Io => (print "IO error. Is domtool already running?\n"; + OS.Process.failure) + + fun combineStatus (a, b) = + if OS.Process.isSuccess a andalso OS.Process.isSuccess b then + OS.Process.success + else + OS.Process.failure + + fun publish () = + StringMap.foldl (fn ({publish, ...}, status) => + combineStatus (status, publish ())) + (#publish (!vhostHandler) ()) + (!handlers) + + fun mkdir dir = + let + fun mkd (tokens, acc) = + case tokens of + [] => true + | (dir::rest) => + let + val dir = acc ^ "/" ^ dir + in + if not (Posix.FileSys.access (dir, [])) + andalso OS.Process.system ("mkdir " ^ dir) = OS.Process.failure then + (print ("Can't created directory " ^ dir ^ "\n"); + false) + else + mkd (rest, dir) + end + in + mkd (String.tokens (fn ch => ch = #"/") dir, dataDir) + end + + fun mkdom (dom, user) = + if not (validDomain dom) then + (print "Invalid domain\n"; + OS.Process.failure) + else if not (validUser user) then + (print "Invalid user\n"; + OS.Process.failure) + else + let + val dir' = toDir dom + val dir = dataDir ^ dir' + in + if not (mkdir dir') + orelse OS.Process.system ("echo " ^ user ^ " >" ^ dir ^ "/.users") = OS.Process.failure + orelse OS.Process.system ("echo " ^ user ^ " >" ^ dir ^ "/.groups") = OS.Process.failure + orelse OS.Process.system ("echo /home/" ^ user ^ " >" ^ dir ^ "/.paths") = OS.Process.failure + orelse OS.Process.system ("chown -R " ^ user ^ "." ^ user ^ " " ^ dir) = OS.Process.failure + orelse OS.Process.system ("chmod -R g+w " ^ dir) = OS.Process.failure + orelse OS.Process.system ("chown domains.adm " ^ dir ^ "/.users " ^ dir ^ "/.groups " ^ dir ^ "/.paths") = OS.Process.failure then + (print "Setup failed\n"; + OS.Process.failure) + else if not (OS.Process.isSuccess + (StringMap.foldl (fn ({mkdom, ...}, status) => + combineStatus (status, mkdom {path = dir, domain = dom})) + (#mkdom (!vhostHandler) {path = dir, domain = dom}) + (!handlers))) then + (print "Setup failed\n"; + OS.Process.failure) + else + (print "Domain created\n"; + OS.Process.success) + end +end diff --git a/src/exim/.cvsignore b/src/exim/.cvsignore new file mode 100644 index 0000000..a705707 --- /dev/null +++ b/src/exim/.cvsignore @@ -0,0 +1,2 @@ +CM +config.sml \ No newline at end of file diff --git a/src/exim/README b/src/exim/README new file mode 100644 index 0000000..c6b47e3 --- /dev/null +++ b/src/exim/README @@ -0,0 +1,41 @@ +EXIM ALIAS AND LOCAL DOMAIN CONFIGURATION + + +This module implements handling of e-mail aliases and configuring +domains for which e-mail should be accepted locally for the exim MTA +(http://www.exim.org). + +A .aliases file in a domain's directory controls its e-mail +aliases. A target below may one of three things: + + * a local username, to deliver mail to that user + * an e-mail address, to forward mail to it + * !, to delete mail to this address + +The file then consists of a sequence of lines of the following types. + + * user target: Send all mail to user@domain to target + * * target: Send all mail to domain not matching any other rule +to target. However, if mail is sent to an existing UNIX username on +Abulafia, the message will go to that account + * ** target: Send all mail that does not match another rule to +domain to target, even mail addressed to real UNIX usernames + +These policies are implemented by writing to two different alias files +which are meant to be processed in different passes. The first one +(probably /etc/aliases) should be check before exim checks an e-mail +recipient against local useranmes or other special targets. After +this, local usernames should be checked. Finally, the second alias +file (such as /etc/aliases.default) should be checked, to implement +"catch-all" addresses that handle all mail not matching other rules. + + +The module also handles receiving notifications of which domains +delegate mail handling to this host and incorporating this information +into exim configuration files. A file local_domains is maintained in +the domtool scratchDir, along with the last version of it in +local_domains.last, to detect when changes have been made. The module +will attempt to generate exim.conf by concatenatning local_domains and +a file exim.base. The paths for these files are configurable in +config.sml, as is the command used to tell exim to reload exim.conf +afterwards. \ No newline at end of file diff --git a/src/exim/config.sample.sml b/src/exim/config.sample.sml new file mode 100644 index 0000000..2d2d883 --- /dev/null +++ b/src/exim/config.sample.sml @@ -0,0 +1,38 @@ +(* +Domtool (http://hcoop.sf.net/) +Copyright (C) 2004 Adam Chlipala + +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 2 +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, write to the Free Software +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +*) + +(* Some options you might want to change *) + +structure EximConfig = +struct + val aliasesFile = "/etc/aliases" + (* File for first pass of e-mail aliases *) + + val aliasesDefaultFile = "/etc/aliases.default" + (* File for second pass of e-mail aliases *) + + val eximBase = "/etc/exim/exim.base" + (* Base exim configuration *) + + val eximFile = "/etc/exim/exim.conf" + (* Exim config file *) + + val pubCommand = "/etc/init.d/exim reload" + (* Command to publish data *) +end diff --git a/src/exim/exim.sig b/src/exim/exim.sig new file mode 100644 index 0000000..79d5003 --- /dev/null +++ b/src/exim/exim.sig @@ -0,0 +1,24 @@ +(* +Domtool (http://hcoop.sf.net/) +Copyright (C) 2004 Adam Chlipala + +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 2 +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, write to the Free Software +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +*) + +signature EXIM = +sig + val localDomain : string -> unit + (* Registers that a domain's mail should be accepted locally *) +end diff --git a/src/exim/exim.sml b/src/exim/exim.sml new file mode 100644 index 0000000..27d51e4 --- /dev/null +++ b/src/exim/exim.sml @@ -0,0 +1,136 @@ +(* +Domtool (http://hcoop.sf.net/) +Copyright (C) 2004 Adam Chlipala + +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 2 +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, write to the Free Software +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +*) + +(* Exim e-mail alias and local domain configuration *) + +structure Exim :> EXIM = +struct + open Config EximConfig Util + + val aliases = ref (NONE : TextIO.outstream option) + val aliasesDefault = ref (NONE : TextIO.outstream option) + val local_domains = ref (NONE : TextIO.outstream option) + + fun init () = (aliases := SOME (TextIO.openOut (scratchDir ^ "/aliases")); + aliasesDefault := SOME (TextIO.openOut (scratchDir ^ "/aliases.default")); + local_domains := SOME (TextIO.openOut (scratchDir ^ "/local_domains")); + TextIO.output (valOf (!local_domains), "local_domains = localhost")) + fun finish () = (TextIO.output (valOf (!local_domains), "\n\n"); + TextIO.closeOut (valOf (!aliases)); + aliases := NONE; + TextIO.closeOut (valOf (!aliasesDefault)); + aliasesDefault := NONE; + TextIO.closeOut (valOf (!local_domains)); + local_domains := NONE) + + fun handler {path, domain, parent, vars, paths, users, groups} = + let + val _ = Domtool.dprint ("Reading aliases " ^ path ^ " for " ^ domain ^ "....") + + val aliases = valOf (!aliases) + val aliasesDefault = valOf (!aliasesDefault) + + val domain = "@" ^ parent + val al = TextIO.openIn path + + fun loop (line, ()) = + let + fun err () = Domtool.error (path, "invalid entry: " ^ line) + in + case String.tokens Char.isSpace line of + [] => () + | ["*", target] => + if validUser target then + TextIO.output (aliasesDefault, "*" ^ domain ^ ":\t" ^ target ^ "@localhost\n") + else if validEmail target then + TextIO.output (aliasesDefault, "*" ^ domain ^ ":\t" ^ target ^ "\n") + else + err () + | ["**", target] => + if validUser target then + TextIO.output (aliases, "*" ^ domain ^ ":\t" ^ target ^ "@localhost\n") + else if validEmail target then + TextIO.output (aliases, "*" ^ domain ^ ":\t" ^ target ^ "\n") + else + err () + | [user, target] => + if validUser user then + (if target = "!" then + TextIO.output (aliases, user ^ domain ^ ":\t/dev/null\n") + else if validUser target then + TextIO.output (aliases, user ^ domain ^ ":\t" ^ target ^ "@localhost\n") + else if validEmail target then + TextIO.output (aliases, user ^ domain ^ ":\t" ^ target ^ "\n") + else + err ()) + else + err () + | _ => err () + end + in + ioLoop (fn () => Domtool.inputLine al) loop (); + TextIO.closeIn al + end handle Io => Domtool.error (path, "IO error") + + fun publish () = + if OS.Process.isSuccess (OS.Process.system + (diff ^ " " ^ scratchDir ^ "/aliases " ^ aliasesFile)) + andalso OS.Process.isSuccess (OS.Process.system + (diff ^ " " ^ scratchDir ^ "/aliases.default " ^ aliasesDefaultFile)) + andalso OS.Process.isSuccess (OS.Process.system + (diff ^ " " ^ scratchDir ^ "/local_domains " ^ + scratchDir ^ "/local_domains.last")) + then + OS.Process.success + else if not (OS.Process.isSuccess (OS.Process.system + (cp ^ " " ^ scratchDir ^ "/aliases " ^ aliasesFile))) then + (print "Error copying aliases\n"; + OS.Process.failure) + else if not (OS.Process.isSuccess (OS.Process.system + (cp ^ " " ^ scratchDir ^ "/aliases.default " ^ aliasesDefaultFile))) then + (print "Error copying aliases.default\n"; + OS.Process.failure) + else if not (OS.Process.isSuccess (OS.Process.system + (cp ^ " " ^ scratchDir ^ "/local_domains " ^ + scratchDir ^ "/local_domains.last"))) then + (print "Error copying local_domains\n"; + OS.Process.failure) + else if not (OS.Process.isSuccess (OS.Process.system + (cat ^ " " ^ scratchDir ^ "/local_domains " ^ eximBase ^ + " >" ^ eximFile))) then + (print "Error creating exim.conf\n"; + OS.Process.failure) + else if OS.Process.isSuccess (OS.Process.system pubCommand) then + OS.Process.success + else + (print "Error publishing exim data\n"; + OS.Process.failure) + + fun mkdom _ = OS.Process.success + + val _ = Domtool.setHandler (".aliases", {init = init, + file = handler, + finish = finish, + publish = publish, + mkdom = mkdom}) + + fun localDomain domain = TextIO.output (valOf (!local_domains), ":" ^ domain) +end + + diff --git a/src/exim/sources.cm b/src/exim/sources.cm new file mode 100644 index 0000000..7873449 --- /dev/null +++ b/src/exim/sources.cm @@ -0,0 +1,4 @@ +Group is + config.sml + exim.sig + exim.sml \ No newline at end of file diff --git a/src/main.sml b/src/main.sml new file mode 100644 index 0000000..b4211bd --- /dev/null +++ b/src/main.sml @@ -0,0 +1,25 @@ +(* +Domtool (http://hcoop.sf.net/) +Copyright (C) 2004 Adam Chlipala + +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 2 +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, write to the Free Software +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +*) + +val _ = OS.Process.exit (case CommandLine.arguments () of + [] => Domtool.read () + | ["publish"] => Domtool.publish () + | ["mkdom", dom, user] => Domtool.mkdom (dom, user) + | _ => (print "Invalid arguments\n"; + OS.Process.failure)) \ No newline at end of file diff --git a/src/map.sml b/src/map.sml new file mode 100644 index 0000000..dc85b8e --- /dev/null +++ b/src/map.sml @@ -0,0 +1,28 @@ +(* +Domtool (http://hcoop.sf.net/) +Copyright (C) 2004 Adam Chlipala + +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 2 +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, write to the Free Software +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +*) + +structure StringKey = +struct + type ord_key = string + val compare = String.compare +end + +structure StringMap = BinaryMapFn (StringKey) +structure StringSet = BinarySetFn (StringKey) + diff --git a/src/postconfig.sml b/src/postconfig.sml new file mode 100644 index 0000000..86965c4 --- /dev/null +++ b/src/postconfig.sml @@ -0,0 +1,25 @@ +(* +Domtool (http://hcoop.sf.net/) +Copyright (C) 2004 Adam Chlipala + +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 2 +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, write to the Free Software +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +*) + +(* Set some things up after all the modules are already loaded *) + +structure PostConfig = +struct + val _ = Djbdns.setLocalDomainHandler Exim.localDomain +end \ No newline at end of file diff --git a/src/smlnj-lib/.cvsignore b/src/smlnj-lib/.cvsignore new file mode 100644 index 0000000..be80172 --- /dev/null +++ b/src/smlnj-lib/.cvsignore @@ -0,0 +1 @@ +CM \ No newline at end of file diff --git a/src/smlnj-lib/binary-map-fn.sml b/src/smlnj-lib/binary-map-fn.sml new file mode 100644 index 0000000..a74d072 --- /dev/null +++ b/src/smlnj-lib/binary-map-fn.sml @@ -0,0 +1,435 @@ +(* binary-map-fn.sml + * + * COPYRIGHT (c) 1993 by AT&T Bell Laboratories. See COPYRIGHT file for details. + * + * This code was adapted from Stephen Adams' binary tree implementation + * of applicative integer sets. + * + * Copyright 1992 Stephen Adams. + * + * This software may be used freely provided that: + * 1. This copyright notice is attached to any copy, derived work, + * or work including all or part of this software. + * 2. Any derived work must contain a prominent notice stating that + * it has been altered from the original. + * + * + * Name(s): Stephen Adams. + * Department, Institution: Electronics & Computer Science, + * University of Southampton + * Address: Electronics & Computer Science + * University of Southampton + * Southampton SO9 5NH + * Great Britian + * E-mail: sra@ecs.soton.ac.uk + * + * Comments: + * + * 1. The implementation is based on Binary search trees of Bounded + * Balance, similar to Nievergelt & Reingold, SIAM J. Computing + * 2(1), March 1973. The main advantage of these trees is that + * they keep the size of the tree in the node, giving a constant + * time size operation. + * + * 2. The bounded balance criterion is simpler than N&R's alpha. + * Simply, one subtree must not have more than `weight' times as + * many elements as the opposite subtree. Rebalancing is + * guaranteed to reinstate the criterion for weight>2.23, but + * the occasional incorrect behaviour for weight=2 is not + * detrimental to performance. + * + *) + +functor BinaryMapFn (K : ORD_KEY) : ORD_MAP = + struct + + structure Key = K + + (* + ** val weight = 3 + ** fun wt i = weight * i + *) + fun wt (i : int) = i + i + i + + datatype 'a map + = E + | T of { + key : K.ord_key, + value : 'a, + cnt : int, + left : 'a map, + right : 'a map + } + + val empty = E + + fun isEmpty E = true + | isEmpty _ = false + + fun numItems E = 0 + | numItems (T{cnt,...}) = cnt + + (* return the first item in the map (or NONE if it is empty) *) + fun first E = NONE + | first (T{value, left=E, ...}) = SOME value + | first (T{left, ...}) = first left + + (* return the first item in the map and its key (or NONE if it is empty) *) + fun firsti E = NONE + | firsti (T{key, value, left=E, ...}) = SOME(key, value) + | firsti (T{left, ...}) = firsti left + +local + fun N(k,v,E,E) = T{key=k,value=v,cnt=1,left=E,right=E} + | N(k,v,E,r as T n) = T{key=k,value=v,cnt=1+(#cnt n),left=E,right=r} + | N(k,v,l as T n,E) = T{key=k,value=v,cnt=1+(#cnt n),left=l,right=E} + | N(k,v,l as T n,r as T n') = + T{key=k,value=v,cnt=1+(#cnt n)+(#cnt n'),left=l,right=r} + + fun single_L (a,av,x,T{key=b,value=bv,left=y,right=z,...}) = + N(b,bv,N(a,av,x,y),z) + | single_L _ = raise Match + fun single_R (b,bv,T{key=a,value=av,left=x,right=y,...},z) = + N(a,av,x,N(b,bv,y,z)) + | single_R _ = raise Match + fun double_L (a,av,w,T{key=c,value=cv,left=T{key=b,value=bv,left=x,right=y,...},right=z,...}) = + N(b,bv,N(a,av,w,x),N(c,cv,y,z)) + | double_L _ = raise Match + fun double_R (c,cv,T{key=a,value=av,left=w,right=T{key=b,value=bv,left=x,right=y,...},...},z) = + N(b,bv,N(a,av,w,x),N(c,cv,y,z)) + | double_R _ = raise Match + + fun T' (k,v,E,E) = T{key=k,value=v,cnt=1,left=E,right=E} + | T' (k,v,E,r as T{right=E,left=E,...}) = + T{key=k,value=v,cnt=2,left=E,right=r} + | T' (k,v,l as T{right=E,left=E,...},E) = + T{key=k,value=v,cnt=2,left=l,right=E} + + | T' (p as (_,_,E,T{left=T _,right=E,...})) = double_L p + | T' (p as (_,_,T{left=E,right=T _,...},E)) = double_R p + + (* these cases almost never happen with small weight*) + | T' (p as (_,_,E,T{left=T{cnt=ln,...},right=T{cnt=rn,...},...})) = + if ln < rn then single_L p else double_L p + | T' (p as (_,_,T{left=T{cnt=ln,...},right=T{cnt=rn,...},...},E)) = + if ln > rn then single_R p else double_R p + + | T' (p as (_,_,E,T{left=E,...})) = single_L p + | T' (p as (_,_,T{right=E,...},E)) = single_R p + + | T' (p as (k,v,l as T{cnt=ln,left=ll,right=lr,...}, + r as T{cnt=rn,left=rl,right=rr,...})) = + if rn >= wt ln then (*right is too big*) + let val rln = numItems rl + val rrn = numItems rr + in + if rln < rrn then single_L p else double_L p + end + + else if ln >= wt rn then (*left is too big*) + let val lln = numItems ll + val lrn = numItems lr + in + if lrn < lln then single_R p else double_R p + end + + else T{key=k,value=v,cnt=ln+rn+1,left=l,right=r} + + local + fun min (T{left=E,key,value,...}) = (key,value) + | min (T{left,...}) = min left + | min _ = raise Match + + fun delmin (T{left=E,right,...}) = right + | delmin (T{key,value,left,right,...}) = T'(key,value,delmin left,right) + | delmin _ = raise Match + in + fun delete' (E,r) = r + | delete' (l,E) = l + | delete' (l,r) = let val (mink,minv) = min r in + T'(mink,minv,l,delmin r) + end + end +in + fun mkDict () = E + + fun singleton (x,v) = T{key=x,value=v,cnt=1,left=E,right=E} + + fun insert (E,x,v) = T{key=x,value=v,cnt=1,left=E,right=E} + | insert (T(set as {key,left,right,value,...}),x,v) = + case K.compare (key,x) of + GREATER => T'(key,value,insert(left,x,v),right) + | LESS => T'(key,value,left,insert(right,x,v)) + | _ => T{key=x,value=v,left=left,right=right,cnt= #cnt set} + fun insert' ((k, x), m) = insert(m, k, x) + + fun inDomain (set, x) = let + fun mem E = false + | mem (T(n as {key,left,right,...})) = (case K.compare (x,key) + of GREATER => mem right + | EQUAL => true + | LESS => mem left + (* end case *)) + in + mem set + end + + fun find (set, x) = let + fun mem E = NONE + | mem (T(n as {key,left,right,...})) = (case K.compare (x,key) + of GREATER => mem right + | EQUAL => SOME(#value n) + | LESS => mem left + (* end case *)) + in + mem set + end + + fun remove (E,x) = raise LibBase.NotFound + | remove (set as T{key,left,right,value,...},x) = ( + case K.compare (key,x) + of GREATER => let + val (left', v) = remove(left, x) + in + (T'(key, value, left', right), v) + end + | LESS => let + val (right', v) = remove (right, x) + in + (T'(key, value, left, right'), v) + end + | _ => (delete'(left,right),value) + (* end case *)) + + fun listItems d = let + fun d2l (E, l) = l + | d2l (T{key,value,left,right,...}, l) = + d2l(left, value::(d2l(right,l))) + in + d2l (d,[]) + end + + fun listItemsi d = let + fun d2l (E, l) = l + | d2l (T{key,value,left,right,...}, l) = + d2l(left, (key,value)::(d2l(right,l))) + in + d2l (d,[]) + end + + fun listKeys d = let + fun d2l (E, l) = l + | d2l (T{key,left,right,...}, l) = d2l(left, key::(d2l(right,l))) + in + d2l (d,[]) + end + + local + fun next ((t as T{right, ...})::rest) = (t, left(right, rest)) + | next _ = (E, []) + and left (E, rest) = rest + | left (t as T{left=l, ...}, rest) = left(l, t::rest) + in + fun collate cmpRng (s1, s2) = let + fun cmp (t1, t2) = (case (next t1, next t2) + of ((E, _), (E, _)) => EQUAL + | ((E, _), _) => LESS + | (_, (E, _)) => GREATER + | ((T{key=x1, value=y1, ...}, r1), (T{key=x2, value=y2, ...}, r2)) => ( + case Key.compare(x1, x2) + of EQUAL => (case cmpRng(y1, y2) + of EQUAL => cmp (r1, r2) + | order => order + (* end case *)) + | order => order + (* end case *)) + (* end case *)) + in + cmp (left(s1, []), left(s2, [])) + end + end (* local *) + + fun appi f d = let + fun app' E = () + | app' (T{key,value,left,right,...}) = ( + app' left; f(key, value); app' right) + in + app' d + end + fun app f d = let + fun app' E = () + | app' (T{value,left,right,...}) = ( + app' left; f value; app' right) + in + app' d + end + + fun mapi f d = let + fun map' E = E + | map' (T{key,value,left,right,cnt}) = let + val left' = map' left + val value' = f(key, value) + val right' = map' right + in + T{cnt=cnt, key=key, value=value', left = left', right = right'} + end + in + map' d + end + fun map f d = mapi (fn (_, x) => f x) d + + fun foldli f init d = let + fun fold (E, v) = v + | fold (T{key,value,left,right,...}, v) = + fold (right, f(key, value, fold(left, v))) + in + fold (d, init) + end + fun foldl f init d = foldli (fn (_, v, accum) => f (v, accum)) init d + + fun foldri f init d = let + fun fold (E,v) = v + | fold (T{key,value,left,right,...},v) = + fold (left, f(key, value, fold(right, v))) + in + fold (d, init) + end + fun foldr f init d = foldri (fn (_, v, accum) => f (v, accum)) init d + +(** To be implemented ** + val filter : ('a -> bool) -> 'a map -> 'a map + val filteri : (Key.ord_key * 'a -> bool) -> 'a map -> 'a map +**) + + end (* local *) + +(* the following are generic implementations of the unionWith, intersectWith, + * and mergeWith operetions. These should be specialized for the internal + * representations at some point. + *) + fun unionWith f (m1, m2) = let + fun ins f (key, x, m) = (case find(m, key) + of NONE => insert(m, key, x) + | (SOME x') => insert(m, key, f(x, x')) + (* end case *)) + in + if (numItems m1 > numItems m2) + then foldli (ins (fn (a, b) => f (b, a))) m1 m2 + else foldli (ins f) m2 m1 + end + fun unionWithi f (m1, m2) = let + fun ins f (key, x, m) = (case find(m, key) + of NONE => insert(m, key, x) + | (SOME x') => insert(m, key, f(key, x, x')) + (* end case *)) + in + if (numItems m1 > numItems m2) + then foldli (ins (fn (k, a, b) => f (k, b, a))) m1 m2 + else foldli (ins f) m2 m1 + end + + fun intersectWith f (m1, m2) = let + (* iterate over the elements of m1, checking for membership in m2 *) + fun intersect f (m1, m2) = let + fun ins (key, x, m) = (case find(m2, key) + of NONE => m + | (SOME x') => insert(m, key, f(x, x')) + (* end case *)) + in + foldli ins empty m1 + end + in + if (numItems m1 > numItems m2) + then intersect f (m1, m2) + else intersect (fn (a, b) => f(b, a)) (m2, m1) + end + fun intersectWithi f (m1, m2) = let + (* iterate over the elements of m1, checking for membership in m2 *) + fun intersect f (m1, m2) = let + fun ins (key, x, m) = (case find(m2, key) + of NONE => m + | (SOME x') => insert(m, key, f(key, x, x')) + (* end case *)) + in + foldli ins empty m1 + end + in + if (numItems m1 > numItems m2) + then intersect f (m1, m2) + else intersect (fn (k, a, b) => f(k, b, a)) (m2, m1) + end + + fun mergeWith f (m1, m2) = let + fun merge ([], [], m) = m + | merge ((k1, x1)::r1, [], m) = mergef (k1, SOME x1, NONE, r1, [], m) + | merge ([], (k2, x2)::r2, m) = mergef (k2, NONE, SOME x2, [], r2, m) + | merge (m1 as ((k1, x1)::r1), m2 as ((k2, x2)::r2), m) = ( + case Key.compare (k1, k2) + of LESS => mergef (k1, SOME x1, NONE, r1, m2, m) + | EQUAL => mergef (k1, SOME x1, SOME x2, r1, r2, m) + | GREATER => mergef (k2, NONE, SOME x2, m1, r2, m) + (* end case *)) + and mergef (k, x1, x2, r1, r2, m) = (case f (x1, x2) + of NONE => merge (r1, r2, m) + | SOME y => merge (r1, r2, insert(m, k, y)) + (* end case *)) + in + merge (listItemsi m1, listItemsi m2, empty) + end + fun mergeWithi f (m1, m2) = let + fun merge ([], [], m) = m + | merge ((k1, x1)::r1, [], m) = mergef (k1, SOME x1, NONE, r1, [], m) + | merge ([], (k2, x2)::r2, m) = mergef (k2, NONE, SOME x2, [], r2, m) + | merge (m1 as ((k1, x1)::r1), m2 as ((k2, x2)::r2), m) = ( + case Key.compare (k1, k2) + of LESS => mergef (k1, SOME x1, NONE, r1, m2, m) + | EQUAL => mergef (k1, SOME x1, SOME x2, r1, r2, m) + | GREATER => mergef (k2, NONE, SOME x2, m1, r2, m) + (* end case *)) + and mergef (k, x1, x2, r1, r2, m) = (case f (k, x1, x2) + of NONE => merge (r1, r2, m) + | SOME y => merge (r1, r2, insert(m, k, y)) + (* end case *)) + in + merge (listItemsi m1, listItemsi m2, empty) + end + + (* this is a generic implementation of filter. It should + * be specialized to the data-structure at some point. + *) + fun filter predFn m = let + fun f (key, item, m) = if predFn item + then insert(m, key, item) + else m + in + foldli f empty m + end + fun filteri predFn m = let + fun f (key, item, m) = if predFn(key, item) + then insert(m, key, item) + else m + in + foldli f empty m + end + + (* this is a generic implementation of mapPartial. It should + * be specialized to the data-structure at some point. + *) + fun mapPartial f m = let + fun g (key, item, m) = (case f item + of NONE => m + | (SOME item') => insert(m, key, item') + (* end case *)) + in + foldli g empty m + end + fun mapPartiali f m = let + fun g (key, item, m) = (case f(key, item) + of NONE => m + | (SOME item') => insert(m, key, item') + (* end case *)) + in + foldli g empty m + end + + end (* functor BinaryMapFn *) diff --git a/src/smlnj-lib/binary-set-fn.sml b/src/smlnj-lib/binary-set-fn.sml new file mode 100644 index 0000000..8896ad9 --- /dev/null +++ b/src/smlnj-lib/binary-set-fn.sml @@ -0,0 +1,418 @@ +(* binary-set-fn.sml + * + * COPYRIGHT (c) 1993 by AT&T Bell Laboratories. See COPYRIGHT file for details. + * + * This code was adapted from Stephen Adams' binary tree implementation + * of applicative integer sets. + * + * Copyright 1992 Stephen Adams. + * + * This software may be used freely provided that: + * 1. This copyright notice is attached to any copy, derived work, + * or work including all or part of this software. + * 2. Any derived work must contain a prominent notice stating that + * it has been altered from the original. + * + * Name(s): Stephen Adams. + * Department, Institution: Electronics & Computer Science, + * University of Southampton + * Address: Electronics & Computer Science + * University of Southampton + * Southampton SO9 5NH + * Great Britian + * E-mail: sra@ecs.soton.ac.uk + * + * Comments: + * + * 1. The implementation is based on Binary search trees of Bounded + * Balance, similar to Nievergelt & Reingold, SIAM J. Computing + * 2(1), March 1973. The main advantage of these trees is that + * they keep the size of the tree in the node, giving a constant + * time size operation. + * + * 2. The bounded balance criterion is simpler than N&R's alpha. + * Simply, one subtree must not have more than `weight' times as + * many elements as the opposite subtree. Rebalancing is + * guaranteed to reinstate the criterion for weight>2.23, but + * the occasional incorrect behaviour for weight=2 is not + * detrimental to performance. + * + * 3. There are two implementations of union. The default, + * hedge_union, is much more complex and usually 20% faster. I + * am not sure that the performance increase warrants the + * complexity (and time it took to write), but I am leaving it + * in for the competition. It is derived from the original + * union by replacing the split_lt(gt) operations with a lazy + * version. The `obvious' version is called old_union. + * + * 4. Most time is spent in T', the rebalancing constructor. If my + * understanding of the output of * in the sml batch + * compiler is correct then the code produced by NJSML 0.75 + * (sparc) for the final case is very disappointing. Most + * invocations fall through to this case and most of these cases + * fall to the else part, i.e. the plain contructor, + * T(v,ln+rn+1,l,r). The poor code allocates a 16 word vector + * and saves lots of registers into it. In the common case it + * then retrieves a few of the registers and allocates the 5 + * word T node. The values that it retrieves were live in + * registers before the massive save. + * + * Modified to functor to support general ordered values + *) + +functor BinarySetFn (K : ORD_KEY) : ORD_SET = + struct + + structure Key = K + + type item = K.ord_key + + datatype set + = E + | T of { + elt : item, + cnt : int, + left : set, + right : set + } + + fun numItems E = 0 + | numItems (T{cnt,...}) = cnt + + fun isEmpty E = true + | isEmpty _ = false + + fun mkT(v,n,l,r) = T{elt=v,cnt=n,left=l,right=r} + + (* N(v,l,r) = T(v,1+numItems(l)+numItems(r),l,r) *) + fun N(v,E,E) = mkT(v,1,E,E) + | N(v,E,r as T{cnt=n,...}) = mkT(v,n+1,E,r) + | N(v,l as T{cnt=n,...}, E) = mkT(v,n+1,l,E) + | N(v,l as T{cnt=n,...}, r as T{cnt=m,...}) = mkT(v,n+m+1,l,r) + + fun single_L (a,x,T{elt=b,left=y,right=z,...}) = N(b,N(a,x,y),z) + | single_L _ = raise Match + fun single_R (b,T{elt=a,left=x,right=y,...},z) = N(a,x,N(b,y,z)) + | single_R _ = raise Match + fun double_L (a,w,T{elt=c,left=T{elt=b,left=x,right=y,...},right=z,...}) = + N(b,N(a,w,x),N(c,y,z)) + | double_L _ = raise Match + fun double_R (c,T{elt=a,left=w,right=T{elt=b,left=x,right=y,...},...},z) = + N(b,N(a,w,x),N(c,y,z)) + | double_R _ = raise Match + + (* + ** val weight = 3 + ** fun wt i = weight * i + *) + fun wt (i : int) = i + i + i + + fun T' (v,E,E) = mkT(v,1,E,E) + | T' (v,E,r as T{left=E,right=E,...}) = mkT(v,2,E,r) + | T' (v,l as T{left=E,right=E,...},E) = mkT(v,2,l,E) + + | T' (p as (_,E,T{left=T _,right=E,...})) = double_L p + | T' (p as (_,T{left=E,right=T _,...},E)) = double_R p + + (* these cases almost never happen with small weight*) + | T' (p as (_,E,T{left=T{cnt=ln,...},right=T{cnt=rn,...},...})) = + if lnrn then single_R p else double_R p + + | T' (p as (_,E,T{left=E,...})) = single_L p + | T' (p as (_,T{right=E,...},E)) = single_R p + + | T' (p as (v,l as T{elt=lv,cnt=ln,left=ll,right=lr}, + r as T{elt=rv,cnt=rn,left=rl,right=rr})) = + if rn >= wt ln (*right is too big*) + then + let val rln = numItems rl + val rrn = numItems rr + in + if rln < rrn then single_L p else double_L p + end + else if ln >= wt rn (*left is too big*) + then + let val lln = numItems ll + val lrn = numItems lr + in + if lrn < lln then single_R p else double_R p + end + else mkT(v,ln+rn+1,l,r) + + fun add (E,x) = mkT(x,1,E,E) + | add (set as T{elt=v,left=l,right=r,cnt},x) = + case K.compare(x,v) of + LESS => T'(v,add(l,x),r) + | GREATER => T'(v,l,add(r,x)) + | EQUAL => mkT(x,cnt,l,r) + fun add' (s, x) = add(x, s) + + fun concat3 (E,v,r) = add(r,v) + | concat3 (l,v,E) = add(l,v) + | concat3 (l as T{elt=v1,cnt=n1,left=l1,right=r1}, v, + r as T{elt=v2,cnt=n2,left=l2,right=r2}) = + if wt n1 < n2 then T'(v2,concat3(l,v,l2),r2) + else if wt n2 < n1 then T'(v1,l1,concat3(r1,v,r)) + else N(v,l,r) + + fun split_lt (E,x) = E + | split_lt (T{elt=v,left=l,right=r,...},x) = + case K.compare(v,x) of + GREATER => split_lt(l,x) + | LESS => concat3(l,v,split_lt(r,x)) + | _ => l + + fun split_gt (E,x) = E + | split_gt (T{elt=v,left=l,right=r,...},x) = + case K.compare(v,x) of + LESS => split_gt(r,x) + | GREATER => concat3(split_gt(l,x),v,r) + | _ => r + + fun min (T{elt=v,left=E,...}) = v + | min (T{left=l,...}) = min l + | min _ = raise Match + + fun delmin (T{left=E,right=r,...}) = r + | delmin (T{elt=v,left=l,right=r,...}) = T'(v,delmin l,r) + | delmin _ = raise Match + + fun delete' (E,r) = r + | delete' (l,E) = l + | delete' (l,r) = T'(min r,l,delmin r) + + fun concat (E, s) = s + | concat (s, E) = s + | concat (t1 as T{elt=v1,cnt=n1,left=l1,right=r1}, + t2 as T{elt=v2,cnt=n2,left=l2,right=r2}) = + if wt n1 < n2 then T'(v2,concat(t1,l2),r2) + else if wt n2 < n1 then T'(v1,l1,concat(r1,t2)) + else T'(min t2,t1, delmin t2) + + + local + fun trim (lo,hi,E) = E + | trim (lo,hi,s as T{elt=v,left=l,right=r,...}) = + if K.compare(v,lo) = GREATER + then if K.compare(v,hi) = LESS then s else trim(lo,hi,l) + else trim(lo,hi,r) + + fun uni_bd (s,E,_,_) = s + | uni_bd (E,T{elt=v,left=l,right=r,...},lo,hi) = + concat3(split_gt(l,lo),v,split_lt(r,hi)) + | uni_bd (T{elt=v,left=l1,right=r1,...}, + s2 as T{elt=v2,left=l2,right=r2,...},lo,hi) = + concat3(uni_bd(l1,trim(lo,v,s2),lo,v), + v, + uni_bd(r1,trim(v,hi,s2),v,hi)) + (* inv: lo < v < hi *) + + (* all the other versions of uni and trim are + * specializations of the above two functions with + * lo=-infinity and/or hi=+infinity + *) + + fun trim_lo (_, E) = E + | trim_lo (lo,s as T{elt=v,right=r,...}) = + case K.compare(v,lo) of + GREATER => s + | _ => trim_lo(lo,r) + + fun trim_hi (_, E) = E + | trim_hi (hi,s as T{elt=v,left=l,...}) = + case K.compare(v,hi) of + LESS => s + | _ => trim_hi(hi,l) + + fun uni_hi (s,E,_) = s + | uni_hi (E,T{elt=v,left=l,right=r,...},hi) = + concat3(l,v,split_lt(r,hi)) + | uni_hi (T{elt=v,left=l1,right=r1,...}, + s2 as T{elt=v2,left=l2,right=r2,...},hi) = + concat3(uni_hi(l1,trim_hi(v,s2),v),v,uni_bd(r1,trim(v,hi,s2),v,hi)) + + fun uni_lo (s,E,_) = s + | uni_lo (E,T{elt=v,left=l,right=r,...},lo) = + concat3(split_gt(l,lo),v,r) + | uni_lo (T{elt=v,left=l1,right=r1,...}, + s2 as T{elt=v2,left=l2,right=r2,...},lo) = + concat3(uni_bd(l1,trim(lo,v,s2),lo,v),v,uni_lo(r1,trim_lo(v,s2),v)) + + fun uni (s,E) = s + | uni (E,s) = s + | uni (T{elt=v,left=l1,right=r1,...}, + s2 as T{elt=v2,left=l2,right=r2,...}) = + concat3(uni_hi(l1,trim_hi(v,s2),v), v, uni_lo(r1,trim_lo(v,s2),v)) + + in + val hedge_union = uni + end + + (* The old_union version is about 20% slower than + * hedge_union in most cases + *) + fun old_union (E,s2) = s2 + | old_union (s1,E) = s1 + | old_union (T{elt=v,left=l,right=r,...},s2) = + let val l2 = split_lt(s2,v) + val r2 = split_gt(s2,v) + in + concat3(old_union(l,l2),v,old_union(r,r2)) + end + + val empty = E + fun singleton x = T{elt=x,cnt=1,left=E,right=E} + + fun addList (s,l) = List.foldl (fn (i,s) => add(s,i)) s l + + val add = add + + fun member (set, x) = let + fun pk E = false + | pk (T{elt=v, left=l, right=r, ...}) = ( + case K.compare(x,v) + of LESS => pk l + | EQUAL => true + | GREATER => pk r + (* end case *)) + in + pk set + end + + local + (* true if every item in t is in t' *) + fun treeIn (t,t') = let + fun isIn E = true + | isIn (T{elt,left=E,right=E,...}) = member(t',elt) + | isIn (T{elt,left,right=E,...}) = + member(t',elt) andalso isIn left + | isIn (T{elt,left=E,right,...}) = + member(t',elt) andalso isIn right + | isIn (T{elt,left,right,...}) = + member(t',elt) andalso isIn left andalso isIn right + in + isIn t + end + in + fun isSubset (E,_) = true + | isSubset (_,E) = false + | isSubset (t as T{cnt=n,...},t' as T{cnt=n',...}) = + (n<=n') andalso treeIn (t,t') + + fun equal (E,E) = true + | equal (t as T{cnt=n,...},t' as T{cnt=n',...}) = + (n=n') andalso treeIn (t,t') + | equal _ = false + end + + local + fun next ((t as T{right, ...})::rest) = (t, left(right, rest)) + | next _ = (E, []) + and left (E, rest) = rest + | left (t as T{left=l, ...}, rest) = left(l, t::rest) + in + fun compare (s1, s2) = let + fun cmp (t1, t2) = (case (next t1, next t2) + of ((E, _), (E, _)) => EQUAL + | ((E, _), _) => LESS + | (_, (E, _)) => GREATER + | ((T{elt=e1, ...}, r1), (T{elt=e2, ...}, r2)) => ( + case Key.compare(e1, e2) + of EQUAL => cmp (r1, r2) + | order => order + (* end case *)) + (* end case *)) + in + cmp (left(s1, []), left(s2, [])) + end + end + + fun delete (E,x) = raise LibBase.NotFound + | delete (set as T{elt=v,left=l,right=r,...},x) = + case K.compare(x,v) of + LESS => T'(v,delete(l,x),r) + | GREATER => T'(v,l,delete(r,x)) + | _ => delete'(l,r) + + val union = hedge_union + + fun intersection (E, _) = E + | intersection (_, E) = E + | intersection (s, T{elt=v,left=l,right=r,...}) = let + val l2 = split_lt(s,v) + val r2 = split_gt(s,v) + in + if member(s,v) + then concat3(intersection(l2,l),v,intersection(r2,r)) + else concat(intersection(l2,l),intersection(r2,r)) + end + + fun difference (E,s) = E + | difference (s,E) = s + | difference (s, T{elt=v,left=l,right=r,...}) = + let val l2 = split_lt(s,v) + val r2 = split_gt(s,v) + in + concat(difference(l2,l),difference(r2,r)) + end + + fun map f set = let + fun map'(acc, E) = acc + | map'(acc, T{elt,left,right,...}) = + map' (add (map' (acc, left), f elt), right) + in + map' (E, set) + end + + fun app apf = + let fun apply E = () + | apply (T{elt,left,right,...}) = + (apply left;apf elt; apply right) + in + apply + end + + fun foldl f b set = let + fun foldf (E, b) = b + | foldf (T{elt,left,right,...}, b) = + foldf (right, f(elt, foldf (left, b))) + in + foldf (set, b) + end + + fun foldr f b set = let + fun foldf (E, b) = b + | foldf (T{elt,left,right,...}, b) = + foldf (left, f(elt, foldf (right, b))) + in + foldf (set, b) + end + + fun listItems set = foldr (op::) [] set + + fun filter pred set = + foldl (fn (item, s) => if (pred item) then add(s, item) else s) + empty set + + fun partition pred set = + foldl + (fn (item, (s1, s2)) => + if (pred item) then (add(s1, item), s2) else (s1, add(s2, item)) + ) + (empty, empty) set + + fun find p E = NONE + | find p (T{elt,left,right,...}) = (case find p left + of NONE => if (p elt) + then SOME elt + else find p right + | a => a + (* end case *)) + + fun exists p E = false + | exists p (T{elt, left, right,...}) = + (exists p left) orelse (p elt) orelse (exists p right) + + end (* BinarySetFn *) diff --git a/src/smlnj-lib/lib-base-sig.sml b/src/smlnj-lib/lib-base-sig.sml new file mode 100644 index 0000000..d2a0c9f --- /dev/null +++ b/src/smlnj-lib/lib-base-sig.sml @@ -0,0 +1,24 @@ +(* lib-base-sig.sml + * + * COPYRIGHT (c) 1993 by AT&T Bell Laboratories. See COPYRIGHT file for details. + *) + +signature LIB_BASE = + sig + + exception Unimplemented of string + (* raised to report unimplemented features *) + exception Impossible of string + (* raised to report internal errors *) + + exception NotFound + (* raised by searching operations *) + + val failure : {module : string, func : string, msg : string} -> 'a + (* raise the exception Fail with a standard format message. *) + + val version : {date : string, system : string, version_id : int list} + val banner : string + + end (* LIB_BASE *) + diff --git a/src/smlnj-lib/lib-base.sml b/src/smlnj-lib/lib-base.sml new file mode 100644 index 0000000..55ec168 --- /dev/null +++ b/src/smlnj-lib/lib-base.sml @@ -0,0 +1,37 @@ +(* lib-base.sml + * + * COPYRIGHT (c) 1993 by AT&T Bell Laboratories. See COPYRIGHT file for details. + *) + +structure LibBase : LIB_BASE = + struct + + (* raised to report unimplemented features *) + exception Unimplemented of string + + (* raised to report internal errors *) + exception Impossible of string + + (* raised by searching operations *) + exception NotFound + + (* raise the exception Fail with a standard format message. *) + fun failure {module, func, msg} = + raise (Fail(concat[module, ".", func, ": ", msg])) + + val version = { + date = "June 1, 1996", + system = "SML/NJ Library", + version_id = [1, 0] + } + + fun f ([], l) = l + | f ([x : int], l) = (Int.toString x)::l + | f (x::r, l) = (Int.toString x) :: "." :: f(r, l) + + val banner = concat ( + #system version :: ", Version " :: + f (#version_id version, [", ", #date version])) + + end (* LibBase *) + diff --git a/src/smlnj-lib/ord-key-sig.sml b/src/smlnj-lib/ord-key-sig.sml new file mode 100644 index 0000000..3a53ec3 --- /dev/null +++ b/src/smlnj-lib/ord-key-sig.sml @@ -0,0 +1,15 @@ +(* ord-key-sig.sml + * + * COPYRIGHT (c) 1993 by AT&T Bell Laboratories. See COPYRIGHT file for details. + * + * Abstract linearly ordered keys. + * + *) + +signature ORD_KEY = + sig + type ord_key + + val compare : ord_key * ord_key -> order + + end (* ORD_KEY *) diff --git a/src/smlnj-lib/ord-map-sig.sml b/src/smlnj-lib/ord-map-sig.sml new file mode 100644 index 0000000..6c63bef --- /dev/null +++ b/src/smlnj-lib/ord-map-sig.sml @@ -0,0 +1,116 @@ +(* ord-map-sig.sml + * + * COPYRIGHT (c) 1996 by AT&T Research. See COPYRIGHT file for details. + * + * Abstract signature of an applicative-style finite maps (dictionaries) + * structure over ordered monomorphic keys. + *) + +signature ORD_MAP = + sig + + structure Key : ORD_KEY + + type 'a map + + val empty : 'a map + (* The empty map *) + + val isEmpty : 'a map -> bool + (* Return true if and only if the map is empty *) + + val singleton : (Key.ord_key * 'a) -> 'a map + (* return the specified singleton map *) + + val insert : 'a map * Key.ord_key * 'a -> 'a map + val insert' : ((Key.ord_key * 'a) * 'a map) -> 'a map + (* Insert an item. *) + + val find : 'a map * Key.ord_key -> 'a option + (* Look for an item, return NONE if the item doesn't exist *) + + val inDomain : ('a map * Key.ord_key) -> bool + (* return true, if the key is in the domain of the map *) + + val remove : 'a map * Key.ord_key -> 'a map * 'a + (* Remove an item, returning new map and value removed. + * Raises LibBase.NotFound if not found. + *) + + val first : 'a map -> 'a option + val firsti : 'a map -> (Key.ord_key * 'a) option + (* return the first item in the map (or NONE if it is empty) *) + + val numItems : 'a map -> int + (* Return the number of items in the map *) + + val listItems : 'a map -> 'a list + val listItemsi : 'a map -> (Key.ord_key * 'a) list + (* Return an ordered list of the items (and their keys) in the map. *) + + val listKeys : 'a map -> Key.ord_key list + (* return an ordered list of the keys in the map. *) + + val collate : ('a * 'a -> order) -> ('a map * 'a map) -> order + (* given an ordering on the map's range, return an ordering + * on the map. + *) + + val unionWith : ('a * 'a -> 'a) -> ('a map * 'a map) -> 'a map + val unionWithi : (Key.ord_key * 'a * 'a -> 'a) -> ('a map * 'a map) -> 'a map + (* return a map whose domain is the union of the domains of the two input + * maps, using the supplied function to define the map on elements that + * are in both domains. + *) + + val intersectWith : ('a * 'b -> 'c) -> ('a map * 'b map) -> 'c map + val intersectWithi : (Key.ord_key * 'a * 'b -> 'c) -> ('a map * 'b map) -> 'c map + (* return a map whose domain is the intersection of the domains of the + * two input maps, using the supplied function to define the range. + *) + + val mergeWith : ('a option * 'b option -> 'c option) + -> ('a map * 'b map) -> 'c map + val mergeWithi : (Key.ord_key * 'a option * 'b option -> 'c option) + -> ('a map * 'b map) -> 'c map + (* merge two maps using the given function to control the merge. For + * each key k in the union of the two maps domains, the function + * is applied to the image of the key under the map. If the function + * returns SOME y, then (k, y) is added to the resulting map. + *) + + val app : ('a -> unit) -> 'a map -> unit + val appi : ((Key.ord_key * 'a) -> unit) -> 'a map -> unit + (* Apply a function to the entries of the map in map order. *) + + val map : ('a -> 'b) -> 'a map -> 'b map + val mapi : (Key.ord_key * 'a -> 'b) -> 'a map -> 'b map + (* Create a new map by applying a map function to the + * name/value pairs in the map. + *) + + val foldl : ('a * 'b -> 'b) -> 'b -> 'a map -> 'b + val foldli : (Key.ord_key * 'a * 'b -> 'b) -> 'b -> 'a map -> 'b + (* Apply a folding function to the entries of the map + * in increasing map order. + *) + + val foldr : ('a * 'b -> 'b) -> 'b -> 'a map -> 'b + val foldri : (Key.ord_key * 'a * 'b -> 'b) -> 'b -> 'a map -> 'b + (* Apply a folding function to the entries of the map + * in decreasing map order. + *) + + val filter : ('a -> bool) -> 'a map -> 'a map + val filteri : (Key.ord_key * 'a -> bool) -> 'a map -> 'a map + (* Filter out those elements of the map that do not satisfy the + * predicate. The filtering is done in increasing map order. + *) + + val mapPartial : ('a -> 'b option) -> 'a map -> 'b map + val mapPartiali : (Key.ord_key * 'a -> 'b option) -> 'a map -> 'b map + (* map a partial function over the elements of a map in increasing + * map order. + *) + + end (* ORD_MAP *) diff --git a/src/smlnj-lib/ord-set-sig.sml b/src/smlnj-lib/ord-set-sig.sml new file mode 100644 index 0000000..746d64e --- /dev/null +++ b/src/smlnj-lib/ord-set-sig.sml @@ -0,0 +1,90 @@ +(* ordset-sig.sml + * + * COPYRIGHT (c) 1993 by AT&T Bell Laboratories. See COPYRIGHT file for details. + * + * Signature for a set of values with an order relation. + *) + +signature ORD_SET = + sig + + structure Key : ORD_KEY + + type item = Key.ord_key + type set + + val empty : set + (* The empty set *) + + val singleton : item -> set + (* Create a singleton set *) + + val add : set * item -> set + val add' : (item * set) -> set + (* Insert an item. *) + + val addList : set * item list -> set + (* Insert items from list. *) + + val delete : set * item -> set + (* Remove an item. Raise NotFound if not found. *) + + val member : set * item -> bool + (* Return true if and only if item is an element in the set *) + + val isEmpty : set -> bool + (* Return true if and only if the set is empty *) + + val equal : (set * set) -> bool + (* Return true if and only if the two sets are equal *) + + val compare : (set * set) -> order + (* does a lexical comparison of two sets *) + + val isSubset : (set * set) -> bool + (* Return true if and only if the first set is a subset of the second *) + + val numItems : set -> int + (* Return the number of items in the table *) + + val listItems : set -> item list + (* Return an ordered list of the items in the set *) + + val union : set * set -> set + (* Union *) + + val intersection : set * set -> set + (* Intersection *) + + val difference : set * set -> set + (* Difference *) + + val map : (item -> item) -> set -> set + (* Create a new set by applying a map function to the elements + * of the set. + *) + + val app : (item -> unit) -> set -> unit + (* Apply a function to the entries of the set + * in increasing order + *) + + val foldl : (item * 'b -> 'b) -> 'b -> set -> 'b + (* Apply a folding function to the entries of the set + * in increasing order + *) + + val foldr : (item * 'b -> 'b) -> 'b -> set -> 'b + (* Apply a folding function to the entries of the set + * in decreasing order + *) + + val partition : (item -> bool) -> set -> (set * set) + + val filter : (item -> bool) -> set -> set + + val exists : (item -> bool) -> set -> bool + + val find : (item -> bool) -> set -> item option + + end (* ORD_SET *) diff --git a/src/smlnj-lib/sources.cm b/src/smlnj-lib/sources.cm new file mode 100644 index 0000000..7c9fa6c --- /dev/null +++ b/src/smlnj-lib/sources.cm @@ -0,0 +1,8 @@ +Group is + lib-base-sig.sml + lib-base.sml + ord-key-sig.sml + ord-map-sig.sml + binary-map-fn.sml + ord-set-sig.sml + binary-set-fn.sml \ No newline at end of file diff --git a/src/util.sig b/src/util.sig new file mode 100644 index 0000000..670a267 --- /dev/null +++ b/src/util.sig @@ -0,0 +1,70 @@ +(* +Domtool (http://hcoop.sf.net/) +Copyright (C) 2004 Adam Chlipala + +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 2 +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, write to the Free Software +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +*) + +(* Utility functions *) + +signature UTIL = +sig + val impLoop : (unit -> 'a) -> ('a -> bool) -> ('a * 'b -> 'b) -> 'b -> unit + (* (impLoop next stop body init) repeatedly executes next until stop returns + * true on the result. Running state is kept in the style of foldl, with + * the state for the next iteration being determiend by calling body with + * the most recent next return and the current state. + *) + + val ioLoop : (unit -> string) -> (string * 'b -> 'b) -> 'b -> unit + (* impLoop specialized to work with TextIO.inputLine, where a return of "" + * indicates end-of-file. + *) + val ioOptLoop : (unit -> string option) -> (string * 'b -> 'b) -> 'b -> unit + (* Like ioLoop, but with NONE as sentinel value. *) + + val isIdent : char -> bool + (* Is the character a valid part of an identifier? (lowercase letter or + * digit? + *) + + val validHost : string -> bool + (* Valid Internet hostname with no periods? *) + val validDomain : string -> bool + (* Valid domain name? *) + val validUser : string -> bool + (* Valid UNIX username? *) + val validEmail : string -> bool + (* Valid e-mail address? *) + val isTmp : string -> bool + (* Is the name of a temporary file generated by an editor? *) + val validIp : string -> bool + (* Is a valid IPv4 address? *) + + val trimLast : string -> string + (* Remove the last character from a string *) + + val toDir : string -> string + (* Translates a domain name into a fileystem path *) + + val checkPath : StringSet.set * string -> bool + (* Given a set of valid path bases and a path, is it allowable? *) + val resolveAddr : string StringMap.map * string -> string + (* Determine the value of an address field that may include variables. + * Check that the final result is a validIp. *) + val resolveDomain : string StringMap.map * string -> string + (* Determine the value of a domain field that may include variables. + * Check that the final result is a validDomain. *) +end diff --git a/src/util.sml b/src/util.sml new file mode 100644 index 0000000..1bc2499 --- /dev/null +++ b/src/util.sml @@ -0,0 +1,115 @@ +(* +Domtool (http://hcoop.sf.net/) +Copyright (C) 2004 Adam Chlipala + +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 2 +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, write to the Free Software +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +*) + +(* Utility functions *) + +structure Util :> UTIL = +struct + fun impLoop next stop body init = + let + fun loop state = + let + val v = next () + in + if stop v then + () + else + loop (body (v, state)) + end + in + loop init + end + + fun ioLoop next body init = impLoop next (fn s => s = "") body init + fun ioOptLoop next body init = + let + fun loop state = + case next () of + NONE => () + | SOME v => loop (body (v, state)) + in + loop init + end + + fun isIdent ch = Char.isLower ch orelse Char.isDigit ch + + fun validHost s = + size s > 0 andalso size s < 20 andalso List.all isIdent (String.explode s) + + fun validDomain s = + size s > 0 andalso size s < 100 andalso List.all validHost (String.fields (fn ch => ch = #".") s) + + fun validUser s = + size s > 0 andalso size s < 20 andalso List.all + (fn ch => isIdent ch orelse ch = #"." orelse ch = #"_" orelse ch = #"-" orelse ch = #"+") + (String.explode s) + + fun validEmail s = + (case String.fields (fn ch => ch = #"@") s of + [user, host] => validUser user andalso validDomain host + | _ => false) + + fun isTmp s = + List.exists (fn ch => ch = #"#" orelse ch = #"~") (String.explode s) + + fun validIp s = + (case map Int.fromString (String.fields (fn ch => ch = #".") s) of + [SOME n1, SOME n2, SOME n3, SOME n4] => + n1 >= 0 andalso n1 < 256 andalso n2 >= 0 andalso n2 < 256 andalso n3 >= 0 andalso n3 < 256 andalso n4 >= 0 andalso n4 < 256 + | _ => false) + + fun trimLast s = + if size s = 0 then + s + else + String.substring (s, 0, size s - 1) + + fun toDir s = + foldr (fn (a, s) => s ^ "/" ^ a) "" (String.tokens (fn ch => ch = #".") s) + + fun checkPath (paths, path) = + StringSet.exists (fn pref => path = pref orelse (size path >= size pref + 2 andalso substring (path, 0, size pref) = pref + andalso String.sub (path, size pref) = #"/")) paths + andalso List.all (fn s => s <> "..") (String.fields (fn ch => ch = #"/") path) + + fun resolveAddr (vars, s) = + if validIp s then + s + else + (case StringMap.find (vars, s) of + NONE => "" + | SOME v => + if validIp v then + v + else + "") + + fun resolveDomain (vars, s) = + if validDomain s then + s + else + (case StringMap.find (vars, s) of + NONE => "" + | SOME v => + if validDomain v then + v + else + "") +end + diff --git a/src/vmail/.cvsignore b/src/vmail/.cvsignore new file mode 100644 index 0000000..a705707 --- /dev/null +++ b/src/vmail/.cvsignore @@ -0,0 +1,2 @@ +CM +config.sml \ No newline at end of file diff --git a/src/vmail/README b/src/vmail/README new file mode 100644 index 0000000..300c8ef --- /dev/null +++ b/src/vmail/README @@ -0,0 +1,43 @@ +VIRTUAL MAILBOXES FOR COURIER IMAP + + +Here are some simple tools for managing virtual e-mailboxes for +Courier IMAP (http://www.inter7.com/courierimap/courierimap.html). + +A short sample session should demonstrate how to use the vmail and +reloadusers command line tools: + +% vmail your.domain add new.user +Password: password +Reenter password: password +Mailbox created. + +% vmail your.domain list +new.user + +% vmail your.domain passwd new.user +Password: password' +Reenter password: password' +Password set. + +% reloadusers + +After this, where mailboxDir is the directory set in config.sml, a +Maildir mailbox exists in mailboxDir/your.domain/new.user, and +login/password data for Courier is in the directories/files given in +config.sml. You must set up an MTA to properly deliver mail to these +mailboxes for this to be useful. + +vmail only allows a user to administer virtual mailboxes for a domain +whose directory in the domtool tree the user's current group has write +access to. Thus, it is important to maintain g+w in these directories +for this to work. + +Actually, this only matters when you use a +sudo-based solution like mentioned in the main README file. You might +be able to find a better way of doing things. At hcoop, we have a +'vmail' user that owns the mailbox directory. Users are allowed via +sudo to run vmail as user vmail, and user vmail is allowed to run the +Courier userdb and userdbpw programs as root. All domtool users are +allowed to run reloadusers as root. + diff --git a/src/vmail/config.sample.sml b/src/vmail/config.sample.sml new file mode 100644 index 0000000..a145e84 --- /dev/null +++ b/src/vmail/config.sample.sml @@ -0,0 +1,35 @@ +(* +Domtool (http://hcoop.sf.net/) +Copyright (C) 2004 Adam Chlipala + +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 2 +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, write to the Free Software +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +*) + +(* Some options you might want to change *) + +structure VmailConfig = +struct + val mailboxDir = "/home/vmail" + (* Location of virtual mailboxes *) + + val courierDir = "/usr/lib/courier-imap" + (* Base of Courier IMAP directory tree *) + + val userdbDir = "/etc/userdb" + (* Directory for storing userdb info *) + + val postReload = "chown mail.mail /etc/userdbshadow.dat" + (* Command to run after reloading userdb data *) +end diff --git a/src/vmail/main.sml b/src/vmail/main.sml new file mode 100644 index 0000000..580f491 --- /dev/null +++ b/src/vmail/main.sml @@ -0,0 +1,20 @@ +(* +Domtool (http://hcoop.sf.net/) +Copyright (C) 2004 Adam Chlipala + +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 2 +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, write to the Free Software +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +*) + +val _ = OS.Process.exit (Vmail.main (CommandLine.arguments ())) \ No newline at end of file diff --git a/src/vmail/reloadusers.cm b/src/vmail/reloadusers.cm new file mode 100644 index 0000000..eac6634 --- /dev/null +++ b/src/vmail/reloadusers.cm @@ -0,0 +1,6 @@ +Group is + config.sml + + reloadusers.sig + reloadusers.sml + reloadusers.main.sml \ No newline at end of file diff --git a/src/vmail/reloadusers.main.sml b/src/vmail/reloadusers.main.sml new file mode 100644 index 0000000..43bc14e --- /dev/null +++ b/src/vmail/reloadusers.main.sml @@ -0,0 +1,20 @@ +(* +Domtool (http://hcoop.sf.net/) +Copyright (C) 2004 Adam Chlipala + +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 2 +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, write to the Free Software +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +*) + +val _ = OS.Process.exit (Reloadusers.main ()) \ No newline at end of file diff --git a/src/vmail/reloadusers.sig b/src/vmail/reloadusers.sig new file mode 100644 index 0000000..6346301 --- /dev/null +++ b/src/vmail/reloadusers.sig @@ -0,0 +1,23 @@ +(* +Domtool (http://hcoop.sf.net/) +Copyright (C) 2004 Adam Chlipala + +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 2 +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, write to the Free Software +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +*) + +signature RELOADUSERS = +sig + val main : unit -> unit +end \ No newline at end of file diff --git a/src/vmail/reloadusers.sml b/src/vmail/reloadusers.sml new file mode 100644 index 0000000..92eea66 --- /dev/null +++ b/src/vmail/reloadusers.sml @@ -0,0 +1,69 @@ +(* +Domtool (http://hcoop.sf.net/) +Copyright (C) 2004 Adam Chlipala + +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 2 +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, write to the Free Software +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +*) + +(* Utility to reload Courier IMAP data after modifying virtual mailboxes *) + +structure Reloadusers :> RELOADUSERS = +struct + open VmailConfig + + fun main _ = + let + val proc = Unix.execute("/bin/sh", ["-c", courierDir ^ "/sbin/pw2userdb"]) + val (stdout, stdin) = Unix.streamsOf proc + + val outf = TextIO.openOut (userdbDir ^ "/localhost") + + fun loop () = + case TextIO.inputLine stdout of + "" => () + | line => + let + val tokens = String.tokens (fn ch => Char.isSpace ch orelse ch = #"|" orelse ch = #"=") line + + fun findHome (n::v::rest) = + if n = "home" then + TextIO.output (outf, "|mail=" ^ v ^ "/Maildir") + else + findHome rest + | findHome _ = () + in + TextIO.output (outf, String.substring (line, 0, size line - 1)); + case tokens of + first::rest => + (case Int.fromString first of + NONE => findHome rest + | _ => ()) + | _ => (); + TextIO.output (outf, "\n"); + loop () + end + in + loop (); + TextIO.closeOut outf; + TextIO.closeIn stdout; + TextIO.closeOut stdin; + Unix.reap proc; + if OS.Process.isSuccess (OS.Process.system (courierDir ^ "/sbin/makeuserdb")) then + OS.Process.system postReload + else + (print "Error running makeuserdb\n"; + OS.Process.failure) + end +end diff --git a/src/vmail/vmail.cm b/src/vmail/vmail.cm new file mode 100644 index 0000000..fbaa168 --- /dev/null +++ b/src/vmail/vmail.cm @@ -0,0 +1,13 @@ +Group is + ../smlnj-lib/sources.cm + ../map.sml + + ../config.sml + config.sml + + ../util.sig + ../util.sml + + vmail.sig + vmail.sml + main.sml \ No newline at end of file diff --git a/src/vmail/vmail.sig b/src/vmail/vmail.sig new file mode 100644 index 0000000..1a936c7 --- /dev/null +++ b/src/vmail/vmail.sig @@ -0,0 +1,23 @@ +(* +Domtool (http://hcoop.sf.net/) +Copyright (C) 2004 Adam Chlipala + +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 2 +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, write to the Free Software +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +*) + +signature VMAIL = +sig + val main : string list -> OS.Process.status +end \ No newline at end of file diff --git a/src/vmail/vmail.sml b/src/vmail/vmail.sml new file mode 100644 index 0000000..356786e --- /dev/null +++ b/src/vmail/vmail.sml @@ -0,0 +1,102 @@ +(* +Domtool (http://hcoop.sf.net/) +Copyright (C) 2004 Adam Chlipala + +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 2 +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, write to the Free Software +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +*) + +(* Administration of Courier IMAP virtual mailboxes *) + +structure Vmail :> VMAIL = +struct + open Config VmailConfig Util + + fun main args = + case args of + domain::rest => + if validDomain domain then + let + val tooldir = dataDir ^ toDir domain + val maildir = mailboxDir ^ "/" ^ domain + in + if not (Posix.FileSys.access (tooldir, [])) then + (print ("Domain not in domtool (would be " ^ tooldir ^ ")\n"); + OS.Process.failure) + else if not (Posix.FileSys.access (tooldir, [Posix.FileSys.A_WRITE])) then + (print "Access denied\n"; + OS.Process.failure) + else + case rest of + ["list"] => + (let + val dir = Posix.FileSys.opendir maildir + + fun loop () = + case Posix.FileSys.readdir dir of + NONE => () + | SOME user => (print (user ^ "\n"); + loop ()) + in + loop (); + Posix.FileSys.closedir dir; + OS.Process.success + end handle Io => OS.Process.success) + | ["add", user] => + if validUser user then + let + val _ = if Posix.FileSys.access (maildir, []) then + () + else + ignore (OS.Process.system ("mkdir " ^ maildir)) + + val umaildir = maildir ^ "/" ^ user + in + if Posix.FileSys.access (umaildir, []) then + (print "Mailbox already exists\n"; + OS.Process.failure) + else if OS.Process.system (courierDir ^ "/bin/maildirmake " ^ umaildir) = OS.Process.success + andalso OS.Process.system (sudo ^ " " ^ courierDir ^ "/sbin/userdb \"" ^ domain ^ "/" ^ user ^ "@" ^ domain ^ "\" set home=/home/vmail mail=/home/vmail/" ^ domain ^ "/" ^ user ^ " uid=1042 gid=1043") = OS.Process.success + andalso OS.Process.system (sudo ^ " " ^ courierDir ^ "/sbin/userdbpw | " ^ sudo ^ " " ^ courierDir ^ "/sbin/userdb \"" ^ domain ^ "/" ^ user ^ "@" ^ domain ^ "\" set systempw") = OS.Process.success then + (print "Mailbox created\n"; + OS.Process.success) + else + (print "Error creating mailbox\n"; + OS.Process.failure) + end + else + (print "Invalid mailbox name\n"; + OS.Process.failure) + | ["passwd", user] => + if not (validUser user) then + (print "Invalid mailbox name\n"; + OS.Process.failure) + else if not (Posix.FileSys.access (maildir ^ "/" ^ user, [])) then + (print "Mailbox does not exist\n"; + OS.Process.failure) + else if OS.Process.system (sudo ^ " " ^ courierDir ^ "/sbin/userdbpw | " ^ sudo ^ " " ^ courierDir ^ "/sbin/userdb \"" ^ domain ^ "/" ^ user ^ "@" ^ domain ^ "\" set systempw") = OS.Process.success then + (print "Password set\n"; + OS.Process.success) + else + (print "Unable to set password\n"; + OS.Process.failure) + | _ => (print "Unknown command\n"; + OS.Process.failure) + end + else + (print "Invalid domain\n"; + OS.Process.failure) + | _ => (print "Invalid command\n"; + OS.Process.failure) +end \ No newline at end of file diff --git a/src/webpasswd/config.sml b/src/webpasswd/config.sml new file mode 100644 index 0000000..41eb1fc --- /dev/null +++ b/src/webpasswd/config.sml @@ -0,0 +1,25 @@ +(* +Domtool (http://hcoop.sf.net/) +Copyright (C) 2004 Adam Chlipala + +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 2 +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, write to the Free Software +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +*) + +structure WebpasswdConfig = +struct + (* Paths to needed programs *) + val getent = "/usr/bin/getent" + val htpasswd = "/usr/bin/htpasswd" +end \ No newline at end of file diff --git a/src/webpasswd/main.sml b/src/webpasswd/main.sml new file mode 100644 index 0000000..b5df22d --- /dev/null +++ b/src/webpasswd/main.sml @@ -0,0 +1,20 @@ +(* +Domtool (http://hcoop.sf.net/) +Copyright (C) 2004 Adam Chlipala + +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 2 +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, write to the Free Software +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +*) + +val _ = OS.Process.exit (Webpasswd.main ()) \ No newline at end of file diff --git a/src/webpasswd/webpasswd.cm b/src/webpasswd/webpasswd.cm new file mode 100644 index 0000000..c68dc99 --- /dev/null +++ b/src/webpasswd/webpasswd.cm @@ -0,0 +1,8 @@ +Group is + ../config.sml + ../apache/config.sml + config.sml + + webpasswd.sig + webpasswd.sml + main.sml \ No newline at end of file diff --git a/src/webpasswd/webpasswd.sig b/src/webpasswd/webpasswd.sig new file mode 100644 index 0000000..46d6f92 --- /dev/null +++ b/src/webpasswd/webpasswd.sig @@ -0,0 +1,23 @@ +(* +Domtool (http://hcoop.sf.net/) +Copyright (C) 2004 Adam Chlipala + +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 2 +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, write to the Free Software +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +*) + +signature WEBPASSWD = +sig + val main : unit -> unit +end \ No newline at end of file diff --git a/src/webpasswd/webpasswd.sml b/src/webpasswd/webpasswd.sml new file mode 100644 index 0000000..f1498b6 --- /dev/null +++ b/src/webpasswd/webpasswd.sml @@ -0,0 +1,50 @@ +(* +Domtool (http://hcoop.sf.net/) +Copyright (C) 2004 Adam Chlipala + +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 2 +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, write to the Free Software +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +*) + +(* Utility to let a user set a password in an Apache password file for a user + * name matches his UNIX login name. *) + +structure Webpasswd :> WEBPASSWD = +struct + open Config ApacheConfig WebpasswdConfig + + fun main () = + let + val uid = SysWord.toInt (Posix.ProcEnv.uidToWord (Posix.ProcEnv.getuid ())) + + val proc = Unix.execute("/bin/sh", ["-c", getent ^ " passwd " ^ + Int.toString uid]) + val (stdout, stdin) = Unix.streamsOf proc + + val name = + case String.tokens (fn ch => ch = #":") (TextIO.inputLine stdout) of + name::_ => name + | _ => raise Fail "Unexpected getent output" + in + TextIO.closeOut stdin; + TextIO.closeIn stdout; + if not (OS.Process.isSuccess (Unix.reap proc)) then + (print "Error reaping getent\n"; + OS.Process.failure) + else + (print ("Update password for " ^ name ^ "\n"); + OS.Process.system (htpasswd ^ " " ^ passwdFile ^ " \"" ^ name ^ "\"")) + end +end + -- 2.20.1