Listing permissions

diff --git a/src/acl.sig b/src/acl.sig
index d815cad..fc72ab6 100644 (file)
--- a/src/acl.sig
+++ b/src/acl.sig
@@ -27,6 +27,9 @@ signature ACL = sig
     val query : acl -> bool
     (* Is this permission granted? *)
 
     val query : acl -> bool
     (* Is this permission granted? *)
 

+    val queryAll : string -> (string * string list) list
+    (* What are all of a user's permissions, by class? *)
+

     val class : {user : string, class : string} -> DataStructures.StringSet.set
     (* For what objects does the user have the 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 d0b41fe..0adfb4b 100644 (file)
--- a/src/acl.sml
+++ b/src/acl.sml
@@ -37,6 +37,13 @@ fun query {user, class, value} =
            NONE => false
          | SOME values => SS.member (values, value)
 
            NONE => false
          | SOME values => SS.member (values, value)
 

+fun queryAll user =
+    case SM.find (!acl, user) of
+       NONE => []
+      | SOME classes => SM.foldri (fn (class, values, out) =>
+                                     (class, SS.foldr (op::) [] values) :: out)
+                                 [] classes
+

 fun class {user, class} =
     case SM.find (!acl, user) of
        NONE => SS.empty
 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 b4ba422..f79d44e 100644 (file)
--- a/src/main-admin.sml
+++ b/src/main-admin.sml
@@ -18,8 +18,20 @@
 
 (* Driver for server *)
 
 
 (* Driver for server *)
 

+fun requestPerms user =
+    case Main.requestListPerms user of
+       NONE => ()
+      | SOME classes =>
+       (print ("Permissions for " ^ user ^ ":\n");
+        app (fn (class, values) =>
+                (print (class ^ ":");
+                 app (fn value => print (" " ^ value)) values;
+                 print "\n")) classes)
+

 val _ =
     case CommandLine.arguments () of
        ["grant", user, class, value] => Main.requestGrant {user = user, class = class, value = value}
       | ["revoke", user, class, value] => Main.requestRevoke {user = user, class = class, value = value}
 val _ =
     case CommandLine.arguments () of
        ["grant", user, class, value] => Main.requestGrant {user = user, class = class, value = value}
       | ["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 ())))

       | _ => print "Invalid command-line arguments\n"
       | _ => print "Invalid command-line arguments\n"

diff --git a/src/main.sig b/src/main.sig
index ee5915a..88e0a65 100644 (file)
--- a/src/main.sig
+++ b/src/main.sig
@@ -33,6 +33,7 @@ signature MAIN = sig
     val request : string -> unit
     val requestGrant : Acl.acl -> unit
     val requestRevoke : Acl.acl -> unit
     val request : string -> unit
     val requestGrant : Acl.acl -> unit
     val requestRevoke : Acl.acl -> unit

+    val requestListPerms : string -> (string * string list) list option

 
     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 9204159..03d5877 100644 (file)
--- a/src/main.sml
+++ b/src/main.sml
@@ -205,6 +205,24 @@ fun requestRevoke acl =
        OpenSSL.close bio
     end
 
        OpenSSL.close bio
     end
 

+fun requestListPerms user =
+    let
+       val (_, bio) = requestBio (fn () => ())
+    in
+       Msg.send (bio, MsgListPerms user);
+       (case Msg.recv bio of
+            NONE => (print "Server closed connection unexpectedly.\n";
+                     NONE)
+          | SOME m =>
+            case m of
+                MsgPerms perms => SOME perms
+              | MsgError s => (print ("Listing failed: " ^ s ^ "\n");
+                               NONE)
+              | _ => (print "Unexpected server reply.\n";
+                      NONE))
+       before OpenSSL.close bio
+    end
+

 fun service () =
     let
        val () = Acl.read Config.aclFile
 fun service () =
     let
        val () = Acl.read Config.aclFile


@@ -310,6 +328,20 @@ fun service () =
                                     handle OpenSSL.OpenSSL _ => ();
                                     loop ())
 
                                     handle OpenSSL.OpenSSL _ => ();
                                     loop ())
 

+                             | MsgListPerms user =>
+                               ((Msg.send (bio, MsgPerms (Acl.queryAll user));
+                                 print ("Sent permission list for user " ^ user ^ ".\n"))
+                                handle OpenSSL.OpenSSL s =>
+                                       (print "OpenSSL error\n";
+                                        Msg.send (bio,
+                                                  MsgError
+                                                      ("Error during permission listing: "
+                                                       ^ s)));
+                               (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 5569355..f2c4d72 100644 (file)
--- a/src/msg.sml
+++ b/src/msg.sml
@@ -59,6 +59,17 @@ fun send (bio, m) =
                         sendAcl (bio, acl))
       | MsgRevoke acl => (OpenSSL.writeInt (bio, 7);
                          sendAcl (bio, acl))
                         sendAcl (bio, acl))
       | MsgRevoke acl => (OpenSSL.writeInt (bio, 7);
                          sendAcl (bio, acl))

+      | MsgListPerms user => (OpenSSL.writeInt (bio, 8);
+                             OpenSSL.writeString (bio, user))
+      | MsgPerms classes => (OpenSSL.writeInt (bio, 9);
+                            app (fn (class, values) =>
+                                    (OpenSSL.writeInt (bio, 1);
+                                     OpenSSL.writeString (bio, class);
+                                     app (fn value =>
+                                             (OpenSSL.writeInt (bio, 1);
+                                              OpenSSL.writeString (bio, value))) values;
+                                     OpenSSL.writeInt (bio, 0))) classes;
+                            OpenSSL.writeInt (bio, 0))

 
 fun checkIt v =
     case v of
 
 fun checkIt v =
     case v of


@@ -90,6 +101,33 @@ fun recv bio =
                   | 7 => (case recvAcl bio of
                               SOME acl => SOME (MsgRevoke acl)
                             | _ => NONE)
                   | 7 => (case recvAcl bio of
                               SOME acl => SOME (MsgRevoke acl)
                             | _ => NONE)

+                  | 8 => (case OpenSSL.readString bio of
+                              SOME user => SOME (MsgListPerms user)
+                            | _ => NONE)
+                  | 9 => let
+                        fun loop classes =
+                            case OpenSSL.readInt bio of
+                                SOME 0 => SOME (MsgPerms (rev classes))
+                              | SOME 1 =>
+                                (case OpenSSL.readString bio of
+                                     SOME class =>
+                                     let
+                                         fun loop' values =
+                                             case OpenSSL.readInt bio of
+                                                 SOME 0 => loop ((class, rev values) :: classes)
+                                               | SOME 1 =>
+                                                 (case OpenSSL.readString bio of
+                                                      SOME value => loop' (value :: values)
+                                                    | NONE => NONE)
+                                               | _ => NONE
+                                     in
+                                         loop' []
+                                     end
+                                   | NONE => NONE)
+                              | _ => NONE
+                    in
+                        loop []
+                    end

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

diff --git a/src/msgTypes.sml b/src/msgTypes.sml
index a5fe2f7..4ee4cbc 100644 (file)
--- a/src/msgTypes.sml
+++ b/src/msgTypes.sml
@@ -35,5 +35,10 @@ datatype msg =
        (* Grant a permission *)
        | MsgRevoke of Acl.acl
        (* Revoke a permission *)
        (* Grant a permission *)
        | MsgRevoke of Acl.acl
        (* Revoke a permission *)

+       | MsgListPerms of string
+       (* List all of a user's permissions *)
+       | 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 *)

 
 end
 
 end