File: stdcompat__filename.ml.in

package info (click to toggle)
ocaml-stdcompat 14-2
  • links: PTS, VCS
  • area: main
  • in suites: bullseye
  • size: 5,152 kB
  • sloc: ml: 22,329; makefile: 211; sh: 120
file content (240 lines) | stat: -rw-r--r-- 6,205 bytes parent folder | download | duplicates (2)
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
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
include Filename

@BEGIN_BEFORE_4_08_0@
let chop_suffix_opt ~suffix filename =
  let len_suffix = String.length suffix in
  let len_filename = String.length filename in
  if len_suffix <= len_filename then
    let len_base = len_filename - len_suffix in
    let filename_suffix = String.sub filename len_base len_suffix in
@BEGIN_WITH_WIN32@
    let filename_suffix, suffix =
        Stdcompat__string.lowercase_ascii filename_suffix,
        Stdcompat__string.lowercase_ascii suffix in
@END_WITH_WIN32@
    if filename_suffix = suffix then
      Some (String.sub filename 0 len_base)
    else
      None
  else
    None
@END_BEFORE_4_08_0@

@BEGIN_BEFORE_3_09_0@
let temp_dir_name =
@BEGIN_WITH_WIN32@
  try Sys.getenv "TEMP"
  with Not_found -> "."
@END_WITH_WIN32@
@BEGIN_WITHOUT_WIN32@
  try Sys.getenv "TMPDIR"
  with Not_found -> "/tmp"
@END_WITHOUT_WIN32@
@END_BEFORE_3_09_0@

@BEGIN_BEFORE_4_00_0@
let current_temp_dir_name = ref temp_dir_name

let get_temp_dir_name () =
  !current_temp_dir_name

let set_temp_dir_name dir =
  current_temp_dir_name := dir
@END_BEFORE_4_00_0@

@BEGIN_BEFORE_4_03_0@
let prng = lazy (Random.State.make_self_init ())

let temp_file_name temp_dir prefix suffix =
  let rnd = Random.State.bits (Lazy.force prng) land 0xFFFFFF in
  concat temp_dir (Printf.sprintf "%s%06x%s" prefix rnd suffix)

let open_temp_file ?(mode = [Open_text]) ?(perms = 0o600)
    ?(temp_dir = get_temp_dir_name ()) prefix suffix =
  let rec try_name counter =
    let name = temp_file_name temp_dir prefix suffix in
    try
      name,
      open_out_gen (Open_wronly :: Open_creat :: Open_excl :: mode) perms name
    with Sys_error _ as e ->
      if counter >= 1000 then
        raise e
      else
        try_name (succ counter) in
  try_name 0
@END_BEFORE_4_03_0@

@BEGIN_BEFORE_4_00_0@
let temp_file ?(temp_dir = !current_temp_dir_name) prefix suffix =
@BEGIN_FROM_3_11_0@
  temp_file ~temp_dir prefix suffix
@END_FROM_3_11_0@
@BEGIN_BEFORE_3_11_0@
  let name, out_channel = open_temp_file ~mode:[] ~temp_dir prefix suffix in
  close_out out_channel;
  name
@END_BEFORE_3_11_0@
@END_BEFORE_4_00_0@

@BEGIN_BEFORE_3_11_0@
let dir_sep =
@BEGIN_WITH_WIN32@
  "\\"
@END_WITH_WIN32@
@BEGIN_WITHOUT_WIN32@
  "/"
@END_WITHOUT_WIN32@
@END_BEFORE_3_11_0@

@BEGIN_BEFORE_4_04_0@
@BEGIN_WITH_UNIX@
let is_dir_sep c =
  c = '/'
@END_WITH_UNIX@
@BEGIN_WITHOUT_UNIX@
let is_dir_sep c =
  match c with
  | '/' | '\\' | ':' -> true
  | _ -> false
@END_WITHOUT_UNIX@

let rec extension_start_from i s =
  if i < 0 then
    String.length s
  else
    let c = String.unsafe_get s i in
    if c = '.' then
      i
    else if is_dir_sep c then
      String.length s
    else
      extension_start_from (pred i) s

