(* 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
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"
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} =
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;
end
val () = registerDescriber (considerAll [Filename {filename = "soa",
- heading = "DNS SOA"}])
+ heading = "DNS SOA",
+ showEmpty = false}])
end
| ["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")
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
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 =
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"))
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
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
(* 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
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
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
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
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
HCoop / hcoop / domtool2.git / commitdiff