src/system/system_generic.ml


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122

(* Unison file synchronizer: src/system/system_generic.ml *)
(* Copyright 1999-2018, Benjamin C. Pierce

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see <http://www.gnu.org/licenses/>.
*)

type fspath = string

let fspathFromString f = f
let fspathToPrintString f = f
let fspathToString f = f
let fspathToDebugString f = String.escaped f

let fspathConcat = Filename.concat
let fspathDirname = Filename.dirname
let fspathAddSuffixToFinalName f suffix = f ^ suffix

(****)

let getenv = Sys.getenv
let putenv = Unix.putenv
let argv () = Sys.argv

(****)

type dir_handle = { readdir : unit -> string; closedir : unit -> unit }

let stat = Unix.LargeFile.stat
let lstat = Unix.LargeFile.lstat
let rmdir = Unix.rmdir
let mkdir = Unix.mkdir
let unlink = Unix.unlink
let rename = Unix.rename
let open_in_gen = open_in_gen
let open_out_gen = open_out_gen
let chmod = Unix.chmod
let chown = Unix.chown
let utimes = Unix.utimes
let link = Unix.link
let openfile = Unix.openfile
let opendir f =
  let h = Unix.opendir f in
  { readdir =  (fun () -> Unix.readdir h);
    closedir = (fun () -> Unix.closedir h) }

let readdir = Unix.readdir
let closedir = Unix.closedir
let readlink = Unix.readlink
(* BCP 5/16: Eta-expand for backward compatibility with OCaml <=4.02 *)
let symlink s1 s2 = Unix.symlink s1 s2
let chdir = Sys.chdir
let getcwd = Sys.getcwd

(****)

let file_exists = Sys.file_exists
let open_in_bin = open_in_bin

(****)

let create_process = Unix.create_process
let open_process_in = Unix.open_process_in
let open_process_out = Unix.open_process_out
let open_process_full cmd = Unix.open_process_full cmd (Unix.environment ())
let close_process_in = Unix.close_process_in
let close_process_out = Unix.close_process_out
let close_process_full = Unix.close_process_full

(****)

let isNotWindows = Sys.os_type <> "Win32"

let canSetTime f =
  isNotWindows ||
  try
    Unix.access f [Unix.W_OK];
    true
  with
    Unix.Unix_error _ -> false

(* Note that Cygwin provides some kind of inode numbers, but we only
   have access to the lower 32 bits on 32bit systems... *)
let hasInodeNumbers () = isNotWindows

(****)

type terminalStateFunctions =
  { defaultTerminal : unit -> unit; rawTerminal : unit -> unit;
    startReading : unit -> unit; stopReading : unit -> unit }

let terminalStateFunctions () =
  let oldState = Unix.tcgetattr Unix.stdin in
  { defaultTerminal =
      (fun () -> Unix.tcsetattr Unix.stdin Unix.TCSANOW oldState);
    rawTerminal =
      (fun () ->
         let newState =
           { oldState with Unix.c_icanon = false; Unix.c_echo = false;
                           Unix.c_vmin = 1 }
         in
         Unix.tcsetattr Unix.stdin Unix.TCSANOW newState);
    startReading = (fun () -> ());
    stopReading = (fun () -> ()) }

(****)

let fingerprint f =
  let ic = open_in_bin f in
  let d = Digest.channel ic (-1) in
  close_in ic;
  d