This commit was manufactured by cvs2svn to create branch 'moogle'.

[helm.git] / helm / DEVEL / profile-manager / profile.ml

diff --git a/helm/DEVEL/profile-manager/profile.ml b/helm/DEVEL/profile-manager/profile.ml
deleted file mode 100644 (file)
index 9c19b3c..0000000
--- 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 := ("  <field id=\"" ^ (Response.quote_attribute field) ^ "\">" ^ (Response.quote value) ^ "</field>\n")::!sl)
-      data ;
-    List.fold_left (^) "" !sl
-  in
-  "<profile id=\"" ^ profile.id ^
-  "\" read=\"" ^ (string_of_access profile.read_access) ^
-  "\" write=\"" ^ (string_of_access profile.write_access) ^
-  "\" profile=\"" ^ (string_of_access profile.profile_access) ^
-  "\">\n" ^ (if with_data then serialize_data profile.data else "") ^ "</profile>"
-
-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 ()