unison

Fork of Unison, a bi-directional file synchronization tool
git clone git://git.laack.co/unison.git
Log | Files | Refs | README | LICENSE

abort.ml (2363B)

      1 (* Unison file synchronizer: src/abort.ml *)
      2 (* Copyright 1999-2020, Benjamin C. Pierce
      3 
      4     This program is free software: you can redistribute it and/or modify
      5     it under the terms of the GNU General Public License as published by
      6     the Free Software Foundation, either version 3 of the License, or
      7     (at your option) any later version.
      8 
      9     This program is distributed in the hope that it will be useful,
     10     but WITHOUT ANY WARRANTY; without even the implied warranty of
     11     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     12     GNU General Public License for more details.
     13 
     14     You should have received a copy of the GNU General Public License
     15     along with this program.  If not, see <http://www.gnu.org/licenses/>.
     16 *)
     17 
     18 let debug = Trace.debug "abort"
     19 
     20 (****)
     21 
     22 let maxerrors =
     23   Prefs.createInt "maxerrors" 1
     24     ~category:(`Advanced `General)
     25     "maximum number of errors before a directory transfer is aborted"
     26     "This preference controls after how many errors Unison aborts a \
     27      directory transfer.  Setting it to a large number allows Unison \
     28      to transfer most of a directory even when some files fail to be \
     29      copied.  The default is 1.  If the preference is set too high, \
     30      Unison may take a long time to abort in case of repeated \
     31      failures (for instance, when the disk is full)."
     32 
     33 (****)
     34 
     35 let files = Hashtbl.create 17
     36 let abortAll = ref false
     37 
     38 let errorCountCell id =
     39   try
     40     Hashtbl.find files id
     41   with Not_found ->
     42     let c = ref 0 in
     43     Hashtbl.add files id c;
     44     c
     45 
     46 let errorCount id = !(errorCountCell id)
     47 let bumpErrorCount id = incr (errorCountCell id)
     48 
     49 (****)
     50 
     51 let reset () = Hashtbl.clear files; abortAll := false
     52 
     53 (****)
     54 
     55 let file id =
     56   debug (fun() -> Util.msg "Aborting line %s\n" (Uutil.File.toString id));
     57   bumpErrorCount id
     58 
     59 let all () = abortAll := true
     60 
     61 (****)
     62 
     63 let isAll () = !abortAll
     64 
     65 let checkAll () =
     66   if !abortAll then raise (Util.Transient "Aborted by user request")
     67 
     68 let check id =
     69   debug (fun() -> Util.msg "Checking line %s\n" (Uutil.File.toString id));
     70   checkAll ();
     71   if errorCount id >= Prefs.read maxerrors then begin
     72     debug (fun() ->
     73       Util.msg "Abort failure for line %s\n" (Uutil.File.toString id));
     74     raise (Util.Transient "Aborted")
     75   end
     76 
     77 let testException e =
     78   (e = Util.Transient "Aborted") ||
     79   (e = Util.Transient "Aborted by user request")