whohas

diff --git a/src/acl.sig b/src/acl.sig
index fc72ab6..2ac1f19 100644 (file)
--- a/src/acl.sig
+++ b/src/acl.sig
@@ -30,6 +30,9 @@ signature ACL = sig
     val queryAll : string -> (string * string list) list
     (* What are all of a user's permissions, by class? *)
 
+    val whoHas : {class : string, value : string} -> string list
+    (* Which users have a permission? *)
+
     val class : {user : string, class : string} -> DataStructures.StringSet.set
     (* For what objects does the user have the permission? *)
 

diff --git a/src/acl.sml b/src/acl.sml
index 0adfb4b..e57f186 100644 (file)
--- a/src/acl.sml
+++ b/src/acl.sml
@@ -44,6 +44,16 @@ fun queryAll user =
                                      (class, SS.foldr (op::) [] values) :: out)
                                  [] classes
 
+fun whoHas {class, value} =
+    SM.foldri (fn (user, classes, users) =>
+                 case SM.find (classes, class) of
+                     NONE => users
+                   | SOME values =>
+                     if SS.member (values, value) then
+                         user :: users
+                     else
+                         users) [] (!acl)
+
 fun class {user, class} =
     case SM.find (!acl, user) of
        NONE => SS.empty

diff --git a/src/main-admin.sml b/src/main-admin.sml
index f79d44e..b318002 100644 (file)
--- a/src/main-admin.sml
+++ b/src/main-admin.sml
@@ -34,4 +34,11 @@ val _ =
       | ["revoke", user, class, value] => Main.requestRevoke {user = user, class = class, value = value}
       | ["perms", user] => requestPerms user
       | ["perms"] => requestPerms (Posix.SysDB.Passwd.name (Posix.SysDB.getpwuid (Posix.ProcEnv.getuid ())))
+      | ["whohas", class, value] =>
+       (case Main.requestWhoHas {class = class, value = value} of
+            NONE => ()
+          | SOME users =>
+            (print ("whohas " ^ class ^ " / " ^ value ^ ":");
+             app (fn user => print (" " ^ user)) users;
+             print "\n"))
       | _ => print "Invalid command-line arguments\n"

diff --git a/src/main.sig b/src/main.sig
index 88e0a65..9e6dda3 100644 (file)
--- a/src/main.sig
+++ b/src/main.sig
@@ -34,6 +34,7 @@ signature MAIN = sig
     val requestGrant : Acl.acl -> unit
     val requestRevoke : Acl.acl -> unit
     val requestListPerms : string -> (string * string list) list option
+    val requestWhoHas : {class : string, value : string} -> string list option
 
     val service : unit -> unit
     val slave : unit -> unit

diff --git a/src/main.sml b/src/main.sml
index 03d5877..9f06c5b 100644 (file)
--- a/src/main.sml
+++ b/src/main.sml
@@ -223,6 +223,24 @@ fun requestListPerms user =
        before OpenSSL.close bio
     end
 
+fun requestWhoHas perm =
+    let
+       val (_, bio) = requestBio (fn () => ())
+    in
+       Msg.send (bio, MsgWhoHas perm);
+       (case Msg.recv bio of
+            NONE => (print "Server closed connection unexpectedly.\n";
+                     NONE)
+          | SOME m =>
+            case m of
+                MsgWhoHasResponse users => SOME users
+              | MsgError s => (print ("whohas failed: " ^ s ^ "\n");
+                               NONE)
+              | _ => (print "Unexpected server reply.\n";
+                      NONE))
+       before OpenSSL.close bio
+    end
+
 fun service () =
     let
        val () = Acl.read Config.aclFile
@@ -342,6 +360,20 @@ fun service () =
                                handle OpenSSL.OpenSSL _ => ();
                                loop ())
 
+                             | MsgWhoHas perm =>
+                               ((Msg.send (bio, MsgWhoHasResponse (Acl.whoHas perm));
+                                 print ("Sent whohas response for " ^ #class perm ^ " / " ^ #value perm ^ ".\n"))
+                                handle OpenSSL.OpenSSL s =>
+                                       (print "OpenSSL error\n";
+                                        Msg.send (bio,
+                                                  MsgError
+                                                      ("Error during whohas: "
+                                                       ^ s)));
+                               (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 f2c4d72..faced87 100644 (file)
--- a/src/msg.sml
+++ b/src/msg.sml
@@ -70,6 +70,14 @@ fun send (bio, m) =
                                               OpenSSL.writeString (bio, value))) values;
                                      OpenSSL.writeInt (bio, 0))) classes;
                             OpenSSL.writeInt (bio, 0))
+      | MsgWhoHas {class, value} => (OpenSSL.writeInt (bio, 10);
+                                    OpenSSL.writeString (bio, class);
+                                    OpenSSL.writeString (bio, value))
+      | MsgWhoHasResponse users => (OpenSSL.writeInt (bio, 11);
+                                   app (fn user =>
+                                           (OpenSSL.writeInt (bio, 1);
+                                            OpenSSL.writeString (bio, user))) users;
+                                   OpenSSL.writeInt (bio, 0))
 
 fun checkIt v =
     case v of
@@ -128,6 +136,21 @@ fun recv bio =
                     in
                         loop []
                     end
+                  | 10 => (case (OpenSSL.readString bio, OpenSSL.readString bio) of
+                               (SOME class, SOME value) => SOME (MsgWhoHas {class = class, value = value})
+                             | _ => NONE)
+                  | 11 => let
+                        fun loop users =
+                            case OpenSSL.readInt bio of
+                                SOME 0 => SOME (MsgWhoHasResponse (rev users))
+                              | SOME 1 =>
+                                (case OpenSSL.readString bio of
+                                     SOME user => loop (user :: users)
+                                   | NONE => NONE)
+                              | _ => NONE
+                    in
+                        loop []
+                    end
                   | _ => NONE)
         
 end

diff --git a/src/msgTypes.sml b/src/msgTypes.sml
index 4ee4cbc..97c9745 100644 (file)
--- a/src/msgTypes.sml
+++ b/src/msgTypes.sml
@@ -40,5 +40,10 @@ datatype msg =
        | MsgPerms of (string * string list) list
        (* A response to MsgListPerms, giving a permission class and all values
        * for which the user is authorized in that class *)
+       | MsgWhoHas of {class : string, value : string}
+       (* Which users have this permission? *)
+       | MsgWhoHasResponse of string list
+       (* These are the users! *)
+
 
 end