From 08a04eb413e8ee58ee35affc5c4125b622ea75c4 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Thu, 14 Dec 2006 23:05:36 +0000 Subject: [PATCH] Listing permissions --- src/acl.sig | 3 +++ src/acl.sml | 7 +++++++ src/main-admin.sml | 12 ++++++++++++ src/main.sig | 1 + src/main.sml | 32 ++++++++++++++++++++++++++++++++ src/msg.sml | 38 ++++++++++++++++++++++++++++++++++++++ src/msgTypes.sml | 5 +++++ 7 files changed, 98 insertions(+) diff --git a/src/acl.sig b/src/acl.sig index d815cad..fc72ab6 100644 --- a/src/acl.sig +++ b/src/acl.sig @@ -27,6 +27,9 @@ signature ACL = sig 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? *) diff --git a/src/acl.sml b/src/acl.sml index d0b41fe..0adfb4b 100644 --- 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) +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 diff --git a/src/main-admin.sml b/src/main-admin.sml index b4ba422..f79d44e 100644 --- a/src/main-admin.sml +++ b/src/main-admin.sml @@ -18,8 +18,20 @@ (* 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} + | ["perms", user] => requestPerms user + | ["perms"] => requestPerms (Posix.SysDB.Passwd.name (Posix.SysDB.getpwuid (Posix.ProcEnv.getuid ()))) | _ => print "Invalid command-line arguments\n" diff --git a/src/main.sig b/src/main.sig index ee5915a..88e0a65 100644 --- 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 requestListPerms : string -> (string * string list) list option val service : unit -> unit val slave : unit -> unit diff --git a/src/main.sml b/src/main.sml index 9204159..03d5877 100644 --- a/src/main.sml +++ b/src/main.sml @@ -205,6 +205,24 @@ fun requestRevoke acl = 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 @@ -310,6 +328,20 @@ fun service () = 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 _ => (); diff --git a/src/msg.sml b/src/msg.sml index 5569355..f2c4d72 100644 --- 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)) + | 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 @@ -90,6 +101,33 @@ fun recv bio = | 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 diff --git a/src/msgTypes.sml b/src/msgTypes.sml index a5fe2f7..4ee4cbc 100644 --- a/src/msgTypes.sml +++ b/src/msgTypes.sml @@ -35,5 +35,10 @@ datatype msg = (* 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 -- 2.20.1