(** Return the suffix used to distinguish the backup from the real file. If the argument is zero this refers to the original file, so an empty suffix is returned. If count=1 this is simply "~", if it is more it is in the form ".~N~". *) let backup_suffix count = function 0 -> "" | n -> if count > 1 then ".~" ^ string_of_int n ^ "~" else "~" (** Create backup files for PATH. This is done by *) let make_backups count path = (* Loop through the existing backups and rename them to the next older backup name until we reach the backup count or run out of existing backups. *) let rec loop n = let path1 = path ^ backup_suffix count n in if Sys.file_exists path1 then begin if n < count then begin loop (n + 1); (* When this returns the file whose name is path2 will not exist, it has either been renamed or it didn't exist. *) let path2 = path ^ backup_suffix count (n + 1) in Unix.link path1 path2 end; Unix.unlink path1 end in loop 0 (** If something went wrong after make_backups we can call this to try to move the latest backups back into place, and move all the older backups to the position vacated by younger ones. *) let restore_backup count path = (* Unlink the (presumably defective) original file *) if Sys.file_exists path then Unix.unlink path; let rec loop n = (* At this point path1 will not exist *) let path2 = path ^ backup_suffix count (n+1) in if Sys.file_exists path2 then begin let path1 = path ^ backup_suffix count n in Unix.link path2 path1; Unix.unlink path2; loop (n + 1) end in loop 0 (** Write the contents of a string to a file. *) let of_string ?(perm=0o0644) ?(backups=0) str path = make_backups backups path; try let chan = open_out_gen [Open_creat; Open_trunc; Open_wronly] perm path in output_string chan str; close_out chan with _ -> restore_backup backups path let append ?(perm=0o0644) str path = let chan = open_out_gen [Open_creat; Open_append; Open_wronly] perm path in output_string chan str; close_out chan (* This needs to work on filesystems like /proc where st_size is invalid. *) let to_string path = let chan = open_in path in let rec loop lst = let buf = String.create 1024 in match input chan buf 0 1024 with 1024 -> loop (buf :: lst) | 0 -> close_in chan; String.concat "" (List.rev lst) | n when n > 0 -> loop (String.sub buf 0 n :: lst) | _ -> close_in chan; raise (Failure "File.to_string") in loop [] let map ?(backups=0) f path = of_string ~backups:backups (f (to_string path)) path (** Obsolete, but does the built-in version use Unix.LargeFile? *) let exists path = (* Sys.file_exists *) try ignore (Unix.LargeFile.stat path); true with Unix.Unix_error (Unix.ENOENT, _, _) -> false exception Modified let write_shadowed ?(backups=1) ?(verbose=0) real_path shadow_path text = let old_text = try Some (to_string real_path) with _ -> None and shadow_text = try Some (to_string shadow_path) with _ -> None in match old_text, shadow_text with Some old, _ when old = text -> if verbose > 0 then prerr_endline ("New version of " ^ real_path ^ " matches old"); () (* No changes *) | Some old, Some shadow when old <> shadow && old <> "" -> (* This is the case where the file and the shadow don't match. We exclude the case where the file is empty and the shadow is not, this probably means something bad happened recently, like a full disk. *) if verbose > 0 then prerr_endline ("Shadowed file " ^ real_path ^ " modified, write aborted"); raise Modified | _ -> (* First unlink the shadow file so if we crash before finishing we won't appear to be in an edited state. *) if Sys.file_exists shadow_path then Unix.unlink shadow_path; of_string ~backups:backups text real_path; of_string text shadow_path (* Like the "test -ef" operator *) let eq path1 path2 = let stat1 = Unix.stat path1 and stat2 = Unix.stat path2 in stat1.Unix.st_dev = stat2.Unix.st_dev && stat1.Unix.st_ino = stat2.Unix.st_ino