X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=matitaB%2Fmatita%2FmatitaAuthentication.ml;h=5669658513a13f1d0e03748abbca6157585c9b1c;hb=54f0752c831479f87d61afcdfdafd2a35edb4053;hp=77aeed15f599c24f73d476b71e81aad45cc593d3;hpb=93ad0bc98a502397b5ba0334c0f7088da045fa2d;p=helm.git diff --git a/matitaB/matita/matitaAuthentication.ml b/matitaB/matita/matitaAuthentication.ml index 77aeed15f..566965851 100644 --- a/matitaB/matita/matitaAuthentication.ml +++ b/matitaB/matita/matitaAuthentication.ml @@ -25,6 +25,8 @@ type session_id = Uuidm.t +type matita_file = MatitaFilesystem.matita_flag * string + (* user table: user id, (password, optional session id) *) type user = string * (string * session_id option) @@ -115,13 +117,47 @@ let deserialize () = session_tbl := []; ;; +let write_ft uid ft = + let ft_ch = open_out (config_path () ^ "/ft_" ^ uid ^ ".dump") in + Marshal.to_channel ft_ch ft []; + close_out ft_ch; +;; + +let read_ft uid = + try + let ft_ch = open_in (config_path () ^ "/ft_" ^ uid ^ ".dump") in + let ft = Marshal.from_channel ft_ch in + close_in ft_ch; + ft + with + | Sys_error _ -> + (* this is an error, we should rebuild the table by a diff of + the directory listing and svn stat *) + [] +;; + +let set_file_flag uid filename flag = + let ft = read_ft uid in + let oldflag = + try List.assoc filename ft + with Not_found -> MatitaFilesystem.MSynchronized + in + if oldflag <> MatitaFilesystem.MConflict + then + let ft = (filename,flag):: + List.filter (fun (fn,_) -> fn <> filename) ft in + write_ft uid ft + else () +;; + let add_user uid pw = try let _ = lookup_user uid in raise (UsernameCollision uid) with Not_found -> - MatitaFilesystem.checkout uid; + let ft = MatitaFilesystem.checkout uid in user_tbl := (uid,(pw,None))::!user_tbl; + write_ft uid ft; serialize () ;;