From: Adam Chlipala Date: Sat, 17 Nov 2007 15:43:25 +0000 (+0000) Subject: Move domain decription to client side; add some more describers X-Git-Tag: release_2010-11-19~145 X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/commitdiff_plain/41c58dafe735d17b7d3241bf248ca8806a355926 Move domain decription to client side; add some more describers --- diff --git a/src/domain.sig b/src/domain.sig index bdf92de..b30f3ec 100644 --- a/src/domain.sig +++ b/src/domain.sig @@ -105,7 +105,7 @@ signature DOMAIN = sig (* Argument is domain to describe, over all nodes. *) datatype description = - Filename of { filename : string, heading : string } + Filename of { filename : string, heading : string, showEmpty : bool } | Extension of { extension : string, heading : string -> string } val considerAll : description list -> subject -> string diff --git a/src/domain.sml b/src/domain.sml index 67ff449..969d957 100644 --- a/src/domain.sml +++ b/src/domain.sml @@ -796,7 +796,7 @@ val describers : (subject -> string) list ref = ref [] fun registerDescriber f = describers := f :: !describers -fun describeOne arg = String.concat (map (fn f => f arg) (!describers)) +fun describeOne arg = String.concat (map (fn f => f arg) (rev (!describers))) val line = "-------------------------------\n" val dline = "===============================\n" @@ -811,7 +811,7 @@ fun describe dom = nodes) datatype description = - Filename of { filename : string, heading : string} + Filename of { filename : string, heading : string, showEmpty : bool } | Extension of { extension : string, heading : string -> string } fun considerAll ds {node, domain} = @@ -832,44 +832,47 @@ fun considerAll ds {node, domain} = case Posix.FileSys.readdir dir of NONE => () | SOME fname => - let - fun readFile entries = - let - val fname = OS.Path.joinDirFile {dir = path, - file = fname} - - val inf = TextIO.openIn fname - - fun loop entries = - case TextIO.inputLine inf of - NONE => entries - | SOME line => loop (line :: entries) - in - loop entries - before TextIO.closeIn inf - end - in - app (fn (d, entries) => - case d of - Filename {filename, heading} => - if fname = filename then - entries := "\n" :: readFile ("\n" :: line :: ":\n" :: heading :: line :: !entries) - else - () - | Extension {extension, heading} => - let - val {base, ext} = OS.Path.splitBaseExt fname - in - case ext of - NONE => () - | SOME extension' => - if extension' = extension then - entries := "\n" :: readFile ("\n" :: line :: ":\n" :: heading base :: line :: !entries) - else - () - end) ds; - loop () - end + (app (fn (d, entries) => + let + fun readFile showEmpty entries' = + let + val fname = OS.Path.joinDirFile {dir = path, + file = fname} + + val inf = TextIO.openIn fname + + fun loop (seenOne, entries') = + case TextIO.inputLine inf of + NONE => if seenOne orelse showEmpty then + "\n" :: entries' + else + !entries + | SOME line => loop (true, line :: entries') + in + loop (false, entries') + before TextIO.closeIn inf + end + in + case d of + Filename {filename, heading, showEmpty} => + if fname = filename then + entries := readFile showEmpty ("\n" :: line :: ":\n" :: heading :: line :: !entries) + else + () + | Extension {extension, heading} => + let + val {base, ext} = OS.Path.splitBaseExt fname + in + case ext of + NONE => () + | SOME extension' => + if extension' = extension then + entries := readFile true ("\n" :: line :: ":\n" :: heading base :: line :: !entries) + else + () + end + end) ds; + loop ()) in loop (); Posix.FileSys.closedir dir; @@ -880,6 +883,7 @@ fun considerAll ds {node, domain} = end val () = registerDescriber (considerAll [Filename {filename = "soa", - heading = "DNS SOA"}]) + heading = "DNS SOA", + showEmpty = false}]) end diff --git a/src/main-admin.sml b/src/main-admin.sml index 459db6d..dbc4074 100644 --- a/src/main-admin.sml +++ b/src/main-admin.sml @@ -55,7 +55,7 @@ val _ = | ["tpe", node, uname] => OS.Process.exit (Main.requestTrustedPath {node = node, uname = uname}) | ["sockperm", node, uname] => OS.Process.exit (Main.requestSocketPerm {node = node, uname = uname}) | ["firewall", node, uname] => OS.Process.exit (Main.requestFirewall {node = node, uname = uname}) - | ["describe", dom] => Main.requestDescribe dom + | ["describe", dom] => print (Domain.describe dom) | _ => (print "Invalid command-line arguments\n"; print "See the documentation: http://wiki.hcoop.net/wiki/DomTool/AdminProcedures\n")) handle OpenSSL.OpenSSL s => print ("OpenSSL exception: " ^ s ^ "\n") diff --git a/src/main.sig b/src/main.sig index 53f019d..55ad560 100644 --- a/src/main.sig +++ b/src/main.sig @@ -45,7 +45,6 @@ signature MAIN = sig val requestRegen : unit -> unit val requestRegenTc : unit -> unit val requestRmuser : string -> unit - val requestDescribe : string -> unit val requestSlavePing : unit -> OS.Process.status val requestSlaveShutdown : unit -> unit diff --git a/src/main.sml b/src/main.sml index ec795e3..15a5853 100644 --- a/src/main.sml +++ b/src/main.sml @@ -873,21 +873,6 @@ fun requestFirewall {node, uname} = before OpenSSL.close bio end -fun requestDescribe dom = - let - val (_, bio) = requestBio (fn () => ()) - in - Msg.send (bio, MsgDescribe dom); - case Msg.recv bio of - NONE => print "Server closed connection unexpectedly.\n" - | SOME m => - case m of - MsgDescription s => print s - | MsgError s => print ("Describe failed: " ^ s ^ "\n") - | _ => print "Unexpected server reply.\n"; - OpenSSL.close bio - end - fun regenerateEither tc checker context = let fun ifReal f = @@ -1432,16 +1417,6 @@ fun service () = SOME "Script execution failed.")) (fn () => ()) - | MsgDescribe dom => - doIt (fn () => (if Domain.validDomain dom then - (Msg.send (bio, MsgDescription (Domain.describe dom)); - ("Requested description of domain " ^ dom, - NONE)) - else - ("Requested description of invalid domain " ^ dom, - SOME "Invalid domain name"))) - (fn () => ()) - | _ => doIt (fn () => ("Unexpected command", SOME "Unexpected command")) diff --git a/src/msg.sml b/src/msg.sml index 5940bbe..91cc78a 100644 --- a/src/msg.sml +++ b/src/msg.sml @@ -229,10 +229,6 @@ fun send (bio, m) = OpenSSL.writeString (bio, dbtype); OpenSSL.writeString (bio, dbname)) | MsgMysqlFixperms => OpenSSL.writeInt (bio, 38) - | MsgDescribe dom => (OpenSSL.writeInt (bio, 39); - OpenSSL.writeString (bio, dom)) - | MsgDescription s => (OpenSSL.writeInt (bio, 40); - OpenSSL.writeString (bio, s)) fun checkIt v = case v of @@ -343,8 +339,6 @@ fun recv bio = SOME (MsgGrantDb {dbtype = dbtype, dbname = dbname}) | _ => NONE) | 38 => SOME MsgMysqlFixperms - | 39 => Option.map MsgDescribe (OpenSSL.readString bio) - | 40 => Option.map MsgDescription (OpenSSL.readString bio) | _ => NONE) end diff --git a/src/msgTypes.sml b/src/msgTypes.sml index 034e26a..25c3592 100644 --- a/src/msgTypes.sml +++ b/src/msgTypes.sml @@ -120,9 +120,5 @@ datatype msg = (* Grant all allowed privileges on a DBMS database to the user *) | MsgMysqlFixperms (* Run the script to grant DROP privileges on MySQL tables to owning users *) - | MsgDescribe of string - (* Ask for a listing of all of a domain's real configuration *) - | MsgDescription of string - (* Reply to MsgDescribe *) end diff --git a/src/plugins/apache.sml b/src/plugins/apache.sml index 64ebc7b..5e7e1f9 100644 --- a/src/plugins/apache.sml +++ b/src/plugins/apache.sml @@ -890,4 +890,10 @@ val () = Env.action_two "setEnv" val () = Domain.registerResetLocal (fn () => ignore (OS.Process.system (Config.rm ^ " -rf /var/domtool/vhosts/*"))) +val () = Domain.registerDescriber (Domain.considerAll + [Domain.Extension {extension = "vhost", + heading = fn host => "Web vhost: " ^ host}, + Domain.Extension {extension = "vhost_ssl", + heading = fn host => "SSL web vhost: " ^ host}]) + end diff --git a/src/plugins/bind.sml b/src/plugins/bind.sml index 5f37520..46ecbc3 100644 --- a/src/plugins/bind.sml +++ b/src/plugins/bind.sml @@ -282,4 +282,12 @@ val () = Slave.registerPostHandler val () = Domain.registerResetLocal (fn () => ignore (OS.Process.system (Config.rm ^ " -rf /var/domtool/zones/*"))) +val () = Domain.registerDescriber (Domain.considerAll + [Domain.Filename {filename = "named.conf", + heading = "named.conf addition", + showEmpty = false}, + Domain.Filename {filename = "dns", + heading = "DNS zonefile contents", + showEmpty = false}]) + end diff --git a/src/plugins/exim.sml b/src/plugins/exim.sml index 461fab1..f4943ac 100644 --- a/src/plugins/exim.sml +++ b/src/plugins/exim.sml @@ -100,4 +100,18 @@ val () = Env.actionV_none "relayMail" name = "mail.relay"}) ()) nodes end) +val () = Domain.registerDescriber (Domain.considerAll + [Domain.Filename {filename = "aliases", + heading = "E-mail aliases", + showEmpty = false}, + Domain.Filename {filename = "aliases.default", + heading = "Default e-mail alias", + showEmpty = false}, + Domain.Filename {filename = "mail", + heading = "E-mail handling", + showEmpty = false}, + Domain.Filename {filename = "mail.relay", + heading = "E-mail relaying", + showEmpty = false}]) + end diff --git a/src/sources b/src/sources index eece575..4e4a836 100644 --- a/src/sources +++ b/src/sources @@ -67,15 +67,15 @@ msg.sml domain.sig domain.sml +plugins/bind.sig +plugins/bind.sml + plugins/alias.sig plugins/alias.sml plugins/exim.sig plugins/exim.sml -plugins/bind.sig -plugins/bind.sml - plugins/apache.sig plugins/apache.sml