X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2FDEVEL%2Fprofile-manager%2Fprofile.ml;fp=helm%2FDEVEL%2Fprofile-manager%2Fprofile.ml;h=0000000000000000000000000000000000000000;hb=1696761e4b8576e8ed81caa905fd108717019226;hp=9c19b3c9d9820e892971bcb0d14ff81742075271;hpb=5325734bc2e4927ed7ec146e35a6f0f2b49f50c1;p=helm.git diff --git a/helm/DEVEL/profile-manager/profile.ml b/helm/DEVEL/profile-manager/profile.ml deleted file mode 100644 index 9c19b3c9d..000000000 --- a/helm/DEVEL/profile-manager/profile.ml +++ /dev/null @@ -1,119 +0,0 @@ - -exception Permission_denied -exception Invalid_access of string - -type access_t = - Allowed - | Denied - | Password - -let access_of_string old = - function - None -> old - | Some "allowed" -> Allowed - | Some "denied" -> Denied - | Some "password" -> Password - | Some s -> raise (Invalid_access s) - -let string_of_access = - function - Allowed -> "allowed" - | Denied -> "denied" - | Password -> "password" - -type t = - { id : string; - mutable password : string; - mutable read_access : access_t; - mutable write_access : access_t; - mutable profile_access : access_t; - data : (string, string) Hashtbl.t; - } - -let serialize profile with_data = - let serialize_data data = - let sl = ref [] in - Hashtbl.iter - (fun field value -> - sl := (" " ^ (Response.quote value) ^ "\n")::!sl) - data ; - List.fold_left (^) "" !sl - in - "\n" ^ (if with_data then serialize_data profile.data else "") ^ "" - -let create key pwd = - let access, pwd' = - match pwd with - Some s -> Password, s - | None -> Allowed, "" - in - let profile = - { id = key; - password = pwd'; - read_access = access; - write_access = access; - profile_access = access; - data = Hashtbl.create 11 - } - in - profile - -let test_read_access profile pwd = - match pwd, profile.read_access with - Some s, Password when s = profile.password -> () - | None, Password when profile.password = "" -> () - | _, Allowed -> () - | _ -> raise Permission_denied - -let test_write_access profile pwd = - match pwd, profile.write_access with - Some s, Password when s = profile.password -> () - | None, Password when profile.password = "" -> () - | _, Allowed -> () - | _ -> raise Permission_denied - -let test_profile_access profile pwd = - match pwd, profile.profile_access with - Some s, Password when s = profile.password -> () - | None, Password when profile.password = "" -> () - | _, Allowed -> () - | _ -> raise Permission_denied - -let get profile pwd = - test_read_access profile pwd ; - serialize profile true - -let set profile field value pwd = - test_write_access profile pwd ; - begin - match value with - Some value' -> Hashtbl.replace profile.data field value' - | None -> Hashtbl.remove profile.data field - end ; - Response.ok () - -let del profile pwd = - test_profile_access profile pwd ; - Response.ok () - -let set_password profile new_pwd pwd = - test_profile_access profile pwd ; - let new_pwd' = - match new_pwd with - Some s -> s - | None -> "" - in - prerr_endline ("old " ^ profile.password ^ " new " ^ new_pwd') ; - profile.password <- new_pwd' ; - Response.ok () - -let set_access profile read_access write_access profile_access pwd = - test_profile_access profile pwd ; - profile.read_access <- access_of_string profile.read_access read_access ; - profile.write_access <- access_of_string profile.write_access write_access ; - profile.profile_access <- access_of_string profile.profile_access profile_access ; - Response.ok ()