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 ()