Privilege setting code

diff --git a/Makefile b/Makefile
index b81232c..4dd594b 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -5,7 +5,7 @@ COMMON_DEPS := configDefault/config.sig configDefault/configDefault.sml \
 
 .PHONY: all mlton smlnj install
 
 
 .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
 
 
 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
 
        $(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*" \
 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-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/
 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-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
 
 
 .PHONY: grab_lib
 

diff --git a/bin/.cvsignore b/bin/.cvsignore
index 1f7b05a..27134a3 100644 (file)
--- a/bin/.cvsignore
+++ b/bin/.cvsignore
@@ -1,3 +1,4 @@
 domtool-server
 domtool-client
 domtool-slave
 domtool-server
 domtool-client
 domtool-slave

+domtool-admin

diff --git a/src/.cvsignore b/src/.cvsignore
index ab70953..29f6762 100644 (file)
--- a/src/.cvsignore
+++ b/src/.cvsignore
@@ -5,3 +5,4 @@ domtool.cm
 domtool-server.mlb
 domtool-client.mlb
 domtool-slave.mlb
 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 (file)
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 (file)
--- a/src/main.sig
+++ b/src/main.sig
@@ -31,6 +31,8 @@ signature MAIN = sig
     val eval : string -> unit
 
     val request : string -> unit
     val eval : string -> unit
 
     val request : string -> unit

+    val requestGrant : Acl.acl -> unit
+

     val service : unit -> unit
     val slave : unit -> unit
 
     val service : unit -> unit
     val slave : unit -> unit
 

diff --git a/src/main.sml b/src/main.sml
index 2aa3da7..e0e85ba 100644 (file)
--- a/src/main.sml
+++ b/src/main.sml
@@ -125,24 +125,33 @@ fun eval fname =
 val dispatcher =
     Config.dispatcher ^ ":" ^ Int.toString Config.dispatcherPort
 
 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)
     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 () = 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)
 
        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
 
 
        val inf = TextIO.openIn fname
 


@@ -166,6 +175,21 @@ fun request fname =
     end
     handle ErrorMsg.Error => ()
 
     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
 fun service () =
     let
        val () = Acl.read Config.aclFile


@@ -216,12 +240,35 @@ fun service () =
                                                      MsgError
                                                          ("Error during configuration evaluation: "
                                                           ^ s)));
                                                      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
                                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 _ => ();
                              | _ =>
                                (Msg.send (bio, MsgError "Unexpected command")
                                 handle OpenSSL.OpenSSL _ => ();

diff --git a/src/msg.sml b/src/msg.sml
index 4dcc3ff..43b6386 100644 (file)
--- 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"
 
           | 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)
 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)
         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
 
 fun checkIt v =
     case v of


@@ -70,6 +82,9 @@ fun recv bio =
                                              file = file})
                             | _ => NONE)
                   | 5 => SOME MsgDoFiles
                                              file = file})
                             | _ => NONE)
                   | 5 => SOME MsgDoFiles

+                  | 6 => (case recvAcl bio of
+                              SOME acl => SOME (MsgGrant acl)
+                            | _ => NONE)

                   | _ => NONE)
         
 end
                   | _ => NONE)
         
 end

diff --git a/src/msgTypes.sml b/src/msgTypes.sml
index 1dfe16e..e89fc9d 100644 (file)
--- 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. *)
        (* 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
 
 end