(*
 * Copyright (C) 2004:
 *    Stefano Zacchiroli <zack@cs.unibo.it>
 *    for the HELM Team http://helm.cs.unibo.it/
 *
 *  This file is part of HELM, an Hypertextual, Electronic
 *  Library of Mathematics, developed at the Computer Science
 *  Department, University of Bologna, Italy.
 *
 *  HELM is free software; you can redistribute it and/or
 *  modify it under the terms of the GNU General Public License
 *  as published by the Free Software Foundation; either version 2
 *  of the License, or (at your option) any later version.
 *
 *  HELM is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *  GNU General Public License for more details.
 *
 *  You should have received a copy of the GNU General Public License
 *  along with HELM; if not, write to the Free Software
 *  Foundation, Inc., 59 Temple Place - Suite 330, Boston,
 *  MA  02111-1307, USA.
 *
 *  For details, see the HELM World-Wide-Web page,
 *  http://helm.cs.unibo.it/
 *)

type profile_id = string

let profiles = "profiles"

let profile_key pid =
  profiles ^ "." ^ pid

let string_of_permission =
 function
   `Read -> "read"
  | `Write -> "write"
  | `Admin -> "admin"

let permission_key for_what pid =
 profile_key pid ^ ".permissions." ^ (string_of_permission for_what)

let read_permission_key = permission_key `Read
let write_permission_key = permission_key `Write
let admin_permission_key = permission_key `Admin

let password_key pid =
  profile_key pid ^ ".password"

let params_key pid =
  profile_key pid ^ ".params"

let param_key pid param =
  params_key pid ^ "." ^ param

exception Access_denied of string * profile_id
exception Profile_exists of profile_id
exception Impossible

let new_key () =
  let hex_of_nibble n =
    if n >= 0 && n < 10 then
      string_of_int n
    else if n >= 10 && n < 16 then
      String.make 1 (Char.chr (n - 10 + (Char.code 'A')))
    else
      raise Impossible
  in
  let rec aux s =
    function
        0 -> s
      | n -> aux ((hex_of_nibble (Random.int 16)) ^ s) (n - 1)
  in
  aux "" 4

let create_fresh_id =
  let rec aux () =
    let key = new_key () in
    if Helm_registry.has (read_permission_key key) then
      aux ()
    else
      key
  in
  aux

let list () = fst (Helm_registry.ls profiles)

let to_list_rel ~prefix () =
 List.map (fun (key,value) -> Pcre.replace ~pat:("^" ^ Pcre.quote (prefix ^ ".")) key, value)
  (Helm_registry.to_list ~prefix ())

let check_permission pid password for_what =
  match password, Helm_registry.get_bool (permission_key for_what pid) with
      None, true -> ()
    | Some pwd, false when Some pwd = Helm_registry.get_opt Helm_registry.get (password_key pid) -> ()
    | _ -> raise (Access_denied (string_of_permission for_what, pid))

let create ?id ?clone ?clone_password ?(read_perm=true) ?(write_perm=true) ?(admin_perm=true) ?password () =
  let pid =
    match id with
	None -> create_fresh_id ()
      | Some pid when Helm_registry.has (read_permission_key pid) -> raise (Profile_exists pid)
      | Some pid -> pid
  in
  let params = 
    match clone with
	None -> []
      | Some pid ->
	  check_permission pid clone_password `Read ;
	  to_list_rel ~prefix:(params_key pid) ()
  in
    List.iter (fun (key, value) -> Helm_registry.set_string key value) params ;
    Helm_registry.set_bool (read_permission_key pid) read_perm ;
    Helm_registry.set_bool (write_permission_key pid) write_perm ;
    Helm_registry.set_bool (admin_permission_key pid) admin_perm ;
    Helm_registry.set_opt Helm_registry.set_string (password_key pid) password ;
    pid

let remove pid ?password () =
  check_permission pid password `Admin ;
  List.iter (fun (key, _) -> Helm_registry.unset key) (Helm_registry.to_list ~prefix:(profile_key pid) ())

let get_params pid ?password () =
   check_permission pid password `Read ;
   to_list_rel ~prefix:(params_key pid) ()

let set_param pid ?password ~key ~value () =
  check_permission pid password `Write ;
  match value with
      Some value' -> Helm_registry.set (param_key pid key) value'
    | None -> Helm_registry.unset (param_key pid key)

let get_param pid ?password ~key () =
  check_permission pid password `Read ;
  Helm_registry.get (param_key pid key)

let set_password pid ?old_password new_password =
  check_permission pid old_password `Admin ;
  Helm_registry.set_opt Helm_registry.set (password_key pid) new_password

let set_permission pid ?password for_what value =
  check_permission pid password `Admin ;
  Helm_registry.set_bool (permission_key for_what pid) value

let get_permission pid ?password for_what = 
  check_permission pid password `Admin ;
  Helm_registry.get_bool (permission_key for_what pid)