structure Compat : COMPAT = struct
structure Char = MLRep.Char.Unsigned
end
+
+val _ = let
+ open MLton.Signal
+in
+ setHandler (Posix.Signal.pipe, Handler.ignore)
+end
| ["slave-shutdown"] => Main.requestSlaveShutdown ()
| ["slave-ping"] => OS.Process.exit (Main.requestSlavePing ())
| ["package", node, pkg] => OS.Process.exit (Main.requestApt {node = node, pkg = pkg})
+ | ["cron", node, uname] => OS.Process.exit (Main.requestCron {node = node, uname = uname})
+ | ["ftp", node, uname] => OS.Process.exit (Main.requestFtp {node = node, uname = uname})
| _ => print "Invalid command-line arguments\n"
val requestSmtpLog : string -> unit
val requestApt : {node : string, pkg : string} -> OS.Process.status
+ val requestCron : {node : string, uname : string} -> OS.Process.status
+ val requestFtp : {node : string, uname : string} -> OS.Process.status
end
before OpenSSL.close bio
end
+fun requestCron {node, uname} =
+ let
+ val (user, context) = requestContext (fn () => ())
+ val bio = OpenSSL.connect (context, if node = Config.masterNode then
+ dispatcher
+ else
+ Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
+
+ val _ = Msg.send (bio, MsgQuery (QCron uname))
+
+ fun loop () =
+ case Msg.recv bio of
+ NONE => (print "Server closed connection unexpectedly.\n";
+ OS.Process.failure)
+ | SOME m =>
+ case m of
+ MsgYes => (print "User has cron permissions.\n";
+ OS.Process.success)
+ | MsgNo => (print "User does not have cron permissions.\n";
+ OS.Process.failure)
+ | MsgError s => (print ("Cron query failed: " ^ s ^ "\n");
+ OS.Process.failure)
+ | _ => (print "Unexpected server reply.\n";
+ OS.Process.failure)
+ in
+ loop ()
+ before OpenSSL.close bio
+ end
+
+fun requestFtp {node, uname} =
+ let
+ val (user, context) = requestContext (fn () => ())
+ val bio = OpenSSL.connect (context, if node = Config.masterNode then
+ dispatcher
+ else
+ Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
+
+ val _ = Msg.send (bio, MsgQuery (QFtp uname))
+
+ fun loop () =
+ case Msg.recv bio of
+ NONE => (print "Server closed connection unexpectedly.\n";
+ OS.Process.failure)
+ | SOME m =>
+ case m of
+ MsgYes => (print "User has FTP permissions.\n";
+ OS.Process.success)
+ | MsgNo => (print "User does not have FTP permissions.\n";
+ OS.Process.failure)
+ | MsgError s => (print ("FTP query failed: " ^ s ^ "\n");
+ OS.Process.failure)
+ | _ => (print "Unexpected server reply.\n";
+ OS.Process.failure)
+ in
+ loop ()
+ before OpenSSL.close bio
+ end
+
fun regenerate context =
let
val b = basis ()
fun answerQuery q =
case q of
QApt pkg => if Apt.installed pkg then MsgYes else MsgNo
+ | QCron user => if Cron.allowed user then MsgYes else MsgNo
+ | QFtp user => if Ftp.allowed user then MsgYes else MsgNo
fun describeQuery q =
case q of
QApt pkg => "Requested installation status of package " ^ pkg
+ | QCron user => "Asked about cron permissions for user " ^ user
+ | QFtp user => "Asked about FTP permissions for user " ^ user
fun service () =
let
case q of
QApt s => (OpenSSL.writeInt (bio, 0);
OpenSSL.writeString (bio, s))
+ | QCron s => (OpenSSL.writeInt (bio, 1);
+ OpenSSL.writeString (bio, s))
+ | QFtp s => (OpenSSL.writeInt (bio, 2);
+ OpenSSL.writeString (bio, s))
fun recvQuery bio =
case OpenSSL.readInt bio of
SOME n =>
(case n of
0 => Option.map QApt (OpenSSL.readString bio)
+ | 1 => Option.map QCron (OpenSSL.readString bio)
+ | 2 => Option.map QFtp (OpenSSL.readString bio)
| _ => NONE)
| NONE => NONE
datatype query =
QApt of string
(* Is this apt package installed? *)
+ | QCron of string
+ (* Is this user allowed to use cron? *)
+ | QFtp of string
+ (* Is this user allowed to use FTP? *)
datatype msg =
MsgOk
--- /dev/null
+(* HCoop Domtool (http://hcoop.sourceforge.net/)
+ * Copyright (c) 2006-2007, 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.
+ *)
+
+(* Cron permissions querying *)
+
+signature CRON = sig
+
+ val allowed : string -> bool
+ (* Is the named user allowed to use cron here? *)
+
+end
--- /dev/null
+(* HCoop Domtool (http://hcoop.sourceforge.net/)
+ * Copyright (c) 2006-2007, 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.
+ *)
+
+(* Cron permissions querying *)
+
+structure Cron :> CRON = struct
+
+val allowed = Slave.lineInFile "/etc/cron.allow"
+
+end
--- /dev/null
+(* HCoop Domtool (http://hcoop.sourceforge.net/)
+ * Copyright (c) 2006-2007, 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.
+ *)
+
+(* FTP permissions querying *)
+
+signature FTP = sig
+
+ val allowed : string -> bool
+ (* Is the named user allowed to use FTP here? *)
+
+end
--- /dev/null
+(* HCoop Domtool (http://hcoop.sourceforge.net/)
+ * Copyright (c) 2006-2007, 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.
+ *)
+
+(* FTP permissions querying *)
+
+structure Ftp :> FTP = struct
+
+val allowed = Slave.lineInFile "/etc/ftpusers"
+
+end
../openssl/mlton/FFI/libssl.h.mlb
compat.sig
-compat_mlton.sml
+local
+ $(SML_LIB)/basis/mlton.mlb
+in
+ compat_mlton.sml
+end
val readList : string -> string list
val writeList : string * string list -> unit
(* Reading and writing lists of strings stored on separate lines in files *)
+
+ val lineInFile : string -> string -> bool
+ (* Is there a line in the file (first arg) that matches that given? *)
+
end
TextIO.closeOut outf
end
+fun lineInFile fname line =
+ let
+ val inf = TextIO.openIn fname
+ val line' = line ^ "\n"
+
+ fun loop () =
+ case TextIO.inputLine inf of
+ NONE => false
+ | SOME line => line = line' orelse loop ()
+ in
+ loop ()
+ before TextIO.closeIn inf
+ end handle IO.Io _ => false
+
end
plugins/apt.sig
plugins/apt.sml
+plugins/cron.sig
+plugins/cron.sml
+
+plugins/ftp.sig
+plugins/ftp.sml
+
mail/vmail.sig
mail/vmail.sml
HCoop / hcoop / domtool2.git / commitdiff