[Limacute-commit] r57 - trunk/cybar
limacute at projects.linpro.no
limacute at projects.linpro.no
Tue Jan 9 12:40:45 CET 2007
Author: limacute
Date: 2007-01-09 12:40:44 +0100 (Tue, 09 Jan 2007)
New Revision: 57
Modified:
trunk/cybar/cybar.ml
Log:
Code review and testing resulted in several fixes related to
undelete, restore and recover, as sieve scripts are alse included.
Modified: trunk/cybar/cybar.ml
===================================================================
--- trunk/cybar/cybar.ml 2007-01-09 10:21:05 UTC (rev 56)
+++ trunk/cybar/cybar.ml 2007-01-09 11:40:44 UTC (rev 57)
@@ -42,7 +42,8 @@
val list_of_queue : 'a queue -> 'a list
exception Queue_is_empty
end;;
-module PriorityQueue = (
+
+module PriorityQueue : PriorityQueue =
struct
type priority = float
type 'a queue = Empty | Node of priority * 'a * 'a queue * 'a queue
@@ -87,11 +88,12 @@
collected
in
list_of_queue queue []
- end : PriorityQueue ) ;;
+ end
module type Utils =
sig
- exception Path_error of string ;;
+ exception Path_error of string
+ exception External_error of string
val file_copy_via : via:string option -> src:string -> dst:string -> int
val file_update : src:string -> dst:string -> int option
val link_update : src:string -> dst:string -> bool
@@ -102,9 +104,10 @@
val string_of_size : Big_int.big_int -> string
val speed : seconds : float -> name:string -> amount:float -> string
val string_of_signal : int -> string
+ val join : ?sep:string -> string list -> string
end
-module Utils = (
+module Utils : Utils =
struct
exception Path_error of string ;;
@@ -130,7 +133,7 @@
| None -> Unix.handle_unix_error (fun () -> file_copy ~src ~dst) () ;
| Some via -> begin
Unix.handle_unix_error (fun () -> file_copy ~src ~dst:(dst^via)) () ;
- Unix.rename ~src:(dst^via) ~dst ;
+ Unix.rename ~src:(dst^via) ~dst
end
end ;
!size
@@ -413,7 +416,19 @@
| _ -> "Unknown signal"
;;
- end : Utils )
+ let join ?sep l =
+ let sep = match sep with
+ | None -> ""
+ | Some sep -> sep
+ in
+ let rec cat l =
+ match l with
+ | [] -> ""
+ | (h::[]) -> h
+ | (h::t) -> h ^ sep ^ (cat t)
+ in
+ cat l
+ end
module type Statistics =
sig
@@ -427,7 +442,7 @@
val show : statistics:t -> unit
val start_time : statistics:t -> float
end
-module Statistics = (
+module Statistics : Statistics =
struct
type statistics = {
start_time:float;
@@ -498,7 +513,7 @@
in
print_endline message
;;
-end : Statistics )
+end
type user = {localpart:string;domain:string option} ;;
@@ -544,6 +559,7 @@
mutable progress:bool;
mutable imapd_conf:string;
mutable imapd_partitions:(string list);
+ mutable defaultpartition_path:string;
mutable sievedir:string;
mutable mbpath:string;
mutable backup_location:string;
@@ -571,6 +587,7 @@
progress=false;
imapd_conf="/kolab/etc/imapd/imapd.conf";
imapd_partitions=[];
+ defaultpartition_path="";
sievedir="/kolab/var/imapd/sieve";
mbpath="/kolab/bin/mbpath";
backup_location=List.fold_left Filename.concat "/backup" [Unix.gethostname ();"cybar"];
@@ -591,6 +608,42 @@
anyuser = false;
};;
+let string_of_action action =
+ match action with
+ | Backup -> "backup"
+ | Undelete user -> "undelete "^(show_user user)
+ | Restore user -> "restore "^(show_user user)
+ | Recover -> "recover"
+;;
+
+let string_of_options options =
+ ("{version:"^options.version)
+ ^(";verbose:"^(string_of_bool options.verbose))
+ ^(";progress:"^(string_of_bool options.progress))
+ ^(";imapd_conf:"^options.imapd_conf)
+ ^(";imapd_partitions:"^(Utils.join options.imapd_partitions))
+ ^(";defaultpartition_path:"^(options.defaultpartition_path))
+ ^(";sievedir:"^options.sievedir)
+ ^(";mbpath:"^options.mbpath)
+ ^(";backup_location:"^options.backup_location)
+ ^(";uidfilter: (string->bool)")
+ ^(";dry_run:"^(string_of_bool options.dry_run))
+ ^(";run:"^(string_of_bool options.run))
+ ^(";backup_age:"^(string_of_float options.backup_age))
+ ^(";virtdomains:"^(string_of_bool options.virtdomains))
+ ^(";hashimapspool:"^(string_of_bool options.hashimapspool))
+ ^(";fulldirhash:"^(string_of_bool options.fulldirhash))
+ ^(";estimated_users:"^(string_of_int options.estimated_users))
+ ^(";estimated_mail_per_dir:"^(string_of_int options.estimated_mail_per_dir))
+ ^(";action:"^(string_of_action options.action))
+ ^(";ctl_mboxlist:"^options.ctl_mboxlist)
+ ^(";cyrreconstruct:"^options.cyrreconstruct)
+ ^(";cyrquota:"^options.cyrquota)
+ ^(";hierarchysep:"^options.hierarchysep)
+ ^(";anyuser:"^(string_of_bool options.anyuser))
+ ^"}"
+;;
+
let verbose (message:string Lazy.t) =
if options.verbose
then print_endline (Lazy.force message)
@@ -627,20 +680,26 @@
let imapd_config = new ConfigParser.rawConfigParser in
let istrue name =
match imapd_config#get ~default:"0" "DEFAULT" name with
- "0" -> false
+ | "0" | "no" | "false" -> false
| _ -> true
in
- let rec findpartitions items =
- match items with
- [] -> ()
- | (name,partition)::items ->
- (if ExtString.String.starts_with name "partition-"
- then begin
- options.imapd_partitions<-partition::options.imapd_partitions ;
- verbose (lazy("Include partition " ^ name ^" in backup. Path is " ^
- partition^".")) ;
- end
- ) ; findpartitions items
+ let findpartitions items =
+ let defaultprefix = imapd_config#get ~default:"default" "DEFAULT" "defaultpartition" in
+ let rec findpartitions items =
+ match items with
+ | [] -> ()
+ | (name,partition)::items -> begin
+ if ExtString.String.starts_with name "partition-"
+ then begin
+ options.imapd_partitions<-partition::options.imapd_partitions ;
+ verbose (lazy("Include partition " ^ name ^" in backup. Path is " ^
+ partition^".")) ;
+ if ExtString.String.starts_with name ("partition-"^defaultprefix)
+ then options.defaultpartition_path<-partition
+ end
+ end ; findpartitions items
+ in
+ findpartitions items
in
let determine_spool_layout () =
begin
@@ -662,6 +721,7 @@
determine_spool_layout () ;
determine_hierarchysep () ;
determine_sievedir () ;
+ verbose (lazy (string_of_options options));
end
;;
@@ -753,16 +813,32 @@
"user"^options.hierarchysep^user.localpart^"*"^post
;;
+(** Locate the path to the users mailspool *)
let find_user_mailspool user =
let name = imap_name user in
let command = options.mbpath ^ " '"^name^"'" in
- let channel = Unix.open_process_in command in
- let mailspool = input_line channel in
- ignore(Unix.close_process_in channel) ;
- mailspool
+ verbose (lazy ("Running "^command)) ;
+ let (channel_stdout,channel_stdin,channel_stderr) =
+ let env = Array.make 0 "" in
+ Unix.open_process_full command env
+ in
+ let mailspool =
+ begin
+ try
+ input_line channel_stdout
+ with End_of_file -> begin
+ let error = input_line channel_stderr in
+ ignore(Unix.close_process_full (channel_stdout,channel_stdin,channel_stderr)) ;
+ raise (Utils.External_error error)
+ end
+ end
+ in
+ ignore(Unix.close_process_full (channel_stdout,channel_stdin,channel_stderr)) ;
+ mailspool
;;
exception Unsupported of string;;
+exception Impossible of string;;
let layout (user:user) : string =
let components =
@@ -788,7 +864,7 @@
| (false,false,false) -> ["user";user.localpart]
| _ -> raise (Unsupported "Unsupported spool layout")
in
- List.fold_left Filename.concat options.backup_location components
+ List.fold_left Filename.concat "" components
;;
(** Used when a required directory is missing *)
@@ -851,6 +927,7 @@
else for_each_user ~domain ~base ~localparts:contains ~collected
end
in
+ verbose (lazy("Traversing hash directory layer in "^base));
for_each_entry_in_subdir ~base ~sub:(Some "user") ~worker ~collected
end
else
@@ -868,6 +945,7 @@
[] -> collected
| (domain::domains) ->
begin
+ verbose (lazy("Found domain "^domain));
let base_domain = Filename.concat base domain in
let domain = Some domain in
let collected = enumerate_user ~domain ~base:base_domain ~collected
@@ -888,6 +966,7 @@
for_each_domain ~base ~domains:contains ~collected
end
in
+ verbose (lazy("Traversing hash directory layer in "^base));
for_each_entry_in_subdir ~base ~sub:None ~worker ~collected
else
begin
@@ -931,7 +1010,7 @@
in
let virtdomains = options.virtdomains in
let hashimapspool = true in
- let base = options.backup_location in
+ let base = Filename.concat options.backup_location "spool" in
let collected = PriorityQueue.empty in
let collected = enumerate_users ~virtdomains ~hashimapspool ~base ~collector ~collected in
try
@@ -981,7 +1060,7 @@
in
let virtdomains = options.virtdomains in
let hashimapspool = true in
- let base = options.backup_location in
+ let base = Filename.concat options.backup_location "spool" in
let collected = Hashtbl.create options.estimated_users in
enumerate_users ~virtdomains ~hashimapspool ~base ~collector ~collected
;;
@@ -991,7 +1070,7 @@
(** Rename deleted users in the backup.
* Also rename the sieve script catalog.
*)
-let rename_deleted_users (deleted_users:user list) =
+let rename_deleted_users ~statistics (deleted_users:user list) =
let stamp =
let now = Unix.time () in
let stamp = string_of_float now in
@@ -1004,7 +1083,10 @@
verbose (lazy("User "^(show_user deleted_user)^" deleted, renaming backup dir "^src^" to "^dst));
if options.dry_run
then verbose (lazy("Skipping rename of "^src))
- else Unix.rename ~src ~dst
+ else begin
+ Unix.rename ~src ~dst ;
+ Statistics.renamed ~statistics
+ end
end
in
let rename_sieve_backup_of_user deleted_user =
@@ -1014,7 +1096,10 @@
verbose (lazy("User "^(show_user deleted_user)^" deleted, renaming sieve backup dir "^src^" to "^dst));
if options.dry_run
then verbose (lazy("Skipping rename of "^src))
- else Unix.rename ~src ~dst
+ else begin
+ Unix.rename ~src ~dst ;
+ Statistics.renamed ~statistics
+ end
end
in
let rec rename_backup_of_users = function
@@ -1045,6 +1130,36 @@
end
;;
+let run ?input command =
+ let input =
+ match input with
+ | None -> Buffer.create 0
+ | Some input -> input
+ in
+ if options.dry_run
+ then
+ verbose (lazy begin
+ "Dry run, but would run \""^command^
+ "\"\nwith input"^
+ (Buffer.contents input)
+ end)
+ else
+ let writer out_channel = Buffer.output_buffer out_channel input in
+ begin
+ verbose (lazy begin
+ "Running \""^command^
+ "\"with input \""^
+ (Buffer.contents input)
+ ^"\""
+ end) ;
+ let (status,output) = Utils.run ~writer command in
+ verbose (lazy begin
+ "with output \""^output^
+ "\" and exit value "^(string_of_int status)
+ end)
+ end
+;;
+
module Sieve =
struct
type classification =
@@ -1432,12 +1547,8 @@
end
end
end
- | (Sieve.DefaultSymlink,Sieve.DefaultSymlink) ->
- begin
- end
- | (Sieve.DefaultSymlink,Sieve.Absent) ->
- begin
- end
+ | (Sieve.DefaultSymlink,Sieve.DefaultSymlink)
+ | (Sieve.DefaultSymlink,Sieve.Absent)
| (Sieve.Bytecode,Sieve.Bytecode)
| (Sieve.Bytecode,Sieve.Absent) ->
verbose (lazy("Doing nothing with source "^backup_from^":"^(Sieve.show source_classification)^
@@ -1509,7 +1620,7 @@
let rec enumerate_partitions ~partitions ~collected =
begin
match partitions with
- [] -> collected
+ | [] -> collected
| partition::partitions ->
begin
if not (Unixutil.isdir partition)
@@ -1526,13 +1637,21 @@
in
let find_users () =
begin
+ (* Find all users that are in the backup *)
let backed_up_users = find_backup_users () in
+ (* Find all users in the system that it is possible to back-up
+ * Also remove those users from the backed_up_users Hashtbl
+ * So now backed_up_users contains those users that are deleted
+ *)
let users_to_backup = find_source_users backed_up_users in
+ (* Put all users to be deleted in a new Hashtbl with different
+ * information
+ *)
let users_to_delete =
let users_to_delete = ref [] in
let collect_user key (priority,user) =
begin
- verbose (lazy("Considering what to do with the backup for non-existing user "^(show_user user)));
+ verbose (lazy("Identified deleted user "^(show_user user)));
users_to_delete := user::!users_to_delete
end
in
@@ -1580,7 +1699,7 @@
end
in
begin
- rename_deleted_users users_to_delete ;
+ rename_deleted_users ~statistics users_to_delete ;
begin
try
backup_users users_to_backup
@@ -1691,22 +1810,17 @@
* By doing a backup of this user first, the undelete algorithm will
* find all files to undelete
*)
- backup_user ~statistics user mailspool ;
+ options.uidfilter <- (fun s->false) ;
+ backup ~statistics ;
exists_or_create absolute_path ;
restore ~src:backup_dir ~dst:absolute_path ~cyrbase:("."^relative_path) ;
- let writer out_channel = Buffer.output_buffer out_channel mboxlines
+ ignore(run ~input:mboxlines (options.ctl_mboxlist^" -u")) ;
+ ignore(run (options.cyrreconstruct^" -rf "^(Filename.quote (imap_wildcardfolders user))));
+ let suffix = match user.domain with
+ | None -> ""
+ | Some domain -> "-d "^domain
in
- let commands = [
- options.ctl_mboxlist^" -u";
- options.cyrreconstruct^" -rf "^(Filename.quote (imap_wildcardfolders user));
- let suffix = match user.domain with
- | None -> ""
- | Some domain -> "-d "^domain
- in
- options.cyrquota^" -f "^suffix;
- ] in
- let run command = verbose (lazy("Running "^command)) in
- ignore (List.map run commands)
+ ignore(run (options.cyrquota^" -f "^suffix));
end
;;
@@ -1759,18 +1873,16 @@
end
| Sieve.Bytecode
| Sieve.Unknown
- | Sieve.Absent -> assert false (** Algorithm does not permit this *)
+ | Sieve.Absent -> raise (Impossible ("Did not expect "^entry)) (** Algorithm does not permit this *)
end
in
- verbose (lazy("Restoring sieve from "^src^" to "^dst));
- begin
- try
- ignore(Unix.stat src) (* Fails if nothing to restore *)
- with
- | Unix.Unix_error (error,f,x) ->
- verbose (lazy("Nothing to restore: "^(Unix.error_message error)))
- end ;
- Unixutil.fold_directory (restore_sieve ~src ~dst) () src
+ if Unixutil.isdir src
+ then begin
+ verbose (lazy("Restoring sieve from "^src^" to "^dst));
+ exists_or_create dst ;
+ Unixutil.fold_directory (restore_sieve ~src ~dst) () src
+ end
+ else verbose (lazy("Nothing to restore"))
in
let (mboxlines,mboxline) = mboxlines_collector ~size:(options.estimated_mail_per_dir*80*10) ~user in
let restore ~src ~dst =
@@ -1813,39 +1925,97 @@
end
in
let cyrbase = "" in
- verbose (lazy("Restoring from "^src^" to "^dst));
- mboxline ~cyrbase ;
- Unixutil.fold_directory (restore ~src ~dst ~cyrbase) () src
+ if Unixutil.isdir src
+ then begin
+ verbose (lazy("Restoring from "^src^" to "^dst));
+ exists_or_create dst ;
+ mboxline ~cyrbase ;
+ Unixutil.fold_directory (restore ~src ~dst ~cyrbase) () src
+ end
+ else verbose (lazy("Nothing to restore"))
in
begin
Statistics.todo ~statistics ;
- (** The restore algorithm will only restore a user that is.
+ (** The restore algorithm will only restore a user that is marked as
+ * deleted.
* Assume an admin deletes a user, detects the error and decides to
* restore.
* The backup shows the user as not yet deleted, and does not restore it.
* By doing a backup of this user first, the restore algorithm will
* find all files to restore.
+ * Notice that when we do recovery, the backup procedure must not run!
+ * Else the whole mailspool is believed to be deletede, and every
+ * user is marked as deleted.
*)
- (* backup_user ~statistics user mailspool ; *)
+ let mailspool =
+ Filename.concat options.defaultpartition_path (layout user)
+ in
+ if was_deleted
+ then begin
+ options.uidfilter <- (fun s->false) ;
+ backup ~statistics ;
+ end ;
+ exists_or_create mailspool ;
let (backup_dir,sieve_backup_dir) =
if was_deleted
then find_deleted_user_backup_and_sieve_dir user
else (find_user_backup_dir user, find_user_sieve_backup_dir user)
in
begin
- let mailspool = find_user_mailspool user in
- restore ~src:backup_dir ~dst:mailspool
+ (* let mailspool = find_user_mailspool user in *)
+ restore ~src:backup_dir ~dst:mailspool ;
end ;
begin
let sievedir = find_user_sieve_dir user in
- restore_sieve ~src:backup_dir ~dst:sievedir
+ (* exists_or_create sievedir ; *)
+ restore_sieve ~src:sieve_backup_dir ~dst:sievedir
end ;
- let writer out_channel = Buffer.output_buffer out_channel mboxlines in
- ignore(Utils.run ~writer (options.ctl_mboxlist^" -u")) ;
- ignore(Utils.run (options.cyrreconstruct^" -rf "^(Filename.quote (imap_name user)))) ;
- Statistics.processed_user ~statistics ;
- progress_user () ;
- end
+ let undeleted path =
+ let regexp = Str.regexp "\\.[0-9]+$" in
+ let repl = "" in
+ Str.replace_first regexp repl path
+ in
+ begin
+ if was_deleted
+ then
+ begin
+ begin
+ let src = backup_dir in
+ let dst = undeleted backup_dir in
+ begin
+ verbose (lazy("User "^(show_user user)^" restored, renaming deleted backup dir "^src^" to "^dst));
+ if options.dry_run
+ then verbose (lazy("Skipping rename of "^src))
+ else begin
+ Unix.rename ~src ~dst ;
+ Statistics.renamed ~statistics
+ end
+ end
+ end ;
+ begin
+ let src = sieve_backup_dir in
+ let dst = undeleted sieve_backup_dir in
+ begin
+ verbose (lazy("User "^(show_user user)^" restored, renaming deleted sieve backup dir "^src^" to "^dst));
+ if options.dry_run
+ then verbose (lazy("Skipping rename of "^src))
+ else
+ if Unixutil.isdir src
+ then
+ begin
+ Unix.rename ~src ~dst ;
+ Statistics.renamed ~statistics
+ end
+ else verbose (lazy("No sieve dir in backup"))
+ end
+ end
+ end
+ end ;
+ ignore(run ~input:mboxlines (options.ctl_mboxlist^" -u")) ;
+ ignore(run (options.cyrreconstruct^" -rf "^(Filename.quote (imap_name user))));
+ Statistics.processed_user ~statistics ;
+ progress_user () ;
+ end
;;
(** Recover the mailspool and the sieve scripts
@@ -1853,10 +2023,12 @@
*)
let recover ~statistics =
(** Traverse the backup dir and determine the deleted users
+ * Notice that deleted users are not restored on recovery,
*)
let find_recoverable_users () =
let deleted_user_regexp = Str.regexp "^\\(.+\\)\\.\\([0-9]+\\)$" in
let collector ~collected ~user ~dir =
+ verbose (lazy("Checking if recovery is needed for "^(show_user user)));
if Str.string_match deleted_user_regexp user.localpart 0
then collected
else
@@ -1867,7 +2039,7 @@
in
let virtdomains = options.virtdomains in
let hashimapspool = true in
- let base = options.backup_location in
+ let base = Filename.concat options.backup_location "spool" in
let collected = [] in
enumerate_users ~virtdomains ~hashimapspool ~base ~collector ~collected
in
@@ -1876,9 +2048,11 @@
[] -> ()
| ((user,dir)::users) ->
let find_user_backup_dir user = dir in
+ verbose (lazy("Starting recovery for user "^(show_user user))) ;
restore ~statistics ~was_deleted:false user
in
let recoverable_users = find_recoverable_users () in
+ verbose (lazy "Starting recovery") ;
recover_users recoverable_users ;
;;
@@ -2062,7 +2236,7 @@
handle_arguments () ;
use_imapd_conf () ;
warn_if_not_cyrus_user () ;
-
+ verbose (lazy ("Running in "^(string_of_action options.action)^" mode"));
let statistics = Statistics.make () in
begin
match options.action with
More information about the Limacute-commit
mailing list