Rmuser
authorAdam Chlipala <adamc@hcoop.net>
Sat, 16 Dec 2006 18:53:44 +0000 (18:53 +0000)
committerAdam Chlipala <adamc@hcoop.net>
Sat, 16 Dec 2006 18:53:44 +0000 (18:53 +0000)
src/acl.sig
src/acl.sml
src/domain.sig
src/domain.sml
src/main-admin.sml
src/main.sig
src/main.sml
src/msg.sml
src/msgTypes.sml

index 10abcde..846b331 100644 (file)
@@ -43,6 +43,11 @@ signature ACL = sig
     val revoke : acl -> unit
     (* Grant/ungrant the user the permission. *)
 
     val revoke : acl -> unit
     (* Grant/ungrant the user the permission. *)
 
+    val revokeFromAll : {class : string, value : string} -> unit
+
+    val rmuser : string -> unit
+    (* Remove all of a user's privileges. *)
+
     val read : string -> unit
     val write : string -> unit
     (* Read/write saved ACL state from/to a file *)
     val read : string -> unit
     val write : string -> unit
     (* Read/write saved ACL state from/to a file *)
index be30fdf..135e555 100644 (file)
@@ -64,6 +64,10 @@ fun class {user, class} =
            NONE => SS.empty
          | SOME values => values
 
            NONE => SS.empty
          | SOME values => values
 
+fun rmuser user =
+    (acl := #1 (SM.remove (!acl, user)))
+    handle NotFound => ()
+
 fun grant {user, class, value} =
     let
        val classes = Option.getOpt (SM.find (!acl, user), SM.empty)
 fun grant {user, class, value} =
     let
        val classes = Option.getOpt (SM.find (!acl, user), SM.empty)
@@ -89,6 +93,14 @@ fun revoke {user, class, value} =
                                     values))
     end
 
                                     values))
     end
 
+fun revokeFromAll {class, value} =
+    acl := SM.map (fn classes =>
+                     case SM.find (classes, class) of
+                         NONE => classes
+                       | SOME values =>
+                         ((SM.insert (classes, class, SS.delete (values, value)))
+                          handle NotFound => classes)) (!acl)
+
 fun read fname =
     let
        val inf = TextIO.openIn fname
 fun read fname =
     let
        val inf = TextIO.openIn fname
index a937624..642c0f4 100644 (file)
@@ -74,5 +74,5 @@ signature DOMAIN = sig
 
     val hasPriv : string -> bool
 
 
     val hasPriv : string -> bool
 
-    val rmdom : string -> unit
+    val rmdom : string list -> unit
 end
 end
index ca2f993..04ee532 100644 (file)
@@ -654,56 +654,70 @@ val _ = Env.type_one "mail_node"
            orelse (hasPriv "mail"
                    andalso List.exists (fn x => x = node) Config.mailNodes_admin))
 
            orelse (hasPriv "mail"
                    andalso List.exists (fn x => x = node) Config.mailNodes_admin))
 
-fun rmdom dom =
+fun rmdom doms =
     let
     let