let extension_start s =
  extension_start_from (String.length s - 1) s

let extension s =
  let i = extension_start s in
  String.sub s i (String.length s - i)

let remove_extension s =
  let i = extension_start s in
  String.sub s 0 i
@END_BEFORE_4_04_0@

@BEGIN_BEFORE_4_10_0@
let null =
@BEGIN_WITH_WIN32@
  "NUL"
@END_WITH_WIN32@
@BEGIN_WITHOUT_WIN32@
   "/dev/null"
@END_WITHOUT_WIN32@

open Stdcompat__pervasives

let quote_redirections buffer quote_string stdin stdout stderr =
  stdin |> Stdcompat__option.iter (fun f ->
    Buffer.add_string buffer " <";
    quote_string buffer f);
  stdout |> Stdcompat__option.iter (fun f ->
    Buffer.add_string buffer " >";
    quote_string buffer f);
  stderr |> Stdcompat__option.iter (fun f ->
    if stderr = stdout then
      Buffer.add_string buffer " 2>&1"
    else (
        Buffer.add_string buffer " 2>";
        quote_string buffer f
     ))

@BEGIN_WITH_WIN32@
let quote_cmd buffer (s : string) =
  s |> String.iter (fun c ->
    (match c with
    | '(' | ')' | '!' | '^' | '%' | '\"' | '<' | '>' | '&' | '|' ->
        Buffer.add_char buffer '^'
    | _ ->
        ());
    Buffer.add_char buffer c)

let check_filename (filename : string) =
  let contains_space = ref false in
  filename |> String.iter (fun c ->
    match c with
    | '\"' | '%' ->
        failwith ("Filename.quote_command: bad file name " ^ filename)
    | ' ' ->
        contains_space := true
    | _ ->
        ());
  !contains_space

let quote s =
  let buffer = Buffer.create (String.length s + 20) in
  Buffer.add_char buffer '\"';
  let bs_count = ref 0 in
  let add_bs count =
    for _ = 1 to count do
      Buffer.add_char buffer '\\'
    done in
  s |> String.iter (fun c ->
    match c with
    | '\\' ->
        incr bs_count
    | '\"' ->
        add_bs (2 * !bs_count + 1);
        bs_count := 0;
        Buffer.add_char buffer '\"'
    | _ ->
        add_bs !bs_count;
        bs_count := 0;
        Buffer.add_char buffer c);
  Buffer.add_char buffer '\"';
  add_bs !bs_count;
  Buffer.contents buffer

let quote_cmd_filename buffer (filename : string) =
  if check_filename filename then (
    Buffer.add_char buffer '"';
    quote_cmd buffer filename;
    Buffer.add_char buffer '"')
  else
    Buffer.add_string buffer filename

let quote_command (command : string) ?(stdin : string option)
    ?(stdout : string option) ?(stderr : string option)
    (args : string list) : string =
  let buffer = Buffer.create 128 in
  Buffer.add_char buffer '\"';
  quote_cmd_filename buffer command;
  args |> List.iter (fun arg ->
    Buffer.add_char buffer ' ';
    quote_cmd buffer (quote arg));
  quote_redirections buffer quote_cmd_filename stdin stdout stderr;
  Buffer.add_char buffer '\"';
  Buffer.contents buffer
@END_WITH_WIN32@
@BEGIN_WITHOUT_WIN32@
let quote_string buffer (s : string) =
  Buffer.add_char buffer '\'';
  s |> String.iter (fun c ->
    match c with
    | '\'' ->
        Buffer.add_string buffer "'\\''"
    | _ ->
        Buffer.add_char buffer c);
  Buffer.add_char buffer '\''

let quote_command (command : string) ?(stdin : string option)
    ?(stdout : string option) ?(stderr : string option)
    (args : string list) : string =
  let buffer = Buffer.create 128 in
  quote_string buffer command;
  args |> List.iter (fun arg ->
    Buffer.add_char buffer ' ';
    quote_string buffer arg);
  quote_redirections buffer quote_string stdin stdout stderr;
  Buffer.contents buffer
@END_WITHOUT_WIN32@
@END_BEFORE_4_10_0@