From 094877b11a71011cc7af7dc1b5a6b853b4985c6d Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adamc@hcoop.net>
Date: Thu, 14 Dec 2006 23:19:05 +0000
Subject: [PATCH] whohas

---
 src/acl.sig        |  3 +++
 src/acl.sml        | 10 ++++++++++
 src/main-admin.sml |  7 +++++++
 src/main.sig       |  1 +
 src/main.sml       | 32 ++++++++++++++++++++++++++++++++
 src/msg.sml        | 23 +++++++++++++++++++++++
 src/msgTypes.sml   |  5 +++++
 7 files changed, 81 insertions(+)

diff --git a/src/acl.sig b/src/acl.sig
index fc72ab6..2ac1f19 100644
--- 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
--- 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
--- 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
--- 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
--- 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
--- 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
--- 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
-- 
2.20.1