From a49a9bfbe03214c68d029fe856a56006267bc8a3 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sat, 9 Dec 2006 02:41:53 +0000 Subject: [PATCH] Now builds with MLton --- Makefile | 38 +++++++++++++++++++++++-- bin/.cvsignore | 1 + configDefault/apache.cfg | 8 +++--- configDefault/bind.cfg | 6 ++-- configDefault/domtool.cfg | 26 ++++++++--------- configDefault/exim.cfg | 25 ++++++++--------- configDefault/mailman.cfg | 8 +++--- configDefault/webalizer.cfg | 4 +-- openssl/mlton/FFI/.cvsignore | 2 ++ openssl/mlton/libssl-h.sml | 13 +++++++++ src/.cvsignore | 2 ++ src/ast.sml | 2 +- src/compat.sig | 21 ++++++++++++++ src/compat_mlton.sml | 21 ++++++++++++++ src/compat_smlnj.sml | 21 ++++++++++++++ src/main-server.sml | 21 ++++++++++++++ src/openssl.sml | 54 +++++++++++++++++++----------------- src/prefix.cm | 14 ++++++++++ src/prefix.mlb | 13 +++++++++ src/{domtool.cm => sources} | 19 +++---------- src/suffix.mlb | 0 21 files changed, 236 insertions(+), 83 deletions(-) create mode 100644 bin/.cvsignore rewrite configDefault/exim.cfg (73%) create mode 100644 openssl/mlton/FFI/.cvsignore create mode 100644 openssl/mlton/libssl-h.sml create mode 100644 src/compat.sig create mode 100644 src/compat_mlton.sml create mode 100644 src/compat_smlnj.sml create mode 100644 src/main-server.sml create mode 100644 src/prefix.cm create mode 100644 src/prefix.mlb rename src/{domtool.cm => sources} (85%) create mode 100644 src/suffix.mlb diff --git a/Makefile b/Makefile index 2d5c588..bbd19f3 100644 --- a/Makefile +++ b/Makefile @@ -1,7 +1,13 @@ -all: configDefault/config.sig configDefault/configDefault.sml \ - openssl/openssl_sml.so openssl/smlnj/FFI/libssl.h.cm +all: mlton -.PHONY: all openssl +COMMON_DEPS := configDefault/config.sig configDefault/configDefault.sml \ + openssl/openssl_sml.so + +.PHONY: all mlton smlnj + +mlton: bin/domtool-server + +smlnj: $(COMMON_DEPS) openssl/smlnj/FFI/libssl.h.cm src/domtool.cm configDefault/config.sig: src/config.sig.header \ configDefault/*.csg configDefault/*.cfs \ @@ -27,7 +33,33 @@ openssl/openssl_sml.so: openssl/openssl_sml.o -o openssl/openssl_sml.so \ openssl/openssl_sml.o -lssl +src/domtool.cm: Makefile src/prefix.cm src/sources + cat src/prefix.cm src/sources >src/domtool.cm + +src/domtool-server.mlb: Makefile src/prefix.mlb src/sources src/suffix.mlb + cat src/prefix.mlb src/sources src/suffix.mlb \ + | sed 's/^\(.*\).grm$$/\1.grm.sig\n\1.grm.sml/' \ + | sed 's/^\(.*\).lex$$/\1.lex.sml/' >src/domtool-server.mlb + echo "main-server.sml" >>src/domtool-server.mlb + openssl/smlnj/FFI/libssl.h.cm: openssl/openssl_sml.h cd openssl/smlnj ; ml-nlffigen -d FFI -lh LibsslH.libh -include ../libssl-h.sml \ -cm libssl.h.cm -D__builtin_va_list="void*" \ ../openssl_sml.h + +openssl/mlton/FFI/libssl.h.mlb: openssl/openssl_sml.h + cd openssl/mlton ; mlnlffigen -dir FFI -libhandle LibsslH.libh -include ../libssl-h.sml \ + -mlbfile libssl.h.mlb -cppopt -D__builtin_va_list="void*" \ + ../openssl_sml.h + +%.lex.sml: %.lex + ml-lex $< + +%.grm.sig %.grm.sml: %.grm + ml-yacc $< + +bin/domtool-server: openssl/mlton/FFI/libssl.h.mlb \ + src/domtool-server.mlb src/domtool.lex.sml \ + src/domtool.grm.sig src/domtool.grm.sml \ + $(COMMON_DEPS) + mlton -output bin/domtool-server -link-opt -ldl src/domtool-server.mlb diff --git a/bin/.cvsignore b/bin/.cvsignore new file mode 100644 index 0000000..5775e09 --- /dev/null +++ b/bin/.cvsignore @@ -0,0 +1 @@ +domtool-server diff --git a/configDefault/apache.cfg b/configDefault/apache.cfg index e657830..2a1f173 100644 --- a/configDefault/apache.cfg +++ b/configDefault/apache.cfg @@ -1,15 +1,15 @@ structure Apache :> APACHE_CONFIG = struct -val reload = "echo \"I would reload Apache now.\"" +val reload = "/usr/bin/rsync --delete /var/domtool/vhosts/* /etc/apache2/ ; echo \"I would reload Apache now.\"" (*"/etc/init.d/apache2 reload"*) -val confDir = "/home/adamc/fake" +val confDir = "/var/domtool/vhosts" -val webNodes = ["this"] +val webNodes = ["deleuze"] val proxyTargets = ["http://hcoop.net/cgi-bin/mailman", "http://hcoop.net/pipermail"] -val logDir = "/home/adamc/fake/log" +val logDir = "/var/log/apache2" end diff --git a/configDefault/bind.cfg b/configDefault/bind.cfg index 5526042..4756423 100644 --- a/configDefault/bind.cfg +++ b/configDefault/bind.cfg @@ -2,11 +2,11 @@ structure Bind :> BIND_CONFIG = struct val defaultTTL = 172800 -val zonePath = "/home/adamc/fake" +val zonePath = "/var/domtool/zones" -val namedConf = "/home/adamc/fake/named.conf" +val namedConf = "/var/domtool/named.conf.local" -val reload = "echo \"I would reload bind now.\"" +val reload = "/usr/bin/rsync --delete /var/domtool/zones/* /etc/bind/zones/ ; /bin/cp /var/domtool/named.conf.local /etc/bind/ ; echo \"I would reload Bind now.\"" (*"/etc/init.d/bind9 reload"*) end diff --git a/configDefault/domtool.cfg b/configDefault/domtool.cfg index d237b52..7aa3022 100644 --- a/configDefault/domtool.cfg +++ b/configDefault/domtool.cfg @@ -1,5 +1,5 @@ -val libRoot = "/home/adamc/cvs/domtool2/lib" -val resultRoot = "/home/adamc/domtool" +val libRoot = "/afs/hcoop.net/common/etc/domtool/lib" +val resultRoot = "/afs/hcoop.net/common/etc/domtool/nodes" val tmpDir = "/tmp/domtool" val cat = "/bin/cat" @@ -14,27 +14,27 @@ val defaultRetry = 900 val defaultExpiry = 1209600 val defaultMinimum = 3600 -val nodeIps = [("this", "127.0.0.1"), ("kirillov", "127.0.0.1")] -val defaultNode = "this" +val nodeIps = [("deleuze", "69.90.123.67"), ("mire", "69.90.123.68")] +val defaultNode = "deleuze" -val aclFile = "/home/adamc/fake/acl" +val aclFile = "/afs/hcoop.net/common/etc/domtool/acl" -val testUser = "adamc" +val testUser = "test" val defaultDomain = "hcoop.net" -val dispatcher = "localhost" +val dispatcher = "deleuze.hcoop.net" val dispatcherPort = 1234 val slavePort = 1235 val queueSize = 5 val bufSize = 1024 -val trustStore = "/home/adamc/fake/TrustKey.pem" -val serverCert = "/home/adamc/fake/servercert.pem" -val serverKey = "/home/adamc/fake/serverkey.pem" +val trustStore = "/afs/hcoop.net/common/etc/domtool/TrustKey.pem" +val serverCert = "/afs/hcoop.net/common/etc/domtool/servercert.pem" +val serverKey = "/etc/domtool/serverkey.pem" -val certDir = "/home/adamc/fake/certs" -val keyDir = "/home/adamc/fake/keys" +val certDir = "/afs/hcoop.net/common/etc/domtool/certs" +val keyDir = "/afs/hcoop.net/common/etc/domtool/keys" -val dispatcherName = "hcoop.net" +val dispatcherName = "deleuze.hcoop.net" diff --git a/configDefault/exim.cfg b/configDefault/exim.cfg dissimilarity index 73% index 26939fd..f10a815 100644 --- a/configDefault/exim.cfg +++ b/configDefault/exim.cfg @@ -1,13 +1,12 @@ -structure Exim :> EXIM_CONFIG = struct - -val aliases = "/home/adamc/fake/aliases" -val aliasesDefault = "/home/adamc/fake/aliases.default" - -val reload = "echo \"I would reload exim now.\"" -(*"/etc/init.d/exim4 reload"*) - -val handleDomains = "/home/adamc/fake/mail" - -val aliasTo = ["this"] - -end +structure Exim :> EXIM_CONFIG = struct + +val aliases = "/var/domtool/aliases" +val aliasesDefault = "/var/domtool/aliases.default" +val handleDomains = "/var/domtool/local_domains.cfg" + +val reload = "cp /var/domtool/aliases /etc/ ; cp /var/domtool/aliases.default /etc/ ; cp /var/domtool/local_domains.cfg /etc/exim4/ ; echo \"I would reload Exim now.\"" +(*"/etc/init.d/exim4 reload"*) + +val aliasTo = ["deleuze"] + +end diff --git a/configDefault/mailman.cfg b/configDefault/mailman.cfg index ab6f51a..837554d 100644 --- a/configDefault/mailman.cfg +++ b/configDefault/mailman.cfg @@ -1,10 +1,10 @@ structure Mailman :> MAILMAN_CONFIG = struct -val node = "this" +val node = "deleuze" -val mapFile = "/home/adamc/fake/mailman.map" +val mapFile = "/var/domtool/mailman.map" -val reload = "echo \"I would reload Mailman now.\"" -(* "/etc/init.d/mailman reload" *) +val reload = "cp /var/domtool/mailman.map /etc/mailman ; echo \"I would reload Mailman now.\"" +(*"/etc/init.d/mailman reload"*) end diff --git a/configDefault/webalizer.cfg b/configDefault/webalizer.cfg index 256f8ff..00ea5ba 100644 --- a/configDefault/webalizer.cfg +++ b/configDefault/webalizer.cfg @@ -1,6 +1,6 @@ structure Webalizer :> WEBALIZER_CONFIG = struct -val configDir = "/home/adamc/fake/webalizer" -val outputDir = "/home/adamc/fake/webalizerOut" +val configDir = "/etc/webalizer" +val outputDir = "/tmp/webalizer" end diff --git a/openssl/mlton/FFI/.cvsignore b/openssl/mlton/FFI/.cvsignore new file mode 100644 index 0000000..73ea653 --- /dev/null +++ b/openssl/mlton/FFI/.cvsignore @@ -0,0 +1,2 @@ +*.sml +*.mlb diff --git a/openssl/mlton/libssl-h.sml b/openssl/mlton/libssl-h.sml new file mode 100644 index 0000000..6e4b191 --- /dev/null +++ b/openssl/mlton/libssl-h.sml @@ -0,0 +1,13 @@ +structure LibsslH = struct + local + val lh = DynLinkage.open_lib + { name = "openssl/openssl_sml.so", global = true, lazy = true } + handle DynLinkage.DynLinkError s => raise Fail s + in + fun libh s = let + val sh = DynLinkage.lib_symbol (lh, s) + in + fn () => DynLinkage.addr sh + end + end +end diff --git a/src/.cvsignore b/src/.cvsignore index 3d38035..5358fb1 100644 --- a/src/.cvsignore +++ b/src/.cvsignore @@ -1,3 +1,5 @@ .cm *.lex.* *.grm.* +domtool.cm +domtool-server.mlb diff --git a/src/ast.sml b/src/ast.sml index 7a9fe25..ba00f78 100644 --- a/src/ast.sml +++ b/src/ast.sml @@ -59,7 +59,7 @@ datatype typ' = | TUnif of string * typ option ref (* Unification variable to be determined during type-checking *) withtype typ = typ' * position - and record = typ StringMap.map + and record = (typ' * position) StringMap.map datatype exp' = EInt of int diff --git a/src/compat.sig b/src/compat.sig new file mode 100644 index 0000000..b54bc27 --- /dev/null +++ b/src/compat.sig @@ -0,0 +1,21 @@ +(* HCoop Domtool (http://hcoop.sourceforge.net/) + * Copyright (c) 2006, 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. + *) + +signature COMPAT = sig + structure Char : WORD +end diff --git a/src/compat_mlton.sml b/src/compat_mlton.sml new file mode 100644 index 0000000..5b52b14 --- /dev/null +++ b/src/compat_mlton.sml @@ -0,0 +1,21 @@ +(* HCoop Domtool (http://hcoop.sourceforge.net/) + * Copyright (c) 2006, 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. + *) + +structure Compat : COMPAT = struct + structure Char = MLRep.Char.Unsigned +end diff --git a/src/compat_smlnj.sml b/src/compat_smlnj.sml new file mode 100644 index 0000000..ff493be --- /dev/null +++ b/src/compat_smlnj.sml @@ -0,0 +1,21 @@ +(* HCoop Domtool (http://hcoop.sourceforge.net/) + * Copyright (c) 2006, 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. + *) + +structure Compat : COMPAT = struct + structure Char = Word32 +end diff --git a/src/main-server.sml b/src/main-server.sml new file mode 100644 index 0000000..696b6f6 --- /dev/null +++ b/src/main-server.sml @@ -0,0 +1,21 @@ +(* HCoop Domtool (http://hcoop.sourceforge.net/) + * Copyright (c) 2006, 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. + *) + +(* Driver for server *) + +val _ = Main.service () diff --git a/src/openssl.sml b/src/openssl.sml index 7a062f1..9ebb959 100644 --- a/src/openssl.sml +++ b/src/openssl.sml @@ -45,16 +45,16 @@ fun ssl_err s = else (print (ZString.toML lib); print ":"); - if C.Ptr.isNull func then - () - else - (print (ZString.toML func); - print ":"); - if C.Ptr.isNull reason then - () - else - print (ZString.toML reason); - print "\n" + if C.Ptr.isNull func then + () + else + (print (ZString.toML func); + print ":"); + if C.Ptr.isNull reason then + () + else + print (ZString.toML reason); + print "\n" end val readBuf : (C.uchar, C.rw) C.obj C.ptr' = C.alloc' C.S.uchar (Word.fromInt Config.bufSize) @@ -78,10 +78,12 @@ fun readChar bio = (ssl_err "BIO_read"; raise OpenSSL "BIO_read failed") else - SOME (chr (Word32.toInt (C.Get.uchar' - (C.Ptr.sub' C.S.uchar (readBuf, 0))))) + SOME (chr (Compat.Char.toInt (C.Get.uchar' + (C.Ptr.sub' C.S.uchar (readBuf, 0))))) end +val charToWord = Word32.fromLargeWord o Compat.Char.toLargeWord + fun readInt bio = let val r = F_OpenSSL_SML_read.f' (bio, C.Ptr.inject' readBuf, four) @@ -94,14 +96,14 @@ fun readInt bio = else SOME (Word32.toInt (Word32.+ - (C.Get.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 0)), + (charToWord (C.Get.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 0))), Word32.+ - (Word32.<< (C.Get.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 1)), + (Word32.<< (charToWord (C.Get.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 1))), eight), Word32.+ - (Word32.<< (C.Get.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 2)), + (Word32.<< (charToWord (C.Get.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 2))), sixteen), - Word32.<< (C.Get.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 3)), + Word32.<< (charToWord (C.Get.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 3))), twentyfour)))))) end @@ -131,8 +133,8 @@ fun readLen (bio, len) = raise OpenSSL "BIO_read failed") else if r = needed then SOME (CharVector.tabulate (Int32.toInt needed, - fn i => chr (Word32.toInt (C.Get.uchar' - (C.Ptr.sub' C.S.uchar (buf, i)))))) + fn i => chr (Compat.Char.toInt (C.Get.uchar' + (C.Ptr.sub' C.S.uchar (buf, i)))))) else loop (C.Ptr.|+! C.S.uchar (buf', Int32.toInt r), needed - r) end @@ -152,8 +154,8 @@ fun readChunk bio = raise OpenSSL "BIO_read failed") else SOME (CharVector.tabulate (Int32.toInt r, - fn i => chr (Word32.toInt (C.Get.uchar' - (C.Ptr.sub' C.S.uchar (readBuf, i)))))) + fn i => chr (Compat.Char.toInt (C.Get.uchar' + (C.Ptr.sub' C.S.uchar (readBuf, i)))))) end fun readString bio = @@ -164,7 +166,7 @@ fun readString bio = fun writeChar (bio, ch) = let val _ = C.Set.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 0), - Word32.fromInt (ord ch)) + Compat.Char.fromInt (ord ch)) fun trier () = let @@ -182,18 +184,20 @@ fun writeChar (bio, ch) = trier () end +val wordToChar = Compat.Char.fromLargeWord o Word32.toLargeWord + fun writeInt (bio, n) = let val w = Word32.fromInt n val _ = (C.Set.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 0), - Word32.andb (w, mask1)); + wordToChar (Word32.andb (w, mask1))); C.Set.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 1), - Word32.andb (Word32.>> (w, eight), mask1)); + wordToChar (Word32.andb (Word32.>> (w, eight), mask1))); C.Set.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 2), - Word32.andb (Word32.>> (w, sixteen), mask1)); + wordToChar (Word32.andb (Word32.>> (w, sixteen), mask1))); C.Set.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 3), - Word32.andb (Word32.>> (w, twentyfour), mask1))) + wordToChar (Word32.andb (Word32.>> (w, twentyfour), mask1)))) fun trier (buf, count) = let diff --git a/src/prefix.cm b/src/prefix.cm new file mode 100644 index 0000000..79ba23d --- /dev/null +++ b/src/prefix.cm @@ -0,0 +1,14 @@ +Group is + +$/basis.cm +$/smlnj-lib.cm +$/ml-yacc-lib.cm +$/html-lib.cm +$/pp-lib.cm +$c/internals/c-int.cm + +../openssl/smlnj/FFI/libssl.h.cm + +compat.sig +compat_smlnj.sml + diff --git a/src/prefix.mlb b/src/prefix.mlb new file mode 100644 index 0000000..11c92f7 --- /dev/null +++ b/src/prefix.mlb @@ -0,0 +1,13 @@ +$(SML_LIB)/basis/basis.mlb +$(SML_LIB)/basis/unsafe.mlb +$(SML_LIB)/smlnj-lib/Util/smlnj-lib.mlb +$(SML_LIB)/mlyacc-lib/mlyacc-lib.mlb +$(SML_LIB)/smlnj-lib/HTML/html-lib.mlb +$(SML_LIB)/smlnj-lib/PP/pp-lib.mlb +$(SML_LIB)/mlnlffi-lib/internals/c-int.mlb + +../openssl/mlton/FFI/libssl.h.mlb + +compat.sig +compat_mlton.sml + diff --git a/src/domtool.cm b/src/sources similarity index 85% rename from src/domtool.cm rename to src/sources index f23f86d..0c03c35 100644 --- a/src/domtool.cm +++ b/src/sources @@ -1,14 +1,3 @@ -Group is - -$/basis.cm -$/smlnj-lib.cm -$/ml-yacc-lib.cm -$/html-lib.cm -$/pp-lib.cm -$c/internals/c-int.cm - -../openssl/smlnj/FFI/libssl.h.cm - errormsg.sig errormsg.sml @@ -21,8 +10,8 @@ ast.sml ../config.sml -domtool.lex domtool.grm +domtool.lex parse.sig parse.sml @@ -54,6 +43,9 @@ slave.sml defaults.sig defaults.sml +openssl.sig +openssl.sml + msgTypes.sml msg.sig msg.sml @@ -82,9 +74,6 @@ plugins/mailman.sml order.sig order.sml -openssl.sig -openssl.sml - htmlPrint.sig htmlPrint.sml diff --git a/src/suffix.mlb b/src/suffix.mlb new file mode 100644 index 0000000..e69de29 -- 2.20.1