uutil.ml (5729B)
1 (* Unison file synchronizer: src/uutil.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 19 (*****************************************************************************) 20 (* Unison name and version *) 21 (*****************************************************************************) 22 23 let myName = ProjectInfo.myName 24 25 let myVersion = ProjectInfo.myVersion ^ " (ocaml " ^ Sys.ocaml_version ^ ")" 26 27 let myMajorVersion = ProjectInfo.myMajorVersion 28 29 let myNameAndVersion = myName ^ " " ^ myVersion 30 31 (*****************************************************************************) 32 (* HASHING *) 33 (*****************************************************************************) 34 35 let hash2 x y = (17 * x + 257 * y) land 0x3FFFFFFF 36 37 external hash_param : int -> int -> 'a -> int = "unsn_hash_univ_param" [@@noalloc] 38 39 let hash x = hash_param 10 100 x 40 41 (*****************************************************************************) 42 (* File sizes *) 43 (*****************************************************************************) 44 45 module type FILESIZE = sig 46 type t 47 val m : t Umarshal.t 48 val zero : t 49 val dummy : t 50 val add : t -> t -> t 51 val sub : t -> t -> t 52 val ofFloat : float -> t 53 val toFloat : t -> float 54 val toString : t -> string 55 val ofInt : int -> t 56 val ofInt64 : int64 -> t 57 val toInt : t -> int 58 val toInt64 : t -> int64 59 val fromStats : Unix.LargeFile.stats -> t 60 val hash : t -> int 61 val percentageOfTotalSize : t -> t -> float 62 end 63 64 module Filesize : FILESIZE = struct 65 type t = int64 66 let m = Umarshal.int64 67 let zero = 0L 68 let dummy = -1L 69 let add = Int64.add 70 let sub = Int64.sub 71 let ofFloat = Int64.of_float 72 let toFloat = Int64.to_float 73 let toString = Int64.to_string 74 let ofInt x = Int64.of_int x 75 let ofInt64 x = x 76 let toInt x = Int64.to_int x 77 let toInt64 x = x 78 let fromStats st = st.Unix.LargeFile.st_size 79 let hash x = 80 hash2 (Int64.to_int x) (Int64.to_int (Int64.shift_right_logical x 31)) 81 let percentageOfTotalSize current total = 82 let total = toFloat total in 83 if total = 0. then 100.0 else 84 toFloat current *. 100.0 /. total 85 end 86 87 (*****************************************************************************) 88 (* File transfer progress display *) 89 (*****************************************************************************) 90 91 module File = 92 struct 93 type t = int 94 let m = Umarshal.int 95 let dummy = -1 96 let ofLine l = l 97 let toLine l = assert (l <> dummy); l 98 let toString l = if l=dummy then "<dummy>" else string_of_int l 99 end 100 101 let progressPrinter = ref (fun _ _ _ -> ()) 102 let setProgressPrinter p = progressPrinter := p 103 let showProgress i bytes ch = 104 if i <> File.dummy then !progressPrinter i bytes ch 105 106 let statusPrinter = ref None 107 let setUpdateStatusPrinter p = statusPrinter := p 108 let showUpdateStatus path = 109 match !statusPrinter with 110 Some f -> f path 111 | None -> Trace.statusDetail path 112 113 (*****************************************************************************) 114 (* Copy bytes from one file_desc to another *) 115 (*****************************************************************************) 116 117 let bufsize = 65536 118 let bufsizeFS = Filesize.ofInt bufsize 119 let buf = Bytes.create bufsize 120 121 let readWrite source target notify = 122 let len = ref 0 in 123 let rec read () = 124 let n = input source buf 0 bufsize in 125 if n > 0 then begin 126 output target buf 0 n; 127 len := !len + n; 128 if !len > 100 * 1024 then begin 129 notify !len; 130 len := 0 131 end; 132 read () 133 end else if !len > 0 then 134 notify !len 135 in 136 Util.convertUnixErrorsToTransient "readWrite" read 137 138 let readWriteBounded source target len notify = 139 let l = ref 0 in 140 let rec read len = 141 if len > Filesize.zero then begin 142 let n = 143 input source buf 0 144 (if len > bufsizeFS then bufsize else Filesize.toInt len) 145 in 146 if n > 0 then begin 147 let _ = output target buf 0 n in 148 l := !l + n; 149 if !l >= 100 * 1024 then begin 150 notify !l; 151 l := 0 152 end; 153 read (Filesize.sub len (Filesize.ofInt n)) 154 end else if !l > 0 then 155 notify !l 156 end else if !l > 0 then 157 notify !l 158 in 159 Util.convertUnixErrorsToTransient "readWriteBounded" (fun () -> read len) 160 161 (*****************************************************************************) 162 (* ESCAPING SHELL PARAMETERS *) 163 (*****************************************************************************) 164 165 (* Using single quotes is simpler under Unix but they are not accepted 166 by the Windows shell. Double quotes without further quoting is 167 sufficient with Windows as filenames are not allowed to contain 168 double quotes. *) 169 let quotes s = 170 if Sys.win32 then 171 "\"" ^ s ^ "\"" 172 else 173 "'" ^ Util.replacesubstring s "'" "'\\''" ^ "'"