lock.ml (1811B)
1 (* Unison file synchronizer: src/lock.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 let rename oldFile newFile = 20 begin try System.link oldFile newFile with Unix.Unix_error _ -> () end; 21 let res = try (System.stat oldFile).Unix.LargeFile.st_nlink = 2 22 with Unix.Unix_error _ -> false 23 in 24 System.unlink oldFile; 25 res 26 27 let flags = [Unix.O_WRONLY; Unix.O_CREAT; Unix.O_EXCL] 28 let create name mode = 29 try 30 Unix.close (System.openfile name flags mode); 31 true 32 with Unix.Unix_error (Unix.EEXIST, _, _) -> 33 false 34 35 let rec unique name i mode = 36 let nm = name ^ (string_of_int i) in 37 if create nm mode then nm else 38 (* highly unlikely *) 39 unique name (i + 1) mode 40 41 let acquire name = 42 Util.convertUnixErrorsToTransient 43 "Lock.acquire" 44 (fun () -> 45 match Sys.unix with 46 | true -> (* O_EXCL is broken under NFS... *) 47 rename (unique name (Unix.getpid ()) 0o600) name 48 | _ -> 49 create name 0o600) 50 51 let release name = try System.unlink name with Unix.Unix_error _ -> () 52 53 let is_locked name = 54 Util.convertUnixErrorsToTransient 55 "Lock.test" 56 (fun () -> System.file_exists name)