From 5ee41dd039e304ae374a5f1265e32839204f14ff Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Thu, 14 Dec 2006 22:23:10 +0000 Subject: [PATCH] Privilege setting code --- Makefile | 10 ++++++- bin/.cvsignore | 1 + src/.cvsignore | 1 + src/main-admin.sml | 24 +++++++++++++++ src/main.sig | 2 ++ src/main.sml | 73 +++++++++++++++++++++++++++++++++++++--------- src/msg.sml | 15 ++++++++++ src/msgTypes.sml | 2 ++ 8 files changed, 114 insertions(+), 14 deletions(-) create mode 100644 src/main-admin.sml diff --git a/Makefile b/Makefile index b81232c..4dd594b 100644 --- a/Makefile +++ b/Makefile @@ -5,7 +5,7 @@ COMMON_DEPS := configDefault/config.sig configDefault/configDefault.sml \ .PHONY: all mlton smlnj install -mlton: bin/domtool-server bin/domtool-client bin/domtool-slave +mlton: bin/domtool-server bin/domtool-client bin/domtool-slave bin/domtool-admin smlnj: $(COMMON_DEPS) openssl/smlnj/FFI/libssl.h.cm src/domtool.cm @@ -52,6 +52,10 @@ src/domtool-slave.mlb: Makefile src/prefix.mlb src/sources src/suffix.mlb $(MAKE_MLB_BASE) >src/domtool-slave.mlb echo "main-slave.sml" >>src/domtool-slave.mlb +src/domtool-admin.mlb: Makefile src/prefix.mlb src/sources src/suffix.mlb + $(MAKE_MLB_BASE) >src/domtool-admin.mlb + echo "main-admin.sml" >>src/domtool-admin.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*" \ @@ -83,6 +87,9 @@ bin/domtool-client: $(COMMON_MLTON_DEPS) src/domtool-client.mlb bin/domtool-slave: $(COMMON_MLTON_DEPS) src/domtool-slave.mlb mlton -output bin/domtool-slave -link-opt -ldl src/domtool-slave.mlb +bin/domtool-admin: $(COMMON_MLTON_DEPS) src/domtool-admin.mlb + mlton -output bin/domtool-admin -link-opt -ldl src/domtool-admin.mlb + install: cp scripts/domtool-publish /usr/local/sbin/ cp scripts/domtool-reset-global /usr/local/sbin/ @@ -91,6 +98,7 @@ install: cp bin/domtool-server /usr/local/sbin/ cp bin/domtool-slave /usr/local/sbin/ cp bin/domtool-client /usr/local/bin/domtool + cp bin/domtool-admin /usr/local/bin/ .PHONY: grab_lib diff --git a/bin/.cvsignore b/bin/.cvsignore index 1f7b05a..27134a3 100644 --- a/bin/.cvsignore +++ b/bin/.cvsignore @@ -1,3 +1,4 @@ domtool-server domtool-client domtool-slave +domtool-admin diff --git a/src/.cvsignore b/src/.cvsignore index ab70953..29f6762 100644 --- a/src/.cvsignore +++ b/src/.cvsignore @@ -5,3 +5,4 @@ domtool.cm domtool-server.mlb domtool-client.mlb domtool-slave.mlb +domtool-admin.mlb diff --git a/src/main-admin.sml b/src/main-admin.sml new file mode 100644 index 0000000..c04a7d9 --- /dev/null +++ b/src/main-admin.sml @@ -0,0 +1,24 @@ +(* 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 _ = + case CommandLine.arguments () of + ["grant", user, class, value] => Main.requestGrant {user = user, class = class, value = value} + | _ => print "Invalid command-line arguments\n" diff --git a/src/main.sig b/src/main.sig index d4467eb..ee6df59 100644 --- a/src/main.sig +++ b/src/main.sig @@ -31,6 +31,8 @@ signature MAIN = sig val eval : string -> unit val request : string -> unit + val requestGrant : Acl.acl -> unit + val service : unit -> unit val slave : unit -> unit diff --git a/src/main.sml b/src/main.sml index 2aa3da7..e0e85ba 100644 --- a/src/main.sml +++ b/src/main.sml @@ -125,24 +125,33 @@ fun eval fname = val dispatcher = Config.dispatcher ^ ":" ^ Int.toString Config.dispatcherPort -fun request fname = +fun requestContext f = let val uid = Posix.ProcEnv.getuid () val user = Posix.SysDB.Passwd.name (Posix.SysDB.getpwuid uid) - + val () = Acl.read Config.aclFile val () = Domain.setUser user - - val _ = check fname - - val uid = Posix.ProcEnv.getuid () - val user = Posix.SysDB.Passwd.name (Posix.SysDB.getpwuid uid) + + val () = f () val context = OpenSSL.context (Config.certDir ^ "/" ^ user ^ ".pem", Config.keyDir ^ "/" ^ user ^ "/key.pem", Config.trustStore) + in + (user, context) + end - val bio = OpenSSL.connect (context, dispatcher) +fun requestBio f = + let + val (user, context) = requestContext f + in + (user, OpenSSL.connect (context, dispatcher)) + end + +fun request fname = + let + val (user, bio) = requestBio (fn () => ignore (check fname)) val inf = TextIO.openIn fname @@ -166,6 +175,21 @@ fun request fname = end handle ErrorMsg.Error => () +fun requestGrant acl = + let + val (user, bio) = requestBio (fn () => ()) + in + Msg.send (bio, MsgGrant acl); + case Msg.recv bio of + NONE => print "Server closed connection unexpectedly.\n" + | SOME m => + case m of + MsgOk => print "Grant succeeded.\n" + | MsgError s => print ("Grant failed: " ^ s ^ "\n") + | _ => print "Unexpected server reply.\n"; + OpenSSL.close bio + end + fun service () = let val () = Acl.read Config.aclFile @@ -216,12 +240,35 @@ fun service () = MsgError ("Error during configuration evaluation: " ^ s))); - OS.FileSys.remove outname; - (ignore (OpenSSL.readChar bio); - OpenSSL.close bio) - handle OpenSSL.OpenSSL _ => (); - loop () + OS.FileSys.remove outname; + (ignore (OpenSSL.readChar bio); + OpenSSL.close bio) + handle OpenSSL.OpenSSL _ => (); + loop () end + + | MsgGrant acl => + if Acl.query {user = user, class = "group", value = "root"} then + ((Acl.grant acl; + Acl.write Config.aclFile; + Msg.send (bio, MsgOk)) + handle OpenSSL.OpenSSL s => + (print "OpenSSL error\n"; + Msg.send (bio, + MsgError + ("Error during granting: " + ^ s))); + (ignore (OpenSSL.readChar bio); + OpenSSL.close bio) + handle OpenSSL.OpenSSL _ => (); + loop ()) + else + ((Msg.send (bio, MsgError "Not authorized to grant privileges"); + ignore (OpenSSL.readChar bio); + OpenSSL.close bio) + handle OpenSSL.OpenSSL _ => (); + loop ()) + | _ => (Msg.send (bio, MsgError "Unexpected command") handle OpenSSL.OpenSSL _ => (); diff --git a/src/msg.sml b/src/msg.sml index 4dcc3ff..43b6386 100644 --- a/src/msg.sml +++ b/src/msg.sml @@ -31,6 +31,16 @@ val i2a = fn 0 => Add | 2 => Modify | _ => raise OpenSSL.OpenSSL "Bad action number to deserialize" +fun sendAcl (bio, {user, class, value}) = + (OpenSSL.writeString (bio, user); + OpenSSL.writeString (bio, class); + OpenSSL.writeString (bio, value)) + +fun recvAcl bio = + case (OpenSSL.readString bio, OpenSSL.readString bio, OpenSSL.readString bio) of + (SOME user, SOME class, SOME value) => SOME {user = user, class = class, value = value} + | _ => NONE + fun send (bio, m) = case m of MsgOk => OpenSSL.writeInt (bio, 1) @@ -45,6 +55,8 @@ fun send (bio, m) = OpenSSL.writeString (bio, dir); OpenSSL.writeString (bio, file)) | MsgDoFiles => OpenSSL.writeInt (bio, 5) + | MsgGrant acl => (OpenSSL.writeInt (bio, 6); + sendAcl (bio, acl)) fun checkIt v = case v of @@ -70,6 +82,9 @@ fun recv bio = file = file}) | _ => NONE) | 5 => SOME MsgDoFiles + | 6 => (case recvAcl bio of + SOME acl => SOME (MsgGrant acl) + | _ => NONE) | _ => NONE) end diff --git a/src/msgTypes.sml b/src/msgTypes.sml index 1dfe16e..e89fc9d 100644 --- a/src/msgTypes.sml +++ b/src/msgTypes.sml @@ -31,5 +31,7 @@ datatype msg = (* The status of a configuration file has changed. *) | MsgDoFiles (* Perform the actions associated with the MsgFiles sent previously. *) + | MsgGrant of Acl.acl + (* Grant a new permission *) end -- 2.20.1