Commit | Line | Data |
---|---|---|
7f918cf1 CE |
1 | (* Copyright (C) 2011,2017 Matthew Fluet. |
2 | * Copyright (C) 1999-2008 Henry Cejtin, Matthew Fluet, Suresh | |
3 | * Jagannathan, and Stephen Weeks. | |
4 | * Copyright (C) 1997-2000 NEC Research Institute. | |
5 | * | |
6 | * MLton is released under a BSD-style license. | |
7 | * See the file MLton-LICENSE for details. | |
8 | *) | |
9 | ||
10 | structure PosixProcEnv: POSIX_PROC_ENV = | |
11 | struct | |
12 | structure Prim = PrimitiveFFI.Posix.ProcEnv | |
13 | structure FileDesc = PrePosix.FileDesc | |
14 | structure GId = PrePosix.GId | |
15 | structure PId = PrePosix.PId | |
16 | structure UId = PrePosix.UId | |
17 | ||
18 | structure Error = PosixError | |
19 | structure SysCall = Error.SysCall | |
20 | structure CS = CUtil.C_String | |
21 | structure CSS = CUtil.C_StringArray | |
22 | ||
23 | type file_desc = FileDesc.t | |
24 | type gid = GId.t | |
25 | type pid = PId.t | |
26 | type uid = UId.t | |
27 | ||
28 | val uidToWord = C_UId.castToSysWord o UId.toRep | |
29 | val wordToUid = UId.fromRep o C_UId.castFromSysWord | |
30 | val gidToWord = C_GId.castToSysWord o GId.toRep | |
31 | val wordToGid = GId.fromRep o C_GId.castFromSysWord | |
32 | ||
33 | local | |
34 | open Prim | |
35 | in | |
36 | val getpgrp = PId.fromRep o getpgrp (* No error checking required *) | |
37 | val getegid = GId.fromRep o getegid (* No error checking required *) | |
38 | val geteuid = UId.fromRep o geteuid (* No error checking required *) | |
39 | val getgid = GId.fromRep o getgid (* No error checking required *) | |
40 | val getpid = PId.fromRep o getpid (* No error checking required *) | |
41 | val getppid = PId.fromRep o getppid (* No error checking required *) | |
42 | val getuid = UId.fromRep o getuid (* No error checking required *) | |
43 | val setgid = fn gid => let val gid = GId.toRep gid | |
44 | in SysCall.simple (fn () => setgid gid) | |
45 | end | |
46 | val setuid = fn uid => let val uid = UId.toRep uid | |
47 | in SysCall.simple (fn () => setuid uid) | |
48 | end | |
49 | end | |
50 | ||
51 | fun setsid () = | |
52 | (PId.fromRep o SysCall.simpleResult') | |
53 | ({errVal = C_PId.castFromFixedInt ~1}, Prim.setsid) | |
54 | ||
55 | fun getgroups () = | |
56 | SysCall.syscall | |
57 | (fn () => | |
58 | let | |
59 | val n = Prim.getgroupsN () | |
60 | val a: C_GId.t array = Array.alloc (C_Int.toInt n) | |
61 | in | |
62 | (Prim.getgroups (n, a), fn n => | |
63 | (GId.listFromRep o ArraySlice.toList) | |
64 | (ArraySlice.slice (a, 0, SOME (C_Int.toInt n)))) | |
65 | end) | |
66 | ||
67 | fun getlogin () = | |
68 | SysCall.syscall' | |
69 | ({errVal = CUtil.C_Pointer.null}, fn () => | |
70 | (Prim.getlogin (), fn cs => | |
71 | CS.toString cs)) | |
72 | ||
73 | fun setpgid {pid, pgid} = | |
74 | let | |
75 | val pid = case pid of NONE => 0 | SOME pid => PId.toRep pid | |
76 | val pgid = case pgid of NONE => 0 | SOME pgid => PId.toRep pgid | |
77 | in | |
78 | SysCall.simple | |
79 | (fn () => Prim.setpgid (pid, pgid)) | |
80 | end | |
81 | ||
82 | fun uname () = | |
83 | SysCall.syscall | |
84 | (fn () => | |
85 | (Prim.uname (), fn _ => | |
86 | [("sysname", CS.toString (Prim.Uname.getSysName ())), | |
87 | ("nodename", CS.toString (Prim.Uname.getNodeName ())), | |
88 | ("release", CS.toString (Prim.Uname.getRelease ())), | |
89 | ("version", CS.toString (Prim.Uname.getVersion ())), | |
90 | ("machine", CS.toString (Prim.Uname.getMachine ()))])) | |
91 | ||
92 | val time = Time.now | |
93 | ||
94 | local | |
95 | local | |
96 | infixr 5 ::? | |
97 | fun (n,s) ::? l = | |
98 | if n = C_Int.fromInt ~1 | |
99 | then l | |
100 | else (n,s) :: l | |
101 | in | |
102 | val sysconfNames = | |
103 | (Prim.SC_2_CHAR_TERM,"2_CHAR_TERM") ::? | |
104 | (Prim.SC_2_C_BIND,"2_C_BIND") ::? | |
105 | (Prim.SC_2_C_DEV,"2_C_DEV") ::? | |
106 | (Prim.SC_2_FORT_DEV,"2_FORT_DEV") ::? | |
107 | (Prim.SC_2_FORT_RUN,"2_FORT_RUN") ::? | |
108 | (Prim.SC_2_LOCALEDEF,"2_LOCALEDEF") ::? | |
109 | (Prim.SC_2_PBS,"2_PBS") ::? | |
110 | (Prim.SC_2_PBS_ACCOUNTING,"2_PBS_ACCOUNTING") ::? | |
111 | (Prim.SC_2_PBS_CHECKPOINT,"2_PBS_CHECKPOINT") ::? | |
112 | (Prim.SC_2_PBS_LOCATE,"2_PBS_LOCATE") ::? | |
113 | (Prim.SC_2_PBS_MESSAGE,"2_PBS_MESSAGE") ::? | |
114 | (Prim.SC_2_PBS_TRACK,"2_PBS_TRACK") ::? | |
115 | (Prim.SC_2_SW_DEV,"2_SW_DEV") ::? | |
116 | (Prim.SC_2_UPE,"2_UPE") ::? | |
117 | (Prim.SC_2_VERSION,"2_VERSION") ::? | |
118 | (Prim.SC_ADVISORY_INFO,"ADVISORY_INFO") ::? | |
119 | (Prim.SC_AIO_LISTIO_MAX,"AIO_LISTIO_MAX") ::? | |
120 | (Prim.SC_AIO_MAX,"AIO_MAX") ::? | |
121 | (Prim.SC_AIO_PRIO_DELTA_MAX,"AIO_PRIO_DELTA_MAX") ::? | |
122 | (Prim.SC_ARG_MAX,"ARG_MAX") ::? | |
123 | (Prim.SC_ASYNCHRONOUS_IO,"ASYNCHRONOUS_IO") ::? | |
124 | (Prim.SC_ATEXIT_MAX,"ATEXIT_MAX") ::? | |
125 | (Prim.SC_AVPHYS_PAGES,"AVPHYS_PAGES") ::? | |
126 | (Prim.SC_BARRIERS,"BARRIERS") ::? | |
127 | (Prim.SC_BC_BASE_MAX,"BC_BASE_MAX") ::? | |
128 | (Prim.SC_BC_DIM_MAX,"BC_DIM_MAX") ::? | |
129 | (Prim.SC_BC_SCALE_MAX,"BC_SCALE_MAX") ::? | |
130 | (Prim.SC_BC_STRING_MAX,"BC_STRING_MAX") ::? | |
131 | (Prim.SC_CHILD_MAX,"CHILD_MAX") ::? | |
132 | (Prim.SC_CLK_TCK,"CLK_TCK") ::? | |
133 | (Prim.SC_CLOCK_SELECTION,"CLOCK_SELECTION") ::? | |
134 | (Prim.SC_COLL_WEIGHTS_MAX,"COLL_WEIGHTS_MAX") ::? | |
135 | (Prim.SC_CPUTIME,"CPUTIME") ::? | |
136 | (Prim.SC_DELAYTIMER_MAX,"DELAYTIMER_MAX") ::? | |
137 | (Prim.SC_EXPR_NEST_MAX,"EXPR_NEST_MAX") ::? | |
138 | (Prim.SC_FSYNC,"FSYNC") ::? | |
139 | (Prim.SC_GETGR_R_SIZE_MAX,"GETGR_R_SIZE_MAX") ::? | |
140 | (Prim.SC_GETPW_R_SIZE_MAX,"GETPW_R_SIZE_MAX") ::? | |
141 | (Prim.SC_HOST_NAME_MAX,"HOST_NAME_MAX") ::? | |
142 | (Prim.SC_IOV_MAX,"IOV_MAX") ::? | |
143 | (Prim.SC_IPV6,"IPV6") ::? | |
144 | (Prim.SC_JOB_CONTROL,"JOB_CONTROL") ::? | |
145 | (Prim.SC_LINE_MAX,"LINE_MAX") ::? | |
146 | (Prim.SC_LOGIN_NAME_MAX,"LOGIN_NAME_MAX") ::? | |
147 | (Prim.SC_MAPPED_FILES,"MAPPED_FILES") ::? | |
148 | (Prim.SC_MEMLOCK,"MEMLOCK") ::? | |
149 | (Prim.SC_MEMLOCK_RANGE,"MEMLOCK_RANGE") ::? | |
150 | (Prim.SC_MEMORY_PROTECTION,"MEMORY_PROTECTION") ::? | |
151 | (Prim.SC_MESSAGE_PASSING,"MESSAGE_PASSING") ::? | |
152 | (Prim.SC_MONOTONIC_CLOCK,"MONOTONIC_CLOCK") ::? | |
153 | (Prim.SC_MQ_OPEN_MAX,"MQ_OPEN_MAX") ::? | |
154 | (Prim.SC_MQ_PRIO_MAX,"MQ_PRIO_MAX") ::? | |
155 | (Prim.SC_NGROUPS_MAX,"NGROUPS_MAX") ::? | |
156 | (Prim.SC_NPROCESSORS_CONF,"NPROCESSORS_CONF") ::? | |
157 | (Prim.SC_NPROCESSORS_ONLN,"NPROCESSORS_ONLN") ::? | |
158 | (Prim.SC_OPEN_MAX,"OPEN_MAX") ::? | |
159 | (Prim.SC_PAGESIZE,"PAGESIZE") ::? | |
160 | (Prim.SC_PAGE_SIZE,"PAGE_SIZE") ::? | |
161 | (Prim.SC_PHYS_PAGES,"PHYS_PAGES") ::? | |
162 | (Prim.SC_PRIORITIZED_IO,"PRIORITIZED_IO") ::? | |
163 | (Prim.SC_PRIORITY_SCHEDULING,"PRIORITY_SCHEDULING") ::? | |
164 | (Prim.SC_RAW_SOCKETS,"RAW_SOCKETS") ::? | |
165 | (Prim.SC_READER_WRITER_LOCKS,"READER_WRITER_LOCKS") ::? | |
166 | (Prim.SC_REALTIME_SIGNALS,"REALTIME_SIGNALS") ::? | |
167 | (Prim.SC_REGEXP,"REGEXP") ::? | |
168 | (Prim.SC_RE_DUP_MAX,"RE_DUP_MAX") ::? | |
169 | (Prim.SC_RTSIG_MAX,"RTSIG_MAX") ::? | |
170 | (Prim.SC_SAVED_IDS,"SAVED_IDS") ::? | |
171 | (Prim.SC_SEMAPHORES,"SEMAPHORES") ::? | |
172 | (Prim.SC_SEM_NSEMS_MAX,"SEM_NSEMS_MAX") ::? | |
173 | (Prim.SC_SEM_VALUE_MAX,"SEM_VALUE_MAX") ::? | |
174 | (Prim.SC_SHARED_MEMORY_OBJECTS,"SHARED_MEMORY_OBJECTS") ::? | |
175 | (Prim.SC_SHELL,"SHELL") ::? | |
176 | (Prim.SC_SIGQUEUE_MAX,"SIGQUEUE_MAX") ::? | |
177 | (Prim.SC_SPAWN,"SPAWN") ::? | |
178 | (Prim.SC_SPIN_LOCKS,"SPIN_LOCKS") ::? | |
179 | (Prim.SC_SPORADIC_SERVER,"SPORADIC_SERVER") ::? | |
180 | (Prim.SC_SS_REPL_MAX,"SS_REPL_MAX") ::? | |
181 | (Prim.SC_STREAM_MAX,"STREAM_MAX") ::? | |
182 | (Prim.SC_SYMLOOP_MAX,"SYMLOOP_MAX") ::? | |
183 | (Prim.SC_SYNCHRONIZED_IO,"SYNCHRONIZED_IO") ::? | |
184 | (Prim.SC_THREADS,"THREADS") ::? | |
185 | (Prim.SC_THREAD_ATTR_STACKADDR,"THREAD_ATTR_STACKADDR") ::? | |
186 | (Prim.SC_THREAD_ATTR_STACKSIZE,"THREAD_ATTR_STACKSIZE") ::? | |
187 | (Prim.SC_THREAD_CPUTIME,"THREAD_CPUTIME") ::? | |
188 | (Prim.SC_THREAD_DESTRUCTOR_ITERATIONS,"THREAD_DESTRUCTOR_ITERATIONS") ::? | |
189 | (Prim.SC_THREAD_KEYS_MAX,"THREAD_KEYS_MAX") ::? | |
190 | (Prim.SC_THREAD_PRIORITY_SCHEDULING,"THREAD_PRIORITY_SCHEDULING") ::? | |
191 | (Prim.SC_THREAD_PRIO_INHERIT,"THREAD_PRIO_INHERIT") ::? | |
192 | (Prim.SC_THREAD_PRIO_PROTECT,"THREAD_PRIO_PROTECT") ::? | |
193 | (Prim.SC_THREAD_PROCESS_SHARED,"THREAD_PROCESS_SHARED") ::? | |
194 | (Prim.SC_THREAD_SAFE_FUNCTIONS,"THREAD_SAFE_FUNCTIONS") ::? | |
195 | (Prim.SC_THREAD_SPORADIC_SERVER,"THREAD_SPORADIC_SERVER") ::? | |
196 | (Prim.SC_THREAD_STACK_MIN,"THREAD_STACK_MIN") ::? | |
197 | (Prim.SC_THREAD_THREADS_MAX,"THREAD_THREADS_MAX") ::? | |
198 | (Prim.SC_TIMEOUTS,"TIMEOUTS") ::? | |
199 | (Prim.SC_TIMERS,"TIMERS") ::? | |
200 | (Prim.SC_TIMER_MAX,"TIMER_MAX") ::? | |
201 | (Prim.SC_TRACE,"TRACE") ::? | |
202 | (Prim.SC_TRACE_EVENT_FILTER,"TRACE_EVENT_FILTER") ::? | |
203 | (Prim.SC_TRACE_EVENT_NAME_MAX,"TRACE_EVENT_NAME_MAX") ::? | |
204 | (Prim.SC_TRACE_INHERIT,"TRACE_INHERIT") ::? | |
205 | (Prim.SC_TRACE_LOG,"TRACE_LOG") ::? | |
206 | (Prim.SC_TRACE_NAME_MAX,"TRACE_NAME_MAX") ::? | |
207 | (Prim.SC_TRACE_SYS_MAX,"TRACE_SYS_MAX") ::? | |
208 | (Prim.SC_TRACE_USER_EVENT_MAX,"TRACE_USER_EVENT_MAX") ::? | |
209 | (Prim.SC_TTY_NAME_MAX,"TTY_NAME_MAX") ::? | |
210 | (Prim.SC_TYPED_MEMORY_OBJECTS,"TYPED_MEMORY_OBJECTS") ::? | |
211 | (Prim.SC_TZNAME_MAX,"TZNAME_MAX") ::? | |
212 | (Prim.SC_V6_ILP32_OFF32,"V6_ILP32_OFF32") ::? | |
213 | (Prim.SC_V6_ILP32_OFFBIG,"V6_ILP32_OFFBIG") ::? | |
214 | (Prim.SC_V6_LP64_OFF64,"V6_LP64_OFF64") ::? | |
215 | (Prim.SC_V6_LPBIG_OFFBIG,"V6_LPBIG_OFFBIG") ::? | |
216 | (Prim.SC_VERSION,"VERSION") ::? | |
217 | (Prim.SC_XBS5_ILP32_OFF32,"XBS5_ILP32_OFF32") ::? | |
218 | (Prim.SC_XBS5_ILP32_OFFBIG,"XBS5_ILP32_OFFBIG") ::? | |
219 | (Prim.SC_XBS5_LP64_OFF64,"XBS5_LP64_OFF64") ::? | |
220 | (Prim.SC_XBS5_LPBIG_OFFBIG,"XBS5_LPBIG_OFFBIG") ::? | |
221 | (Prim.SC_XOPEN_CRYPT,"XOPEN_CRYPT") ::? | |
222 | (Prim.SC_XOPEN_ENH_I18N,"XOPEN_ENH_I18N") ::? | |
223 | (Prim.SC_XOPEN_LEGACY,"XOPEN_LEGACY") ::? | |
224 | (Prim.SC_XOPEN_REALTIME,"XOPEN_REALTIME") ::? | |
225 | (Prim.SC_XOPEN_REALTIME_THREADS,"XOPEN_REALTIME_THREADS") ::? | |
226 | (Prim.SC_XOPEN_SHM,"XOPEN_SHM") ::? | |
227 | (Prim.SC_XOPEN_STREAMS,"XOPEN_STREAMS") ::? | |
228 | (Prim.SC_XOPEN_UNIX,"XOPEN_UNIX") ::? | |
229 | (Prim.SC_XOPEN_VERSION,"XOPEN_VERSION") ::? | |
230 | [] | |
231 | end | |
232 | in | |
233 | fun sysconf s = | |
234 | case List.find (fn (_, s') => s = s') sysconfNames of | |
235 | NONE => Error.raiseSys Error.inval | |
236 | | SOME (n, _) => | |
237 | (SysWord.fromLargeInt o C_Long.toLarge o SysCall.simpleResult') | |
238 | ({errVal = C_Long.fromInt ~1}, fn () => Prim.sysconf n) | |
239 | end | |
240 | ||
241 | local | |
242 | structure Times = Prim.Times | |
243 | ||
244 | val clocksPerSec = | |
245 | (* syconf is not implemented on MinGW; | |
246 | * we don't want a SysErr during Basis Library initialization. | |
247 | *) | |
248 | if (let open Primitive.MLton.Platform.OS in host = MinGW end) | |
249 | then LargeInt.zero | |
250 | else SysWord.toLargeIntX (sysconf "CLK_TCK") | |
251 | ||
252 | fun cvt (clocks: C_Clock.t) = | |
253 | Time.fromTicks (LargeInt.quot | |
254 | (LargeInt.* (C_Clock.toLargeInt clocks, | |
255 | Time.ticksPerSecond), | |
256 | clocksPerSec)) | |
257 | in | |
258 | fun times () = | |
259 | SysCall.syscall' | |
260 | ({errVal = C_Clock.castFromFixedInt ~1}, fn () => | |
261 | (Prim.times (), fn elapsed => | |
262 | {elapsed = cvt elapsed, | |
263 | utime = cvt (Times.getUTime ()), | |
264 | stime = cvt (Times.getSTime ()), | |
265 | cutime = cvt (Times.getCUTime ()), | |
266 | cstime = cvt (Times.getCSTime ())})) | |
267 | end | |
268 | ||
269 | fun environ () = CSS.toList (Prim.environGet ()) | |
270 | ||
271 | fun getenv name = | |
272 | let | |
273 | val cs = Prim.getenv (NullString.nullTerm name) | |
274 | in | |
275 | if CUtil.C_Pointer.isNull cs | |
276 | then NONE | |
277 | else SOME (CS.toString cs) | |
278 | end | |
279 | ||
280 | fun ctermid () = CS.toString (Prim.ctermid ()) | |
281 | ||
282 | fun isatty fd = (Prim.isatty (FileDesc.toRep fd)) <> C_Int.zero | |
283 | ||
284 | fun ttyname fd = | |
285 | SysCall.syscall' | |
286 | ({errVal = CUtil.C_Pointer.null}, fn () => | |
287 | (Prim.ttyname (FileDesc.toRep fd), fn cs => | |
288 | CS.toString cs)) | |
289 | end |