1(* This is a terrible hack that plays on the internal representation 2 of file descriptors. The result is a number (as a string) 3 that the fdstatus.exe auxiliary program can use to check whether 4 the fd is open. *) 5 6let string_of_fd (fd: Unix.file_descr) : string = 7 match Sys.os_type with 8 | "Unix" | "Cygwin" -> string_of_int (Obj.magic fd : int) 9 | "Win32" -> 10 if Sys.word_size = 32 then 11 Int32.to_string (Obj.magic fd : int32) 12 else 13 Int64.to_string (Obj.magic fd : int64) 14 | _ -> assert false 15 16let _ = 17 let f0 = Unix.(openfile "tmp.txt" [O_WRONLY; O_CREAT; O_TRUNC] 0o600) in 18 let f1 = Unix.(openfile "tmp.txt" [O_RDONLY; O_KEEPEXEC] 0) in 19 let f2 = Unix.(openfile "tmp.txt" [O_RDONLY; O_CLOEXEC] 0) in 20 let d0 = Unix.dup f0 in 21 let d1 = Unix.dup ~cloexec:false f1 in 22 let d2 = Unix.dup ~cloexec:true f2 in 23 let (p0, p0') = Unix.pipe () in 24 let (p1, p1') = Unix.pipe ~cloexec:false () in 25 let (p2, p2') = Unix.pipe ~cloexec:true () in 26 let s0 = Unix.(socket PF_INET SOCK_STREAM 0) in 27 let s1 = Unix.(socket ~cloexec:false PF_INET SOCK_STREAM 0) in 28 let s2 = Unix.(socket ~cloexec:true PF_INET SOCK_STREAM 0) in 29 let (x0, x0') = 30 try Unix.(socketpair PF_UNIX SOCK_STREAM 0) 31 with Invalid_argument _ -> (p0, p0') in 32 (* socketpair not available under Win32; keep the same output *) 33 let (x1, x1') = 34 try Unix.(socketpair ~cloexec:false PF_UNIX SOCK_STREAM 0) 35 with Invalid_argument _ -> (p1, p1') in 36 let (x2, x2') = 37 try Unix.(socketpair ~cloexec:true PF_UNIX SOCK_STREAM 0) 38 with Invalid_argument _ -> (p2, p2') in 39 40 let fds = [| f0;f1;f2; d0;d1;d2; 41 p0;p0';p1;p1';p2;p2'; 42 s0;s1;s2; 43 x0;x0';x1;x1';x2;x2' |] in 44 let pid = 45 Unix.create_process 46 (Filename.concat Filename.current_dir_name "fdstatus.exe") 47 (Array.append [| "fdstatus" |] (Array.map string_of_fd fds)) 48 Unix.stdin Unix.stdout Unix.stderr in 49 ignore (Unix.waitpid [] pid); 50 Array.iter (fun fd -> try Unix.close fd with Unix.Unix_error _ -> ()) fds; 51 Sys.remove "tmp.txt" 52