[Limacute-commit] r58 - trunk/cybar
jhf at projects.linpro.no
jhf at projects.linpro.no
Tue Jan 9 12:56:52 CET 2007
Author: jhf
Date: 2007-01-09 12:56:51 +0100 (Tue, 09 Jan 2007)
New Revision: 58
Modified:
trunk/cybar/cybar.ml
Log:
Integrated upstream patches, conflicts resolved.
Added some comments to the code.
Modified: trunk/cybar/cybar.ml
===================================================================
--- trunk/cybar/cybar.ml 2007-01-09 11:40:44 UTC (rev 57)
+++ trunk/cybar/cybar.ml 2007-01-09 11:56:51 UTC (rev 58)
@@ -32,21 +32,25 @@
module Unix = UnixLabels
module String = StringLabels
+(** Make a priority queue that orders it's elements in
+ * Ascending priority (Smallest priority is returned)
+ *)
module type PriorityQueue =
sig
type priority = float (* still concrete *)
type 'a queue (* now abstract *)
+ exception Queue_is_empty
val empty : 'a queue
val insert : 'a queue -> float -> 'a -> 'a queue
val extract : 'a queue -> float * 'a * 'a queue
val list_of_queue : 'a queue -> 'a list
- exception Queue_is_empty
end;;
module PriorityQueue : PriorityQueue =
struct
type priority = float
type 'a queue = Empty | Node of priority * 'a * 'a queue * 'a queue
+ exception Queue_is_empty
let empty = Empty
let rec insert queue prio elt =
match queue with
@@ -55,7 +59,6 @@
if prio <= p
then Node(prio, elt, insert right p e, left)
else Node(p, e, insert right prio elt, left)
- exception Queue_is_empty
let rec remove_top = function
Empty -> raise Queue_is_empty
| Node(prio, elt, left, Empty) -> left
@@ -90,24 +93,27 @@
list_of_queue queue []
end
+ (**
+ * Module for various auxiliary functions
+ *)
module type Utils =
-sig
- 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
- val mkdirs : mode:int -> string -> unit
- val run : ?writer:(out_channel -> unit) -> string -> int * string
- val iso : float -> string
- val string_of_time : float -> string
- 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
+ sig
+ 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
+ val mkdirs : mode:int -> string -> unit
+ val run : ?writer:(out_channel -> unit) -> string -> int * string
+ val iso : float -> string
+ val string_of_time : float -> string
+ 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 : Utils =
+module Utils : Utils =
struct
exception Path_error of string ;;
@@ -133,7 +139,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
@@ -431,89 +437,89 @@
end
module type Statistics =
-sig
- type t
- val make : unit -> t
- val copied_file : statistics:t -> int -> unit
- val renamed : statistics:t -> unit
- val considered : statistics:t -> unit
- val processed_user : statistics:t -> unit
- val todo : statistics:t -> unit
- val show : statistics:t -> unit
- val start_time : statistics:t -> float
-end
-module Statistics : Statistics =
-struct
- type statistics = {
- start_time:float;
- mutable copied_files:int;
- mutable copied_size:Big_int.big_int;
- mutable renames:int;
- mutable processed_users:int;
- mutable considered:int; (* Number of files that we considered to backup *)
- mutable total_users:int;
- mutable users_left_to_backup:int;
- }
- type t = statistics
- let make () = {
- start_time=Unix.gettimeofday () ;
- copied_files=0;
- copied_size=Big_int.zero_big_int;
- considered=0;
- renames=0;
- processed_users=0;
- total_users=0;
- users_left_to_backup=0;
- };;
+ sig
+ type t
+ val make : unit -> t
+ val copied_file : statistics:t -> int -> unit
+ val renamed : statistics:t -> unit
+ val considered : statistics:t -> unit
+ val processed_user : statistics:t -> unit
+ val todo : statistics:t -> unit
+ val show : statistics:t -> unit
+ val start_time : statistics:t -> float
+ end
+module Statistics : Statistics =
+ struct
+ type statistics = {
+ start_time:float;
+ mutable copied_files:int;
+ mutable copied_size:Big_int.big_int;
+ mutable renames:int;
+ mutable processed_users:int;
+ mutable considered:int; (* Number of files that we considered to backup *)
+ mutable total_users:int;
+ mutable users_left_to_backup:int;
+ }
+ type t = statistics
+ let make () = {
+ start_time=Unix.gettimeofday () ;
+ copied_files=0;
+ copied_size=Big_int.zero_big_int;
+ considered=0;
+ renames=0;
+ processed_users=0;
+ total_users=0;
+ users_left_to_backup=0;
+ };;
- let start_time ~statistics = statistics.start_time ;;
+ let start_time ~statistics = statistics.start_time ;;
- let copied_file ~statistics size =
- statistics.copied_files<-statistics.copied_files+1;
- statistics.copied_size<-Big_int.add_int_big_int size statistics.copied_size;
- ;;
- let renamed ~statistics =
- statistics.renames<-statistics.renames+1
- ;;
- let considered ~statistics =
- statistics.considered<-statistics.considered+1
- ;;
- let processed_user ~statistics =
- statistics.processed_users<-statistics.processed_users+1 ;
- statistics.users_left_to_backup<-statistics.users_left_to_backup-1
- ;;
- let todo ~statistics =
- statistics.total_users<-statistics.total_users+1 ;
- statistics.users_left_to_backup<-statistics.users_left_to_backup+1
- ;;
- let show ~statistics =
- let running_time = (Unix.gettimeofday ()) -. statistics.start_time in
- let user_speed = running_time /. (float_of_int statistics.processed_users) in
- let file_speed = (float_of_int statistics.considered) /. running_time in
- let copy_size = Utils.string_of_size statistics.copied_size in
- let copy_speed =
- let speed = ((Big_int.float_of_big_int statistics.copied_size) /. running_time) in
- Utils.string_of_size (Big_int.big_int_of_int (int_of_float speed))
- in
- let process_times = Unix.times () in
- let message =
- "Program duration: " ^ (Utils.string_of_time running_time)^"\n"^
- "Total users: "^(string_of_int statistics.total_users)^"\n"^
- "Users processed: "^(string_of_int statistics.processed_users)^"\n"^
- "Users left for later: "^(string_of_int statistics.users_left_to_backup)^"\n"^
- "Files considered: "^(string_of_int statistics.considered)^"\n"^
- "Copied files: "^(string_of_int statistics.copied_files)^"\n"^
- "Copied size: "^copy_size^"\n"^
- "Speed: "^copy_speed^"/second\n"^
- "Renames: "^(string_of_int statistics.renames)^"\n"^
- "Speed: "^(Utils.string_of_time user_speed)^"/user\n"^
- "Speed: "^(string_of_float file_speed)^" files/second\n"^
- "User time: "^(Utils.string_of_time process_times.Unix.tms_utime)^"\n"^
- "System time: "^(Utils.string_of_time process_times.Unix.tms_stime)
- in
- print_endline message
- ;;
-end
+ let copied_file ~statistics size =
+ statistics.copied_files<-statistics.copied_files+1;
+ statistics.copied_size<-Big_int.add_int_big_int size statistics.copied_size;
+ ;;
+ let renamed ~statistics =
+ statistics.renames<-statistics.renames+1
+ ;;
+ let considered ~statistics =
+ statistics.considered<-statistics.considered+1
+ ;;
+ let processed_user ~statistics =
+ statistics.processed_users<-statistics.processed_users+1 ;
+ statistics.users_left_to_backup<-statistics.users_left_to_backup-1
+ ;;
+ let todo ~statistics =
+ statistics.total_users<-statistics.total_users+1 ;
+ statistics.users_left_to_backup<-statistics.users_left_to_backup+1
+ ;;
+ let show ~statistics =
+ let running_time = (Unix.gettimeofday ()) -. statistics.start_time in
+ let user_speed = running_time /. (float_of_int statistics.processed_users) in
+ let file_speed = (float_of_int statistics.considered) /. running_time in
+ let copy_size = Utils.string_of_size statistics.copied_size in
+ let copy_speed =
+ let speed = ((Big_int.float_of_big_int statistics.copied_size) /. running_time) in
+ Utils.string_of_size (Big_int.big_int_of_int (int_of_float speed))
+ in
+ let process_times = Unix.times () in
+ let message =
+ "Program duration: " ^ (Utils.string_of_time running_time)^"\n"^
+ "Total users: "^(string_of_int statistics.total_users)^"\n"^
+ "Users processed: "^(string_of_int statistics.processed_users)^"\n"^
+ "Users left for later: "^(string_of_int statistics.users_left_to_backup)^"\n"^
+ "Files considered: "^(string_of_int statistics.considered)^"\n"^
+ "Copied files: "^(string_of_int statistics.copied_files)^"\n"^
+ "Copied size: "^copy_size^"\n"^
+ "Speed: "^copy_speed^"/second\n"^
+ "Renames: "^(string_of_int statistics.renames)^"\n"^
+ "Speed: "^(Utils.string_of_time user_speed)^"/user\n"^
+ "Speed: "^(string_of_float file_speed)^" files/second\n"^
+ "User time: "^(Utils.string_of_time process_times.Unix.tms_utime)^"\n"^
+ "System time: "^(Utils.string_of_time process_times.Unix.tms_stime)
+ in
+ print_endline message
+ ;;
+ end
type user = {localpart:string;domain:string option} ;;
@@ -644,16 +650,25 @@
^"}"
;;
+(**
+ * Message to print when verbosity is on
+ *)
let verbose (message:string Lazy.t) =
if options.verbose
then print_endline (Lazy.force message)
else ()
;;
+(**
+ * Message to print when a warning occurs
+ *)
let warning message =
let message = "#### " ^ message in
print_endline message
;;
+(**
+ * Action to show progress when a user is processed
+ *)
let progress_user () =
if options.progress
then
@@ -663,6 +678,9 @@
end
else ()
;;
+(**
+ * Action to show progress when a file is processed
+ *)
let progress_file () =
if options.progress
then
@@ -678,6 +696,8 @@
(** Parse imapd.conf, and find settings *)
let use_imapd_conf () =
let imapd_config = new ConfigParser.rawConfigParser in
+ (** Helper to read boolean value
+ *)
let istrue name =
match imapd_config#get ~default:"0" "DEFAULT" name with
| "0" | "no" | "false" -> false
@@ -715,6 +735,7 @@
let determine_sievedir () =
options.sievedir<-imapd_config#get ~default:options.sievedir "DEFAULT" "sievedir"
in
+ (* Do the actual processing *)
begin
imapd_config#readfile options.imapd_conf ;
findpartitions (imapd_config#items "DEFAULT") ;
@@ -763,6 +784,11 @@
else dir_nohash_c name
;;
+(**
+ * Return the path to the sieve dir of the user.
+ * prefix the path with ~prefix and use the algorithm
+ * dir_c to calculate hashes in the path.
+ *)
let find_user_sieve_dirs ~prefix ~dir_c (user:user) : string =
let elements =
let localpart = cyrus_escape user.localpart in
@@ -775,18 +801,28 @@
let path = List.fold_left Filename.concat prefix elements in
path
;;
+
+(**
+ * Return the path to the sieve backup dir of this user.
+ *)
let find_user_sieve_backup_dir (user:user) : string =
let prefix = Filename.concat options.backup_location "sieve" in
let dir_c = dir_hash_c in
find_user_sieve_dirs ~prefix ~dir_c user
;;
+(**
+ * Return the path to the sieve dir of this user.
+ *)
let find_user_sieve_dir (user:user) : string =
let prefix = options.sievedir in
let dir_c = dir_c in
find_user_sieve_dirs ~prefix ~dir_c user
;;
+(**
+ * Return the path to the email backup dir of this user.
+ *)
let find_user_backup_dir (user:user) : string =
let elements =
let localpart = cyrus_escape user.localpart in
@@ -800,6 +836,9 @@
path
;;
+(**
+ * Show the imap name of the user
+ *)
let imap_name user =
"user"^options.hierarchysep^(show_user user)
;;
@@ -813,7 +852,10 @@
"user"^options.hierarchysep^user.localpart^"*"^post
;;
-(** Locate the path to the users mailspool *)
+(**
+ * Locate the path to the users mailspool
+ * Return the path to the email dir of this user.
+ *)
let find_user_mailspool user =
let name = imap_name user in
let command = options.mbpath ^ " '"^name^"'" in
@@ -869,6 +911,7 @@
(** Used when a required directory is missing *)
exception Missing_directory of string;;
+
(** enumerate users
* Given a choice of hash or not, traverse directory and find all users.
* Use worker function tracked return value to collect results
@@ -1086,7 +1129,7 @@
else begin
Unix.rename ~src ~dst ;
Statistics.renamed ~statistics
- end
+ else Unix.rename ~src ~dst
end
in
let rename_sieve_backup_of_user deleted_user =
@@ -1160,6 +1203,10 @@
end
;;
+(**
+ * Types of sieve scripts
+ * helpers to categorize sieve scripts
+ *)
module Sieve =
struct
type classification =
@@ -1200,10 +1247,10 @@
;;
end
- (** Helper module to contain code for working on
- * classification of files in mailspool and backup
- * of mailspool
- *)
+(** Helper module to contain code for working on
+ * classification of files in mailspool and backup
+ * of mailspool
+ *)
module Mbox =
struct
type classification =
@@ -1473,9 +1520,6 @@
let backup_users () =
let backup_user_sieve ~statistics user =
let backup_housekeeping ~backup_from ~backup_to backup_hash =
- let now = Unix.time () in
- let stamp = string_of_float now in
- let stamp = String.sub ~pos:0 ~len:((String.length stamp)-2) stamp in (* Chop of last . *)
let cleanup entry classification =
match classification with
| Sieve.Script
More information about the Limacute-commit
mailing list