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@
|