-       val domPath = String.concatWith "/" (rev (String.fields (fn ch => ch = #".") dom))
-
        fun doNode (node, _) =
            let
                val dname = OS.Path.joinDirFile {dir = Config.resultRoot,
                                                 file = node}
        fun doNode (node, _) =
            let
                val dname = OS.Path.joinDirFile {dir = Config.resultRoot,
                                                 file = node}
-               val dname = OS.Path.concat (dname, domPath)
 
 
-               fun visitDom (dom, dname, actions) =
+               fun doDom (dom, actions) =
                    let
                    let
-                       val dir = Posix.FileSys.opendir dname
-
-                       fun loop actions =
-                           case Posix.FileSys.readdir dir of
-                               NONE => actions
-                             | SOME fname =>
-                               let
-                                   val fnameFull = OS.Path.joinDirFile {dir = dname,
-                                                                        file = fname}
-                               in
-                                   if Posix.FileSys.ST.isDir (Posix.FileSys.stat fnameFull) then
-                                       loop (visitDom (fname ^ "." ^ dom,
-                                                       fnameFull,
-                                                       actions))
-                                   else                                                        
-                                       loop ({action = Slave.Delete,
-                                              domain = dom,
-                                              dir = dname,
-                                              file = fnameFull} :: actions)
-                               end
+                       val domPath = String.concatWith "/" (rev (String.fields (fn ch => ch = #".") dom))
+                       val dname = OS.Path.concat (dname, domPath)
+
+                       fun visitDom (dom, dname, actions) =
+                           let
+                               val dir = Posix.FileSys.opendir dname
+
+                               fun loop actions =
+                                   case Posix.FileSys.readdir dir of
+                                       NONE => actions
+                                     | SOME fname =>
+                                       let
+                                           val fnameFull = OS.Path.joinDirFile {dir = dname,
+                                                                                file = fname}
+                                       in
+                                           if Posix.FileSys.ST.isDir (Posix.FileSys.stat fnameFull) then
+                                               loop (visitDom (fname ^ "." ^ dom,
+                                                               fnameFull,
+                                                               actions))
+                                           else                                                        
+                                               loop ({action = Slave.Delete,
+                                                      domain = dom,
+                                                      dir = dname,
+                                                      file = fnameFull} :: actions)
+                                       end
+                           in
+                               loop actions
+                               before Posix.FileSys.closedir dir
+                           end
+                               handle OS.SysErr _ =>
+                                      (print ("Warning: System error deleteing domain " ^ dom ^ " on " ^ node ^ ".\n");
+                                       actions)
                    in
                    in
-                       loop actions
-                       before Posix.FileSys.closedir dir
+                       visitDom (dom, dname, actions)
                    end
 
                    end
 
-               val actions = visitDom (dom, dname, [])
+               val actions = foldl doDom [] doms
            in
                handleSite (node, actions)
            end
            in
                handleSite (node, actions)
            end
-               handle IO.Io _ => print ("Warning: IO error deleting domain " ^ dom ^ " on " ^ node ^ ".\n")
+               handle IO.Io _ => print ("Warning: IO error deleting domains on " ^ node ^ ".\n")
 
        fun cleanupNode (node, _) =
            let
 
        fun cleanupNode (node, _) =
            let
-               val dname = OS.Path.joinDirFile {dir = Config.resultRoot,
-                                                file = node}
-               val dname = OS.Path.concat (dname, domPath)
+               fun doDom dom =
+                   let
+                       val domPath = String.concatWith "/" (rev (String.fields (fn ch => ch = #".") dom))
+                       val dname = OS.Path.joinDirFile {dir = Config.resultRoot,
+                                                        file = node}
+                       val dname = OS.Path.concat (dname, domPath)
+                   in
+                       ignore (OS.Process.system (Config.rm ^ " -rf " ^ dname))
+                   end
            in
            in
-               ignore (OS.Process.system (Config.rm ^ " -rf " ^ dname))
+               app doDom doms
            end
     in
        app doNode Config.nodeIps;
            end
     in
        app doNode Config.nodeIps;
index 2931ae6..7305822 100644 (file)
@@ -41,6 +41,6 @@ val _ =
             (print ("whohas " ^ class ^ " / " ^ value ^ ":");
              app (fn user => print (" " ^ user)) users;
              print "\n"))
             (print ("whohas " ^ class ^ " / " ^ value ^ ":");
              app (fn user => print (" " ^ user)) users;
              print "\n"))
-      | ["rmdom", dom] => Main.requestRmdom dom
+      | "rmdom" :: doms => Main.requestRmdom doms
       | ["regen"] => Main.requestRegen ()
       | _ => print "Invalid command-line arguments\n"
       | ["regen"] => Main.requestRegen ()
       | _ => print "Invalid command-line arguments\n"
index c086bd5..791b357 100644 (file)
@@ -38,8 +38,9 @@ signature MAIN = sig
     val requestRevoke : Acl.acl -> unit
     val requestListPerms : string -> (string * string list) list option
     val requestWhoHas : {class : string, value : string} -> string list option
     val requestRevoke : Acl.acl -> unit
     val requestListPerms : string -> (string * string list) list option
     val requestWhoHas : {class : string, value : string} -> string list option
-    val requestRmdom : string -> unit
+    val requestRmdom : string list -> unit
     val requestRegen : unit -> unit
     val requestRegen : unit -> unit
+    val requestRmuser : string -> unit
 
     val service : unit -> unit
     val slave : unit -> unit
 
     val service : unit -> unit
     val slave : unit -> unit
index f22c430..997713d 100644 (file)
@@ -371,6 +371,21 @@ fun requestRmdom dom =
        OpenSSL.close bio
     end
 
        OpenSSL.close bio
     end
 
+fun requestRmuser user =
+    let
+       val (_, bio) = requestBio (fn () => ())
+    in
+       Msg.send (bio, MsgRmuser user);
+       case Msg.recv bio of
+           NONE => print "Server closed connection unexpectedly.\n"
+         | SOME m =>
+           case m of
+               MsgOk => print "Removal succeeded.\n"
+             | MsgError s => print ("Removal failed: " ^ s ^ "\n")
+             | _ => print "Unexpected server reply.\n";
+       OpenSSL.close bio
+    end
+
 fun regenerate context =
     let
        val b = basis ()
 fun regenerate context =
     let
        val b = basis ()
@@ -439,6 +454,18 @@ fun regenerate context =
        Env.post ()
     end
 
        Env.post ()
     end
 
+fun rmuser user =
+    let
+       val doms = Acl.class {user = user, class = "domain"}
+       val doms = List.filter (fn dom =>
+                                  case Acl.whoHas {class = "domain", value = dom} of
+                                      [_] => true
+                                    | _ => false) (StringSet.listItems doms)
+    in
+       Acl.rmuser user;
+       Domain.rmdom doms
+    end
+
 fun service () =
     let
        val () = Acl.read Config.aclFile
 fun service () =
     let
        val () = Acl.read Config.aclFile
@@ -583,12 +610,15 @@ fun service () =
                                handle OpenSSL.OpenSSL _ => ();
                                loop ())
 
                                handle OpenSSL.OpenSSL _ => ();
                                loop ())
 
-                             | MsgRmdom dom =>
+                             | MsgRmdom doms =>
                                if Acl.query {user = user, class = "priv", value = "all"}
                                if Acl.query {user = user, class = "priv", value = "all"}
-                                  orelse Acl.query {user = user, class = "domain", value = dom} then
-                                   ((Domain.rmdom dom;
+                                  orelse List.all (fn dom => Acl.query {user = user, class = "domain", value = dom}) doms then
+                                   ((Domain.rmdom doms;
+                                     app (fn dom =>
+                                             Acl.revokeFromAll {class = "domain", value = dom}) doms;
+                                     Acl.write Config.aclFile;
                                      Msg.send (bio, MsgOk);
                                      Msg.send (bio, MsgOk);
-                                     print ("Removed domain " ^ dom ^ ".\n"))
+                                     print ("Removed domains" ^ foldl (fn (d, s) => s ^ " " ^ d) "" doms ^ ".\n"))
                                     handle OpenSSL.OpenSSL s =>
                                            (print "OpenSSL error\n";
                                             Msg.send (bio,
                                     handle OpenSSL.OpenSSL s =>
                                            (print "OpenSSL error\n";
                                             Msg.send (bio,
@@ -629,6 +659,30 @@ fun service () =
                                      ignore (OpenSSL.readChar bio);
                                      OpenSSL.close bio)
                                     handle OpenSSL.OpenSSL _ => ();
                                      ignore (OpenSSL.readChar bio);
                                      OpenSSL.close bio)
                                     handle OpenSSL.OpenSSL _ => ();
+                                    loop ())
+
+                             | MsgRmuser user =>
+                               if Acl.query {user = user, class = "priv", value = "all"} then
+                                   ((rmuser user;
+                                     Acl.write Config.aclFile;
+                                     Msg.send (bio, MsgOk);
+                                     print ("Removed user " ^ user ^ ".\n"))
+                                    handle OpenSSL.OpenSSL s =>
+                                           (print "OpenSSL error\n";
+                                            Msg.send (bio,
+                                                      MsgError
+                                                          ("Error during revocation: "
+                                                           ^ s)));
+                                   (ignore (OpenSSL.readChar bio);
+                                    OpenSSL.close bio)
+                                   handle OpenSSL.OpenSSL _ => ();
+                                   loop ())
+                               else
+                                   ((Msg.send (bio, MsgError "Not authorized to remove users");
+                                     print "Unauthorized user asked to remove a user!\n";
+                                     ignore (OpenSSL.readChar bio);
+                                     OpenSSL.close bio)
+                                    handle OpenSSL.OpenSSL _ => ();
                                     loop ())                           
 
                              | _ =>
                                     loop ())                           
 
                              | _ =>
index bb6a2b1..251626a 100644 (file)
@@ -93,9 +93,11 @@ fun send (bio, m) =
                                    sendList OpenSSL.writeString (bio, users))
       | MsgMultiConfig codes => (OpenSSL.writeInt (bio, 12);
                                 sendList OpenSSL.writeString (bio, codes))
                                    sendList OpenSSL.writeString (bio, users))
       | MsgMultiConfig codes => (OpenSSL.writeInt (bio, 12);
                                 sendList OpenSSL.writeString (bio, codes))
-      | MsgRmdom dom => (OpenSSL.writeInt (bio, 13);
-                        OpenSSL.writeString (bio, dom))
+      | MsgRmdom doms => (OpenSSL.writeInt (bio, 13);
+                         sendList OpenSSL.writeString (bio, doms))
       | MsgRegenerate => OpenSSL.writeInt (bio, 14)
       | MsgRegenerate => OpenSSL.writeInt (bio, 14)
+      | MsgRmuser dom => (OpenSSL.writeInt (bio, 15);
+                         OpenSSL.writeString (bio, dom))
 
 fun checkIt v =
     case v of
 
 fun checkIt v =
     case v of
@@ -143,8 +145,9 @@ fun recv bio =
                           (recvList OpenSSL.readString bio)
                   | 12 => Option.map MsgMultiConfig
                           (recvList OpenSSL.readString bio)
                           (recvList OpenSSL.readString bio)
                   | 12 => Option.map MsgMultiConfig
                           (recvList OpenSSL.readString bio)
-                  | 13 => Option.map MsgRmdom (OpenSSL.readString bio)
+                  | 13 => Option.map MsgRmdom (recvList OpenSSL.readString bio)
                   | 14 => SOME MsgRegenerate
                   | 14 => SOME MsgRegenerate
+                  | 15 => Option.map MsgRmuser (OpenSSL.readString bio)
                   | _ => NONE)
         
 end
                   | _ => NONE)
         
 end
index 89ab255..44f4178 100644 (file)
@@ -46,10 +46,13 @@ datatype msg =
        (* These are the users! *)
        | MsgMultiConfig of string list
        (* Multiple Domtool sources in dependency order *)
        (* These are the users! *)
        | MsgMultiConfig of string list
        (* Multiple Domtool sources in dependency order *)
-       | MsgRmdom of string
-       (* Remove all configuration associated with a domain and revoke rights
-       * to that domain from all users. *)
+       | MsgRmdom of string list
+       (* Remove all configuration associated with some domains and revoke
+       * rights to those domains from all users. *)
        | MsgRegenerate
        (* Make a clean slate of it and reprocess all configuration from scratch. *)
        | MsgRegenerate
        (* Make a clean slate of it and reprocess all configuration from scratch. *)
+       | MsgRmuser of string
+       (* Remove all ACL entries for a user, and remove all domains to which
+       * that user and no one else has rights. *)
 
 end
 
 end