package / ocaml-base-compiler.4.10.0 / ocamltest / ocamltest_stdlib_stubs.c
1 /**************************************************************************/
2 /* */
3 /* OCaml */
4 /* */
5 /* Sebastien Hinderer, projet Gallium, INRIA Paris */
6 /* */
7 /* Copyright 2018 Institut National de Recherche en Informatique et */
8 /* en Automatique. */
9 /* */
10 /* All rights reserved. This file is distributed under the terms of */
11 /* the GNU Lesser General Public License version 2.1, with the */
12 /* special exception on linking described in the file LICENSE. */
13 /* */
14 /**************************************************************************/
15
16 /* Stubs for ocamltest's standard library */
17
18 #include <stdio.h>
19 #include <stdlib.h>
20
21 #include <caml/config.h>
22 #include <caml/mlvalues.h>
23 #include <caml/memory.h>
24 #include <caml/alloc.h>
25 /*
26 #include <caml/fail.h>
27 */
28 #include <caml/signals.h>
29 #include <caml/osdeps.h>
30
31
32 #ifdef _WIN32
33
34 /*
35 * Windows Vista functions enabled
36 */
37 #undef _WIN32_WINNT
38 #define _WIN32_WINNT 0x0600
39
40 #include <wtypes.h>
41 #include <winbase.h>
42 #include <process.h>
43 #include <sys/types.h>
44
45 #define luid_eq(l, r) (l.LowPart == r.LowPart && l.HighPart == r.HighPart)
46
47 CAMLprim value caml_has_symlink(value unit)
48 {
49 CAMLparam1(unit);
50 HANDLE hProcess = GetCurrentProcess();
51 BOOL result = FALSE;
52
53 if (OpenProcessToken(hProcess, TOKEN_READ, &hProcess)) {
54 LUID seCreateSymbolicLinkPrivilege;
55
56 if (LookupPrivilegeValue(NULL,
57 SE_CREATE_SYMBOLIC_LINK_NAME,
58 &seCreateSymbolicLinkPrivilege)) {
59 DWORD length;
60
61 if (!GetTokenInformation(hProcess, TokenPrivileges, NULL, 0, &length)) {
62 if (GetLastError() == ERROR_INSUFFICIENT_BUFFER) {
63 TOKEN_PRIVILEGES* privileges =
64 (TOKEN_PRIVILEGES*)caml_stat_alloc(length);
65 if (GetTokenInformation(hProcess,
66 TokenPrivileges,
67 privileges,
68 length,
69 &length)) {
70 DWORD count = privileges->PrivilegeCount;
71
72 if (count) {
73 LUID_AND_ATTRIBUTES* privs = privileges->Privileges;
74 while (count-- &&
75 !(result = luid_eq(privs->Luid,
76 seCreateSymbolicLinkPrivilege)))
77 privs++;
78 }
79 }
80
81 caml_stat_free(privileges);
82 }
83 }
84 }
85
86 CloseHandle(hProcess);
87 }
88
89 CAMLreturn(Val_bool(result));
90 }
91
92
93 #else /* _WIN32 */
94
95 #ifdef HAS_SYMLINK
96
97 CAMLprim value caml_has_symlink(value unit)
98 {
99 CAMLparam0();
100 CAMLreturn(Val_true);
101 }
102
103 #else /* HAS_SYMLINK */
104
105 CAMLprim value unix_symlink(value to_dir, value path1, value path2)
106 { caml_invalid_argument("symlink not implemented"); }
107
108 CAMLprim value caml_has_symlink(value unit)
109 {
110 CAMLparam0();
111 CAMLreturn(Val_false);
112 }
113
114 #endif
115
116 #endif /* _WIN32 */
117