1 /*
2 * system calls
3 * Copyright (C) 2003-2012,2016-2017 Sam Steingold
4 * Copyright (C) 2005,2008,2017-2018 Bruno Haible
5 * Copyright (C) 2005,2010 Arseny Slobodyuk
6 * This is Free Software, distributed under the GNU GPL v2+
7 */
8
9 #if defined(_WIN32)
10 /* need this for CreateHardLink to work */
11 # define WINVER 0x0500
12 #endif
13 #if defined(__CYGWIN__)
14 # define UNIX_CYGWIN
15 #endif
16
17 /* clisp.h includes system headers among other stuff
18 (windows.h on windows) */
19
20 #include "clisp.h"
21 #include "config.h"
22
23 # include <sys/time.h>
24 # include <time.h>
25 # include <unistd.h>
26 #if defined(HAVE_SYS_UNISTD_H)
27 # include <sys/unistd.h>
28 #endif
29 #include <errno.h> /* from gnulib */
30 #include <sys/types.h>
31 #if defined(HAVE_SYS_STAT_H)
32 # include <sys/stat.h>
33 #endif
34 #if defined(HAVE_SYS_RESOURCE_H)
35 # include <sys/resource.h>
36 #endif
37 #include <sys/wait.h> /* always present on unix, imported from gnulib elsewhere */
38 #if defined(HAVE_SYS_STATVFS_H)
39 # include <sys/statvfs.h>
40 #endif
41 #if defined(HAVE_CRYPT_H)
42 # include <crypt.h>
43 #endif
44 #if defined(HAVE_UTIME_H)
45 # include <utime.h>
46 #endif
47 #include <wchar.h>
48 #include <limits.h>
49 #if !defined(NZERO) /* should be defined in <limits.h> */
50 # define NZERO 20
51 #endif
52 #if defined(HAVE_SYSLOG_H)
53 # include <syslog.h>
54 #endif
55 #if defined(HAVE_UTMPX_H)
56 # include <utmpx.h>
57 #endif
58 #if defined(HAVE_SIGNAL_H)
59 # include <signal.h>
60 #endif
61 #if defined(HAVE_FCNTL_H)
62 # include <fcntl.h>
63 #endif
64 #if defined(HAVE_SYS_PARAM_H) /* might not be present on woe32 */
65 # include <sys/param.h>
66 #endif
67 #if defined(HAVE_FTW_H)
68 # include <ftw.h>
69 #endif
70 #include <fnmatch.h>
71
72 #if defined(WIN32_NATIVE) || defined(UNIX_CYGWIN)
73 #include <initguid.h>
74 DEFINE_GUID(FMTID_SummaryInformation, 0xF29F85E0, 0x4FF9, 0x1068,
75 0xAB, 0x91, 0x08, 0x00, 0x2B, 0x27, 0xB3, 0xD9);
76 DEFINE_GUID(FMTID_UserDefinedProperties, 0xD5CDD505, 0x2E9C, 0x101B,
77 0x93, 0x97, 0x08, 0x00, 0x2B, 0x2C, 0xF9, 0xAE);
78 #endif
79
80 #include <stdio.h> /* for BUFSIZ */
81 #include <stdlib.h>
82 #include <string.h> /* for strcpy(), strcat() */
83
84 /* #define DEBUG */
85 #if defined(DEBUG)
86 extern object nobject_out (FILE* stream, object obj);
87 # define XOUT(obj,label) \
88 (printf("[%s:%d] %s: %s:\n",__FILE__,__LINE__,STRING(obj),label), \
89 obj=nobject_out(stdout,obj), printf("\n"))
90 #else
91 # undef OBJECT_OUT
92 # define OBJECT_OUT(o,l)
93 # define XOUT(o,l)
94 #endif
95
96 /* http://opengroup.org/onlinepubs/9699919799/basedefs/sys/types.h.html
97 specifies tha pid_t is signed, assume that uid_t & gid_t are signed too */
98 #if SIZEOF_PID_T == 8
99 # define pid_to_I(g) sint64_to_I(g)
100 # define I_to_pid(g) I_to_sint64(g=check_sint64(g))
101 #else
102 # define pid_to_I(g) sint32_to_I(g)
103 # define I_to_pid(g) I_to_sint32(g=check_sint32(g))
104 #endif
105 #if SIZEOF_UID_T == 8
106 # define uid_to_I(g) sint64_to_I(g)
107 # define I_to_uid(g) I_to_sint64(g=check_sint64(g))
108 #else
109 # define uid_to_I(g) sint32_to_I(g)
110 # define I_to_uid(g) I_to_sint32(g=check_sint32(g))
111 #endif
112 #if SIZEOF_GID_T == 8
113 # define gid_to_I(g) sint64_to_I(g)
114 # define I_to_gid(g) I_to_sint64(g=check_sint64(g))
115 #else
116 # define gid_to_I(g) sint32_to_I(g)
117 # define I_to_gid(g) I_to_sint32(g=check_sint32(g))
118 #endif
119
120 /* general convenience macros */
121 /* when the portability is ensured by gnulib, use ANSIC_error;
122 when we use WIN32_NATIVE functions, use OS_error */
123 #define GETTER(type,conv,call) \
124 type id; \
125 begin_system_call(); id = call(); end_system_call(); \
126 VALUES1(conv##_to_I(id))
127 #define GETTER0(type,call) GETTER(type##_t,type,call)
128 #define GETTER1(type,call) \
129 type##_t id = I_to_##type(STACK_0); \
130 type##_t ret; \
131 begin_system_call(); ret=call(id); end_system_call(); \
132 if (ret==(type##_t)-1) ANSIC_error(); \
133 VALUES1(type##_to_I(ret)); skipSTACK(1)
134 #define SETTER(type,conv,call) \
135 type val = conv(STACK_0); \
136 int status; \
137 begin_system_call(); status = call(val); end_system_call(); \
138 if (status) ANSIC_error(); \
139 VALUES1(popSTACK())
140 #define SETTER1(type,call) SETTER(type##_t,I_to_##type,call)
141 #define SETTER2(type,call) \
142 type##_t eid = I_to_##type(STACK_0); \
143 type##_t rid = I_to_##type(STACK_1); \
144 int status; \
145 begin_system_call(); status = call(rid,eid); end_system_call(); \
146 if (status) ANSIC_error(); \
147 VALUES0; skipSTACK(2)
148
149 /* for COPY-FILE, must come before DEFMODULE for DEFCHECKER to work */
150 typedef enum {
151 COPY_METHOD_COPY,
152 COPY_METHOD_SYMLINK,
153 COPY_METHOD_HARDLINK,
154 COPY_METHOD_HARDLINK_OR_COPY, /* EXDEV=>COPY */
155 COPY_METHOD_RENAME
156 } copy_method_t;
157
158 DEFMODULE(syscalls,"POSIX")
159
160 #if defined(HAVE_FCNTL) || defined(WIN32_NATIVE)
161 /* we use posix fcntl() on unix and win32 LockFileEx() on win32.
162 since cygwin supports fcntl(), we use it there, but another option
163 would be to use cygwin get_osfhandle() + win32 LockFileEx(), see
164 http://article.gmane.org/gmane.os.cygwin/35175
165 https://cygwin.com/ml/cygwin/2003-08/msg00588.html */
166
167 /* ============================== aux ============================== */
168
169 /* the input handle from input stream and output handle from output stream
170 can trigger GC */
stream_get_handle(gcv_object_t * stream_)171 static Handle stream_get_handle (gcv_object_t *stream_) {
172 if (uint_p(*stream_)) {
173 Handle fd = (Handle)I_to_uint(*stream_);
174 *stream_ = nullobj;
175 return fd;
176 } else {
177 pushSTACK(*stream_); funcall(L(input_stream_p),1);
178 return stream_lend_handle(stream_,!nullp(value1),NULL);
179 }
180 }
181
182 /* signal the appropriate error error */
error_OS_stream(object stream)183 static _Noreturn void error_OS_stream (object stream) {
184 if (eq(nullobj,stream)) OS_error();
185 else OS_filestream_error(stream);
186 }
187
188 /* ============================== locking ============================== */
189 #if defined(WIN32_NATIVE)
190 /* LockFileEx does not exist on Windows95/98/ME. */
191 typedef BOOL (WINAPI * LockFileExFuncType)
192 (HANDLE hFile, DWORD dwFlags, DWORD dwReserved,
193 DWORD nNumberOfBytesToLockLow, DWORD nNumberOfBytesToLockHigh,
194 LPOVERLAPPED lpOverlapped);
195 static LockFileExFuncType LockFileExFunc = NULL;
my_LockFileEx(HANDLE hFile,DWORD dwFlags,DWORD dwReserved,DWORD nNumberOfBytesToLockLow,DWORD nNumberOfBytesToLockHigh,LPOVERLAPPED lpOverlapped)196 static BOOL my_LockFileEx
197 (HANDLE hFile, DWORD dwFlags, DWORD dwReserved,
198 DWORD nNumberOfBytesToLockLow, DWORD nNumberOfBytesToLockHigh,
199 LPOVERLAPPED lpOverlapped) {
200 (void)dwFlags; (void)dwReserved;
201 return LockFile(hFile,lpOverlapped->Offset,lpOverlapped->OffsetHigh,
202 nNumberOfBytesToLockLow,nNumberOfBytesToLockHigh);
203 }
204 typedef BOOL (WINAPI * UnlockFileExFuncType)
205 (HANDLE hFile, DWORD dwReserved,
206 DWORD nNumberOfBytesToUnlockLow, DWORD nNumberOfBytesToUnlockHigh,
207 LPOVERLAPPED lpOverlapped);
208 static UnlockFileExFuncType UnlockFileExFunc = NULL;
my_UnlockFileEx(HANDLE hFile,DWORD dwReserved,DWORD nNumberOfBytesToUnlockLow,DWORD nNumberOfBytesToUnlockHigh,LPOVERLAPPED lpOverlapped)209 static BOOL my_UnlockFileEx
210 (HANDLE hFile, DWORD dwReserved,
211 DWORD nNumberOfBytesToUnlockLow, DWORD nNumberOfBytesToUnlockHigh,
212 LPOVERLAPPED lpOverlapped) {
213 (void)dwReserved;
214 return UnlockFile(hFile,lpOverlapped->Offset,lpOverlapped->OffsetHigh,
215 nNumberOfBytesToUnlockLow,nNumberOfBytesToUnlockHigh);
216 }
217 #endif
218
219 #if defined(SIZEOF_OFF_T) && SIZEOF_OFF_T == 8
220 # define I_to_offset(x) I_to_uint64(check_uint64(x))
221 #else
222 # define I_to_offset(x) I_to_uint32(check_uint32(x))
223 #endif
224 DEFUN(POSIX::STREAM-LOCK, stream lockp &key :BLOCK SHARED :START :LENGTH)
225 { /* the interface to fcntl(2) */
226 Handle fd = (Handle)-1;
227 bool lock_p = !nullp(STACK_4), failed_p;
228 object stream;
229 uintL start = missingp(STACK_1) ? 0 : I_to_UL(check_ulong(STACK_1));
230 #if defined(WIN32_NATIVE)
231 uint64 length;
232 DWORD flags = !lock_p ? 0 :
233 (missingp(STACK_2) ? LOCKFILE_EXCLUSIVE_LOCK : 0) | /* (SHARED NIL) */
234 (nullp(STACK_3) ? LOCKFILE_FAIL_IMMEDIATELY : 0); /* (BLOCK T) */
235 OVERLAPPED ol = {0,0,start,0,NULL};
236 #else
237 off_t length;
238 int cmd = nullp(STACK_3) ? F_SETLK : F_SETLKW; /* (BLOCK T) */
239 struct flock fl;
240 fl.l_type = !lock_p ? F_UNLCK : /* unlock */
241 missingp(STACK_2) ? F_WRLCK : F_RDLCK; /* (SHARED NIL) */
242 fl.l_whence = SEEK_SET;
243 fl.l_start = start;
244 #endif
245 if (uint_p(STACK_5)) { /* STREAM */
246 fd = (Handle)I_to_uint(STACK_5);
247 stream = nullobj;
248 } else
249 stream = open_file_stream_handle(STACK_5,&fd,false);
250 if (missingp(STACK_0)) { /* no :LENGTH => use file size */
251 /* we use OS to get file size instead of calling FILE-LENGTH because
252 on win32 FILE-LENGTH will fail with ERROR_LOCK_VIOLATION when the
253 underlying file is locked */
254 # if defined(WIN32_NATIVE)
255 uint32 size_hi;
256 uint32 size_lo;
257 begin_blocking_system_call();
258 size_lo = GetFileSize(fd,(DWORD*)&size_hi);
259 /* Value returned can be (LONG) -1 even on success,
260 check the last error code */
261 failed_p = (size_lo == INVALID_FILE_SIZE) && (GetLastError() != 0);
262 end_blocking_system_call();
263 if (failed_p) goto stream_lock_error;
264 length = ((uint64)size_hi << 32) | (uint64)size_lo;
265 # elif defined(HAVE_FSTAT)
266 struct stat st;
267 begin_blocking_system_call();
268 failed_p = (-1 == fstat(fd,&st));
269 end_blocking_system_call();
270 if (failed_p) goto stream_lock_error;
271 length = st.st_size;
272 # else
273 length = 0;
274 # endif
275 } else
276 length = I_to_offset(STACK_0);
277 begin_blocking_system_call();
278 #if defined(WIN32_NATIVE)
279 if (lock_p) {
280 failed_p = !(*LockFileExFunc)(fd,flags,0,length,0,&ol);
281 if (failed_p && nullp(STACK_3) && GetLastError() == ERROR_LOCK_VIOLATION)
282 failed_p = lock_p = false; /* failed to lock, :BLOCK NIL */
283 } else
284 failed_p = !(*UnlockFileExFunc)(fd,0,length,0,&ol);
285 #else
286 fl.l_len = length;
287 if ((failed_p = (-1 == fcntl(fd,cmd,&fl)))
288 && lock_p && (cmd == F_SETLK) && (errno == EACCES || errno == EAGAIN))
289 failed_p = lock_p = false; /* failed to lock, :BLOCK NIL */
290 #endif
291 end_blocking_system_call();
292 if (failed_p) stream_lock_error:
293 error_OS_stream(stream);
294 skipSTACK(6);
295 VALUES_IF(lock_p);
296 }
297 #endif /* fcntl | WIN32_NATIVE */
298
299 /* ============================== fcntl ============================== */
300 #if defined(HAVE_FCNTL)
301 DEFCHECKER(check_fcntl_cmd, prefix=F_GET, delim=, default=,FD FL)
302 /* note that O_ACCMODE is treated specially */
303 DEFCHECKER(check_fl_flags, prefix=O, default=,bitmasks=both, \
304 RDONLY WRONLY RDWR :APPEND CREAT TRUNC EXCL NOCTTY SYNC NONBLOCK \
305 BINARY TEXT NOINHERIT DIRECT LARGEFILE :DIRECTORY NOFOLLOW)
306 DEFCHECKER(check_fd_flags, prefix=FD,bitmasks=both,CLOEXEC)
307 DEFUN(POSIX::STREAM-OPTIONS, stream cmd &optional value)
308 { /* http://opengroup.org/onlinepubs/9699919799/functions/fcntl.html */
309 int cmd = check_fcntl_cmd(STACK_1);
310 Handle fd = stream_get_handle(&STACK_2);
311 int value;
312 if (boundp(STACK_0)) { /* SET */
313 switch (cmd) {
314 case F_GETFD: value = check_fd_flags_of_list(STACK_0);
315 cmd = F_SETFD; break;
316 case F_GETFL: value = check_fl_flags_of_list(STACK_0);
317 cmd = F_SETFL; break;
318 default: NOTREACHED;
319 }
320 begin_blocking_system_call();
321 value = fcntl(fd,cmd,value);
322 end_blocking_system_call();
323 if (-1 == value) error_OS_stream(STACK_2);
324 VALUES0;
325 } else { /* GET */
326 begin_blocking_system_call();
327 value = fcntl(fd,cmd);
328 end_blocking_system_call();
329 if (-1 == value) error_OS_stream(STACK_2);
330 switch (cmd) {
331 case F_GETFD: value1 = check_fd_flags_to_list(value); break;
332 case F_GETFL:
333 switch (value & O_ACCMODE) {
334 case O_RDONLY: STACK_0 = `:RDONLY`; break;
335 case O_WRONLY: STACK_0 = `:WRONLY`; break;
336 case O_RDWR: STACK_0 = `:RDWR`; break;
337 default: NOTREACHED;
338 }
339 STACK_1 = check_fl_flags_to_list(value & ~O_ACCMODE);
340 value1 = allocate_cons();
341 Car(value1) = STACK_0;
342 Cdr(value1) = STACK_1;
343 break;
344 default: NOTREACHED;
345 }
346 mv_count = 1;
347 }
348 skipSTACK(3);
349 }
350 #endif
351
352 /* call f on physical namestring of path and data
353 > path: a pathname designator
354 > f: system call
355 < data: anything which f accepts
356 < value1: the physical namestring of path (for error reporting)
357 < returns whatever f returns
358 NB: on success, unix functions return 0, while woe32 functions return 1 !
359 can trigger GC */
on_pnamestring(object path,void * (* f)(const char *,void *),void * data)360 static /*maygc*/ void* on_pnamestring
361 (object path, void* (*f) (const char*,void*), void* data) {
362 void* ret;
363 pushSTACK(physical_namestring(path)); /* save for blocking */
364 with_string_0(STACK_0,GLO(pathname_encoding),pathz, {
365 begin_blocking_system_call();
366 ret = (*f)(pathz,data);
367 end_blocking_system_call();
368 });
369 value1 = popSTACK();
370 return ret;
371 }
372 #define ON_PNAMESTRING(p,f,d) on_pnamestring(p,(void*(*)(const char*,void*))&(f),(void*)(d))
373
374 /* =========================== file truncate =========================== */
375 /* NB: woe32 has ftruncate, but, just like fstat, it does not accept a Handle,
376 just an integer of an unknown nature */
377
378 #if defined(WIN32_NATIVE)
379 typedef LARGE_INTEGER file_offset_t;
I_to_file_offset(object obj,file_offset_t * length)380 static inline void I_to_file_offset (object obj, file_offset_t *length)
381 { length->QuadPart = I_to_sint64(check_sint64(obj)); }
382 #elif defined(UNIX)
383 typedef off_t file_offset_t;
I_to_file_offset(object obj,file_offset_t * length)384 static inline void I_to_file_offset (object obj, file_offset_t *length)
385 { *length = I_to_offset(obj); }
386 #else
387 # error file_offset_t is not defined
388 #endif
389
390 /* truncate a file, STACK_0 = path */
path_truncate(const char * path,file_offset_t * length)391 static void* path_truncate (const char *path, file_offset_t *length) {
392 #if defined(WIN32_NATIVE)
393 HANDLE fd = CreateFile(path,GENERIC_WRITE,0,NULL,OPEN_EXISTING,
394 FILE_ATTRIBUTE_NORMAL,NULL);
395 return (void*)(!(fd != INVALID_HANDLE_VALUE
396 && SetFilePointerEx(fd,*length,NULL,FILE_BEGIN)
397 && SetEndOfFile(fd)
398 && CloseHandle(fd)));
399 #elif defined(HAVE_TRUNCATE)
400 return (void*)(uintP)truncate(path,*length);
401 #else
402 #error FILE-SIZE: no truncate and not woe32
403 #endif
404 }
405
406 /* truncate a stream, STACK_0 = stream */
stream_truncate(Handle fd,file_offset_t * length)407 static void stream_truncate (Handle fd, file_offset_t *length) {
408 begin_blocking_system_call();
409 #if defined(WIN32_NATIVE)
410 { LARGE_INTEGER cur_pos;
411 if (!(SetFilePointerEx(fd,(LARGE_INTEGER){QuadPart:0},
412 &cur_pos,FILE_CURRENT)
413 && SetFilePointerEx(fd,*length,NULL,FILE_BEGIN)
414 && SetEndOfFile(fd)
415 && SetFilePointerEx(fd,cur_pos,NULL,FILE_BEGIN)))
416 { end_blocking_system_call(); OS_filestream_error(STACK_0); }
417 }
418 #elif defined(HAVE_FTRUNCATE)
419 if (ftruncate(fd,*length))
420 { end_blocking_system_call(); OS_file_error(STACK_0); }
421 #else
422 #error FILE-SIZE: no ftruncate and not woe32
423 #endif
424 end_blocking_system_call();
425 }
426
427 /* separate from SET-FILE-STAT because it works only on paths
428 while (setf file-size) supports streams as well */
429 DEFUN(POSIX::%SET-FILE-SIZE, file new-size) {
430 /* http://opengroup.org/onlinepubs/9699919799/functions/truncate.html
431 http://opengroup.org/onlinepubs/9699919799/functions/ftruncate.html
432 http://msdn.microsoft.com/en-us/library/aa365542(VS.85).aspx
433 http://msdn.microsoft.com/en-us/library/aa365531(VS.85).aspx */
434 file_offset_t length;
435 Handle fd;
436 I_to_file_offset(STACK_0,&length);
437 /* stream_truncate uses STACK_0 for error reporting */
438 pushSTACK(open_file_stream_handle(STACK_1,&fd,true));
439 if (eq(nullobj,STACK_0)) { /* not a stream - use path */
440 if (ON_PNAMESTRING(STACK_2,path_truncate,&length))
441 OS_file_error(value1);
442 } else stream_truncate(fd,&length); /* stream - use fd */
443 VALUES1(STACK_1); skipSTACK(3);
444 }
445
446 #if defined(WIN32_NATIVE)
get_file_size(const char * path,file_offset_t * length)447 static void* get_file_size (const char *path, file_offset_t *length) {
448 Handle fd = CreateFile(path,GENERIC_WRITE,0,NULL,OPEN_EXISTING,
449 FILE_ATTRIBUTE_NORMAL,NULL);
450 return (void*)(!(fd != INVALID_HANDLE_VALUE
451 && GetFileSizeEx(fd,length)
452 && CloseHandle(fd)));
453 }
454 #endif
455 DEFUN(POSIX:FILE-SIZE, file) {
456 /* we could implement this in Lisp like this:
457 (defun file-size (file)
458 (handler-case (file-length file)
459 (file-error (c) (with-open-file (s file) (file-length s))))) */
460 Handle fd;
461 object stream = open_file_stream_handle(STACK_0,&fd,true);
462 if (eq(nullobj,stream)) { /* not a stream - use path */
463 #if defined(WIN32_NATIVE)
464 LARGE_INTEGER length;
465 if (ON_PNAMESTRING(STACK_0,get_file_size,&length))
466 OS_file_error(value1);
467 VALUES1(sint64_to_I(length.QuadPart));
468 #elif defined(HAVE_STAT)
469 struct stat buf;
470 if (ON_PNAMESTRING(STACK_0,stat,&buf))
471 OS_file_error(value1);
472 VALUES1(off_to_I(buf.st_size));
473 #else
474 #error FILE-SIZE: no stat and not woe32
475 #endif
476 skipSTACK(1);
477 } else { /* stream - use FILE-LENGTH */
478 STACK_0 = stream;
479 funcall(L(file_length),1);
480 }
481 }
482
483 /* ============================== syslog ============================== */
484 #if defined(HAVE_SYSLOG)
485 DEFCHECKER(check_syslog_severity,prefix=LOG, \
486 EMERG ALERT CRIT ERR WARNING NOTICE INFO DEBUG)
487 DEFCHECKER(check_syslog_facility,default=LOG_USER,prefix=LOG,\
488 KERN USER MAIL NEWS UUCP DAEMON AUTH CRON LPR SYSLOG AUTHPRIV FTP \
489 LOCAL0 LOCAL1 LOCAL2 LOCAL3 LOCAL4 LOCAL5 LOCAL6 LOCAL7)
490 DEFFLAGSET(syslog_opt_flags,LOG_PID LOG_CONS LOG_NDELAY LOG_ODELAY LOG_NOWAIT)
491 #if defined(HAVE_OPENLOG)
492 static char* log_ident=NULL;
493 DEFUN(POSIX:OPENLOG,ident &key PID CONS NDELAY ODELAY NOWAIT FACILITY) {
494 int facility = check_syslog_facility(popSTACK());
495 int logopt = syslog_opt_flags();
496 with_string_0(check_string(popSTACK()),GLO(misc_encoding),ident, {
497 log_ident = (char*)clisp_realloc(log_ident,strlen(ident)+1);
498 begin_blocking_system_call();
499 strcpy(log_ident,ident);
500 openlog(log_ident,logopt,facility);
501 end_blocking_system_call();
502 });
503 VALUES0;
504 }
505 #endif
506 #if defined(HAVE_SETLOGMASK)
507 DEFUN(POSIX:SETLOGMASK, maskpri) {
508 int priority = (missingp(STACK_0) ? (skipSTACK(1),0) /*query*/ :
509 check_syslog_severity(popSTACK()));
510 int logmask;
511 begin_system_call();
512 logmask = setlogmask(LOG_MASK(priority));
513 end_system_call();
514 VALUES1(check_syslog_severity_reverse(logmask));
515 }
516 #endif
517 DEFUN(POSIX::%SYSLOG, severity facility message) {
518 int priority =
519 check_syslog_severity(STACK_2) | check_syslog_facility(STACK_1);
520 with_string_0(STACK_0 = check_string(STACK_0),GLO(misc_encoding),mesg, {
521 begin_blocking_system_call();
522 /* disable %m but avoid surprises with % special handling
523 http://opengroup.org/onlinepubs/9699919799/functions/syslog.html */
524 syslog(priority,"%s",mesg);
525 end_blocking_system_call();
526 });
527 VALUES0; skipSTACK(3);
528 }
529 #if defined(HAVE_CLOSELOG)
530 DEFUN(POSIX:CLOSELOG,) {
531 begin_blocking_system_call();
532 closelog();
533 #if defined(HAVE_OPENLOG)
534 if(log_ident) { free(log_ident); log_ident=NULL; }
535 #endif
536 end_blocking_system_call();
537 VALUES0;
538 }
539 #endif
540 #endif /* HAVE_SYSLOG */
541
542 /* ========================== time conversion ========================== */
543 /* call ENCODE-UNIVERSAL-TIME on struct tm and timezone */
tm_to_lisp(struct tm * tm,object timezone)544 static Values tm_to_lisp (struct tm *tm, object timezone) {
545 pushSTACK(fixnum(tm->tm_sec));
546 pushSTACK(fixnum(tm->tm_min));
547 pushSTACK(fixnum(tm->tm_hour));
548 pushSTACK(fixnum(tm->tm_mday));
549 pushSTACK(fixnum(1+tm->tm_mon));
550 pushSTACK(fixnum(1900+tm->tm_year));
551 pushSTACK(timezone);
552 funcall(S(encode_universal_time),7);
553 }
554 DEFUN(POSIX:STRING-TIME, format &optional datum timezone)
555 { /* http://opengroup.org/onlinepubs/9699919799/functions/strptime.html
556 http://opengroup.org/onlinepubs/9699919799/functions/strftime.html */
557 STACK_2 = check_string(STACK_2); /* format */
558 if (missingp(STACK_1)) { /* datum defaults to the current time */
559 funcall(L(get_universal_time),0);
560 STACK_1 = value1;
561 }
562 if (stringp(STACK_1)) { /* parse: strptime */
563 struct tm tm;
564 unsigned int offset;
565 tm.tm_sec = 0; /* Seconds [0,60]. */
566 tm.tm_min = 0; /* Minutes [0,59]. */
567 tm.tm_hour = 0; /* Hour [0,23]. */
568 tm.tm_mday = 1; /* Day of month [1,31]. */
569 tm.tm_mon = 0; /* Month of year [0,11]. */
570 tm.tm_year = 0; /* Years since 1900. */
571 tm.tm_wday = 0; /* Day of week [0,6] (C: Sunday=0 <== CL: Monday=0 */
572 tm.tm_isdst = false; /* Daylight Savings flag. */
573 with_string_0(STACK_1,GLO(misc_encoding),buf, {
574 with_string_0(STACK_2,GLO(misc_encoding),format, {
575 char *ret;
576 begin_system_call();
577 if ((ret = strptime(buf,format,&tm))) offset = ret - buf;
578 else offset = 0;
579 end_system_call();
580 });
581 });
582 if (offset == 0) {
583 pushSTACK(STACK_1);/*datum*/ pushSTACK(STACK_(2+1));/*format*/
584 pushSTACK(TheSubr(subr_self)->name);
585 error(error_condition,GETTEXT("~S: invalid format ~S or datum ~S"));
586 }
587 tm_to_lisp(&tm,STACK_0); /* set value1 */
588 value2 = tm.tm_isdst > 0 ? T : NIL;
589 value3 = fixnum(offset);
590 mv_count = 3;
591 skipSTACK(3);
592 } else if (integerp(STACK_1)) { /* format: strftime */
593 struct tm tm;
594 funcall(`CL:DECODE-UNIVERSAL-TIME`,2);
595 tm.tm_sec = posfixnum_to_V(value1); /* Seconds [0,60]. */
596 tm.tm_min = posfixnum_to_V(value2); /* Minutes [0,59]. */
597 tm.tm_hour = posfixnum_to_V(value3); /* Hour [0,23]. */
598 tm.tm_mday = posfixnum_to_V(value4); /* Day of month [1,31]. */
599 tm.tm_mon = posfixnum_to_V(value5) - 1; /* Month of year [0,11]. */
600 tm.tm_year = posfixnum_to_V(value6) - 1900; /* Years since 1900. */
601 /* Day of week [0,6] (C: Sunday=0 <== CL: Monday=0 */
602 tm.tm_wday = (posfixnum_to_V(value7) + 1) % 7;
603 tm.tm_isdst = !nullp(value8); /* Daylight Savings flag. */
604 /* tm.tm_yday == Day of year [0,365]. -- use mkime() */
605 { time_t ret;
606 begin_system_call(); ret = mktime(&tm); end_system_call();
607 if (ret == (time_t)-1) ANSIC_error();
608 }
609 with_string_0(STACK_0,GLO(misc_encoding),format, {
610 /* at least 4 characters per each format char + safety */
611 size_t bufsize = 4 * format_bytelen + 64;
612 char* buf = (char*)alloca(bufsize);
613 size_t retval;
614 begin_system_call();
615 retval = strftime(buf,bufsize,format,&tm);
616 end_system_call();
617 VALUES1(n_char_to_string(buf,retval,GLO(misc_encoding)));
618 });
619 skipSTACK(1);
620 } else error_string_integer(STACK_1);
621 }
622
623 #if defined(HAVE_GETDATE) && defined(HAVE_DECL_GETDATE_ERR)
624 DEFUN(POSIX:GETDATE, timespec &optional timezone)
625 { /* http://opengroup.org/onlinepubs/9699919799/functions/getdate.html */
626 struct tm *tm;
627 getdate_restart:
628 STACK_1 = check_string(STACK_1);
629 with_string_0(STACK_1,GLO(misc_encoding),timespec, {
630 begin_system_call();
631 tm = getdate(timespec);
632 end_system_call();
633 });
634 if (tm == NULL) {
635 pushSTACK(NIL); /* no PLACE */
636 pushSTACK(fixnum(getdate_err));
637 pushSTACK(STACK_(1+2));
638 pushSTACK(TheSubr(subr_self)->name);
639 check_value(error_condition,GETTEXT("~S(~S): getdate error ~S"));
640 STACK_1 = value1;
641 goto getdate_restart;
642 }
643 tm_to_lisp(tm,STACK_0);
644 skipSTACK(2);
645 }
646 #endif /* HAVE_GETDATE & HAVE_DECL_GETDATE_ERR */
647
648 /* ========================== string comparison ========================== */
649 /* call strverscmp() on STACK_0 & STACK_1 and remove them from STACK */
string_version_compare(void)650 static /*maygc*/ int string_version_compare (void) {
651 int ret;
652 STACK_0 = check_string(STACK_0);
653 STACK_1 = check_string(STACK_1);
654 with_string_0(STACK_0,GLO(misc_encoding),s1, {
655 with_string_0(STACK_1,GLO(misc_encoding),s2, {
656 begin_system_call(); ret = strverscmp(s2,s1); end_system_call();
657 });
658 });
659 skipSTACK(2);
660 return ret;
661 }
662
663 DEFUN(OS::VERSION-COMPARE, string1 string2) {
664 int ret=string_version_compare();
665 VALUES1(ret<0 ? S(smaller) : ret>0 ? S(greater) : S(numequal));
666 }
667 DEFUN(OS:VERSION<, string1 string2){VALUES_IF(string_version_compare() < 0);}
668 DEFUN(OS:VERSION<=, string1 string2){VALUES_IF(string_version_compare() <= 0);}
669 DEFUN(OS:VERSION>, string1 string2){VALUES_IF(string_version_compare() > 0);}
670 DEFUN(OS:VERSION>=, string1 string2){VALUES_IF(string_version_compare() >= 0);}
671
672 /* ========================== temporary files ========================== */
673 #define ENSURE_6X(name,template) \
674 if (name##_bytelen > 6 \
675 && name[name##_bytelen-1]=='X' \
676 && name[name##_bytelen-2]=='X' \
677 && name[name##_bytelen-3]=='X' \
678 && name[name##_bytelen-4]=='X' \
679 && name[name##_bytelen-5]=='X' \
680 && name[name##_bytelen-6]=='X') { \
681 c_template = name; \
682 } else { \
683 c_template = (char*)alloca(name##_bytelen+6); \
684 strcpy(c_template,name); \
685 strcat(c_template,"XXXXXX"); \
686 }
687 #if defined(WIN32_NATIVE)
688 # define allocate_lisp_handle(fd) allocate_handle((HANDLE)_get_osfhandle(fd))
689 #else
690 # define allocate_lisp_handle allocate_handle
691 #endif
692 DEFUN(POSIX:MKSTEMP, template &key :DIRECTION :BUFFERED :EXTERNAL-FORMAT \
693 :ELEMENT-TYPE) {
694 /* http://opengroup.org/onlinepubs/9699919799/functions/mkstemp.html */
695 object fname = physical_namestring(STACK_4);
696 direction_t dir = (boundp(STACK_3) ? check_direction(STACK_3)
697 : DIRECTION_OUTPUT);
698 int fd;
699 with_string_0(fname,GLO(pathname_encoding),namez,{
700 char *c_template;
701 begin_blocking_system_call();
702 ENSURE_6X(namez,c_template);
703 fd = mkstemp(c_template);
704 end_blocking_system_call();
705 fname = asciz_to_string(c_template,GLO(pathname_encoding));
706 });
707 if (fd == -1) ANSIC_error();
708 pushSTACK(fname); funcall(L(pathname),1); STACK_4=value1; /* filename */
709 pushSTACK(value1); funcall(L(truename),1); STACK_3=value1; /* truename */
710 pushSTACK(allocate_lisp_handle(fd));
711 /* stack layout: FD, eltype, extfmt, buff, truename, filename */
712 VALUES1(make_file_stream(dir,false,true));
713 }
714
715 /* ================= user accounting database functions ================= */
716 #if defined(HAVE_UTMPX_H)
717 DEFCHECKER(check_ut_type,default=,EMPTY RUN-LVL BOOT-TIME OLD-TIME NEW-TIME \
718 USER-PROCESS INIT-PROCESS LOGIN-PROCESS DEAD-PROCESS ACCOUNTING)
check_utmpx(gcv_object_t * arg)719 static int check_utmpx (gcv_object_t *arg) {
720 *arg = check_classname(*arg,`POSIX::UTMPX`);
721 return check_ut_type(TheStructure(*arg)->recdata[4]);
722 }
723 /* convert C struct utmpx to Lisp
724 can trigger GC */
utmpx_to_lisp(struct utmpx * utmpx,gcv_object_t * utmpx_o)725 static Values utmpx_to_lisp (struct utmpx *utmpx, gcv_object_t *utmpx_o) {
726 pushSTACK(check_ut_type_reverse(utmpx->ut_type));
727 pushSTACK(safe_to_string(utmpx->ut_user));
728 pushSTACK(safe_to_string(utmpx->ut_id));
729 pushSTACK(safe_to_string(utmpx->ut_line));
730 pushSTACK(L_to_I(utmpx->ut_pid));
731 #if defined(HAVE_UTMPX_UT_HOST)
732 pushSTACK(safe_to_string(utmpx->ut_host));
733 #else
734 pushSTACK(NIL);
735 #endif
736 pushSTACK(sec_usec_number(utmpx->ut_tv.tv_sec,utmpx->ut_tv.tv_usec,1));
737 if (utmpx_o) {
738 TheStructure(*utmpx_o)->recdata[7] = popSTACK(); /* tv */
739 TheStructure(*utmpx_o)->recdata[6] = popSTACK(); /* host */
740 TheStructure(*utmpx_o)->recdata[5] = popSTACK(); /* pid */
741 TheStructure(*utmpx_o)->recdata[4] = popSTACK(); /* line */
742 TheStructure(*utmpx_o)->recdata[3] = popSTACK(); /* id */
743 TheStructure(*utmpx_o)->recdata[2] = popSTACK(); /* user */
744 TheStructure(*utmpx_o)->recdata[1] = popSTACK(); /* type */
745 VALUES1(*utmpx_o);
746 } else funcall(`POSIX::MAKE-UTMPX`,7);
747 }
748 #if defined(HAVE_ENDUTXENT)
749 DEFUN(POSIX::ENDUTXENT,) {
750 begin_blocking_system_call(); endutxent(); end_blocking_system_call();
751 VALUES0;
752 }
753 #endif
754 #if defined(HAVE_GETUTXENT)
755 DEFUN(POSIX::GETUTXENT, &optional utmpx) {
756 struct utmpx *utmpx;
757 if (!missingp(STACK_0)) STACK_0 = check_classname(STACK_0,`POSIX::UTMPX`);
758 begin_blocking_system_call(); utmpx=getutxent(); end_blocking_system_call();
759 if (utmpx) utmpx_to_lisp(utmpx,missingp(STACK_0) ? NULL : &STACK_0);
760 else VALUES1(NIL);
761 skipSTACK(1);
762 }
763 #endif
764 #if defined(HAVE_GETUTXID)
DEFUN(POSIX::GETUTXID,id)765 DEFUN(POSIX::GETUTXID, id) {
766 struct utmpx utmpx, *utmpx_p;
767 utmpx.ut_type = check_utmpx(&STACK_0);
768 begin_blocking_system_call();
769 utmpx_p = getutxid(&utmpx);
770 end_blocking_system_call();
771 if (utmpx_p) utmpx_to_lisp(utmpx_p,&STACK_0);
772 else VALUES1(NIL);
773 skipSTACK(1);
774 }
775 #endif
776 #if defined(HAVE_GETUTXLINE)
DEFUN(POSIX::GETUTXLINE,line)777 DEFUN(POSIX::GETUTXLINE, line) {
778 struct utmpx utmpx, *utmpx_p;
779 utmpx.ut_type = check_utmpx(&STACK_0);
780 begin_blocking_system_call();
781 utmpx_p = getutxline(&utmpx);
782 end_blocking_system_call();
783 if (utmpx_p) utmpx_to_lisp(utmpx_p,&STACK_0);
784 else VALUES1(NIL);
785 skipSTACK(1);
786 }
787 #endif
788 #if defined(HAVE_PUTUTXLINE)
DEFUN(POSIX::PUTUTXLINE,utmpx)789 DEFUN(POSIX::PUTUTXLINE, utmpx) {
790 struct utmpx utmpx, *utmpx_p;
791 utmpx.ut_type = check_utmpx(&STACK_0);
792 begin_blocking_system_call();
793 utmpx_p = pututxline(&utmpx);
794 end_blocking_system_call();
795 if (utmpx_p) utmpx_to_lisp(utmpx_p,&STACK_0);
796 else ANSIC_error();
797 skipSTACK(1);
798 }
799 #endif
800 #if defined(HAVE_SETUTXENT)
801 DEFUN(POSIX::SETUTXENT,) {
802 begin_blocking_system_call(); setutxent(); end_blocking_system_call();
803 VALUES0;
804 }
805 #endif
806 #endif /* HAVE_UTMPX_H */
807
808 /* ========================= processes & signals ========================= */
809 #if defined(HAVE_GETPPID)
810 DEFUN(POSIX:GETPPID,) { GETTER0(pid,getppid); }
811 #endif
812 #if defined(HAVE_GETSID)
813 DEFUN(POSIX:GETSID, pid) { GETTER1(pid,getsid); }
814 #endif
815 #if defined(HAVE_SETSID)
816 DEFUN(POSIX:SETSID,) { GETTER0(pid,setsid); } /* sic! */
817 #endif
818 #if defined(HAVE_GETPGRP)
819 DEFUN(POSIX:GETPGRP,) { GETTER0(pid,getpgrp); }
820 #endif
821 #if defined(HAVE_SETPGRP)
822 DEFUN(POSIX:SETPGRP,) {
823 pid_t ret;
824 # if defined(HAVE_SETPGRP_POSIX)
825 begin_system_call(); ret=setpgrp(); end_system_call();
826 # else /* BSD version, identical to setpgid() */
827 begin_system_call(); ret=setpgrp(0,0); end_system_call();
828 # endif
829 if (ret==(pid_t)-1) ANSIC_error();
830 VALUES1(pid_to_I(ret));
831 }
832 #endif
833 #if defined(HAVE_GETPGID)
834 DEFUN(POSIX:PGID, pid) { GETTER1(pid,getpgid); }
835 #endif
836 #if defined(HAVE_SETPGID)
837 DEFUN(POSIX::%SETPGID, pid pgid) {
838 pid_t pgid = I_to_pid(STACK_0);
839 pid_t pid = I_to_pid(STACK_1);
840 int ret;
841 begin_system_call(); ret=setpgid(pid,pgid); end_system_call();
842 if (ret==-1) ANSIC_error();
843 VALUES1(STACK_0); skipSTACK(2);
844 }
845 #endif
846 #if defined(HAVE_SETREUID)
847 DEFUN(POSIX:SETREUID, ruid euid) { SETTER2(uid,setreuid); }
848 #endif
849 #if defined(HAVE_SETREGID)
850 DEFUN(POSIX:SETREGID, rgid egid) { SETTER2(gid,setregid); }
851 #endif
852 /* http://opengroup.org/onlinepubs/9699919799/basedefs/signal.h.html */
DEFCHECKER(check_signal,SIGABRT SIGALRM SIGBUS SIGCHLD SIGCONT SIGFPE SIGHUP SIGILL SIGINT SIGKILL SIGPIPE SIGQUIT SIGSEGV SIGSTOP SIGTERM SIGTSTP SIGTTIN SIGTTOU SIGUSR1 SIGUSR2 SIGPOLL SIGPROF SIGSYS SIGTRAP SIGURG SIGVTALRM SIGXCPU SIGXFSZ)853 DEFCHECKER(check_signal,SIGABRT SIGALRM SIGBUS SIGCHLD SIGCONT SIGFPE SIGHUP \
854 SIGILL SIGINT SIGKILL SIGPIPE SIGQUIT SIGSEGV SIGSTOP SIGTERM \
855 SIGTSTP SIGTTIN SIGTTOU SIGUSR1 SIGUSR2 SIGPOLL SIGPROF SIGSYS \
856 SIGTRAP SIGURG SIGVTALRM SIGXCPU SIGXFSZ)
857 #if defined(HAVE_KILL)
858 DEFUN(POSIX:KILL, pid sig) {
859 int sig = check_signal(STACK_0);
860 pid_t pid = I_to_pid(STACK_1);
861 int ret;
862 begin_system_call(); ret=kill(pid,sig); end_system_call();
863 if (ret==-1) ANSIC_error();
864 VALUES0; skipSTACK(2);
865 }
866 #endif /* HAVE_KILL */
867
868 /* ============================= file sync ============================= */
869 #if defined(WIN32_NATIVE) || defined(HAVE_SYNC) || defined(HAVE_FSYNC)
870 DEFUN(POSIX:SYNC, &optional file) {
871 if (missingp(STACK_0)) { /* sync() */
872 # if defined(HAVE_SYNC)
873 begin_blocking_system_call(); sync(); end_blocking_system_call();
874 # endif
875 } else { /* fsync() */
876 Handle fd = stream_get_handle(&STACK_0);
877 bool failed_p;
878 begin_blocking_system_call();
879 # if defined(HAVE_FSYNC)
880 failed_p = (-1 == fsync(fd));
881 # elif defined(WIN32_NATIVE)
882 failed_p = (!FlushFileBuffers(fd));
883 # endif
884 end_blocking_system_call();
885 if (failed_p) error_OS_stream(STACK_0);
886 }
887 VALUES0; skipSTACK(1);
888 }
889 #endif
890 /* ========================== process priority ========================== */
891 #if defined(WIN32_NATIVE)
892 DEFCHECKER(check_priority_value,suffix=PRIORITY_CLASS,default=0, \
893 REALTIME :HIGH ABOVE-NORMAL :NORMAL BELOW-NORMAL :LOW IDLE)
894 #else
895 DEFCHECKER(check_priority_value,default=0, \
896 REALTIME=-NZERO :HIGH=(-NZERO/2) ABOVE-NORMAL=(-NZERO/4) :NORMAL=0 \
897 BELOW-NORMAL=(NZERO/4) :LOW=(NZERO/2) IDLE=NZERO)
898 #endif
899 DEFCHECKER(check_priority_which,prefix=PRIO,default=0, PROCESS PGRP USER)
900 DEFUN(OS:PRIORITY, pid &optional which) {
901 int which = check_priority_which(popSTACK());
902 int pid = I_to_uint32(check_uint32(popSTACK()));
903 int res;
904 bool failed_p;
905 #if defined(HAVE_GETPRIORITY)
906 begin_system_call();
907 errno = 0;
908 res = getpriority(which,pid);
909 failed_p = (errno != 0);
910 end_system_call();
911 #elif defined(WIN32_NATIVE)
912 {
913 HANDLE handle;
914 begin_system_call();
915 handle = OpenProcess(PROCESS_QUERY_INFORMATION,FALSE,pid);
916 if (handle != INVALID_HANDLE_VALUE) {
917 res = (int)GetPriorityClass(handle);
918 failed_p = (res == 0);
919 CloseHandle(handle);
920 } else failed_p = true;
921 end_system_call();
922 }
923 #else
924 # error OS:PRIORITY is not defined
925 #endif
926 if (failed_p) OS_error();
927 VALUES1(check_priority_value_reverse(res));
928 }
929 DEFUN(OS::%SET-PRIORITY, value pid which) {
930 int which = check_priority_which(popSTACK());
931 int pid = I_to_uint32(check_uint32(popSTACK()));
932 int value = check_priority_value(STACK_0);
933 bool failed_p = true;
934 #if defined(HAVE_SETPRIORITY)
935 begin_system_call();
936 failed_p = (0 != setpriority(which,pid,value));
937 end_system_call();
938 #elif defined(WIN32_NATIVE)
939 {
940 HANDLE handle;
941 begin_system_call();
942 handle = OpenProcess(PROCESS_QUERY_INFORMATION,FALSE,pid);
943 if (handle != INVALID_HANDLE_VALUE) {
944 failed_p = !SetPriorityClass(handle,value);
945 CloseHandle(handle);
946 }
947 end_system_call();
948 }
949 #else
950 # error OS::%SET-PRIORITY is not defined
951 #endif
952 if (failed_p) OS_error();
953 VALUES1(popSTACK());
954 }
955
956 /* posix math functions in <math.h> */
957 /* Must include <math.h> */
958 #define decimal_string solaris_decimal_string /* needed on Solaris */
959 #undef floor /* needed on Linux */
960 #include <math.h>
961 #define floor(a,b) ((a) / (b))
962 #undef decimal_string
963
964 #define D_S to_double(popSTACK())
965 #define I_S to_int(popSTACK())
966 #define N_D(n,v) \
967 { double x=n; v=c_double_to_DF((dfloatjanus*)&x); }
968 #define VAL_D(func) double res=func(D_S); N_D(res,value1)
969 #define VAL_ID(func) \
970 double xx=D_S; int nn=I_S; double res=func(nn,xx); N_D(res,value1)
971
972 #if defined(HAVE_ERFC)
DEFUNF(POSIX::ERF,x)973 DEFUNF(POSIX::ERF,x) { VAL_D(erf); mv_count=1; }
974 #endif
975 #if defined(HAVE_ERFC)
DEFUNF(POSIX::ERFC,x)976 DEFUNF(POSIX::ERFC,x) { VAL_D(erfc); mv_count=1; }
977 #endif
978
DEFUNF(POSIX::J0,x)979 DEFUNF(POSIX::J0,x) { VAL_D(j0); mv_count=1; }
DEFUNF(POSIX::J1,x)980 DEFUNF(POSIX::J1,x) { VAL_D(j1); mv_count=1; }
DEFUNF(POSIX::JN,i x)981 DEFUNF(POSIX::JN,i x) { VAL_ID(jn); mv_count=1; }
DEFUNF(POSIX::Y0,x)982 DEFUNF(POSIX::Y0,x) { VAL_D(y0); mv_count=1; }
DEFUNF(POSIX::Y1,x)983 DEFUNF(POSIX::Y1,x) { VAL_D(y1); mv_count=1; }
DEFUNF(POSIX::YN,i y)984 DEFUNF(POSIX::YN,i y) { VAL_ID(yn); mv_count=1; }
985 #if defined(HAVE_TGAMMA)
986 /* http://opengroup.org/onlinepubs/9699919799/functions/tgamma.html */
DEFUNF(POSIX::TGAMMA,x)987 DEFUNF(POSIX::TGAMMA,x) { VAL_D(tgamma); mv_count=1; }
988 #endif
989
990 #if defined(HAVE_LGAMMA) || HAVE_DECL_LGAMMA_R
991 /* http://opengroup.org/onlinepubs/9699919799/functions/lgamma.html */
DEFUNF(POSIX::LGAMMA,x)992 DEFUNF(POSIX::LGAMMA,x) {
993 # if HAVE_DECL_LGAMMA_R
994 int sign;
995 double res = lgamma_r(D_S,&sign);
996 value2 = (sign > 0 ? Fixnum_1 : Fixnum_minus1);
997 # else
998 double res = lgamma(D_S);
999 # if HAVE_DECL_SIGNGAM
1000 value2 = (signgam > 0 ? Fixnum_1 : Fixnum_minus1);
1001 # else
1002 value2 = NIL;
1003 # endif
1004 # endif
1005 N_D(res,value1); mv_count=2;
1006 }
1007 #endif
1008
bogomips(void)1009 static double bogomips (void)
1010 {
1011 if (clock() != (clock_t)-1) {
1012 unsigned long loops = 1;
1013 while ((loops <<= 1)) {
1014 unsigned long ticks;
1015 volatile unsigned long ii;
1016 ticks = clock();
1017 for (ii = loops; ii > 0; ii--);
1018 ticks = clock() - ticks;
1019 if (ticks >= CLOCKS_PER_SEC)
1020 return (1.0 * loops / ticks) * (CLOCKS_PER_SEC / 500000.0);
1021 }
1022 }
1023 return -1.0;
1024 }
1025 DEFUN(OS:BOGOMIPS,) { N_D(bogomips(),value1); mv_count=1; }
1026
1027 DEFUN(POSIX:LOADAVG, &optional percentp) {
1028 double loadavg[3];
1029 int ret;
1030 begin_system_call();
1031 ret = getloadavg(loadavg,3);
1032 end_system_call();
1033 if (ret != 3) ANSIC_error();
1034 mv_count=3;
1035 if (missingp(STACK_0)) {
1036 N_D(loadavg[0],value1); pushSTACK(value1);
1037 N_D(loadavg[1],value1); pushSTACK(value1);
1038 N_D(loadavg[2],value3);
1039 value2 = popSTACK(); value1 = popSTACK();
1040 } else { /* return % as ints, to avoid consing */
1041 value1 = fixnum((int)(loadavg[0]*100+0.49999999999));
1042 value2 = fixnum((int)(loadavg[1]*100+0.49999999999));
1043 value3 = fixnum((int)(loadavg[2]*100+0.49999999999));
1044 }
1045 skipSTACK(1);
1046 }
1047
1048 #undef D_S
1049 #undef I_S
1050 #undef N_D
1051 #undef VAL_D
1052 #undef VAL_ID
1053
1054 /* "gcc --mno-cygwin -l crypt" links with cygwin lib-crypt,
1055 so we have to disable this explicitly */
1056 #if defined(HAVE_CRYPT) && !defined(WIN32_NATIVE)
DEFUN(POSIX::CRYPT,key salt)1057 DEFUN(POSIX::CRYPT, key salt) {
1058 char *result;
1059 STACK_0 = check_string(STACK_0);
1060 STACK_1 = check_string(STACK_1);
1061 with_string_0(STACK_0,GLO(misc_encoding),salt, {
1062 with_string_0(STACK_1,GLO(misc_encoding),key, {
1063 begin_system_call();
1064 result = crypt(key,salt);
1065 end_system_call();
1066 });
1067 });
1068 if (result == NULL) ANSIC_error();
1069 VALUES1(asciz_to_string(result,GLO(misc_encoding)));
1070 skipSTACK(2);
1071 }
1072 #endif
1073 #if defined(HAVE_ENCRYPT) || defined(HAVE_SETKEY)
1074 /* move information from a bit vector to the char block
1075 can trigger GC */
get_block(char block[64],object vector)1076 static void get_block (char block[64], object vector) {
1077 while (!bit_vector_p(Atype_8Bit,vector)
1078 || vector_length(vector) != 8) {
1079 pushSTACK(NIL); /* no PLACE */
1080 pushSTACK(vector); /* TYPE-ERROR slot DATUM */
1081 pushSTACK(`(VECTOR (UNSIGNED-BYTE 8) 8)`); /* EXPECTED-TYPE */
1082 pushSTACK(STACK_0); pushSTACK(vector);
1083 pushSTACK(TheSubr(subr_self)->name);
1084 check_value(type_error,GETTEXT("~S: ~S is not of type ~S"));
1085 vector = value1;
1086 }
1087 {
1088 uintL index=0, ii, jj, kk=0;
1089 object dv = array_displace_check(vector,8,&index);
1090 uint8* ptr1 = TheSbvector(dv)->data + index;
1091 for (ii = 0; ii<8; ii++) {
1092 uint8 bb = *ptr1++;
1093 for (jj = 0; jj<8; jj++)
1094 block[kk++] = ((bb & bit(jj)) != 0);
1095 }
1096 }
1097 }
1098 #endif
1099 #if defined(HAVE_ENCRYPT) && !defined(WIN32_NATIVE)
1100 /* the inverse of get_block(): move data from block to vector,
1101 which is known to be a (VECTOR BIT) */
set_block(char block[64],object vector)1102 static void set_block (char block[64], object vector) {
1103 uintL index=0, ii, jj, kk=0;
1104 object dv = array_displace_check(vector,8,&index);
1105 uint8* ptr1 = TheSbvector(dv)->data + index;
1106 for (ii = 0; ii<8; ii++) {
1107 uint8 bb = 0;
1108 for (jj = 0; jj<8; jj++)
1109 bb |= (block[kk++]!=0) << jj;
1110 *ptr1++ = bb;
1111 }
1112 }
DEFUN(POSIX::ENCRYPT,block flag)1113 DEFUN(POSIX::ENCRYPT, block flag) {
1114 int flag = nullp(popSTACK());
1115 char block[64];
1116 bool failed_p;
1117 get_block(block,STACK_0);
1118 begin_system_call();
1119 errno = 0; encrypt(block,flag); failed_p = (errno != 0);
1120 end_system_call();
1121 if (failed_p) ANSIC_error();
1122 set_block(block,STACK_0);
1123 VALUES1(popSTACK());
1124 }
1125 #endif
1126 #if defined(HAVE_SETKEY) && !defined(WIN32_NATIVE)
DEFUN(POSIX::SETKEY,key)1127 DEFUN(POSIX::SETKEY, key) {
1128 char block[64];
1129 bool failed_p;
1130 get_block(block,popSTACK());
1131 begin_system_call();
1132 errno = 0; setkey(block); failed_p = (errno != 0);
1133 end_system_call();
1134 if (failed_p) ANSIC_error();
1135 VALUES0;
1136 }
1137 #endif
1138
1139 /* ========= SYSTEM INFORMATION ========== */
1140 #include <sys/utsname.h>
1141 DEFUN(POSIX::UNAME,)
1142 { /* Lisp interface to uname(2) */
1143 struct utsname utsname;
1144 begin_system_call(); uname(&utsname); end_system_call();
1145 pushSTACK(safe_to_string(utsname.sysname));
1146 pushSTACK(safe_to_string(utsname.nodename));
1147 pushSTACK(safe_to_string(utsname.release));
1148 pushSTACK(safe_to_string(utsname.version));
1149 pushSTACK(safe_to_string(utsname.machine));
1150 funcall(`POSIX::MAKE-UNAME`,5);
1151 }
1152
1153 #if defined(HAVE_SYSCONF)
1154 DEFCHECKER(sysconf_arg,prefix=_SC,default=, \
1155 AIO-LISTIO-MAX AIO-MAX AIO-PRIO-DELTA-MAX \
1156 ARG-MAX ATEXIT-MAX BC-BASE-MAX BC-DIM-MAX BC-SCALE-MAX \
1157 BC-STRING-MAX CHILD-MAX CLK-TCK COLL-WEIGHTS-MAX DELAYTIMER-MAX \
1158 EXPR-NEST-MAX HOST-NAME-MAX IOV-MAX LINE-MAX LOGIN-NAME-MAX \
1159 NGROUPS-MAX GETGR-R-SIZE-MAX GETPW-R-SIZE-MAX MQ-OPEN-MAX \
1160 MQ-PRIO-MAX OPEN-MAX ADVISORY-INFO BARRIERS ASYNCHRONOUS-IO \
1161 CLOCK-SELECTION CPUTIME FSYNC IPV6 JOB-CONTROL MAPPED-FILES \
1162 MEMLOCK MEMLOCK-RANGE MEMORY-PROTECTION MESSAGE-PASSING \
1163 MONOTONIC-CLOCK PRIORITIZED-IO PRIORITY-SCHEDULING RAW-SOCKETS \
1164 READER-WRITER-LOCKS REALTIME-SIGNALS REGEXP SAVED-IDS SEMAPHORES \
1165 SHARED-MEMORY-OBJECTS SHELL SPAWN SPIN-LOCKS SPORADIC-SERVER \
1166 SS-REPL-MAX SYNCHRONIZED-IO THREAD-ATTR-STACKADDR \
1167 THREAD-ATTR-STACKSIZE THREAD-CPUTIME THREAD-PRIO-INHERIT \
1168 THREAD-PRIO-PROTECT THREAD-PRIORITY-SCHEDULING \
1169 THREAD-PROCESS-SHARED THREAD-SAFE-FUNCTIONS THREAD-SPORADIC-SERVER \
1170 THREAD-ROBUST-PRIO-INHERIT THREAD-ROBUST-PRIO-PROTECT THREADS \
1171 TIMEOUTS TIMERS TRACE TRACE-EVENT-FILTER \
1172 TRACE-EVENT-NAME-MAX TRACE-INHERIT TRACE-LOG TRACE-NAME-MAX \
1173 TRACE-SYS-MAX TRACE-USER-EVENT-MAX TYPED-MEMORY-OBJECTS :VERSION \
1174 XBS5-ILP32-OFF32 XBS5-ILP32-OFFBIG XBS5-LP64-OFF64 XBS5-LPBIG-OFFBIG\
1175 V6-ILP32-OFF32 V6-ILP32-OFFBIG V6-LP64-OFF64 V6-LPBIG-OFFBIG \
1176 V7-ILP32-OFF32 V7-ILP32-OFFBIG V7-LP64-OFF64 V7-LPBIG-OFFBIG \
1177 2-C-BIND 2-C-DEV 2-CHAR-TERM 2-FORT-DEV 2-FORT-RUN 2-LOCALEDEF \
1178 2-PBS 2-PBS-ACCOUNTING 2-PBS-CHECKPOINT 2-PBS-LOCATE 2-PBS-MESSAGE \
1179 2-PBS-TRACK 2-SW-DEV 2-UPE 2-VERSION PAGESIZE PHYS-PAGES \
1180 AVPHYS-PAGES THREAD-DESTRUCTOR-ITERATIONS THREAD-KEYS-MAX \
1181 THREAD-STACK-MIN THREAD-THREADS-MAX RE-DUP-MAX RTSIG-MAX \
1182 SEM-NSEMS-MAX SEM-VALUE-MAX SIGQUEUE-MAX STREAM-MAX SYMLOOP-MAX \
1183 TIMER-MAX TTY-NAME-MAX TZNAME-MAX XOPEN-CRYPT \
1184 XOPEN-ENH-I18N XOPEN-LEGACY XOPEN-REALTIME XOPEN-REALTIME-THREADS \
1185 XOPEN-SHM XOPEN-STREAMS XOPEN-UNIX XOPEN-UUCP XOPEN-VERSION \
1186 NPROCESSORS-CONF NPROCESSORS-ONLN)
1187 DEFUN(POSIX::SYSCONF, &optional what)
1188 { /* Lisp interface to sysconf(3c) */
1189 object what = popSTACK();
1190 if (!missingp(what)) {
1191 int cmd = sysconf_arg(what), res;
1192 begin_system_call(); res = sysconf(cmd); end_system_call();
1193 VALUES1(L_to_I(res));
1194 } else { /* all possible values */
1195 unsigned int pos = 0;
1196 for (; pos < sysconf_arg_map.size; pos++) {
1197 int res;
1198 begin_system_call();
1199 res = sysconf(sysconf_arg_map.table[pos].c_const);
1200 end_system_call();
1201 pushSTACK(*sysconf_arg_map.table[pos].l_const);
1202 pushSTACK(L_to_I(res));
1203 }
1204 VALUES1(listof(2*sysconf_arg_map.size));
1205 }
1206 }
1207 #endif /* HAVE_SYSCONF */
1208
1209 #if defined(HAVE_CONFSTR)
1210 DEFCHECKER(confstr_arg,prefix=_CS,PATH POSIX-V6-ILP32-OFF32-CFLAGS \
1211 POSIX-V6-ILP32-OFF32-LDFLAGS POSIX-V6-ILP32-OFF32-LIBS \
1212 POSIX-V6-ILP32-OFFBIG-CFLAGS POSIX-V6-ILP32-OFFBIG-LDFLAGS \
1213 POSIX-V6-ILP32-OFFBIG-LIBS POSIX-V6-LP64-OFF64-CFLAGS \
1214 POSIX-V6-LP64-OFF64-LDFLAGS POSIX-V6-LP64-OFF64-LIBS \
1215 POSIX-V6-LPBIG-OFFBIG-CFLAGS POSIX-V6-LPBIG-OFFBIG-LDFLAGS \
1216 POSIX-V6-LPBIG-OFFBIG-LIBS POSIX-V6-WIDTH-RESTRICTED-ENVS \
1217 V7-ENV POSIX-V7-ILP32-OFF32-CFLAGS POSIX-V7-ILP32-OFF32-LDFLAGS \
1218 POSIX-V7-ILP32-OFF32-LIBS POSIX-V7-ILP32-OFFBIG-CFLAGS \
1219 POSIX-V7-ILP32-OFFBIG-LDFLAGS POSIX-V7-ILP32-OFFBIG-LIBS \
1220 POSIX-V7-LP64-OFF64-CFLAGS POSIX-V7-LP64-OFF64-LDFLAGS \
1221 POSIX-V7-LP64-OFF64-LIBS POSIX-V7-LPBIG-OFFBIG-CFLAGS \
1222 POSIX-V7-LPBIG-OFFBIG-LDFLAGS POSIX-V7-LPBIG-OFFBIG-LIBS \
1223 POSIX-V7-THREADS-CFLAGS POSIX-V7-THREADS-LDFLAGS \
1224 POSIX-V7-WIDTH-RESTRICTED-ENVS \
1225 XBS5-ILP32-OFF32-CFLAGS XBS5-ILP32-OFF32-LDFLAGS \
1226 XBS5-ILP32-OFF32-LIBS XBS5-ILP32-OFF32-LINTFLAGS \
1227 XBS5-ILP32-OFFBIG-CFLAGS XBS5-ILP32-OFFBIG-LDFLAGS \
1228 XBS5-ILP32-OFFBIG-LIBS XBS5-ILP32-OFFBIG-LINTFLAGS \
1229 XBS5-LP64-OFF64-CFLAGS XBS5-LP64-OFF64-LDFLAGS \
1230 XBS5-LP64-OFF64-LIBS XBS5-LP64-OFF64-LINTFLAGS \
1231 XBS5-LPBIG-OFFBIG-CFLAGS XBS5-LPBIG-OFFBIG-LDFLAGS \
1232 XBS5-LPBIG-OFFBIG-LIBS XBS5-LPBIG-OFFBIG-LINTFLAGS)
1233 DEFUN(POSIX::CONFSTR, &optional what)
1234 { /* Lisp interface to confstr(3c) */
1235 #define CS_S(cmd) \
1236 begin_system_call(); res = confstr(cmd,buf,BUFSIZ); end_system_call(); \
1237 if (res == 0) value1 = T; \
1238 else if (res <= BUFSIZ) value1 = asciz_to_string(buf,GLO(misc_encoding)); \
1239 else { \
1240 /* Here we cannot use alloca(), because alloca() is generally unsafe \
1241 for sizes > BUFSIZ. */ \
1242 char *tmp = (char*)clisp_malloc(res); \
1243 begin_system_call(); \
1244 confstr(cmd,tmp,res); \
1245 end_system_call(); \
1246 /* FIXME: asciz_to_string may signal an error in which case tmp leaks */ \
1247 value1 = asciz_to_string(tmp,GLO(misc_encoding)); \
1248 begin_system_call(); \
1249 free(tmp); \
1250 end_system_call(); \
1251 }
1252
1253 size_t res;
1254 char buf[BUFSIZ];
1255 object what = popSTACK();
1256 if (!missingp(what)) {
1257 int cmd = confstr_arg(what);
1258 CS_S(cmd); mv_count = 1;
1259 } else { /* all possible values */
1260 unsigned int pos = 0;
1261 for (; pos < confstr_arg_map.size; pos++) {
1262 CS_S(confstr_arg_map.table[pos].c_const);
1263 pushSTACK(*confstr_arg_map.table[pos].l_const);
1264 pushSTACK(value1);
1265 }
1266 VALUES1(listof(2*confstr_arg_map.size));
1267 }
1268 }
1269 #endif /* HAVE_CONFSTR */
1270
1271 #if defined(HAVE_PATHCONF) && defined(HAVE_FPATHCONF)
1272 DEFCHECKER(pathconf_arg,prefix=_PC,default=,FILESIZEBITS LINK-MAX MAX-CANON \
1273 MAX-INPUT NAME-MAX PATH-MAX PIPE-BUF 2-SYMLINKS ALLOC-SIZE-MIN \
1274 REC-INCR-XFER-SIZE REC-MAX-XFER-SIZE REC-MIN-XFER-SIZE \
1275 REC-XFER-ALIGN SYMLINK-MAX CHOWN-RESTRICTED NO-TRUNC VDISABLE \
1276 ASYNC-IO PRIO-IO SYNC-IO SOCK-MAXBUF)
1277 #define DO_PATHCONF(f,spec,what) \
1278 if (missingp(what)) { /* all possible values */ \
1279 unsigned int pos = 0; \
1280 for (; pos < pathconf_arg_map.size; pos++) { \
1281 long res; \
1282 begin_system_call(); \
1283 res = f(spec,pathconf_arg_map.table[pos].c_const); \
1284 end_system_call(); \
1285 pushSTACK(*pathconf_arg_map.table[pos].l_const); \
1286 pushSTACK(res == -1 ? S(Kerror) : L_to_I(res)); \
1287 } \
1288 VALUES1(listof(2*pathconf_arg_map.size)); \
1289 } else { \
1290 long res; \
1291 begin_system_call(); \
1292 if ((res = f(spec,pathconf_arg(what))) == -1) ANSIC_error();\
1293 end_system_call(); \
1294 VALUES1(L_to_I(res)); \
1295 }
DEFUN(POSIX::PATHCONF,pathspec & optional what)1296 DEFUN(POSIX::PATHCONF, pathspec &optional what)
1297 { /* http://opengroup.org/onlinepubs/9699919799/functions/pathconf.html */
1298 Handle fd;
1299 if (integerp(STACK_1)) {
1300 fd = I_to_UL(STACK_1);
1301 pathconf_fd: DO_PATHCONF(fpathconf,fd,STACK_0);
1302 } else {
1303 object file = open_file_stream_handle(STACK_1,&fd,true);
1304 if (eq(nullobj,file)) { /* not an open stream ==> use truename */
1305 with_string_0(STACK_1 = physical_namestring(STACK_1),
1306 GLO(pathname_encoding), namez,
1307 { DO_PATHCONF(pathconf,namez,STACK_0); });
1308 } else goto pathconf_fd; /* open stream ==> use fd */
1309 }
1310 skipSTACK(2);
1311 }
1312 #endif /* HAVE_PATHCONF && HAVE_FPATHCONF */
1313
1314 #if defined(HAVE_CHROOT)
DEFUN(POSIX::CHROOT,path)1315 DEFUN(POSIX::CHROOT, path)
1316 { /* http://opengroup.org/onlinepubs/007908799/xsh/chroot.html (LEGACY) */
1317 int status;
1318 STACK_0 = physical_namestring(STACK_0);
1319 with_string_0(STACK_0, GLO(pathname_encoding), namez, {
1320 begin_blocking_system_call();
1321 status = chroot(namez);
1322 end_blocking_system_call();
1323 });
1324 if (status) OS_file_error(STACK_0);
1325 skipSTACK(1); VALUES0;
1326 }
1327 #endif /* HAVE_CHROOT */
1328
1329 #if defined(HAVE_SYS_RESOURCE_H)
rusage_to_lisp(struct rusage * ru)1330 static /*maygc*/ Values rusage_to_lisp (struct rusage *ru) {
1331 int count = 2;
1332 pushSTACK(sec_usec_number(ru->ru_utime.tv_sec,ru->ru_utime.tv_usec,0));
1333 pushSTACK(sec_usec_number(ru->ru_stime.tv_sec,ru->ru_stime.tv_usec,0));
1334 pushSTACK(L_to_I(ru->ru_maxrss)); count++;
1335 pushSTACK(L_to_I(ru->ru_ixrss)); count++;
1336 pushSTACK(L_to_I(ru->ru_idrss)); count++;
1337 pushSTACK(L_to_I(ru->ru_isrss)); count++;
1338 pushSTACK(L_to_I(ru->ru_minflt)); count++;
1339 pushSTACK(L_to_I(ru->ru_majflt)); count++;
1340 pushSTACK(L_to_I(ru->ru_nswap)); count++;
1341 pushSTACK(L_to_I(ru->ru_inblock)); count++;
1342 pushSTACK(L_to_I(ru->ru_oublock)); count++;
1343 pushSTACK(L_to_I(ru->ru_msgsnd)); count++;
1344 pushSTACK(L_to_I(ru->ru_msgrcv)); count++;
1345 pushSTACK(L_to_I(ru->ru_nsignals)); count++;
1346 pushSTACK(L_to_I(ru->ru_nvcsw)); count++;
1347 pushSTACK(L_to_I(ru->ru_nivcsw)); count++;
1348 funcall(`POSIX::MAKE-USAGE`,count);
1349 }
1350
1351 #if !defined(HAVE_WAIT4)
1352 # define wait4(p,s,o,r) (errno=ENOSYS,ANSIC_error(),(pid_t)-1)
1353 #endif
DEFFLAGSET(wait_flags,WNOHANG WUNTRACED WSTOPPED WEXITED WCONTINUED WNOWAIT)1354 DEFFLAGSET(wait_flags, WNOHANG WUNTRACED WSTOPPED WEXITED WCONTINUED WNOWAIT)
1355 DEFUN(POSIX::WAIT, &key :PID :USAGE :NOHANG :UNTRACED :STOPPED :EXITED \
1356 :CONTINUED :NOWAIT) {
1357 int status, options = wait_flags();
1358 bool usage = !missingp(STACK_0);
1359 pid_t ret, pid = missingp(STACK_1) ? (pid_t)-1 : I_to_pid(STACK_1);
1360 struct rusage ru;
1361 begin_blocking_system_call();
1362 begin_want_sigcld();
1363 ret = usage ? wait4(pid,&status,options,&ru) : waitpid(pid,&status,options);
1364 end_want_sigcld();
1365 end_blocking_system_call();
1366 if (ret == (pid_t)-1) ANSIC_error();
1367 if (ret == (pid_t)0 && (options & WNOHANG))
1368 VALUES1(Fixnum_0); /* no process changed status */
1369 else { /* some process changed status */
1370 if (usage) {
1371 rusage_to_lisp(&ru);
1372 STACK_0 = value1;
1373 mv_count = 4;
1374 } else mv_count = 3;
1375 STACK_1 = pid_to_I(ret);
1376 if (WIFEXITED(status)) {
1377 value2 = `:EXITED`;
1378 value3 = fixnum(WEXITSTATUS(status));
1379 } else if (WIFSIGNALED(status)) {
1380 value3 = check_signal_reverse(WTERMSIG(status));
1381 value2 = `:SIGNALED`;
1382 } else if (WIFSTOPPED(status)) {
1383 value3 = check_signal_reverse(WSTOPSIG(status));
1384 value2 = `:STOPPED`;
1385 # if defined(WIFCONTINUED) /* cygwin does not have this */
1386 } else if (WIFCONTINUED(status)) {
1387 value2 = `:CONTINUED`;
1388 value3 = NIL;
1389 # endif
1390 } else {
1391 value2 = NIL;
1392 value3 = fixnum(status);
1393 }
1394 value1 = STACK_1;
1395 if (usage) value4 = STACK_0;
1396 }
1397 skipSTACK(2);
1398 }
1399
1400 /* http://article.gmane.org/gmane.lisp.clisp.devel/20422
1401 https://sourceforge.net/p/clisp/mailman/message/23010926/
1402 https://sourceforge.net/p/clisp/bugs/593/ */
1403 DEFUN(POSIX::BEGIN-SUBPROCESSES,) {
1404 begin_system_call();
1405 begin_want_sigcld();
1406 end_system_call();
1407 VALUES0;
1408 }
1409 DEFUN(POSIX::END-SUBPROCESSES,) {
1410 begin_system_call();
1411 end_want_sigcld();
1412 end_system_call();
1413 VALUES0;
1414 }
1415
1416 #if defined(HAVE_GETRUSAGE)
1417 DEFCHECKER(check_rusage, prefix=RUSAGE, SELF CHILDREN THREAD LWP)
1418 DEFUN(POSIX::USAGE, &optional what) { /* getrusage(3) */
1419 struct rusage ru;
1420 object what = popSTACK();
1421 if (missingp(what)) {
1422 unsigned int pos;
1423 for (pos = 0; pos < check_rusage_map.size; pos++) {
1424 int status;
1425 pushSTACK(*check_rusage_map.table[pos].l_const);
1426 begin_system_call();
1427 status = getrusage(check_rusage_map.table[pos].c_const,&ru);
1428 end_system_call();
1429 if (status) pushSTACK(S(Kerror));
1430 else { rusage_to_lisp(&ru); pushSTACK(value1); }
1431 }
1432 VALUES1(listof(2*check_rusage_map.size));
1433 } else {
1434 int who = check_rusage(what);
1435 begin_system_call();
1436 if (getrusage(who,&ru)) ANSIC_error();
1437 end_system_call();
1438 rusage_to_lisp(&ru);
1439 }
1440 }
1441 #endif /* HAVE_GETRUSAGE */
1442 #endif /* HAVE_SYS_RESOURCE_H */
1443
1444 #if defined(HAVE_GETRLIMIT) || defined(HAVE_SETRLIMIT)
1445 DEFCHECKER(getrlimit_arg,prefix=RLIMIT, CPU FSIZE DATA STACK CORE RSS NOFILE \
1446 AS NPROC MEMLOCK LOCKS)
1447 #if SIZEOF_RLIM_T == 8
1448 # define rlim_to_I_0(lim) uint64_to_I(lim)
1449 # define I_to_rlim_0(lim) I_to_uint64(check_uint64(lim))
1450 #else
1451 # define rlim_to_I_0(lim) uint32_to_I(lim)
1452 # define I_to_rlim_0(lim) I_to_uint32(check_uint32(lim))
1453 #endif
rlim_to_I(rlim_t lim)1454 static /* maygc */ inline object rlim_to_I (rlim_t lim)
1455 { return lim == RLIM_INFINITY ? NIL : rlim_to_I_0(lim); }
I_to_rlim(object lim)1456 static /* maygc */ inline rlim_t I_to_rlim (object lim)
1457 { return missingp(lim) ? RLIM_INFINITY : I_to_rlim_0(lim); }
1458 #endif /* HAVE_GETRLIMIT || HAVE_SETRLIMIT */
1459 #if defined(HAVE_GETRLIMIT)
1460 DEFUN(POSIX::RLIMIT, &optional what)
1461 { /* getrlimit(3) */
1462 struct rlimit rl;
1463 object what = popSTACK();
1464 if (!missingp(what)) {
1465 int cmd = getrlimit_arg(what);
1466 begin_system_call();
1467 if (getrlimit(cmd,&rl)) ANSIC_error();
1468 end_system_call();
1469 pushSTACK(rlim_to_I(rl.rlim_cur)); pushSTACK(rlim_to_I(rl.rlim_max));
1470 VALUES2(STACK_1,STACK_0); skipSTACK(2);
1471 } else {
1472 unsigned int pos;
1473 for (pos = 0; pos < getrlimit_arg_map.size; pos++) {
1474 int status;
1475 pushSTACK(*getrlimit_arg_map.table[pos].l_const);
1476 begin_system_call();
1477 status = getrlimit(getrlimit_arg_map.table[pos].c_const,&rl);
1478 end_system_call();
1479 if (status) pushSTACK(S(Kerror));
1480 else {
1481 pushSTACK(rlim_to_I(rl.rlim_cur)); pushSTACK(rlim_to_I(rl.rlim_max));
1482 funcall(`POSIX::MAKE-RLIMIT`,2); pushSTACK(value1);
1483 }
1484 }
1485 VALUES1(listof(2*getrlimit_arg_map.size));
1486 }
1487 }
1488 #endif /* HAVE_GETRLIMIT */
1489 #if defined(HAVE_SETRLIMIT)
1490 /* parse the RLIMIT structure
1491 NOTE: arg is intentionally not reset by check_classname
1492 to avoid argument modification
1493 can trigger GC */
check_rlimit(object arg,struct rlimit * rl)1494 static void check_rlimit (object arg, struct rlimit *rl) {
1495 pushSTACK(check_classname(arg,`POSIX::RLIMIT`));
1496 rl->rlim_cur = I_to_rlim(TheStructure(STACK_0)->recdata[1]);
1497 rl->rlim_max = I_to_rlim(TheStructure(STACK_0)->recdata[2]);
1498 skipSTACK(1);
1499 }
1500 DEFUN(POSIX::SET-RLIMIT, what cur max)
1501 { /* setrlimit(3): 3 ways to call:
1502 (setf (rlimit what) (values cur max))
1503 (setf (rlimit what) #S(rlimit :cur cur :max max))
1504 (setf (rlimit) rlimit-plist-as-returned-by-rlimit-without-arguments) */
1505 if (nullp(STACK_2)) { /* 3rd way */
1506 if (!nullp(STACK_0)) goto rlimit_bad;
1507 STACK_0 = STACK_1;
1508 while (!endp(STACK_0)) {
1509 int what = getrlimit_arg(Car(STACK_0));
1510 struct rlimit rl;
1511 STACK_0 = Cdr(STACK_0);
1512 if (!consp(STACK_0)) { STACK_0 = NIL; goto rlimit_bad; }
1513 check_rlimit(Car(STACK_0),&rl);
1514 STACK_0 = Cdr(STACK_0);
1515 begin_system_call();
1516 if (setrlimit(what,&rl)) ANSIC_error();
1517 end_system_call();
1518 }
1519 } else {
1520 int what = getrlimit_arg(STACK_2);
1521 struct rlimit rl;
1522 if (nullp(STACK_1) || posfixnump(STACK_1)) { /* 1st way */
1523 rl.rlim_cur = I_to_rlim(STACK_1);
1524 rl.rlim_max = I_to_rlim(STACK_0);
1525 } else { /* 2nd way */
1526 if (!nullp(STACK_0)) goto rlimit_bad;
1527 check_rlimit(STACK_1,&rl);
1528 }
1529 begin_system_call();
1530 if (setrlimit(what,&rl)) ANSIC_error();
1531 end_system_call();
1532 }
1533 VALUES2(STACK_1,STACK_0); skipSTACK(3); return;
1534 rlimit_bad:
1535 pushSTACK(TheSubr(subr_self)->name);
1536 error(error_condition,GETTEXT("~S: bad arguments: ~S ~S ~S"));
1537 }
1538 #endif /* HAVE_SETRLIMIT */
1539
1540 /* ==== SOCKETS ===== */
1541 #if defined(HAVE_NETDB_H)
1542 # include <netdb.h>
1543 #endif
1544 #include <netinet/in.h>
1545 #include <arpa/inet.h>
1546
1547 #define H_ERRMSG \
1548 (h_errno == HOST_NOT_FOUND ? "host not found" : \
1549 (h_errno == TRY_AGAIN ? "try again later" : \
1550 (h_errno == NO_RECOVERY ? "a non-recoverable error occurred" : \
1551 (h_errno == NO_DATA ? "valid name, but no data for this host" : \
1552 (h_errno == NO_ADDRESS ? "no IP address for this host" : \
1553 "unknown error")))))
1554
1555 #if 0
1556 void print_he (struct hostent *he) {
1557 int ii;
1558 char **pp;
1559 struct in_addr in;
1560 printf("h_name: %s; h_length: %d; h_addrtype: %d\n [size in.s_addr: %d]\n",
1561 he->h_name,he->h_length,he->h_addrtype,sizeof(in.s_addr));
1562 for (pp = he->h_aliases; *pp != 0; pp++) printf("\t%s", *pp);
1563 printf("\n IP:");
1564 for (pp = he->h_addr_list; *pp != 0; pp++) {
1565 (void) memcpy(&in.s_addr, *pp, sizeof (in.s_addr));
1566 (void) printf("\t%s", inet_ntoa(in));
1567 }
1568 printf("\n");
1569 }
1570 #endif
1571
1572 /* C struct hostent --> Lisp HOSTENT structure
1573 can trigger GC */
1574 Values hostent_to_lisp (struct hostent *he); /* used by NEW-CLX => not static */
hostent_to_lisp(struct hostent * he)1575 Values hostent_to_lisp (struct hostent *he) {
1576 pushSTACK(ascii_to_string(he->h_name));
1577 push_string_array(he->h_aliases);
1578 { int ii = 0;
1579 for (; he->h_addr_list[ii]; ii++)
1580 pushSTACK(addr_to_string(he->h_addrtype,he->h_addr_list[ii]));
1581 { object tmp = listof(ii); pushSTACK(tmp); }}
1582 pushSTACK(fixnum(he->h_addrtype));
1583 funcall(`POSIX::MAKE-HOSTENT`,4);
1584 }
1585
1586 DEFUN(POSIX::RESOLVE-HOST-IPADDR,&optional host)
1587 { /* Lisp interface to gethostbyname(3) and gethostbyaddr(3) */
1588 object arg = popSTACK();
1589 struct hostent *he = NULL;
1590
1591 if (missingp(arg)) {
1592 # if !defined(HAVE_GETHOSTENT)
1593 VALUES1(NIL);
1594 # else
1595 int count = 0;
1596 begin_system_call();
1597 sethostent(1);
1598 for (; (he = gethostent()); count++) {
1599 end_system_call();
1600 hostent_to_lisp(he); pushSTACK(value1);
1601 begin_system_call();
1602 }
1603 endhostent();
1604 end_system_call();
1605 VALUES1(listof(count));
1606 # endif
1607 return;
1608 }
1609
1610 he = resolve_host(arg);
1611
1612 if (he == NULL) {
1613 pushSTACK(arg); pushSTACK(arg);
1614 STACK_1 = ascii_to_string(H_ERRMSG);
1615 pushSTACK(`POSIX::RESOLVE-HOST-IPADDR`);
1616 error(error_condition,"~S (~S): ~S");
1617 }
1618
1619 hostent_to_lisp(he);
1620 }
1621
1622 #if (defined(HAVE_GETSERVBYPORT) && defined(HAVE_GETSERVBYNAME)) || defined(WIN32_NATIVE)
1623 /* Lisp interface to getservbyport(3) and getservbyname(3) */
1624
1625 /* C struct servent --> Lisp SERVICE structure
1626 can trigger GC */
servent_to_lisp(struct servent * se)1627 static Values servent_to_lisp (struct servent * se) {
1628 pushSTACK(safe_to_string(se->s_name));
1629 push_string_array(se->s_aliases);
1630 pushSTACK(L_to_I(ntohs(se->s_port)));
1631 pushSTACK(safe_to_string(se->s_proto));
1632 funcall(`POSIX::MAKE-SERVICE`,4);
1633 }
1634
1635 DEFUN(POSIX:SERVICE, &optional service-name protocol) {
1636 object protocol = popSTACK();
1637 char *proto = NULL;
1638 char proto_buf[16];
1639 object serv;
1640 struct servent * se;
1641 if (!missingp(protocol)) { /* check protocol */
1642 protocol = check_string(protocol);
1643 with_string_0(protocol,GLO(misc_encoding), protocolz, {
1644 begin_system_call();
1645 strncpy(proto_buf,protocolz,15);
1646 end_system_call();
1647 });
1648 proto = proto_buf;
1649 proto_buf[15] = 0;
1650 }
1651 serv = popSTACK();
1652 if (missingp(serv)) {
1653 uintL count = 0;
1654 # if defined(HAVE_SETSERVENT) && defined(HAVE_GETSERVENT) && defined(HAVE_ENDSERVENT)
1655 begin_system_call();
1656 setservent(1);
1657 while ((se = getservent()))
1658 if (proto==NULL || (se->s_proto && !strcmp(proto,se->s_proto))) {
1659 end_system_call();
1660 servent_to_lisp(se); pushSTACK(value1); count++;
1661 begin_system_call();
1662 }
1663 endservent();
1664 end_system_call();
1665 # else /* no getservent - emulate */
1666 uintL port;
1667 begin_system_call();
1668 for (port = 0; port < 0x10000; port++) {
1669 se = getservbyport(port,proto);
1670 if (se != NULL) {
1671 end_system_call();
1672 servent_to_lisp(se); pushSTACK(value1); count++;
1673 begin_system_call();
1674 }
1675 }
1676 end_system_call();
1677 # endif
1678 VALUES1(listof(count));
1679 return;
1680 } else if (symbolp(serv)) {
1681 serv = Symbol_name(serv);
1682 goto servent_string;
1683 } else if (stringp(serv)) { servent_string:
1684 with_string_0(serv,GLO(misc_encoding),servz, {
1685 begin_system_call();
1686 se = getservbyname(servz,proto);
1687 end_system_call();
1688 });
1689 } else if (integerp(serv)) {
1690 uintL port = I_to_UL(serv);
1691 begin_system_call();
1692 se = getservbyport(htons(port),proto);
1693 end_system_call();
1694 } else
1695 error_string_integer(serv);
1696 if (se == NULL) ANSIC_error();
1697 servent_to_lisp(se);
1698 }
1699
1700 #endif /* getservbyname getservbyport */
1701
1702 #if defined(HAVE_GETGRGID) && defined(HAVE_GETGRNAM)
1703
1704 #if defined(HAVE_GRP_H)
1705 # include <grp.h>
1706 #endif
1707
1708 /* C struct group --> Lisp GROUP-INFO structure
1709 can trigger GC */
grp_to_lisp(struct group * group)1710 static Values grp_to_lisp (struct group *group) {
1711 pushSTACK(safe_to_string(group->gr_name));
1712 pushSTACK(gid_to_I(group->gr_gid));
1713 push_string_array(group->gr_mem);
1714 funcall(`POSIX::MAKE-GROUP-INFO`,3);
1715 }
1716
1717 DEFUN(POSIX::GROUP-INFO, &optional group)
1718 { /* return the GROUP-INFO for the group or a list thereof if it is NIL. */
1719 object group = popSTACK();
1720 struct group *gr = NULL;
1721 bool failed_p;
1722 group_info_restart:
1723
1724 # if defined(HAVE_GETGRENT) && defined(HAVE_SETGRENT) && defined(HAVE_ENDGRENT)
1725 if (missingp(group)) { /* all groups as a list */
1726 int count = 0;
1727 begin_system_call();
1728 setgrent();
1729 for (; (gr = getgrent()); count++) {
1730 end_system_call();
1731 grp_to_lisp(gr); pushSTACK(value1);
1732 begin_system_call();
1733 }
1734 endgrent();
1735 end_system_call();
1736 VALUES1(listof(count));
1737 return;
1738 }
1739 # endif /* setgrent getgrent endgrent */
1740
1741 begin_system_call();
1742 errno = 0;
1743 if (integerp(group))
1744 gr = getgrgid(I_to_gid(group));
1745 else if (symbolp(group)) {
1746 group = Symbol_name(group);
1747 goto group_info_string;
1748 } else if (stringp(group)) { group_info_string:
1749 with_string_0(group,GLO(misc_encoding),groupz, { gr = getgrnam(groupz); });
1750 } else {
1751 end_system_call(); error_string_integer(group);
1752 }
1753 failed_p = (errno != 0);
1754 end_system_call();
1755
1756 if (NULL == gr) {
1757 if (!failed_p) {
1758 pushSTACK(NIL); /* no PLACE */
1759 pushSTACK(group); pushSTACK(TheSubr(subr_self)->name);
1760 check_value(error_condition,GETTEXT("~S(~S): No such group"));
1761 group = value1;
1762 goto group_info_restart;
1763 } else ANSIC_error();
1764 }
1765 grp_to_lisp(gr);
1766 }
1767 #endif /* getgrgid getgrnam */
1768
1769 #if defined(HAVE_GETLOGIN) && defined(HAVE_GETPWNAM) && defined(HAVE_GETPWUID) && defined(HAVE_GETUID)
1770
1771 #if defined(HAVE_PWD_H)
1772 # include <pwd.h>
1773 #endif
1774
1775 /* C struct passwd --> Lisp USER-INFO structure
1776 can trigger GC */
passwd_to_lisp(struct passwd * pwd)1777 static Values passwd_to_lisp (struct passwd *pwd) {
1778 pushSTACK(safe_to_string(pwd->pw_name));
1779 pushSTACK(safe_to_string(pwd->pw_passwd));
1780 pushSTACK(UL_to_I(pwd->pw_uid));
1781 pushSTACK(UL_to_I(pwd->pw_gid));
1782 pushSTACK(safe_to_string(pwd->pw_gecos));
1783 pushSTACK(safe_to_string(pwd->pw_dir));
1784 pushSTACK(safe_to_string(pwd->pw_shell));
1785 funcall(`POSIX::MAKE-USER-INFO`,7);
1786 }
1787
1788 DEFUN(POSIX::USER-INFO, &optional user)
1789 { /* return the USER-INFO for the user or a list thereof if user is NIL. */
1790 object user = popSTACK();
1791 struct passwd *pwd = NULL;
1792 bool failed_p;
1793 user_info_restart:
1794
1795 # if defined(HAVE_GETPWENT) && defined(HAVE_SETPWENT) && defined(HAVE_ENDPWENT)
1796 if (missingp(user)) { /* all users as a list */
1797 int count = 0;
1798 begin_system_call();
1799 setpwent();
1800 for (; (pwd = getpwent()); ) {
1801 /* on cygwin uid of -1 is returned */
1802 /* when user has no entry in /etc/passwd */
1803 if (pwd->pw_uid == (uid_t) -1) continue;
1804 end_system_call();
1805 passwd_to_lisp(pwd); pushSTACK(value1);
1806 begin_system_call();
1807 count++;
1808 }
1809 endpwent();
1810 end_system_call();
1811 VALUES1(listof(count));
1812 return;
1813 }
1814 # endif /* setpwent getpwent endpwent */
1815
1816 begin_system_call();
1817 errno = 0;
1818 if (integerp(user))
1819 pwd = getpwuid(I_to_uid(user));
1820 else if (eq(user,S(Kdefault))) {
1821 char *username = getlogin();
1822 if (username != NULL)
1823 pwd = getpwnam(username);
1824 else pwd = getpwuid(getuid());
1825 } else if (symbolp(user)) {
1826 user = Symbol_name(user);
1827 goto user_info_string;
1828 } else if (stringp(user)) { user_info_string:
1829 with_string_0(user,GLO(misc_encoding),userz, { pwd = getpwnam(userz); });
1830 } else {
1831 end_system_call(); error_string_integer(user);
1832 }
1833 failed_p = (errno != 0);
1834 end_system_call();
1835
1836 if (NULL == pwd) {
1837 if (!failed_p) {
1838 pushSTACK(NIL); /* no PLACE */
1839 pushSTACK(user); pushSTACK(TheSubr(subr_self)->name);
1840 check_value(error_condition,GETTEXT("~S(~S): No such user"));
1841 user = value1;
1842 goto user_info_restart;
1843 } else ANSIC_error();
1844 }
1845 passwd_to_lisp(pwd);
1846 }
1847 #elif defined(WIN32_NATIVE)
1848 /* FIXME: use
1849 http://msdn.microsoft.com/library/en-us/netmgmt/netmgmt/user_info_1_str.asp
1850 http://msdn.microsoft.com/library/en-us/netmgmt/netmgmt/netusergetinfo.asp
1851 http://msdn.microsoft.com/library/en-us/netmgmt/netmgmt/netuserenum.asp */
1852 #endif /* user-info */
1853
1854 #if defined(HAVE_GETUSERSHELL) && defined(HAVE_ENDUSERSHELL)
1855 DEFUN(POSIX:USER-SHELLS,) {
1856 int count = 0;
1857 char *shell;
1858 begin_system_call();
1859 for (;(shell = getusershell()); count++) {
1860 end_system_call();
1861 pushSTACK(asciz_to_string(shell,GLO(misc_encoding)));
1862 begin_system_call();
1863 }
1864 endusershell();
1865 end_system_call();
1866 VALUES1(listof(count));
1867 }
1868 #endif /* HAVE_GETUSERSHELL & HAVE_ENDUSERSHELL */
1869
1870 #if defined(HAVE_GETUID)
1871 DEFUN(POSIX:UID,){ GETTER0(uid,getuid); }
1872 #endif
1873 #if defined(HAVE_SETUID)
1874 DEFUN(POSIX::%SETUID, uid) { SETTER1(uid,setuid); }
1875 #endif
1876 #if defined(HAVE_GETGID)
1877 DEFUN(POSIX:GID,){ GETTER0(gid,getgid); }
1878 #endif
1879 #if defined(HAVE_SETGID)
1880 DEFUN(POSIX::%SETGID, gid) { SETTER1(gid,setgid); }
1881 #endif
1882 #if defined(HAVE_GETEUID)
1883 DEFUN(POSIX:EUID,){ GETTER0(uid,geteuid); }
1884 #endif
1885 #if defined(HAVE_SETEUID)
1886 DEFUN(POSIX::%SETEUID, euid) { SETTER1(uid,seteuid); }
1887 #endif
1888 #if defined(HAVE_GETEGID)
1889 DEFUN(POSIX:EGID,){ GETTER0(gid,getegid); }
1890 #endif
1891 #if defined(HAVE_SETEGID)
1892 DEFUN(POSIX::%SETEGID, egid) { SETTER1(gid,setegid); }
1893 #endif
1894 #if defined(HAVE_GETGROUPS)
1895 DEFUN(POSIX:GROUPS,) {
1896 int group_count, ret;
1897 gid_t *groups;
1898 begin_system_call(); group_count = getgroups(0,NULL); end_system_call();
1899 groups = (gid_t*)alloca(sizeof(gid_t) * group_count);
1900 begin_system_call(); ret = getgroups(group_count,groups); end_system_call();
1901 if (ret == -1) ANSIC_error();
1902 while (ret--) pushSTACK(gid_to_I(*groups++));
1903 VALUES1(listof(group_count));
1904 }
1905 #endif
1906 #if defined(HAVE_SETGROUPS)
1907 DEFUN(POSIX::%SETGROUPS, groups) {
1908 int group_count = llength1(STACK_0,NULL), i = group_count;
1909 gid_t *groups = (gid_t*)alloca(sizeof(gid_t) * group_count), *pgrp = groups;
1910 pushSTACK(STACK_0);
1911 while (i--) {
1912 *pgrp++ = I_to_gid(Car(STACK_0));
1913 STACK_0 = Cdr(STACK_0);
1914 }
1915 if (!nullp(popSTACK())) NOTREACHED;
1916 begin_system_call(); i = setgroups(group_count,groups); end_system_call();
1917 if (i == -1) ANSIC_error();
1918 VALUES1(popSTACK());
1919 }
1920 #endif
1921 #if defined(HAVE_GETHOSTID)
1922 /* http://opengroup.org/onlinepubs/9699919799/functions/gethostid.html */
1923 /* this is returned as an integer, not as a string,
1924 because this is NOT the IP address:
1925 (posix:gethostid) ==> 430729603
1926 (rawsock:convert-address :inet 430729603) ==> "131.105.172.25"
1927 (rawsock:htonl 430729603) ==> 2204740633
1928 (rawsock:convert-address :inet 2204740633) ==> "25.172.105.131"
1929 but (rawsock:resolve-host-ipaddr :default) ==> "172.25.131.105" */
1930 DEFUN(POSIX:HOSTID,) { GETTER(unsigned long,ulong,gethostid); }
1931 #endif
1932 #if defined(HAVE_SETHOSTID) && !defined(_AIX)
1933 /* sethostid is not appropriately declared in the system header files on AIX 7. */
1934 #define I_to_hid(x) I_to_ulong(check_ulong(x))
1935 DEFUN(POSIX::%SETHOSTID, hostid) {
1936 unsigned long hid = I_to_ulong(check_ulong(STACK_0 = STACK_0));
1937 int e;
1938 begin_system_call(); errno = 0; sethostid(hid); e = errno; end_system_call();
1939 if (e) ANSIC_error();
1940 VALUES1(popSTACK());
1941 }
1942 #endif
1943 #ifndef MAXHOSTNAMELEN /* see unix.d */
1944 # define MAXHOSTNAMELEN 256 /* see <sys/param.h> */
1945 #endif
1946 #if defined(HAVE_GETDOMAINNAME)
1947 DEFUN(POSIX:DOMAINNAME,) {
1948 char domain[MAXHOSTNAMELEN];
1949 int e;
1950 begin_system_call();
1951 e = getdomainname(domain,MAXHOSTNAMELEN);
1952 end_system_call();
1953 if (e) ANSIC_error();
1954 VALUES1(asciz_to_string(domain,GLO(misc_encoding)));
1955 }
1956 #endif
1957 #if defined(HAVE_SETDOMAINNAME)
1958 DEFUN(POSIX::%SETDOMAINNAME, domain) {
1959 int e;
1960 with_string_0(STACK_0 = check_string(STACK_0),GLO(misc_encoding),domain, {
1961 begin_system_call();
1962 e = setdomainname(domain,domain_len);
1963 end_system_call();
1964 });
1965 if (e) ANSIC_error();
1966 VALUES1(popSTACK()); /* return the argument for the sake of SETF */
1967 }
1968 #endif
1969
1970 #if defined(HAVE_FSTAT) && defined(HAVE_STAT)
file_stat_to_STACK(object file,const struct stat * ps)1971 static void file_stat_to_STACK (object file, const struct stat *ps) {
1972 pushSTACK(file); /* the object stat'ed */
1973 pushSTACK(L_to_I(ps->st_dev)); /* device */
1974 #if defined(SIZEOF_INO_T) && SIZEOF_INO_T == 8
1975 pushSTACK(uint64_to_I(ps->st_ino)); /* inode */
1976 #else
1977 pushSTACK(uint32_to_I(ps->st_ino)); /* inode */
1978 #endif
1979 #ifdef S_IFMT
1980 { /* protection & format */
1981 unsigned int fmt = ps->st_mode & S_IFMT;
1982 if (fmt) {
1983 pushSTACK(allocate_cons());
1984 Car(STACK_0) = mknod_type_check_reverse(fmt);
1985 Cdr(STACK_0) = check_chmod_mode_to_list(ps->st_mode & ~S_IFMT);
1986 } else pushSTACK(check_chmod_mode_to_list(ps->st_mode));
1987 }
1988 #else
1989 pushSTACK(check_chmod_mode_to_list(ps->st_mode)); /* protection */
1990 #endif
1991 pushSTACK(UL_to_I(ps->st_nlink)); /* number of hard links */
1992 pushSTACK(UL_to_I(ps->st_uid)); /* user ID of owner */
1993 pushSTACK(UL_to_I(ps->st_gid)); /* group ID of owner */
1994 #if defined(HAVE_STAT_ST_RDEV)
1995 pushSTACK(L_to_I(ps->st_rdev)); /* device type (if inode device) */
1996 #else
1997 pushSTACK(NIL);
1998 #endif
1999 pushSTACK(off_to_I(ps->st_size)); /* total size, in bytes */
2000 #if defined(HAVE_STAT_ST_BLKSIZE)
2001 pushSTACK(UL_to_I(ps->st_blksize)); /* blocksize for filesystem I/O */
2002 #else
2003 pushSTACK(NIL);
2004 #endif
2005 #if defined(HAVE_STAT_ST_BLOCKS)
2006 pushSTACK(UL_to_I(ps->st_blocks)); /* number of blocks allocated */
2007 #else
2008 pushSTACK(NIL);
2009 #endif
2010 /* cannot use convert_time_to_universal() because this is used on win32 */
2011 pushSTACK(UL_to_I(ps->st_atime+UNIX_LISP_TIME_DIFF));/*time of last access*/
2012 pushSTACK(UL_to_I(ps->st_mtime+UNIX_LISP_TIME_DIFF));/*last modification*/
2013 pushSTACK(UL_to_I(ps->st_ctime+UNIX_LISP_TIME_DIFF));/*time of last change*/
2014 }
2015
2016 DEFUN(POSIX::FILE-STAT, file &optional linkp)
2017 { /* Lisp interface to stat(2), lstat(2) and fstat(2)
2018 the first arg can be a pathname designator or a file descriptor designator
2019 the return value is the FILE-STAT structure */
2020 bool link_p = missingp(STACK_0);
2021 struct stat buf;
2022 object file = STACK_1;
2023 bool error_p;
2024
2025 if (integerp(file)) {
2026 begin_blocking_system_call();
2027 error_p = (fstat(I_to_UL(file),&buf) < 0);
2028 end_blocking_system_call();
2029 if (error_p) ANSIC_error();
2030 } else {
2031 Handle fd;
2032 file = open_file_stream_handle(STACK_1,&fd,true);
2033 if (eq(nullobj,file)) { /* not a stream - treat as a pathname */
2034 if (ON_PNAMESTRING(STACK_1,*(link_p ? &stat : &lstat),&buf))
2035 OS_file_error(value1);
2036 file = value1;
2037 } else { /* file is a stream, fd is valid */
2038 # if defined(WIN32_NATIVE)
2039 /* woe32 does have fstat(), but it does not accept a file handle,
2040 only an integer of an unknown nature.
2041 FIXME: actually, the integer is an "OS File Hangle"
2042 accessibe via int _open_osfhandle (intptr_t osfhandle, int flags);
2043 http://msdn.microsoft.com/en-us/library/bdts1c9x.aspx
2044 however, it is not clear whether this itroduces a leak:
2045 the osfhandle is supposed to be closed by _close, but it also closes
2046 the original handle which is no good */
2047 BY_HANDLE_FILE_INFORMATION fi;
2048 begin_blocking_system_call();
2049 error_p = !GetFileInformationByHandle(fd,&fi);
2050 end_blocking_system_call();
2051 if (error_p) error_OS_stream(STACK_1);
2052 pushSTACK(STACK_1); /* file */
2053 pushSTACK(uint32_to_I(fi.dwVolumeSerialNumber)); /* device */
2054 pushSTACK(UL2_to_I(fi.nFileIndexHigh,fi.nFileIndexLow)); /* "inode" */
2055 pushSTACK(check_file_attributes_to_list(fi.dwFileAttributes));
2056 pushSTACK(uint32_to_I(fi.nNumberOfLinks)); /* number of hard links */
2057 pushSTACK(NIL); pushSTACK(NIL); /* no GID or UID */
2058 pushSTACK(NIL); /* no rdev */
2059 pushSTACK(UL2_to_I(fi.nFileSizeHigh,fi.nFileSizeLow)); /* size */
2060 pushSTACK(NIL); pushSTACK(NIL); /* no blocksize od blocks */
2061 pushSTACK(convert_time_to_universal(&(fi.ftLastAccessTime)));
2062 pushSTACK(convert_time_to_universal(&(fi.ftLastWriteTime)));
2063 pushSTACK(convert_time_to_universal(&(fi.ftCreationTime)));
2064 goto call_make_file_stat;
2065 # else
2066 begin_blocking_system_call();
2067 error_p = (fstat(fd,&buf) < 0);
2068 end_blocking_system_call();
2069 if (error_p) error_OS_stream(STACK_1);
2070 file = eq(nullobj,STACK_1) ? fixnum(fd) : (object)STACK_1; /* restore */
2071 # endif
2072 }
2073 }
2074
2075 file_stat_to_STACK(file,&buf);
2076 call_make_file_stat:
2077 funcall(`POSIX::MAKE-FILE-STAT`,14);
2078 skipSTACK(2); /* drop linkp & file */
2079 }
2080 #endif /* fstat lstat fstat */
2081
2082 #if defined(HAVE_STAT) && (defined(HAVE_CHMOD) || defined(HAVE_CHOWN) || defined(HAVE_UTIME))
2083 /* error-signalling replacement for chmod()
2084 STACK_O is the path - for error reporting
2085 return -1 on error and 0 on success
2086 can trigger GC */
my_chmod(char * path,mode_t mode)2087 static int my_chmod (char *path, mode_t mode) {
2088 #if defined(WIN32_NATIVE)
2089 if (!SetFileAttributes(path,mode)) return -1;
2090 #elif defined(HAVE_CHMOD)
2091 if (chmod(path,mode)) return -1;
2092 #else
2093 end_blocking_system_call();
2094 pushSTACK(CLSTEXT("~S(~S ~S ~S): this platform lacks ~S"));
2095 pushSTACK(TheSubr(subr_self)->name); pushSTACK(STACK_2);
2096 pushSTACK(`:MODE`); pushSTACK(fixnum(mode));
2097 pushSTACK(`"chmod()"`);
2098 funcall(S(warn),5);
2099 begin_blocking_system_call();
2100 #endif
2101 return 0;
2102 }
2103 /* error-signalling replacement for chown()
2104 STACK_O is the path - for error reporting
2105 return -1 on error and 0 on success
2106 can trigger GC */
my_chown(char * path,uid_t uid,gid_t gid)2107 static int my_chown (char *path, uid_t uid, gid_t gid) {
2108 #if defined(HAVE_CHOWN)
2109 if (chown(path,uid,gid)) return -1;
2110 #else
2111 end_blocking_system_call();
2112 pushSTACK(CLSTEXT("~S(~S ~S ~S ~S ~S): this platform lacks ~S"));
2113 pushSTACK(TheSubr(subr_self)->name); pushSTACK(STACK_2);
2114 pushSTACK(`:UID`); pushSTACK((uid != (uid_t)-1) ? fixnum(uid) : NIL);
2115 pushSTACK(`:GID`); pushSTACK((gid != (gid_t)-1) ? fixnum(gid) : NIL);
2116 pushSTACK(`"chown()"`);
2117 funcall(S(warn),7);
2118 begin_blocking_system_call();
2119 #endif
2120 return 0;
2121 }
2122 /* error-signalling replacement for utime()
2123 STACK_O is the path - for error reporting
2124 return -1 on error and 0 on success
2125 can trigger GC */
2126 #if !defined(WIN32_NATIVE)
my_utime(char * path,bool utb_a,bool utb_m,struct utimbuf * utb)2127 static int my_utime (char *path, bool utb_a, bool utb_m, struct utimbuf *utb) {
2128 if (utb_a && !utb_m) {
2129 struct stat st;
2130 if (stat(path,&st) < 0) return -1;
2131 utb->modtime = st.st_mtime;
2132 }
2133 if (utb_m && !utb_a) {
2134 struct stat st;
2135 if (stat(path,&st) < 0) return -1;
2136 utb->actime = st.st_atime;
2137 }
2138 #if defined(HAVE_UTIME)
2139 if (utime(path,utb)) return -1;
2140 #else
2141 end_blocking_system_call();
2142 pushSTACK(CLSTEXT("~S(~S ~S ~S ~S ~S): this platform lacks ~S"));
2143 pushSTACK(TheSubr(subr_self)->name); pushSTACK(STACK_2);
2144 pushSTACK(`:ATIME`);
2145 pushSTACK(utb_a ? convert_time_to_universal(&(utb->actime)) : NIL);
2146 pushSTACK(`:MTIME`);
2147 pushSTACK(utb_m ? convert_time_to_universal(&(utb->modtime)) : NIL);
2148 pushSTACK(`"utime()"`);
2149 funcall(S(warn),7);
2150 begin_blocking_system_call();
2151 #endif
2152 return 0;
2153 }
2154 #else /* WIN32_NATIVE */
2155 /* win32 implementation of utime() is severely broken:
2156 http://www.codeproject.com/datetime/dstbugs.asp */
2157 struct a_m_time { FILETIME actime; FILETIME modtime; };
my_utime(char * path,bool utb_a,bool utb_m,struct a_m_time * tm)2158 static int my_utime (char *path, bool utb_a, bool utb_m, struct a_m_time *tm) {
2159 HANDLE hfile = CreateFile(path, GENERIC_WRITE, 0 , NULL, OPEN_EXISTING,
2160 FILE_ATTRIBUTE_NORMAL, NULL);
2161 BOOL success_p;
2162 if (hfile == INVALID_HANDLE_VALUE) return -1;
2163 success_p = SetFileTime(hfile,NULL,utb_a ? &(tm->actime) : NULL,
2164 utb_m ? &(tm->modtime) : NULL);
2165 CloseHandle(hfile);
2166 if (!success_p) return -1;
2167 return 0;
2168 }
2169 #endif /* WIN32_NATIVE */
2170 #if defined(WIN32_NATIVE) || defined(UNIX_CYGWIN)
2171 /* get WIN32_FIND_DATA from the PATH
2172 < sh - search handle (optional)
2173 < wfd - file information
2174 < value1 - the actual path used
2175 can trigger GC */
find_first_file(object path,WIN32_FIND_DATA * wfd,HANDLE * sh)2176 static void find_first_file (object path, WIN32_FIND_DATA *wfd, HANDLE *sh) {
2177 HANDLE s_h = ON_PNAMESTRING(path,FindFirstFile,wfd);
2178 if (s_h == INVALID_HANDLE_VALUE) OS_file_error(value1);
2179 if (sh) *sh = s_h;
2180 else {
2181 begin_blocking_system_call();
2182 FindClose(s_h);
2183 begin_blocking_system_call();
2184 }
2185 }
2186 /* get file times from an object
2187 can trigger GC */
get_file_time(object path,FILETIME * atime,FILETIME * mtime)2188 static void get_file_time (object path, FILETIME *atime, FILETIME *mtime) {
2189 WIN32_FIND_DATA wfd;
2190 find_first_file(path,&wfd,NULL);
2191 if (atime) *atime = wfd.ftLastAccessTime;
2192 if (mtime) *mtime = wfd.ftLastWriteTime;
2193 }
2194 #endif /* WIN32_NATIVE | UNIX_CYGWIN */
2195 DEFUN(POSIX::SET-FILE-STAT, file &key ATIME MTIME MODE UID GID)
2196 { /* interface to chmod(2), chown(2), utime(2)
2197 http://opengroup.org/onlinepubs/9699919799/functions/utime.html
2198 http://opengroup.org/onlinepubs/9699919799/functions/chown.html
2199 http://opengroup.org/onlinepubs/9699919799/functions/chmod.html */
2200 gid_t gid = (missingp(STACK_0) ? skipSTACK(1), (gid_t)-1
2201 : I_to_uint32(check_uint32(popSTACK())));
2202 uid_t uid = (missingp(STACK_0) ? skipSTACK(1), (uid_t)-1
2203 : I_to_uint32(check_uint32(popSTACK())));
2204 mode_t mode = (missingp(STACK_0) ? skipSTACK(1), (mode_t)-1
2205 # if defined(WIN32_NATIVE)
2206 : (mode_t)check_file_attributes_of_list(popSTACK())
2207 # else
2208 : check_chmod_mode_of_list(popSTACK())
2209 # endif
2210 );
2211 # if defined(WIN32_NATIVE)
2212 struct a_m_time utb;
2213 # else
2214 struct utimbuf utb;
2215 # endif
2216 bool utb_a = false, utb_m = false;
2217 int status = 0;
2218 if (!missingp(STACK_0)) { /* mtime */
2219 if (integerp(STACK_0))
2220 convert_time_from_universal(STACK_0,&(utb.modtime));
2221 else if (eq(STACK_0,T)) {
2222 funcall(L(get_universal_time),0);
2223 convert_time_from_universal(value1,&(utb.modtime));
2224 } else { /* set from another file */
2225 # if defined(WIN32_NATIVE)
2226 get_file_time(STACK_0,NULL,&(utb.modtime));
2227 # else
2228 struct stat st;
2229 if (ON_PNAMESTRING(STACK_0,stat,&st)) OS_file_error(value1);
2230 utb.modtime = st.st_mtime;
2231 # endif
2232 }
2233 utb_m = true;
2234 }
2235 if (!missingp(STACK_1)) { /* atime */
2236 if (integerp(STACK_1))
2237 convert_time_from_universal(STACK_1,&(utb.actime));
2238 else if (eq(STACK_1,T)) {
2239 funcall(L(get_universal_time),0);
2240 convert_time_from_universal(value1,&(utb.actime));
2241 } else { /* set from another file */
2242 # if defined(WIN32_NATIVE)
2243 get_file_time(STACK_0,&(utb.actime),NULL);
2244 # else
2245 struct stat st;
2246 if (ON_PNAMESTRING(STACK_1,stat,&st)) OS_file_error(value1);
2247 utb.actime = st.st_atime;
2248 # endif
2249 }
2250 utb_a = true;
2251 }
2252 skipSTACK(2); /* drop atime & mtime */
2253 STACK_0 = physical_namestring(STACK_0);
2254 with_string_0(STACK_0,GLO(pathname_encoding),path, {
2255 begin_blocking_system_call();
2256 if (status == 0 && (mode != (mode_t)-1))
2257 status = my_chmod(path,mode);
2258 if (status == 0 && ((uid != (uid_t)-1) || (gid != (gid_t)-1)))
2259 status = my_chown(path,uid,gid);
2260 if (status == 0 && (utb_a || utb_m))
2261 status = my_utime(path,utb_a,utb_m,&utb);
2262 end_blocking_system_call();
2263 });
2264 if (status < 0) OS_file_error(STACK_0);
2265 VALUES0; skipSTACK(1);
2266 }
2267 #endif /* chmod chown utime */
2268
2269 #if defined(HAVE_NFTW)
DEFFLAGSET(ftw_flags,FTW_CHDIR FTW_DEPTH FTW_MOUNT FTW_PHYS)2270 DEFFLAGSET(ftw_flags,FTW_CHDIR FTW_DEPTH FTW_MOUNT FTW_PHYS)
2271 DEFCHECKER(check_ftw_kind,prefix=FTW, F D DP SL SLN DNR NS)
2272 /* STACK_0 = function to be called */
2273 static int nftw_fn (const char *path, const struct stat *ps, int kind,
2274 struct FTW *ftw) {
2275 end_blocking_system_call(); /* back to lisp land */
2276 pushSTACK(asciz_to_string(path,GLO(pathname_encoding)));
2277 if (kind != FTW_NS) {
2278 file_stat_to_STACK(STACK_0,ps);
2279 funcall(`POSIX::MAKE-FILE-STAT`,14);
2280 pushSTACK(value1);
2281 } else pushSTACK(NIL);
2282 pushSTACK(check_ftw_kind_reverse(kind));
2283 pushSTACK(fixnum(ftw->base));
2284 pushSTACK(fixnum(ftw->level));
2285 funcall(STACK_5,5);
2286 begin_blocking_system_call(); /* leave to blocking system call */
2287 if (nullp(value1)) return 0;
2288 else { /* terminate the walk, return the value */
2289 STACK_1 = value1;
2290 return 1;
2291 }
2292 }
2293 DEFUN(POSIX:FILE-TREE-WALK, path func &key FD-LIMIT CHDIR DEPTH MOUNT PHYS)
2294 { /* http://opengroup.org/onlinepubs/9699919799/functions/nftw.html */
2295 int flags = ftw_flags(), ret;
2296 int fd_limit = check_uint_defaulted(popSTACK(),5);
2297 STACK_1 = physical_namestring(STACK_1);
2298 with_string_0(STACK_1,GLO(pathname_encoding),path, {
2299 begin_blocking_system_call();
2300 ret = nftw(path,nftw_fn,fd_limit,flags);
2301 end_blocking_system_call();
2302 });
2303 VALUES1(ret ? (object)STACK_1 : NIL); skipSTACK(2);
2304 }
2305 #endif /* HAVE_NFTW */
2306
2307 /* <http://opengroup.org/onlinepubs/9699919799/basedefs/sys/stat.h.html> */
2308 DEFCHECKER(check_chmod_mode, type=mode_t, \
2309 prefix=S_I, delim=, default=, bitmasks=both, \
2310 SUID SGID SVTX RWXU RUSR WUSR XUSR RWXG RGRP \
2311 WGRP XGRP RWXO ROTH WOTH XOTH)
2312 DEFUN(POSIX::CONVERT-MODE, mode)
2313 { /* convert between symbolic and numeric permissions */
2314 VALUES1(integerp(STACK_0)
2315 ? check_chmod_mode_to_list(I_to_uint32(check_uint32(popSTACK())))
2316 : uint32_to_I(check_chmod_mode_of_list(popSTACK())));
2317 }
2318
2319 #if defined(HAVE_UMASK)
DEFUN(POSIX::UMASK,cmask)2320 DEFUN(POSIX::UMASK, cmask)
2321 { /* lisp interface to umask(2)
2322 http://opengroup.org/onlinepubs/9699919799/functions/umask.html */
2323 mode_t cmask = check_chmod_mode_of_list(popSTACK());
2324 begin_system_call();
2325 cmask = umask(cmask);
2326 end_system_call();
2327 VALUES1(fixnum(cmask));
2328 }
2329 #endif /* umask */
2330
2331 DEFCHECKER(mknod_type_check,prefix=S_I,delim=,default=, \
2332 FIFO FSOCK FCHR FDIR FBLK FREG)
DEFUN(POSIX::MKNOD,path type mode)2333 DEFUN(POSIX::MKNOD, path type mode)
2334 { /* lisp interface to mknod(2)
2335 http://opengroup.org/onlinepubs/9699919799/functions/mknod.html */
2336 object md = popSTACK();
2337 object tp = popSTACK();
2338 mode_t mode = check_chmod_mode_of_list(md) | mknod_type_check(tp);
2339 int ret;
2340 STACK_0 = physical_namestring(STACK_0);
2341 with_string_0(STACK_0,GLO(pathname_encoding),path, {
2342 begin_blocking_system_call();
2343 ret = mknod(path,mode,0);
2344 end_blocking_system_call();
2345 });
2346 if (ret) OS_file_error(STACK_0);
2347 skipSTACK(1);
2348 VALUES0;
2349 }
2350
2351 DEFUN(POSIX:MKDTEMP, template) {
2352 object fname = physical_namestring(popSTACK());
2353 with_string_0(fname,GLO(pathname_encoding),namez,{
2354 char *c_template;
2355 if (namez[namez_bytelen-1] == '/') /* mkdtemp(".../") --> ENOENT */
2356 namez[--namez_bytelen] = 0;
2357 begin_blocking_system_call();
2358 ENSURE_6X(namez,c_template);
2359 c_template = mkdtemp(c_template);
2360 end_blocking_system_call();
2361 if (NULL == c_template) ANSIC_error();
2362 fname = asciz_to_string(c_template,GLO(pathname_encoding));
2363 });
2364 pushSTACK(fname);
2365 /* stack layout: the name of the new directory - without the trailing slash */
2366 #if defined(WIN32_NATIVE)
2367 pushSTACK(GLO(backslash_string));
2368 #else
2369 pushSTACK(GLO(slash_string));
2370 #endif
2371 VALUES1(string_concat(2));
2372 }
2373
2374 #if defined(WIN32_NATIVE) || (defined(HAVE_STATVFS) && defined(HAVE_SYS_STATVFS_H))
2375 #if defined(WIN32_NATIVE)
2376 /* winsup/src/winsup/cygwin/syscalls.cc */
2377 typedef unsigned long fsblkcnt_t;
2378 typedef unsigned long fsfilcnt_t;
2379 struct statvfs {
2380 unsigned long f_bsize; /* file system block size */
2381 unsigned long f_frsize; /* fragment size */
2382 fsblkcnt_t f_blocks; /* size of fs in f_frsize units */
2383 fsblkcnt_t f_bfree; /* free blocks in fs */
2384 fsblkcnt_t f_bavail; /* free blocks avail to non-superuser */
2385 fsfilcnt_t f_files; /* total file nodes in file system */
2386 fsfilcnt_t f_ffree; /* free file nodes in fs */
2387 fsfilcnt_t f_favail; /* avail file nodes in fs */
2388 unsigned long f_fsid; /* file system id */
2389 unsigned long f_flag; /* mount flags */
2390 unsigned long f_namemax; /* maximum length of filenames */
2391 char f_volname[MAX_PATH]; /* volume name */
2392 char f_fstype[MAX_PATH]; /* file system type */
2393 };
2394 #define HAVE_STATVFS_F_VOLNAME
2395 #define HAVE_STATVFS_F_FSTYPE
statvfs(const char * fname,struct statvfs * sfs)2396 static int statvfs (const char *fname, struct statvfs *sfs) {
2397 /* GetDiskFreeSpaceEx must be called before GetDiskFreeSpace on
2398 WinME, to avoid the MS KB 314417 bug */
2399 ULARGE_INTEGER availb, freeb, totalb;
2400 DWORD spc, bps, availc, freec, totalc, vsn, maxlen, flags, bpc;
2401 char root[MAX_PATH], *rootp = root;
2402 if (fname[1] == ':') { /* c:\ */
2403 *rootp++ = *fname++;
2404 *rootp++ = *fname++;
2405 } else if (fname[0] == '\\' && fname[1] == '\\') { /* \\host\dir\ */
2406 const char *cp = strchr(fname + 2,'\\');
2407 unsigned int len;
2408 if (cp) cp = strchr(cp+1,'\\'); /* just host, no dir => error later */
2409 memcpy(root,fname,(len = cp - fname));
2410 rootp = root + len;
2411 } else {
2412 SetLastError(ERROR_DIRECTORY);
2413 return -1;
2414 }
2415 *rootp++ = '\\';
2416 *rootp = 0;
2417
2418 if (!GetDiskFreeSpace(root,&spc,&bps,&freec,&totalc))
2419 return -1; /* bytes per sector, sectors per cluster */
2420 bpc = spc*bps; /* bytes per cluster */
2421 if (GetDiskFreeSpaceEx(root,&availb,&totalb,&freeb)) {
2422 availc = availb.QuadPart / bpc;
2423 totalc = totalb.QuadPart / bpc;
2424 freec = freeb.QuadPart / bpc;
2425 } else
2426 availc = freec;
2427 if (!GetVolumeInformation(root,sfs->f_volname,MAX_PATH,&vsn,&maxlen,&flags,
2428 sfs->f_fstype,MAX_PATH))
2429 return -1;
2430 sfs->f_bsize = bpc;
2431 sfs->f_frsize = bpc;
2432 sfs->f_blocks = totalc;
2433 sfs->f_bfree = freec;
2434 sfs->f_bavail = availc;
2435 sfs->f_files = (fsfilcnt_t)-1;
2436 sfs->f_ffree = (fsfilcnt_t)-1;
2437 sfs->f_favail = (fsfilcnt_t)-1;
2438 sfs->f_fsid = vsn;
2439 sfs->f_flag = flags;
2440 sfs->f_namemax = maxlen;
2441 return 0;
2442 }
2443 #endif
2444 DEFCHECKER(vfs_flags,default=,bitmasks=both, ST_RDONLY ST_NOSUID ST_NOTRUNC \
2445 ST_NODEV ST_NOEXEC ST_SYNCHRONOUS ST_MANDLOCK ST_WRITE ST_APPEND \
2446 ST_IMMUTABLE ST_NOATIME ST_NODIRATIME \
2447 FILE_NAMED_STREAMS FILE_READ_ONLY_VOLUME FILE_SUPPORTS_OBJECT_IDS \
2448 FILE_SUPPORTS_REPARSE_POINTS FILE_SUPPORTS_SPARSE_FILES \
2449 FILE_VOLUME_QUOTAS FILE_SUPPORTS_ENCRYPTION \
2450 FS_CASE_IS_PRESERVED FS_CASE_SENSITIVE \
2451 FS_FILE_COMPRESSION FS_FILE_ENCRYPTION FS_PERSISTENT_ACLS \
2452 FS_UNICODE_STORED_ON_DISK FS_VOL_IS_COMPRESSED)
2453 /* there is also a legacy interface (f)statfs()
2454 which is not POSIX and is not supported */
2455 DEFUN(POSIX::STAT-VFS, file)
2456 { /* Lisp interface to statvfs(2), fstatvfs(2)
2457 the first arg can be a pathname designator or a file descriptor designator
2458 the return value is the STAT-VFS structure */
2459 object file = STACK_0;
2460 struct statvfs buf;
2461 bool error_p;
2462
2463 #if defined(HAVE_FSTATVFS)
2464 if (integerp(file)) {
2465 begin_blocking_system_call();
2466 error_p = (fstatvfs(I_to_L(file),&buf) < 0);
2467 end_blocking_system_call();
2468 if (error_p) ANSIC_error();
2469 } else {
2470 Handle fd;
2471 file = open_file_stream_handle(file,&fd,true);
2472 if (!eq(nullobj,file)) { /* an open stream */
2473 pushSTACK(file);
2474 begin_blocking_system_call();
2475 error_p = (fstatvfs(fd,&buf) < 0);
2476 end_blocking_system_call();
2477 file = popSTACK();
2478 if (error_p) error_OS_stream(STACK_0);
2479 STACK_0 = file;
2480 } else
2481 #endif
2482 if (ON_PNAMESTRING(STACK_0,statvfs,&buf))
2483 OS_file_error(value1);
2484 #if defined(HAVE_FSTATVFS)
2485 }
2486 #endif
2487
2488 /* STACK_0 is already the object statvfs'ed */
2489 #define pushSLOT(s) pushSTACK(s==(unsigned long)-1 ? NIL : ulong_to_I(s))
2490 pushSLOT(buf.f_bsize); /* file system block size */
2491 pushSLOT(buf.f_frsize); /* fundamental file system block size */
2492 #if defined(SIZEOF_FSBLKCNT_T) && SIZEOF_FSBLKCNT_T == 8
2493 # define pushBSLOT(s) pushSTACK(s==(fsblkcnt_t)-1 ? NIL : uint64_to_I(s))
2494 #else
2495 # define pushBSLOT(s) pushSTACK(s==(fsblkcnt_t)-1 ? NIL : uint32_to_I(s))
2496 #endif
2497 pushBSLOT(buf.f_blocks); /* total # of blocks on file system */
2498 pushBSLOT(buf.f_bfree); /* total number of free blocks */
2499 pushBSLOT(buf.f_bavail); /* # of free blocks available to
2500 non-privileged processes */
2501 #undef pushBSLOT
2502 #if defined(SIZEOF_FSFILCNT_T) && SIZEOF_FSFILCNT_T == 8
2503 # define pushFSLOT(s) pushSTACK(s==(fsfilcnt_t)-1 ? NIL : uint64_to_I(s))
2504 #else
2505 # define pushFSLOT(s) pushSTACK(s==(fsfilcnt_t)-1 ? NIL : uint32_to_I(s))
2506 #endif
2507 pushFSLOT(buf.f_files); /* total # of file serial numbers */
2508 pushFSLOT(buf.f_ffree); /* total # of free file serial numbers */
2509 pushFSLOT(buf.f_favail); /* # of file serial numbers available to
2510 non-privileged processes */
2511 #undef pushFSLOT
2512 #if HAVE_SCALAR_FSID
2513 pushSLOT(buf.f_fsid); /* file system ID */
2514 #else
2515 /* On Linux, f_fsid of 'struct statfs' is a struct consisting of two ints.
2516 With glibc <= 2.1, f_fsid of 'struct statvfs' is the same. We are
2517 prepared to return one number only, so we just return the first int.
2518 This matches the behaviour of glibc >= 2.2 on 32-bit platforms. */
2519 pushSLOT((*(uintL*)&buf.f_fsid)); /* file system ID */
2520 #endif
2521 pushSTACK(vfs_flags_to_list(buf.f_flag)); /* Bit mask of f_flag values. */
2522 pushSLOT(buf.f_namemax); /* maximum filename length */
2523 #if defined(HAVE_STATVFS_F_VOLNAME)
2524 pushSTACK(asciz_to_string(buf.f_volname,GLO(pathname_encoding)));
2525 #else
2526 pushSTACK(NIL);
2527 #endif
2528 #if defined(HAVE_STATVFS_F_FSTYPE)
2529 pushSTACK(asciz_to_string(buf.f_fstype,GLO(pathname_encoding)));
2530 #else
2531 pushSTACK(NIL);
2532 #endif
2533 funcall(`POSIX::MAKE-STAT-VFS`,14);
2534 #undef pushSLOT
2535 }
2536
2537 #endif /* fstatvfs statvfs */
2538
2539
2540 #if defined(WIN32_NATIVE) || defined(UNIX_CYGWIN)
2541
2542 /* Dynamically load some functions missing in Windows95/98/ME
2543 to work with Security IDentifiers (SIDs). */
2544
2545 #include <aclapi.h>
2546
2547 /* Added in Windows NT 4.0 */
2548 typedef DWORD (WINAPI * GetSecurityInfoFunc_t)
2549 (HANDLE handle, SE_OBJECT_TYPE ObjectType, SECURITY_INFORMATION SecurityInfo,
2550 PSID* ppsidOwner, PSID* ppsidGroup, PACL* ppDacl, PACL* ppSacl,
2551 PSECURITY_DESCRIPTOR* ppSecurityDescriptor);
2552 static GetSecurityInfoFunc_t GetSecurityInfoFunc;
2553 #undef GetSecurityInfo
2554 #define GetSecurityInfo (*GetSecurityInfoFunc)
2555
2556 /* Added in Windows NT Workstation */
2557 typedef BOOL (WINAPI * LookupAccountSidFunc_t)
2558 (LPCTSTR lpSystemName, PSID lpSid, LPTSTR lpName, LPDWORD cchName,
2559 LPTSTR lpReferencedDomainName, LPDWORD cchReferencedDomainName,
2560 PSID_NAME_USE peUse);
2561 static LookupAccountSidFunc_t LookupAccountSidFunc;
2562 #undef LookupAccountSid
2563 #define LookupAccountSid (*LookupAccountSidFunc)
2564
2565 /* Added in Windows NT Workstation */
2566 typedef DWORD (WINAPI * GetLengthSidFunc_t) (PSID pSid);
2567 static GetLengthSidFunc_t GetLengthSidFunc;
2568 #undef GetLengthSid
2569 #define GetLengthSid (*GetLengthSidFunc)
2570
2571 /* Added in Windows NT Workstation */
2572 typedef BOOL (WINAPI * CopySidFunc_t)
2573 (DWORD nDestinationSidLength, PSID pDestinationSid, PSID pSourceSid);
2574 static CopySidFunc_t CopySidFunc;
2575 #undef CopySid
2576 #define CopySid (*CopySidFunc)
2577
2578 /* Added in Windows NT Workstation */
2579 typedef BOOL (WINAPI * EqualSidFunc_t) (PSID pSid1, PSID pSid2);
2580 static EqualSidFunc_t EqualSidFunc;
2581 #undef EqualSid
2582 #define EqualSid (*EqualSidFunc)
2583
2584 /* Added in Windows 2000 Professional */
2585 typedef BOOL (WINAPI * ConvertSidToStringSidFunc_t)
2586 (IN PSID Sid, OUT LPTSTR *StringSid);
2587 static ConvertSidToStringSidFunc_t ConvertSidToStringSidFunc;
2588 #undef ConvertSidToStringSid
2589 #define ConvertSidToStringSid (*ConvertSidToStringSidFunc)
2590
2591 static BOOL initialized_sid_apis = FALSE;
2592
initialize_sid_apis()2593 static void initialize_sid_apis () {
2594 HMODULE advapi32 = LoadLibrary("advapi32.dll");
2595 if (advapi32 != NULL) {
2596 GetSecurityInfoFunc = (GetSecurityInfoFunc_t)
2597 GetProcAddress(advapi32, "GetSecurityInfo");
2598 LookupAccountSidFunc = (LookupAccountSidFunc_t)
2599 GetProcAddress(advapi32, "LookupAccountSidA");
2600 GetLengthSidFunc = (GetLengthSidFunc_t)
2601 GetProcAddress(advapi32, "GetLengthSid");
2602 CopySidFunc = (CopySidFunc_t) GetProcAddress(advapi32, "CopySid");
2603 EqualSidFunc = (EqualSidFunc_t) GetProcAddress(advapi32, "EqualSid");
2604 ConvertSidToStringSidFunc = (ConvertSidToStringSidFunc_t)
2605 GetProcAddress(advapi32, "ConvertSidToStringSidA");
2606 }
2607 initialized_sid_apis = TRUE;
2608 }
2609
2610 #endif /* (WIN32_NATIVE || UNIX_CYGWIN) */
2611
2612 /* FILE-OWNER */
2613
2614 #if defined(HAVE_GETPWUID)
get_owner(const char * filename)2615 static const char * get_owner (const char *filename) {
2616 struct stat statbuf;
2617 if (lstat(filename, &statbuf) >= 0) {
2618 struct passwd *pwd = getpwuid(statbuf.st_uid);
2619 if (pwd)
2620 return pwd->pw_name;
2621 }
2622 return "";
2623 }
2624 #elif defined(WIN32_NATIVE)
2625
2626 /* A cache mapping SID -> owner. */
2627 struct sid_cache_entry {
2628 PSID psid;
2629 char *name;
2630 };
2631 static struct sid_cache_entry *sid_cache = NULL;
2632 static size_t sid_cache_count = 0;
2633 static size_t sid_cache_allocated = 0;
2634
sid_cache_get(PSID psid)2635 static const char * sid_cache_get (PSID psid) {
2636 size_t i;
2637 for (i = 0; i < sid_cache_count; i++)
2638 if (EqualSid(psid, sid_cache[i].psid))
2639 return sid_cache[i].name;
2640 return NULL;
2641 }
2642
sid_cache_put(PSID psid,const char * name)2643 static void sid_cache_put (PSID psid, const char *name) {
2644 if (sid_cache_count == sid_cache_allocated) {
2645 size_t new_allocated = 2 * sid_cache_allocated + 5;
2646 sid_cache = (struct sid_cache_entry*)
2647 (sid_cache != NULL
2648 ? realloc(sid_cache, new_allocated * sizeof(struct sid_cache_entry))
2649 : malloc(new_allocated * sizeof(struct sid_cache_entry)));
2650 sid_cache_allocated = (sid_cache == NULL)?0:new_allocated;
2651 }
2652 if (sid_cache != NULL) {
2653 DWORD psid_len = GetLengthSid(psid);
2654 size_t name_len = strlen(name) + 1;
2655 char *memory = (char *)malloc(psid_len+name_len);
2656 if (memory == NULL)
2657 return;
2658 if (!CopySid(psid_len, memory, psid)) return;
2659 memcpy(memory+psid_len, name, name_len);
2660 sid_cache[sid_cache_count].psid = memory;
2661 sid_cache[sid_cache_count].name = memory + psid_len;
2662 sid_cache_count++;
2663 }
2664 }
2665
get_owner(const char * filename)2666 static const char * get_owner (const char *filename) {
2667 char *owner;
2668
2669 if (!initialized_sid_apis)
2670 initialize_sid_apis();
2671 owner = "";
2672 if (GetSecurityInfoFunc != NULL
2673 && LookupAccountSidFunc != NULL
2674 && GetLengthSidFunc != NULL
2675 && CopySidFunc != NULL
2676 && EqualSidFunc != NULL) {
2677 /* On Windows, directories don't have an owner. */
2678 WIN32_FIND_DATA entry;
2679 HANDLE searchhandle = FindFirstFile(filename, &entry);
2680 if (searchhandle != INVALID_HANDLE_VALUE) {
2681 if (!(entry.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY)) {
2682 /* It's a file. */
2683 HANDLE filehandle =
2684 CreateFile(filename, GENERIC_READ,
2685 FILE_SHARE_READ | FILE_SHARE_WRITE, NULL,
2686 OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
2687 if (filehandle != INVALID_HANDLE_VALUE) {
2688 /* Get the owner. */
2689 PSID psid;
2690 PSECURITY_DESCRIPTOR psd;
2691 DWORD err =
2692 GetSecurityInfo(filehandle, SE_FILE_OBJECT,
2693 OWNER_SECURITY_INFORMATION,
2694 &psid, NULL, NULL, NULL, &psd);
2695 if (err == 0) {
2696 owner = (char*)sid_cache_get(psid);
2697 if (owner == NULL) {
2698 char buf1[256];
2699 DWORD buf1size = sizeof(buf1);
2700 char buf2[256];
2701 DWORD buf2size = sizeof(buf2);
2702 SID_NAME_USE role;
2703 if (!LookupAccountSid(NULL, psid, buf1, &buf1size, buf2,
2704 &buf2size, &role)) {
2705 char *s;
2706 if (ConvertSidToStringSidFunc != NULL
2707 && !ConvertSidToStringSidFunc(psid, &s)) {
2708 /* Fallback: Use S-R-I-S-S... notation. */
2709 strncpy(buf1, s, buf1size);
2710 buf1[buf1size - 1] = '\0';
2711 LocalFree(s);
2712 owner = buf1;
2713 } else (owner = buf1)[0] = '\0';
2714 } else { /* DOMAIN\Account */
2715 int len = strlen(buf2);
2716 buf2[len] = '\\';
2717 strcpy(buf2+len+1,buf1);
2718 owner = buf2;
2719 }
2720 sid_cache_put(psid, owner);
2721 }
2722 LocalFree(psd);
2723 }
2724 CloseHandle(filehandle);
2725 }
2726 }
2727 FindClose(searchhandle);
2728 }
2729 }
2730 return owner;
2731 }
2732 #else /* neither HAVE_GETPWUID nor WIN32_NATIVE - should never happen! */
get_owner(const char * filename)2733 static const char * get_owner (const char *filename) { return ""; }
2734 #endif
2735
2736 DEFUN(OS::FILE-OWNER, file) {
2737 VALUES1(safe_to_string((char*)ON_PNAMESTRING(popSTACK(),get_owner,NULL)));
2738 }
2739
2740 /* end of FILE-OWNER */
2741
2742 #if defined(WIN32_NATIVE)
2743
2744 /* Pointers to functions unavailable on windows 95, 98, ME */
2745
2746 typedef BOOL (WINAPI * CreateHardLinkFuncType)
2747 (LPCTSTR lpFileName, LPCTSTR lpExistingFileName,
2748 LPSECURITY_ATTRIBUTES lpSecurityAttributes);
2749 static CreateHardLinkFuncType CreateHardLinkFunc = NULL;
2750
2751 typedef BOOL (WINAPI * BackupWriteFuncType)
2752 (HANDLE hFile, LPBYTE lpBuffer, DWORD nNumberOfBytesToWrite,
2753 LPDWORD lpNumberOfBytesWritten, BOOL bAbort, BOOL bProcessSecurity,
2754 LPVOID *lpContext);
2755 static BackupWriteFuncType BackupWriteFunc = NULL;
2756
init_win32_link(void)2757 static void init_win32_link (void) {
2758 HMODULE kernel32 = LoadLibrary ("kernel32.dll");
2759 if (kernel32 != NULL) {
2760 CreateHardLinkFunc = (CreateHardLinkFuncType)
2761 GetProcAddress (kernel32, "CreateHardLinkA");
2762 BackupWriteFunc = (BackupWriteFuncType)
2763 GetProcAddress (kernel32, "BackupWrite");
2764 LockFileExFunc = (LockFileExFuncType)
2765 GetProcAddress (kernel32, "LockFileEx");
2766 if (LockFileExFunc == NULL)
2767 LockFileExFunc = (LockFileExFuncType) &my_LockFileEx;
2768 UnlockFileExFunc = (UnlockFileExFuncType)
2769 GetProcAddress (kernel32, "UnlockFileEx");
2770 if (UnlockFileExFunc == NULL)
2771 UnlockFileExFunc = (UnlockFileExFuncType) &my_UnlockFileEx;
2772 }
2773 }
2774 #endif
2775
2776 #if defined(WIN32_NATIVE) || defined(UNIX_CYGWIN)
2777 typedef HRESULT (WINAPI * StgOpenStorageExFuncType) (const WCHAR* pwcsName,
2778 DWORD grfMode, DWORD stgfmt, DWORD grfAttrs, void * reserved1,
2779 void * reserved2, REFIID riid, void ** ppObjectOpen);
2780 static StgOpenStorageExFuncType StgOpenStorageExFunc = NULL;
2781
init_win32_cygwin_open_storage(void)2782 static void init_win32_cygwin_open_storage (void) {
2783 HMODULE ole32 = LoadLibrary ("ole32.dll");
2784 if (ole32 != NULL)
2785 StgOpenStorageExFunc = (StgOpenStorageExFuncType)
2786 GetProcAddress (ole32, "StgOpenStorageEx");
2787 }
2788 #endif
2789
2790 /* COPY-FILE related functions. */
2791
2792 #if defined(WIN32_NATIVE)
2793 /* Checks if it's safe to call OldHardLink */
OldHardLinkGuard()2794 static BOOL OldHardLinkGuard () {
2795 OSVERSIONINFO vi;
2796 if (BackupWriteFunc == NULL) return FALSE;
2797 vi.dwOSVersionInfoSize = sizeof(vi);
2798 if (!GetVersionEx(&vi)) return FALSE;
2799 return vi.dwPlatformId == VER_PLATFORM_WIN32_NT;
2800 }
2801
2802 /* From knowledge base article Q234727
2803 This approach works on NT >= 3.51. */
OldHardLink(LPCTSTR source,LPCTSTR dest)2804 static BOOL OldHardLink( LPCTSTR source, LPCTSTR dest ) {
2805
2806 WCHAR wsource[ MAX_PATH + 1 ];
2807 WCHAR wdest[ MAX_PATH + 1 ];
2808 WCHAR wdestfull[ MAX_PATH + 1 ];
2809 LPWSTR wdestfullfile;
2810
2811 HANDLE hFileSource;
2812
2813 WIN32_STREAM_ID StreamId;
2814 DWORD dwBytesWritten;
2815 LPVOID lpContext;
2816 DWORD cbPathLen;
2817 DWORD StreamHeaderSize;
2818
2819 BOOL bSuccess;
2820
2821 /* convert from ANSI to UNICODE */
2822 if (MultiByteToWideChar(CP_ACP, MB_ERR_INVALID_CHARS /*error on invalid chars*/,
2823 dest, -1/*null terminated*/, wdest, MAX_PATH + 1) == 0) return FALSE;
2824
2825 /* open existing file that we link to */
2826 hFileSource = CreateFile(source, FILE_WRITE_ATTRIBUTES,
2827 FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE,
2828 NULL, /* sa */ OPEN_EXISTING, 0, NULL );
2829
2830 if (hFileSource == INVALID_HANDLE_VALUE) return FALSE;
2831
2832 /* validate and sanitize supplied link path and use the result
2833 the full path MUST be Unicode for BackupWrite */
2834 cbPathLen = GetFullPathNameW( wdest , MAX_PATH, wdestfull, &wdestfullfile);
2835
2836 if (cbPathLen == 0) return FALSE;
2837
2838 cbPathLen = (cbPathLen + 1) * sizeof(WCHAR); // adjust for byte count
2839
2840 /* prepare and write the WIN32_STREAM_ID out */
2841 lpContext = NULL;
2842
2843 StreamId.dwStreamId = BACKUP_LINK;
2844 StreamId.dwStreamAttributes = 0;
2845 StreamId.dwStreamNameSize = 0;
2846 StreamId.Size.HighPart = 0;
2847 StreamId.Size.LowPart = cbPathLen;
2848
2849 /* compute length of variable size WIN32_STREAM_ID */
2850 StreamHeaderSize = (LPBYTE)&StreamId.cStreamName - (LPBYTE)&StreamId
2851 + StreamId.dwStreamNameSize ;
2852
2853 bSuccess = BackupWriteFunc(hFileSource,
2854 (LPBYTE)&StreamId, /* buffer to write */
2855 StreamHeaderSize, /* number of bytes to write */
2856 &dwBytesWritten,
2857 FALSE, /* don't abort yet */
2858 FALSE, /* don't process security */
2859 &lpContext);
2860 bSuccess &= BackupWriteFunc(hFileSource,(LPBYTE)wdestfull, cbPathLen,
2861 &dwBytesWritten, FALSE, FALSE, &lpContext);
2862 /* free context */
2863 bSuccess &= BackupWriteFunc(hFileSource,NULL,0,&dwBytesWritten,TRUE, FALSE,
2864 &lpContext);
2865 CloseHandle( hFileSource );
2866 return bSuccess;
2867 }
2868
MkHardLink(char * old_pathstring,char * new_pathstring)2869 static inline int MkHardLink (char* old_pathstring, char* new_pathstring) {
2870 if (CreateHardLinkFunc != NULL)
2871 return CreateHardLinkFunc(new_pathstring,old_pathstring,NULL);
2872 if (OldHardLinkGuard())
2873 return OldHardLink(old_pathstring,new_pathstring);
2874 SetLastError(ERROR_INVALID_FUNCTION); /* or what ? */
2875 return 0;
2876 }
2877 #endif
2878
2879 /* Hard/Soft Link a file
2880 > old_pathstring: old file name, ASCIZ-String
2881 > new_pathstring: new file name, ASCIZ-String
2882 > STACK_3: old pathname
2883 > STACK_1: new pathname */
2884 #if defined(WIN32_NATIVE)
2885 # define HAVE_LINK
2886 #elif !defined(LINK_FOLLOWS_SYMLINKS) && defined(HAVE_REALPATH)
my_link(const char * source,const char * destination)2887 static inline int my_link (const char* source, const char* destination) {
2888 # ifndef MAXPATHLEN /* see unix.d */
2889 # define MAXPATHLEN 4096 /* see <sys/param.h> */
2890 # endif
2891 char path_buffer[MAXPATHLEN];
2892 if (NULL == realpath(source,path_buffer)) OS_file_error(STACK_3);
2893 return link(path_buffer,destination);
2894 }
2895 #else
2896 # define my_link link
2897 #endif
2898 #if defined(HAVE_LINK)
hardlink_file(char * old_pathstring,char * new_pathstring,bool error_p)2899 static bool hardlink_file (char* old_pathstring, char* new_pathstring,
2900 bool error_p) {
2901 gcv_object_t *failed = NULL;
2902 begin_blocking_system_call();
2903 # if defined(WIN32_NATIVE)
2904 if (MkHardLink(old_pathstring,new_pathstring) == FALSE)
2905 failed = (GetLastError() == ERROR_FILE_NOT_FOUND ? &STACK_3 : &STACK_1);
2906 # else
2907 if (my_link(old_pathstring,new_pathstring) < 0)
2908 failed = (errno==ENOENT ? &STACK_3 : &STACK_1);
2909 # endif
2910 end_blocking_system_call();
2911 if (failed && error_p) OS_file_error(*failed);
2912 return failed != NULL;
2913 }
hardlink_file_o(gcv_object_t * old_pathstring,gcv_object_t * new_pathstring,bool error_p)2914 static /*maygc*/ bool hardlink_file_o (gcv_object_t *old_pathstring,
2915 gcv_object_t *new_pathstring,
2916 bool error_p) {
2917 bool status;
2918 *old_pathstring = physical_namestring(*old_pathstring);
2919 *new_pathstring = physical_namestring(*new_pathstring);
2920 with_string_0(*old_pathstring, GLO(pathname_encoding), source_asciz, {
2921 with_string_0(*new_pathstring, GLO(pathname_encoding), dest_asciz, {
2922 status = hardlink_file(source_asciz,dest_asciz,error_p);
2923 });
2924 });
2925 return status;
2926 }
2927 #endif
2928 #if defined(HAVE_SYMLINK)
symlink_file(char * old_pathstring,char * new_pathstring)2929 static inline void symlink_file (char* old_pathstring, char* new_pathstring) {
2930 gcv_object_t *failed = NULL;
2931 int len = strlen(new_pathstring) - 1;
2932 if ('/' == new_pathstring[len]) /* symlink to "foo/" => ENOENT */
2933 new_pathstring[len] = 0;
2934 begin_blocking_system_call();
2935 if (symlink(old_pathstring,new_pathstring) < 0) /* symlink file */
2936 failed = (errno==ENOENT ? &STACK_3 : &STACK_1);
2937 end_blocking_system_call();
2938 if (failed) OS_file_error(*failed);
2939 }
2940 #endif
2941
2942 /* Copy attributes from stream STACK_1 to stream STACK_0 and close them
2943 can trigger GC */
copy_attributes_and_close()2944 static void copy_attributes_and_close () {
2945 Handle source_fd = stream_lend_handle(&STACK_1,true,NULL);
2946 Handle dest_fd = stream_lend_handle(&STACK_0,false,NULL);
2947 struct stat source_sb;
2948 struct stat dest_sb;
2949
2950 # if defined(HAVE_FSTAT) && !defined(WIN32_NATIVE)
2951 begin_blocking_system_call();
2952 if (fstat(source_fd, &source_sb) == -1) {
2953 end_blocking_system_call();
2954 pushSTACK(file_stream_truename(STACK_1));
2955 goto close_and_err;
2956 }
2957 if (fstat(dest_fd, &dest_sb) == -1) {
2958 end_blocking_system_call();
2959 pushSTACK(file_stream_truename(STACK_0));
2960 goto close_and_err;
2961 }
2962 end_blocking_system_call();
2963 # elif defined(HAVE_STAT)
2964 if (ON_PNAMESTRING(STACK_1,stat,&source_sb)) {
2965 pushSTACK(file_stream_truename(STACK_1));
2966 goto close_and_err;
2967 }
2968 if (ON_PNAMESTRING(STACK_0,stat,&dest_sb) == (void*)-1) {
2969 pushSTACK(file_stream_truename(STACK_0));
2970 goto close_and_err;
2971 }
2972 # else
2973 goto close_success;
2974 # endif
2975
2976 # if defined(WIN32_NATIVE) /*** file mode ***/
2977 { BOOL ret;
2978 BY_HANDLE_FILE_INFORMATION fi;
2979 begin_blocking_system_call();
2980 ret = GetFileInformationByHandle(source_fd,&fi);
2981 end_blocking_system_call();
2982 if (!ret) {
2983 pushSTACK(file_stream_truename(STACK_1));
2984 goto close_and_err;
2985 }
2986 if (!ON_PNAMESTRING(STACK_0,SetFileAttributes,fi.dwFileAttributes)) {
2987 pushSTACK(file_stream_truename(STACK_0));
2988 goto close_and_err;
2989 }
2990 }
2991 # elif defined(HAVE_FCHMOD)
2992 begin_blocking_system_call();
2993 if (((source_sb.st_mode & 0777) != (dest_sb.st_mode & 0777))
2994 && (fchmod(dest_fd, source_sb.st_mode & 0777) == -1)) {
2995 end_blocking_system_call();
2996 pushSTACK(file_stream_truename(STACK_0));
2997 goto close_and_err;
2998 }
2999 end_blocking_system_call();
3000 # elif defined(HAVE_CHMOD)
3001 if ((source_sb.st_mode & 0777) != (dest_sb.st_mode & 0777)
3002 && ON_PNAMESTRING(STACK_0,chmod,source_sb.st_mode & 0777)) {
3003 pushSTACK(file_stream_truename(STACK_0));
3004 goto close_and_err;
3005 }
3006 # endif
3007
3008 # if defined(HAVE_FCHOWN) /*** owner/group ***/
3009 begin_blocking_system_call();
3010 if (fchown(dest_fd, source_sb.st_uid, source_sb.st_gid) == -1) {
3011 end_blocking_system_call();
3012 pushSTACK(file_stream_truename(STACK_0));
3013 goto close_and_err;
3014 }
3015 end_blocking_system_call();
3016 # elif defined(HAVE_CHOWN)
3017 { int ret;
3018 with_string_0(physical_namestring(STACK_0),GLO(pathname_encoding),destz,{
3019 begin_blocking_system_call();
3020 ret = chown(destz, source_sb.st_uid, source_sb.st_gid);
3021 end_blocking_system_call();
3022 });
3023 if (ret == -1) {
3024 pushSTACK(file_stream_truename(STACK_0));
3025 goto close_and_err;
3026 }
3027 }
3028 # endif
3029
3030 # if defined(HAVE_UTIME)
3031 /* we must close the streams now - before utime() -
3032 because close() modifies write and access times */
3033 builtin_stream_close(&STACK_0,0);
3034 builtin_stream_close(&STACK_1,0);
3035 { /*** access/mod times ***/
3036 struct utimbuf utb;
3037 /* first element of the array is access time, second is mod time. set
3038 both tv_usec to zero since the file system can't gurantee that
3039 kind of precision anyway. */
3040 utb.actime = source_sb.st_atime;
3041 utb.modtime = source_sb.st_mtime;
3042 if (ON_PNAMESTRING(STACK_0,utime,&utb)) {
3043 pushSTACK(file_stream_truename(STACK_0));
3044 goto close_and_err;
3045 }
3046 }
3047 return;
3048 # endif
3049 close_success:
3050 builtin_stream_close(&STACK_0,0);
3051 builtin_stream_close(&STACK_1,0);
3052 return;
3053 close_and_err:
3054 builtin_stream_close(&STACK_1,0);
3055 builtin_stream_close(&STACK_2,0);
3056 OS_file_error(STACK_0);
3057 }
3058
3059 /* on success, push (source dest byte-count) on retval (an address in STACK)
3060 can trigger GC */
copy_file_low(object source,object dest,bool preserve_p,if_exists_t if_exists,if_does_not_exist_t if_not_exists,gcv_object_t * retval)3061 static void copy_file_low (object source, object dest,
3062 bool preserve_p, if_exists_t if_exists,
3063 if_does_not_exist_t if_not_exists,
3064 gcv_object_t* retval) {
3065 /* (let ((buffer (make-array buffer-size :element-type 'unsigned-byte)))
3066 (with-open-file (source-stream source :direction :input
3067 :element-type 'unsigned-byte)
3068 (with-open-file (dest-stream dest :direction (if append-p :append :output)
3069 :element-type 'unsigned-byte)
3070 (loop for bytes-read = (read-byte-sequence buffer source-stream)
3071 until (= 0 bytes-read)
3072 do (write-byte-sequence buffer dest-stream :end bytes-read)))))
3073 */
3074 uintL total_count = 0; /* return value: total byte count */
3075 /* create the two streams */
3076 pushSTACK(dest);
3077 /* input: */
3078 pushSTACK(source); /* filename */
3079 pushSTACK(S(Kdirection)); pushSTACK(S(Kinput));
3080 pushSTACK(S(Kelement_type)); pushSTACK(S(unsigned_byte));
3081 pushSTACK(S(Kif_does_not_exist));
3082 pushSTACK(if_does_not_exist_symbol(if_not_exists));
3083 funcall(L(open),7); source = value1;
3084 if (nullp(source)) {
3085 skipSTACK(1); /* drop dest */
3086 return;
3087 }
3088 pushSTACK(STACK_0); STACK_1 = source;
3089 /* stack layout: 1: source stream; 0: dest path */
3090 /* output: */
3091 pushSTACK(S(Kdirection)); pushSTACK(S(Koutput));
3092 pushSTACK(S(Kelement_type)); pushSTACK(S(unsigned_byte));
3093 pushSTACK(S(Kif_exists)); pushSTACK(if_exists_symbol(if_exists));
3094 funcall(L(open),7); dest = value1;
3095 if (nullp(dest)) {
3096 builtin_stream_close(&STACK_0,0);
3097 skipSTACK(1); /* drop source */
3098 return;
3099 }
3100 pushSTACK(dest);
3101 /* stack layout: 0=output stream; 1=input stream */
3102 { /* make the bit buffer and copy data */
3103 uintL bytes_read;
3104 char buffer[strm_buffered_bufflen];
3105 /* stack layout: 0 - dest-stream; 1 - source-stream */
3106 Handle fd_in = stream_lend_handle(&STACK_1,true,NULL);
3107 Handle fd_ou = stream_lend_handle(&STACK_0,false,NULL);
3108 while ((bytes_read = fd_read(fd_in,buffer,strm_buffered_bufflen,
3109 persev_full))) {
3110 total_count += bytes_read;
3111 fd_write(fd_ou,buffer,bytes_read,persev_full);
3112 }
3113 }
3114 if (!preserve_p) {
3115 builtin_stream_close(&STACK_0,0);
3116 builtin_stream_close(&STACK_1,0);
3117 } else
3118 copy_attributes_and_close();
3119 /* clean up the stack */
3120 pushSTACK(allocate_cons());
3121 Cdr(STACK_0) = *retval;
3122 *retval = STACK_0;
3123 STACK_2 = file_stream_truename(STACK_2); /* source */
3124 STACK_1 = file_stream_truename(STACK_1); /* dest */
3125 STACK_0 = UL_to_I(total_count);
3126 Car(*retval) = listof(3);
3127 }
3128
3129 DEFCHECKER(check_copy_method,enum=copy_method_t,default=COPY_METHOD_COPY,\
3130 prefix=COPY_METHOD, :COPY SYMLINK HARDLINK HARDLINK-OR-COPY :RENAME)
3131 /* copy just one file: source --> dest (both STRINGs, NIL or PATHNAME)
3132 can trigger GC */
copy_one_file(object source,object src_path,object dest,object dest_path,copy_method_t method,bool preserve_p,if_exists_t if_exists,if_does_not_exist_t if_not_exists,gcv_object_t * retval)3133 static void copy_one_file (object source, object src_path,
3134 object dest, object dest_path,
3135 copy_method_t method, bool preserve_p,
3136 if_exists_t if_exists,
3137 if_does_not_exist_t if_not_exists,
3138 gcv_object_t* retval) {
3139 pushSTACK(source); pushSTACK(src_path);
3140 pushSTACK(dest); pushSTACK(dest_path);
3141 XOUT(source,"copy_one_file");
3142 XOUT(src_path,"copy_one_file");
3143 XOUT(dest,"copy_one_file");
3144 XOUT(dest_path,"copy_one_file");
3145 /* merge source into dest: "cp foo bar/" --> "cp foo bar/foo" */
3146 pushSTACK(STACK_2); /* src_path */
3147 funcall(L(merge_pathnames),2); pushSTACK(value1); /* dest_path */
3148
3149 if (method == COPY_METHOD_COPY) {
3150 copy_file_low(STACK_2,STACK_0,preserve_p,if_exists,if_not_exists,retval);
3151 skipSTACK(4);
3152 return;
3153 }
3154
3155 pushSTACK(STACK_0); funcall(L(probe_pathname),1);
3156 if (!nullp(value1)) { /* destination exists; value1 == truename */
3157 pushSTACK(value1); STACK_2 = dest = value1;
3158 /* 5 STACK: 0=dest_true; 1=dest_path; 2=dest; 3=src_path; 4=src */
3159 switch (if_exists) {
3160 case IF_EXISTS_NIL: skipSTACK(5); return;
3161 case IF_EXISTS_APPEND:
3162 /* we know that method != COPY_METHOD_COPY - handled above! */
3163 pushSTACK(S(Kappend));
3164 pushSTACK(check_copy_method_reverse(method));
3165 pushSTACK(`POSIX::COPY-FILE`);
3166 error(error_condition,GETTEXT("~S: ~S forbids ~S"));
3167 case IF_EXISTS_OVERWRITE:
3168 case IF_EXISTS_SUPERSEDE:
3169 case IF_EXISTS_RENAME_AND_DELETE:
3170 /* these are the same since (sym)link/rename are atomic */
3171 break;
3172 case IF_EXISTS_UNBOUND: case IF_EXISTS_ERROR:
3173 case IF_EXISTS_RENAME: /* delegate to OPEN */
3174 pushSTACK(value1); /* destination */
3175 pushSTACK(S(Kif_exists)); pushSTACK(if_exists_symbol(if_exists));
3176 pushSTACK(S(Kdirection)); pushSTACK(S(Koutput));
3177 funcall(L(open),5);
3178 pushSTACK(value1); builtin_stream_close(&STACK_0,0);
3179 funcall(L(delete_file),1);
3180 break;
3181 default: NOTREACHED;
3182 }
3183 } else pushSTACK(STACK_0); /* destination does not exist, use dest_path */
3184
3185 pushSTACK(STACK_3); funcall(L(probe_pathname),1);
3186 if (nullp(value1)) { /* source does not exist */
3187 if (method == COPY_METHOD_RENAME || method == COPY_METHOD_HARDLINK
3188 || method == COPY_METHOD_HARDLINK_OR_COPY) {
3189 if (if_not_exists == IF_DOES_NOT_EXIST_NIL) {
3190 skipSTACK(5); return;
3191 } else { /* delegate error to OPEN */
3192 pushSTACK(STACK_3); /* source */
3193 pushSTACK(S(Kif_does_not_exist));
3194 pushSTACK(if_does_not_exist_symbol(if_not_exists));
3195 pushSTACK(S(Kdirection)); pushSTACK(S(Kinput));
3196 funcall(L(open),5);
3197 NOTREACHED;
3198 }
3199 }
3200 }
3201 pushSTACK(value1);
3202
3203 /* 6 STACK: 0=src_true; 1=dest_true ... */
3204 switch (method) {
3205 case COPY_METHOD_RENAME:
3206 pushSTACK(STACK_0); pushSTACK(STACK_2);
3207 pushSTACK(S(Kif_exists)); pushSTACK(if_exists_symbol(if_exists));
3208 funcall(L(rename_file),4);
3209 source = STACK_4; dest = STACK_1;
3210 break;
3211 case COPY_METHOD_HARDLINK_OR_COPY: {
3212 # if defined(HAVE_LINK)
3213 if (hardlink_file_o(&STACK_0/*source*/,&STACK_1/*dest*/,false))
3214 goto copy_one_file_copy;
3215 source = STACK_0; dest = STACK_1;
3216 break;
3217 # endif
3218 } /* FALLTHROUGH if no hardlinks */
3219 case COPY_METHOD_SYMLINK:
3220 # if defined(HAVE_SYMLINK)
3221 STACK_1 = physical_namestring(STACK_1); /* dest */
3222 /* use the original argument, not the truename here,
3223 so that the user can create relative symlinks */
3224 STACK_0 = (stringp(STACK_5) ? (object)STACK_5 /* source */
3225 : physical_namestring(STACK_4));
3226 with_string_0(STACK_0, GLO(pathname_encoding), source_asciz, {
3227 with_string_0(STACK_1, GLO(pathname_encoding), dest_asciz,
3228 { symlink_file(source_asciz,dest_asciz); });
3229 });
3230 source = STACK_0; dest = STACK_1;
3231 break;
3232 # endif
3233 /* FALLTHROUGH if no symlinks */
3234 case COPY_METHOD_HARDLINK:
3235 # if defined(HAVE_LINK)
3236 hardlink_file_o(&STACK_0/*source*/,&STACK_1/*dest*/,true);
3237 source = STACK_0; dest = STACK_1;
3238 break;
3239 # endif
3240 /* FALLTHROUGH if no hardlinks */
3241 default: copy_one_file_copy:
3242 copy_file_low(STACK_0,STACK_1,preserve_p,if_exists,if_not_exists,retval);
3243 skipSTACK(6);
3244 return;
3245 }
3246 /* update retval */
3247 STACK_0 = dest;
3248 STACK_1 = source;
3249 STACK_2 = allocate_cons();
3250 Cdr(STACK_2) = *retval;
3251 *retval = STACK_2;
3252 Car(*retval) = listof(2);
3253 skipSTACK(4);
3254 }
3255
3256 /* (COPY-FILE source target &key method preserve (if-exists :supersede)
3257 (if-does-not-exist :error))
3258 source and target are pathname designators (whether or not they
3259 can be streams is up for debate). if target is missing a name or
3260 type designator it is taken from source.
3261 keywords:
3262 method := :hardlink ; make a hard link
3263 | :symlink ; make a symbolic link
3264 | :rename ; move
3265 | :copy (or nil) ; make a copy
3266 if the underlying file system does not support a given operation
3267 a copy is made
3268
3269 preserve := t ;; preserve as much of source-file's attributes as
3270 ;; possible
3271 | nil ;; don't try to preserve source-file's attributes
3272 ;; when creating target-file
3273 for target:
3274 if-exists := :supersede ;; the existing file is superseded. that is
3275 ;; a new file with the same name (and
3276 ;; attributes if possible) is created.
3277 | :error ;; an error of type file-error is signaled.
3278 | :new-version ;; a new file is created with a larger
3279 ;; version number
3280 | :rename ;; the existing file is renamed to "orig.bak"
3281 | :append ;; the contents of source-file are appended to
3282 ;; the end of target-file
3283 for source:
3284 if-does-not-exist := nil ;; do nothing and return nil
3285 | :error ;; (default) signal an error
3286 */
3287 DEFUN(POSIX::COPY-FILE, source target &key METHOD :PRESERVE \
3288 :IF-EXISTS :IF-DOES-NOT-EXIST) {
3289 if_does_not_exist_t if_not_exists = check_if_does_not_exist(STACK_0);
3290 if_exists_t if_exists = check_if_exists(STACK_1);
3291 bool preserve_p = (!nullp(STACK_2) && boundp(STACK_2));
3292 bool wild_source_p, wild_dest_p;
3293 copy_method_t method = check_copy_method(STACK_3);
3294 STACK_1 = NIL; /* return value */
3295 /* stack: 5 - source; 4 - dest */
3296 pushSTACK(STACK_5); funcall(L(pathname),1); STACK_3 = value1;
3297 pushSTACK(STACK_3); funcall(L(wild_pathname_p),1);
3298 wild_source_p = !nullp(value1);
3299 pushSTACK(STACK_4); funcall(L(pathname),1); STACK_2 = value1;
3300 pushSTACK(STACK_2); funcall(L(wild_pathname_p),1);
3301 wild_dest_p = !nullp(value1);
3302 XOUT(STACK_3,"POSIX::COPY-FILE -- source");
3303 XOUT(STACK_2,"POSIX::COPY-FILE -- dest");
3304 if (wild_source_p) {
3305 pushSTACK(STACK_3); /* source pathname */
3306 pushSTACK(S(Kif_does_not_exist)); pushSTACK(S(Kdiscard));
3307 funcall(L(directory),3);
3308 STACK_0 = value1;
3309 XOUT(STACK_0,"POSIX::COPY-FILE: source list");
3310 if (wild_dest_p) {
3311 while (!nullp(STACK_0)) {
3312 pushSTACK(Car(STACK_0)); /* truename */
3313 pushSTACK(STACK_(3+1)); /* source */
3314 pushSTACK(STACK_(2+2)); /* dest */
3315 funcall(L(translate_pathname),3);
3316 copy_one_file(NIL,Car(STACK_0),NIL,value1,method,
3317 preserve_p,if_exists,if_not_exists,&STACK_1);
3318 STACK_0 = Cdr(STACK_0);
3319 }
3320 } else { /* non-wild dest, must be a directory */
3321 pushSTACK(STACK_2); funcall(L(probe_directory),1);
3322 if (nullp(value1)) { /* dest is a non-exitent dir */
3323 pushSTACK(STACK_2); funcall(L(make_directory),1);
3324 }
3325 while (!nullp(STACK_0)) {
3326 copy_one_file(NIL,Car(STACK_0),STACK_4,STACK_2,method,
3327 preserve_p,if_exists,if_not_exists,&STACK_1);
3328 STACK_0 = Cdr(STACK_0);
3329 }
3330 }
3331 } else /* non-wild source */
3332 copy_one_file(STACK_5,STACK_3,STACK_4,STACK_2,method,preserve_p,
3333 if_exists,if_not_exists,&STACK_1);
3334 VALUES1(STACK_1);
3335 skipSTACK(6);
3336 }
3337
3338 DEFUN(POSIX::DUPLICATE-HANDLE, old &optional new)
3339 { /* Lisp interface to dup(2)/dup2(2). */
3340 Handle new_handle = (Handle)check_uint_defaulted(popSTACK(),(uintL)-1);
3341 Handle old_handle = (Handle)I_to_uint(check_uint(popSTACK()));
3342 begin_blocking_system_call();
3343 if (new_handle == (Handle)(uintL)-1)
3344 new_handle = handle_dup(old_handle);
3345 else
3346 new_handle = handle_dup2(old_handle,new_handle);
3347 end_blocking_system_call();
3348 VALUES1(fixnum(new_handle));
3349 }
3350
3351 #if defined(WIN32_NATIVE) || defined(UNIX_CYGWIN)
3352 #include <shlobj.h>
3353 /* for CLSID_ShellLink & IID_IShellLink */
3354 #include <shldisp.h>
3355 #include <shlguid.h>
3356
3357 /* also exists in w32shell.c
3358 redefining here for compilation with cygwin
3359 where no use of COM is made in base set */
3360
BTCoCreateInstance(REFCLSID rclsid,LPUNKNOWN pUnkOuter,DWORD dwClsContext,REFIID riid,LPVOID * ppv)3361 static HRESULT BTCoCreateInstance(REFCLSID rclsid, LPUNKNOWN pUnkOuter,
3362 DWORD dwClsContext, REFIID riid,
3363 LPVOID * ppv )
3364 {
3365 HRESULT result;
3366 result = CoCreateInstance(rclsid, pUnkOuter, dwClsContext, riid, ppv);
3367 if (result != CO_E_NOTINITIALIZED
3368 || CoInitialize(NULL) != S_OK) return result;
3369 return CoCreateInstance(rclsid, pUnkOuter, dwClsContext, riid, ppv);
3370 }
3371
3372 DEFCHECKER(check_file_attributes, type=DWORD, \
3373 default=, prefix=FILE_ATTRIBUTE, bitmasks=both, \
3374 ARCHIVE COMPRESSED :DEVICE :DIRECTORY ENCRYPTED HIDDEN :NORMAL \
3375 NOT-CONTENT-INDEXED OFFLINE READONLY REPARSE-POINT SPARSE-FILE \
3376 SYSTEM TEMPORARY)
3377 DEFUN(POSIX::CONVERT-ATTRIBUTES, attributes)
3378 { /* convert between symbolic and numeric file attributes */
3379 if (posfixnump(STACK_0))
3380 VALUES1(check_file_attributes_to_list
3381 (I_to_uint32(check_uint32(popSTACK()))));
3382 else if (listp(STACK_0))
3383 VALUES1(fixnum(check_file_attributes_of_list(popSTACK())));
3384 else VALUES1(fixnum(check_file_attributes(popSTACK())));
3385 }
3386 /* convert the 8 members of WIN32_FIND_DATA to the FILE-INFO struct
3387 can trigger GC */
wfd_to_file_info(WIN32_FIND_DATA * wfd)3388 static Values wfd_to_file_info (WIN32_FIND_DATA *wfd) {
3389 pushSTACK(check_file_attributes_to_list(wfd->dwFileAttributes));
3390 pushSTACK(convert_time_to_universal_w32(&(wfd->ftCreationTime)));
3391 pushSTACK(convert_time_to_universal_w32(&(wfd->ftLastAccessTime)));
3392 pushSTACK(convert_time_to_universal_w32(&(wfd->ftLastWriteTime)));
3393 pushSTACK(UL2_to_I(wfd->nFileSizeHigh,wfd->nFileSizeLow));
3394 pushSTACK(asciz_to_string(wfd->cFileName,GLO(pathname_encoding)));
3395 pushSTACK(asciz_to_string(wfd->cAlternateFileName,GLO(pathname_encoding)));
3396 funcall(`POSIX::MAKE-FILE-INFO`,7);
3397 }
3398
3399 DEFUN(POSIX::FILE-INFO, file &optional all) {
3400 WIN32_FIND_DATA wfd;
3401 if (missingp(STACK_0)) {
3402 find_first_file(STACK_1,&wfd,NULL);
3403 wfd_to_file_info(&wfd);
3404 } else {
3405 HANDLE sh;
3406 gcv_object_t *phys = &STACK_0;
3407 unsigned int count = 1;
3408 find_first_file(STACK_1,&wfd,&sh); *phys = value1; /* physical name */
3409 wfd_to_file_info(&wfd); pushSTACK(value1);
3410 while (1) {
3411 begin_blocking_system_call();
3412 if (!FindNextFile(sh,&wfd)) {
3413 end_blocking_system_call();
3414 if (GetLastError() == ERROR_NO_MORE_FILES) break;
3415 OS_file_error(*phys);
3416 }
3417 end_blocking_system_call();
3418 wfd_to_file_info(&wfd); pushSTACK(value1); count++;
3419 }
3420 begin_blocking_system_call(); FindClose(sh); end_blocking_system_call();
3421 VALUES1(listof(count));
3422 }
3423 skipSTACK(2); /* drop arguments */
3424 }
3425
3426 DEFUN(POSIX::MAKE-SHORTCUT, file &key WORKING-DIRECTORY ARGUMENTS \
3427 SHOW-COMMAND ICON DESCRIPTION HOT-KEY PATH) {
3428 HRESULT hres;
3429 IShellLink* psl;
3430 IPersistFile* ppf;
3431 gcv_object_t *file = &STACK_7;
3432
3433 /* Get a pointer to the IShellLink interface. */
3434 begin_blocking_system_call();
3435 hres = BTCoCreateInstance(&CLSID_ShellLink, NULL, CLSCTX_INPROC_SERVER,
3436 &IID_IShellLink, (LPVOID*)&psl);
3437 if (!SUCCEEDED(hres)) goto fail_none;
3438 end_blocking_system_call();
3439 if (!missingp(STACK_0)) { /* PATH */
3440 object path = check_string(STACK_0);
3441 with_string_0(path,GLO(pathname_encoding),pathz, {
3442 begin_blocking_system_call();
3443 hres = psl->lpVtbl->SetPath(psl,pathz);
3444 if (!SUCCEEDED(hres)) goto fail_psl;
3445 end_blocking_system_call();
3446 });
3447 }
3448 skipSTACK(1); /* drop PATH */
3449 if (!missingp(STACK_0)) { /* HOT-KEY */
3450 WORD hot_key = 0;
3451 object hk = STACK_0;
3452 BYTE *pb = (BYTE*)&hot_key;
3453 restart_hot_key:
3454 if (charp(hk)) hot_key = char_int(hk);
3455 else while (consp(hk)) {
3456 if (eq(Car(hk),`:CONTROL`)) pb[1] |= HOTKEYF_CONTROL;
3457 else if (eq(Car(hk),`:ALT`)) pb[1] |= HOTKEYF_ALT;
3458 else if (eq(Car(hk),`:EXT`)) pb[1] |= HOTKEYF_EXT;
3459 else if (eq(Car(hk),`:SHIFT`)) pb[1] |= HOTKEYF_SHIFT;
3460 else if (charp(Car(hk))) {
3461 pb[0] = char_int(hk);
3462 break;
3463 } else {
3464 pushSTACK(NIL); /* no PLACE */
3465 pushSTACK(hk); /* TYPE-ERROR slot DATUM */
3466 pushSTACK(`(MEMBER :ALT :CONTROL :EXT :SHIFT)`); /* EXPECTED-TYPE */
3467 pushSTACK(STACK_0); pushSTACK(hk); pushSTACK(TheSubr(subr_self)->name);
3468 check_value(type_error,GETTEXT("~S: ~S is not a ~S"));
3469 hk = value1;
3470 goto restart_hot_key;
3471 }
3472 hk = Cdr(hk);
3473 }
3474 if (pb[0] == 0) { /* STACK_0 is the HOT-KEY arg */
3475 pushSTACK(TheSubr(subr_self)->name);
3476 error(error_condition,GETTEXT("~S: invalid hotkey spec ~S"));
3477 }
3478 begin_blocking_system_call();
3479 hres = psl->lpVtbl->SetHotkey(psl,hot_key);
3480 if (!SUCCEEDED(hres)) goto fail_psl;
3481 end_blocking_system_call();
3482 }
3483 skipSTACK(1); /* drop HOT-KEY */
3484 if (!missingp(STACK_0)) { /* DESCRIPTION */
3485 object desc = check_string(STACK_0);
3486 with_string_0(desc,GLO(pathname_encoding),descz, {
3487 begin_blocking_system_call();
3488 hres = psl->lpVtbl->SetDescription(psl,descz);
3489 if (!SUCCEEDED(hres)) goto fail_psl;
3490 end_blocking_system_call();
3491 });
3492 }
3493 skipSTACK(1); /* drop DESCRIPTION */
3494 if (!missingp(STACK_0)) { /* ICON */
3495 object icon_name;
3496 int icon_idx = 0;
3497 if (consp(STACK_0)) { /* (file . index) or (file index) */
3498 icon_name = check_string(Car(STACK_0));
3499 icon_idx = I_to_uint32(check_uint32(consp(Cdr(STACK_0))
3500 ? Car(Cdr(STACK_0))
3501 : Cdr(STACK_0)));
3502 } else icon_name = check_string(STACK_0);
3503 with_string_0(icon_name,GLO(pathname_encoding),iconz, {
3504 begin_blocking_system_call();
3505 hres = psl->lpVtbl->SetIconLocation(psl,iconz,icon_idx);
3506 if (!SUCCEEDED(hres)) goto fail_psl;
3507 end_blocking_system_call();
3508 });
3509 }
3510 skipSTACK(1); /* drop ICON */
3511 if (!missingp(STACK_0)) { /* SHOW-COMMAND */
3512 object sc = STACK_0;
3513 int sci;
3514 restart_show_command:
3515 if (eq(sc,S(Knormal))) sci = SW_SHOWNORMAL;
3516 else if (eq(sc,`:MAX`)) sci = SW_SHOWMAXIMIZED;
3517 else if (eq(sc,`:MIN`)) sci = SW_SHOWMINIMIZED;
3518 else {
3519 pushSTACK(NIL); /* no PLACE */
3520 pushSTACK(sc); /* TYPE-ERROR slot DATUM */
3521 pushSTACK(`(MEMBER :NORMAL :MAX :MIN)`); /* EXPECTED-TYPE */
3522 pushSTACK(STACK_0); pushSTACK(sc); pushSTACK(TheSubr(subr_self)->name);
3523 check_value(type_error,GETTEXT("~S: ~S is not a ~S"));
3524 sc = value1;
3525 goto restart_show_command;
3526 }
3527 begin_blocking_system_call();
3528 hres = psl->lpVtbl->SetShowCmd(psl,sci);
3529 if (!SUCCEEDED(hres)) goto fail_psl;
3530 end_blocking_system_call();
3531 }
3532 skipSTACK(1); /* drop SHOW-COMMAND */
3533 if (!missingp(STACK_0)) { /* ARGUMENTS */
3534 object args = check_string(STACK_0);
3535 with_string_0(args,GLO(pathname_encoding),argz, {
3536 begin_blocking_system_call();
3537 hres = psl->lpVtbl->SetArguments(psl,argz);
3538 if (!SUCCEEDED(hres)) goto fail_psl;
3539 end_blocking_system_call();
3540 });
3541 }
3542 skipSTACK(1); /* drop ARGUMENTS */
3543 if (!missingp(STACK_0)) { /* WORKING-DIRECTORY */
3544 object wd = check_string(STACK_0);
3545 with_string_0(wd,GLO(pathname_encoding),wdz, {
3546 begin_blocking_system_call();
3547 hres = psl->lpVtbl->SetWorkingDirectory(psl,wdz);
3548 if (!SUCCEEDED(hres)) goto fail_psl;
3549 end_blocking_system_call();
3550 });
3551 }
3552 skipSTACK(1); /* drop WORKING-DIRECTORY */
3553 STACK_0 = physical_namestring(STACK_0); /* pathname */
3554
3555 begin_blocking_system_call();
3556 hres = psl->lpVtbl->QueryInterface(psl,&IID_IPersistFile,(LPVOID*)&ppf);
3557 if (!SUCCEEDED(hres)) goto fail_psl;
3558 { /* Ensure that the string is Unicode & Save the shortcut. */
3559 WCHAR wsz[MAX_PATH];
3560 with_string_0(*file, GLO(pathname_encoding), pathz, {
3561 MultiByteToWideChar(CP_ACP, 0, pathz, -1, wsz, MAX_PATH);
3562 hres = ppf->lpVtbl->Save(ppf, wsz, TRUE);
3563 if (!SUCCEEDED(hres)) goto fail_ppf;
3564 });
3565 }
3566 ppf->lpVtbl->Release(ppf);
3567 psl->lpVtbl->Release(psl);
3568 end_blocking_system_call();
3569 VALUES1(popSTACK()); return;
3570 fail_ppf: ppf->lpVtbl->Release(ppf);
3571 fail_psl: psl->lpVtbl->Release(psl);
3572 fail_none: end_blocking_system_call(); OS_file_error(*file);
3573 }
3574
3575 DEFUN(POSIX::SHORTCUT-INFO, file) {
3576 HRESULT hres;
3577 IShellLink* psl;
3578 char path[MAX_PATH], wd[MAX_PATH], args[MAX_PATH],
3579 icon[MAX_PATH], desc[MAX_PATH];
3580 WIN32_FIND_DATA wfd;
3581 IPersistFile* ppf;
3582 gcv_object_t *file = &STACK_0;
3583 int icon_idx, show_cmd;
3584 WORD hot_key;
3585
3586 STACK_0 = physical_namestring(STACK_0);
3587
3588 /* Get a pointer to the IShellLink interface. */
3589 begin_blocking_system_call();
3590 hres = BTCoCreateInstance(&CLSID_ShellLink, NULL, CLSCTX_INPROC_SERVER,
3591 &IID_IShellLink, (LPVOID*)&psl);
3592 if (!SUCCEEDED(hres)) goto fail_none;
3593 /* Get a pointer to the IPersistFile interface. */
3594 hres = psl->lpVtbl->QueryInterface(psl,&IID_IPersistFile,(LPVOID*)&ppf);
3595 if (!SUCCEEDED(hres)) goto fail_psl;
3596 { /* Ensure that the string is Unicode & Load the shortcut. */
3597 WCHAR wsz[MAX_PATH];
3598 with_string_0(STACK_0, GLO(pathname_encoding), pathz, {
3599 MultiByteToWideChar(CP_ACP, 0, pathz, -1, wsz, MAX_PATH);
3600 hres = ppf->lpVtbl->Load(ppf, wsz, STGM_READ);
3601 if (!SUCCEEDED(hres)) goto fail_ppf;
3602 });
3603 }
3604 /* Resolve the link. */
3605 hres = psl->lpVtbl->Resolve(psl,NULL,0);
3606 if (!SUCCEEDED(hres)) goto fail_ppf;
3607 /* 1 path, 2 file info */
3608 hres = psl->lpVtbl->GetPath(psl,path, MAX_PATH, &wfd, 4/*SLGP_RAWPATH*/);
3609 if (!SUCCEEDED(hres)) goto fail_ppf;
3610 /* 3 working directory */
3611 hres = psl->lpVtbl->GetWorkingDirectory(psl,wd, MAX_PATH);
3612 if (!SUCCEEDED(hres)) goto fail_ppf;
3613 /* 4 arguments */
3614 hres = psl->lpVtbl->GetArguments(psl,args, MAX_PATH);
3615 if (!SUCCEEDED(hres)) goto fail_ppf;
3616 /* 5 show command */
3617 hres = psl->lpVtbl->GetShowCmd(psl,&show_cmd);
3618 if (!SUCCEEDED(hres)) goto fail_ppf;
3619 /* 6 icon */
3620 hres = psl->lpVtbl->GetIconLocation(psl,icon, MAX_PATH, &icon_idx);
3621 if (!SUCCEEDED(hres)) goto fail_ppf;
3622 /* 7 description */
3623 hres = psl->lpVtbl->GetDescription(psl,desc, MAX_PATH);
3624 if (!SUCCEEDED(hres)) goto fail_ppf;
3625 /* 8 hot key */
3626 hres = psl->lpVtbl->GetHotkey(psl,&hot_key);
3627 if (!SUCCEEDED(hres)) goto fail_ppf;
3628 ppf->lpVtbl->Release(ppf);
3629 psl->lpVtbl->Release(psl);
3630 end_blocking_system_call();
3631 pushSTACK(asciz_to_string(path,GLO(pathname_encoding))); /* 1 */
3632 wfd_to_file_info(&wfd); pushSTACK(value1); /* 2 */
3633 pushSTACK(asciz_to_string(wd,GLO(pathname_encoding))); /* 3 */
3634 pushSTACK(asciz_to_string(args,GLO(pathname_encoding))); /* 4 */
3635 switch (show_cmd) { /* 5 */
3636 case SW_SHOWNORMAL: pushSTACK(S(Knormal)); break;
3637 case SW_SHOWMAXIMIZED: pushSTACK(`:MAX`); break;
3638 case SW_SHOWMINIMIZED: pushSTACK(`:MIN`); break;
3639 default: NOTREACHED;
3640 }
3641 pushSTACK(asciz_to_string(icon,GLO(pathname_encoding)));
3642 pushSTACK(fixnum(icon_idx));
3643 { object tmp = listof(2); pushSTACK(tmp); } /* 6 */
3644 pushSTACK(asciz_to_string(desc,GLO(pathname_encoding))); /* 7 */
3645 { int count=0; /* 8 */
3646 BYTE *pb = (BYTE*)&hot_key;
3647 if (pb[1] & HOTKEYF_ALT) { pushSTACK(`:ALT`); count++; }
3648 if (pb[1] & HOTKEYF_CONTROL) { pushSTACK(`:CONTROL`); count++; }
3649 if (pb[1] & HOTKEYF_EXT) { pushSTACK(`:EXT`); count++; }
3650 if (pb[1] & HOTKEYF_SHIFT) { pushSTACK(`:SHIFT`); count++; }
3651 pushSTACK(int_char(pb[0]));
3652 if (count) { object tmp = listof(count+1); pushSTACK(tmp); }
3653 }
3654 funcall(`POSIX::MAKE-SHORTCUT-INFO`,9);
3655 return;
3656 fail_ppf: ppf->lpVtbl->Release(ppf);
3657 fail_psl: psl->lpVtbl->Release(psl);
3658 fail_none: end_blocking_system_call(); OS_file_error(*file);
3659 }
3660
3661 DEFCHECKER(processor_architecture, type=WORD, default=, \
3662 prefix=PROCESSOR_ARCHITECTURE, INTEL MIPS ALPHA PPC SHX ARM \
3663 IA64 ALPHA64 MSIL AMD64 IA32_ON_WIN64 UNKNOWN)
3664 DEFUN(POSIX::SYSTEM-INFO,)
3665 { /* interface to GetSystemInfo() */
3666 SYSTEM_INFO si;
3667 begin_system_call();
3668 GetSystemInfo(&si);
3669 end_system_call();
3670 pushSTACK(processor_architecture_reverse(si.wProcessorArchitecture));
3671 pushSTACK(UL_to_I(si.dwPageSize));
3672 pushSTACK(UL_to_I((DWORD)si.lpMinimumApplicationAddress));
3673 pushSTACK(UL_to_I((DWORD)si.lpMaximumApplicationAddress));
3674 pushSTACK(UL_to_I(si.dwActiveProcessorMask));
3675 pushSTACK(UL_to_I(si.dwNumberOfProcessors));
3676 pushSTACK(UL_to_I(si.dwProcessorType));
3677 pushSTACK(UL_to_I(si.dwAllocationGranularity));
3678 pushSTACK(fixnum(si.wProcessorLevel));
3679 pushSTACK(fixnum(si.wProcessorRevision));
3680 funcall(`POSIX::MAKE-SYSTEM-INFO`,10);
3681 }
3682
3683 DEFUN(POSIX::VERSION,)
3684 { /* interface to GetVersionEx() */
3685 OSVERSIONINFOEX vi;
3686 bool status;
3687 vi.dwOSVersionInfoSize = sizeof(OSVERSIONINFOEX);
3688 begin_system_call();
3689 status = GetVersionEx((OSVERSIONINFO*)&vi);
3690 end_system_call();
3691 if (!status) OS_error();
3692
3693 pushSTACK(UL_to_I(vi.dwMajorVersion));
3694 pushSTACK(UL_to_I(vi.dwMinorVersion));
3695 pushSTACK(UL_to_I(vi.dwBuildNumber));
3696 switch (vi.dwPlatformId) {
3697 case VER_PLATFORM_WIN32s: pushSTACK(`:S`); break;
3698 case VER_PLATFORM_WIN32_WINDOWS: pushSTACK(`:WINDOWS`); break;
3699 case VER_PLATFORM_WIN32_NT: pushSTACK(`:NT`); break;
3700 default: pushSTACK(UL_to_I(vi.dwPlatformId));
3701 }
3702 pushSTACK(safe_to_string(vi.szCSDVersion));
3703 pushSTACK(UL_to_I(vi.wServicePackMajor));
3704 pushSTACK(UL_to_I(vi.wServicePackMinor));
3705 { /* wSuiteMask */
3706 object suites = NIL;
3707 unsigned int count = 0;
3708 if (vi.wSuiteMask & VER_SUITE_BACKOFFICE)
3709 { pushSTACK(`:BACKOFFICE`); count++; }
3710 if (vi.wSuiteMask & VER_SUITE_DATACENTER)
3711 { pushSTACK(`:DATACENTER`); count++; }
3712 if (vi.wSuiteMask & VER_SUITE_ENTERPRISE)
3713 { pushSTACK(`:ENTERPRISE`); count++; }
3714 if (vi.wSuiteMask & VER_SUITE_SMALLBUSINESS)
3715 { pushSTACK(`:SMALLBUSINESS`); count++; }
3716 if (vi.wSuiteMask & VER_SUITE_SMALLBUSINESS_RESTRICTED)
3717 { pushSTACK(`:SMALLBUSINESS-RESTRICTED`); count++; }
3718 if (vi.wSuiteMask & VER_SUITE_TERMINAL)
3719 { pushSTACK(`:TERMINAL`); count++; }
3720 if (vi.wSuiteMask & VER_SUITE_PERSONAL)
3721 { pushSTACK(`:PERSONAL`); count++; }
3722 if (count) suites = listof(count);
3723 pushSTACK(suites);
3724 }
3725 switch (vi.wProductType) {
3726 case VER_NT_WORKSTATION: pushSTACK(`:WORKSTATION`); break;
3727 case VER_NT_DOMAIN_CONTROLLER: pushSTACK(`:DOMAIN-CONTROLLER`); break;
3728 case VER_NT_SERVER: pushSTACK(`:SERVER`); break;
3729 default: pushSTACK(UL_to_I(vi.wProductType));
3730 }
3731 funcall(`POSIX::MAKE-VERSION`,9);
3732 }
3733
3734 DEFUN(POSIX::MEMORY-STATUS,)
3735 { /* interface to GlobalMemoryStatus() */
3736 #ifdef HAVE_GLOBALMEMORYSTATUSEX
3737 MEMORYSTATUSEX ms;
3738 bool status;
3739 ms.dwLength = sizeof(MEMORYSTATUSEX);
3740 begin_system_call();
3741 status = GlobalMemoryStatusEx(&ms);
3742 end_system_call();
3743 if (!status) OS_error();
3744 pushSTACK(UQ_to_I(ms.ullTotalPhys));
3745 pushSTACK(UQ_to_I(ms.ullAvailPhys));
3746 pushSTACK(UQ_to_I(ms.ullTotalPageFile));
3747 pushSTACK(UQ_to_I(ms.ullAvailPageFile));
3748 pushSTACK(UQ_to_I(ms.ullTotalVirtual));
3749 pushSTACK(UQ_to_I(ms.ullAvailVirtual));
3750 #else
3751 MEMORYSTATUS ms;
3752 ms.dwLength = sizeof(MEMORYSTATUS);
3753 begin_system_call(); GlobalMemoryStatus(&ms); end_system_call();
3754 pushSTACK(UL_to_I(ms.dwTotalPhys));
3755 pushSTACK(UL_to_I(ms.dwAvailPhys));
3756 pushSTACK(UL_to_I(ms.dwTotalPageFile));
3757 pushSTACK(UL_to_I(ms.dwAvailPageFile));
3758 pushSTACK(UL_to_I(ms.dwTotalVirtual));
3759 pushSTACK(UL_to_I(ms.dwAvailVirtual));
3760 #endif
3761 funcall(`POSIX::MKMEMSTAT`,6);
3762 }
3763
3764 /* FILE-PROPERTIES */
3765
3766 #ifndef PIDSI_TITLE
3767 #define PIDSI_TITLE 0x00000002L
3768 #define PIDSI_SUBJECT 0x00000003L
3769 #define PIDSI_AUTHOR 0x00000004L
3770 #define PIDSI_KEYWORDS 0x00000005L
3771 #define PIDSI_COMMENTS 0x00000006L
3772 #define PIDSI_TEMPLATE 0x00000007L
3773 #define PIDSI_LASTAUTHOR 0x00000008L
3774 #define PIDSI_REVNUMBER 0x00000009L
3775 #define PIDSI_EDITTIME 0x0000000aL
3776 #define PIDSI_LASTPRINTED 0x0000000bL
3777 #define PIDSI_CREATE_DTM 0x0000000cL
3778 #define PIDSI_LASTSAVE_DTM 0x0000000dL
3779 #define PIDSI_PAGECOUNT 0x0000000eL
3780 #define PIDSI_WORDCOUNT 0x0000000fL
3781 #define PIDSI_CHARCOUNT 0x00000010L
3782 #define PIDSI_THUMBNAIL 0x00000011L
3783 #define PIDSI_APPNAME 0x00000012L
3784 #define PIDSI_DOC_SECURITY 0x00000013L
3785 #define PRSPEC_LPWSTR ( 0 )
3786 #define PRSPEC_PROPID ( 1 )
3787 #define STG_E_PROPSETMISMATCHED 0x800300F0L
3788 #endif
3789
3790 /* Pushes corresponding value to STACK */
PropVariantToLisp(PROPVARIANT * pvar)3791 static int PropVariantToLisp (PROPVARIANT *pvar) {
3792 if(pvar->vt & VT_ARRAY) {
3793 pushSTACK(S(Karray));
3794 return 1;
3795 }
3796 if(pvar->vt & VT_BYREF) {
3797 pushSTACK(`:BYREF`);
3798 return 1;
3799 }
3800 switch(pvar->vt) {
3801 case VT_EMPTY: pushSTACK(`:EMPTY`); break;
3802 case VT_NULL: pushSTACK(`:NULL`); break;
3803 case VT_BLOB: pushSTACK(`:BLOB`); break;
3804 case VT_BOOL: pushSTACK(pvar->boolVal ? T : NIL); break;
3805 case VT_I1: pushSTACK(sfixnum(pvar->cVal)); break;
3806 case VT_UI1: pushSTACK(fixnum(pvar->bVal)); break;
3807 case VT_I2: pushSTACK(sfixnum(pvar->iVal)); break;
3808 case VT_UI2: pushSTACK(fixnum(pvar->uiVal)); break;
3809 case VT_I4:
3810 case VT_INT: pushSTACK(L_to_I(pvar->lVal)); break;
3811 case VT_UI4:
3812 case VT_UINT: pushSTACK(UL_to_I(pvar->ulVal)); break;
3813 case VT_ERROR: pushSTACK(UL_to_I(pvar->scode)); break;
3814 case VT_I8: pushSTACK(sint64_to_I(*((sint64 *)&pvar->hVal))); break;
3815 case VT_CY: {
3816 double dbl = (*((sint64 *)&pvar->cyVal))/10000.0;
3817 pushSTACK(c_double_to_DF((dfloatjanus *)&dbl));
3818 } break;
3819 case VT_UI8: pushSTACK(uint64_to_I(*((uint64 *)&pvar->uhVal))); break;
3820 case VT_R4: pushSTACK(c_float_to_FF((ffloatjanus *)&pvar->fltVal)); break;
3821 case VT_R8: pushSTACK(c_double_to_DF((dfloatjanus *)&pvar->dblVal));break;
3822 case VT_DATE:pushSTACK(c_double_to_DF((dfloatjanus *)&pvar->date)); break;
3823 case VT_BSTR:
3824 pushSTACK(n_char_to_string((const char *)pvar->bstrVal,
3825 *((DWORD *)(((const char *)pvar->bstrVal)-4)),
3826 Symbol_value(S(unicode_16_little_endian))));
3827 break;
3828 case VT_LPSTR:
3829 pushSTACK(safe_to_string(pvar->pszVal));
3830 break;
3831 case VT_LPWSTR:
3832 pushSTACK(n_char_to_string((const char *)pvar->pwszVal,
3833 wcslen(pvar->pwszVal)*2,
3834 Symbol_value(S(unicode_16_little_endian))));
3835 break;
3836 case VT_FILETIME:
3837 pushSTACK(convert_time_to_universal_w32(&(pvar->filetime))); break;
3838 case VT_CF: pushSTACK(`:CLIPBOARD-FORMAT`); break;
3839 default: pushSTACK(`:NOTIMPLEMENTED`); break;
3840 }
3841 return 1;
3842 }
3843 /* popSTACK -> pvar */
LispToPropVariant(PROPVARIANT * pvar)3844 static int LispToPropVariant (PROPVARIANT * pvar) {
3845 int rv = 0;int sfp = 0;
3846 VARTYPE typehint = VT_EMPTY;
3847 if (consp(STACK_0)) {
3848 /* (KW VALUE) OR (KW NIL) ? */
3849 if (!nullp(Cdr(STACK_0)) && !nullp(Car(STACK_0))
3850 && consp(Cdr(STACK_0)) && nullp(Cdr(Cdr(STACK_0)))
3851 && symbolp(Car(STACK_0))) {
3852 if (eq(Car(STACK_0),`:I1`)) typehint = VT_I1;
3853 else if (eq(Car(STACK_0),`:UI1`)) typehint = VT_UI1;
3854 else if (eq(Car(STACK_0),`:I2`)) typehint = VT_I2;
3855 else if (eq(Car(STACK_0),`:UI2`)) typehint = VT_UI2;
3856 else if (eq(Car(STACK_0),`:I4`)) typehint = VT_I4;
3857 else if (eq(Car(STACK_0),`:INT`)) typehint = VT_INT;
3858 else if (eq(Car(STACK_0),`:UI4`)) typehint = VT_UI4;
3859 else if (eq(Car(STACK_0),`:UINT`)) typehint = VT_UINT;
3860 else if (eq(Car(STACK_0),`:I8`)) typehint = VT_I8;
3861 else if (eq(Car(STACK_0),`:UI8`)) typehint = VT_UI8;
3862 else if (eq(Car(STACK_0),`:R4`)) typehint = VT_R4;
3863 else if (eq(Car(STACK_0),`:R8`)) typehint = VT_R8;
3864 else if (eq(Car(STACK_0),`:CY`)) typehint = VT_CY;
3865 else if (eq(Car(STACK_0),`:DATE`)) typehint = VT_DATE;
3866 else if (eq(Car(STACK_0),`:BSTR`)) typehint = VT_BSTR;
3867 else if (eq(Car(STACK_0),`:BOOL`)) typehint = VT_BOOL;
3868 else if (eq(Car(STACK_0),`:ERROR`)) typehint = VT_ERROR;
3869 else if (eq(Car(STACK_0),`:FILETIME`)) typehint = VT_FILETIME;
3870 else if (eq(Car(STACK_0),`:LPSTR`)) typehint = VT_LPSTR;
3871 else if (eq(Car(STACK_0),`:LPWSTR`)) typehint = VT_LPWSTR;
3872 else { skipSTACK(1); return 0; }
3873 STACK_0 = Car(Cdr(STACK_0)); /* VALUE */
3874 } else { skipSTACK(1); return 0; }
3875 }
3876 if (stringp(STACK_0)
3877 && (typehint == VT_EMPTY || typehint == VT_BSTR
3878 || typehint == VT_LPSTR || typehint == VT_LPWSTR)) {
3879 if (typehint == VT_EMPTY) {
3880 # define STG_STRINGS_NONUNICODE
3881 # ifdef STG_STRINGS_UNICODE
3882 typehint = VT_LPWSTR;
3883 # else
3884 typehint = VT_LPSTR;
3885 # endif
3886 }
3887 do {
3888 uintL str_len;
3889 uintL str_offset;
3890 object str_string = unpack_string_ro(STACK_0,&str_len,&str_offset);
3891 const chart* ptr1;
3892 unpack_sstring_alloca(str_string,str_len,str_offset, ptr1=);
3893 if (typehint == VT_LPWSTR || typehint == VT_BSTR) {
3894 uintL str_bytelen =
3895 cslen(Symbol_value(S(unicode_16_little_endian)),ptr1,str_len);
3896 LPWSTR str = SysAllocStringByteLen(NULL,str_bytelen+4);
3897 if (typehint == VT_BSTR) {
3898 /* it's ok, SysAllocStringByteLen returns pointer after DWORD */
3899 *(((DWORD *)str)-1) = (DWORD)str_bytelen;
3900 }
3901 cstombs(Symbol_value(S(unicode_16_little_endian)),ptr1,str_len,
3902 (uintB *)str,str_bytelen);
3903 ((uintB *)str)[str_bytelen] = '\0';
3904 ((uintB *)str)[str_bytelen+1] = '\0';
3905 pvar->pwszVal = str;
3906 pvar->vt = typehint;
3907 } else { /* Win XP explorer seems to create ANSI strings. So do we. */
3908 uintL str_bytelen = cslen(GLO(misc_encoding),ptr1,str_len);
3909 char * str = (char *) SysAllocStringByteLen(NULL, str_bytelen+2);
3910 cstombs(GLO(misc_encoding),ptr1,str_len,(uintB *)str,str_bytelen);
3911 str[str_bytelen] = '\0';
3912 pvar->pszVal = str;
3913 pvar->vt = VT_LPSTR;
3914 }
3915 rv = 1;
3916 } while(0);
3917 } else if (integerp(STACK_0)) {
3918 if (typehint == VT_EMPTY) typehint = VT_FILETIME; /* assume FILETIME */
3919 if (typehint == VT_FILETIME) {
3920 pvar->vt = VT_FILETIME; rv = 1;
3921 convert_time_from_universal_w32(STACK_0,&(pvar->filetime));
3922 } else if (typehint == VT_I1) {
3923 pvar->vt = typehint; pvar->cVal = I_to_sint8(STACK_0); rv = 1;
3924 } else if (typehint == VT_UI1) {
3925 pvar->vt = typehint; pvar->bVal = I_to_uint8(STACK_0); rv = 1;
3926 } else if (typehint == VT_I2) {
3927 pvar->vt = typehint; pvar->iVal = I_to_sint16(STACK_0); rv = 1;
3928 } else if (typehint == VT_UI2) {
3929 pvar->vt = typehint; pvar->uiVal = I_to_uint16(STACK_0); rv = 1;
3930 } else if (typehint == VT_I4 || typehint == VT_INT) { /* VT_I4 != VT_INT */
3931 pvar->vt = typehint; pvar->lVal = I_to_sint32(STACK_0); rv = 1;
3932 } else if (typehint == VT_UI4 || typehint == VT_UINT) {
3933 pvar->vt = typehint; pvar->ulVal = I_to_uint32(STACK_0); rv = 1;
3934 } else if (typehint == VT_ERROR) {
3935 pvar->vt = typehint; pvar->scode = I_to_uint32(STACK_0); rv = 1;
3936 } else if (typehint == VT_I8) {
3937 pvar->vt = typehint;
3938 *((sint64 *)&pvar->hVal) = I_to_sint64(STACK_0);rv = 1;
3939 } else if (typehint == VT_UI8) {
3940 pvar->vt = typehint;
3941 *((uint64 *)&pvar->uhVal) = I_to_uint64(STACK_0);rv = 1;
3942 } else if (typehint == VT_CY) {
3943 sint64 i64 = I_to_uint64(STACK_0);
3944 pvar->vt = typehint;
3945 *((uint64 *)&pvar->cyVal) = i64*10000;rv = 1;
3946 }
3947 } else if ((sfp = single_float_p(STACK_0)) || double_float_p(STACK_0)) {
3948 if (typehint == VT_EMPTY) typehint = (sfp?VT_R4:VT_R8);
3949 if (typehint == VT_R4) {
3950 if (sfp) {
3951 pvar->vt = VT_R4;
3952 pvar->fltVal = 0;
3953 FF_to_c_float(STACK_0,(ffloatjanus *)&pvar->fltVal);
3954 rv = 1;
3955 }
3956 } else if (typehint == VT_R8) {
3957 pvar->vt = VT_R8;
3958 if (sfp) {
3959 float v = 0;
3960 FF_to_c_float(STACK_0,(ffloatjanus *)&v);
3961 pvar->dblVal = v;
3962 } else {
3963 pvar->dblVal = 0; /* DF_to_c_double takes only clean doubles */
3964 DF_to_c_double(STACK_0,(dfloatjanus *)&pvar->dblVal);
3965 }
3966 rv = 1;
3967 } else if (typehint == VT_DATE && double_float_p(STACK_0)) {
3968 /* A 64-bit floating point number representing the number of days
3969 (not seconds) since December 31, 1899. For example, January 1, 1900,
3970 is 2.0, January 2, 1900, is 3.0, and so on). This is stored in the
3971 same representation as VT_R8. */
3972 pvar->vt = VT_DATE;
3973 pvar->date = 0;
3974 DF_to_c_double(STACK_0,(dfloatjanus *)&pvar->date);
3975 rv = 1;
3976 } else if (typehint == VT_CY) {
3977 double dbl = 0; float v = 0;
3978 pvar->vt = typehint;
3979 if (sfp) {
3980 FF_to_c_float(STACK_0,(ffloatjanus *)&v);
3981 dbl = v;
3982 } else {
3983 DF_to_c_double(STACK_0,(dfloatjanus *)&dbl);
3984 }
3985 *((uint64 *)&pvar->cyVal) = (uint64) (dbl*10000 + 0.5);rv = 1;
3986 }
3987 } else if (symbolp(STACK_0)) {
3988 if (typehint == VT_EMPTY && eq(STACK_0,`:EMPTY`)) {
3989 pvar->vt = VT_EMPTY; rv = 1; } else
3990 if (typehint == VT_EMPTY && eq(STACK_0,`:NULL`)) {
3991 pvar->vt = VT_NULL; rv = 1; } else
3992 if (typehint == VT_BOOL && eq(STACK_0,NIL)) {
3993 pvar->vt = VT_BOOL; pvar->boolVal = FALSE; rv = 1; } else
3994 if (typehint == VT_BOOL && eq(STACK_0,T)) {
3995 pvar->vt = VT_BOOL; pvar->boolVal = TRUE; rv = 1; }
3996 }
3997 skipSTACK(1);
3998 return rv;
3999 }
4000
4001 WINOLEAPI PropVariantClear(PROPVARIANT* pvar);
4002
kwtopropid(object kw)4003 static PROPID kwtopropid (object kw) {
4004 if (eq(kw,`:CODEPAGE`)) return 1 /* PID_CODEPAGE */;
4005 if (eq(kw,`:LOCALE`)) return 0x80000000 /* PID_LOCALE */;
4006 if (eq(kw,`:TITLE`)) return PIDSI_TITLE;
4007 if (eq(kw,`:SUBJECT`)) return PIDSI_SUBJECT;
4008 if (eq(kw,`:AUTHOR`)) return PIDSI_AUTHOR;
4009 if (eq(kw,`:KEYWORDS`)) return PIDSI_KEYWORDS;
4010 if (eq(kw,`:COMMENTS`)) return PIDSI_COMMENTS;
4011 if (eq(kw,`:TEMPLATE`)) return PIDSI_TEMPLATE;
4012 if (eq(kw,`:LASTAUTHOR`)) return PIDSI_LASTAUTHOR;
4013 if (eq(kw,`:REVNUMBER`)) return PIDSI_REVNUMBER;
4014 if (eq(kw,`:EDITTIME`)) return PIDSI_EDITTIME;
4015 if (eq(kw,`:LASTPRINTED`)) return PIDSI_LASTPRINTED;
4016 if (eq(kw,`:CREATE-DTM`)) return PIDSI_CREATE_DTM;
4017 if (eq(kw,`:LASTSAVE-DTM`)) return PIDSI_LASTSAVE_DTM;
4018 if (eq(kw,`:PAGECOUNT`)) return PIDSI_PAGECOUNT;
4019 if (eq(kw,`:WORDCOUNT`)) return PIDSI_WORDCOUNT;
4020 if (eq(kw,`:CHARCOUNT`)) return PIDSI_CHARCOUNT;
4021 if (eq(kw,`:THUMBNAIL`)) return PIDSI_THUMBNAIL;
4022 if (eq(kw,`:APPNAME`)) return PIDSI_APPNAME;
4023 if (eq(kw,`:DOC-SECURITY`)) return PIDSI_DOC_SECURITY;
4024 return (PROPID)-1;
4025 }
4026
4027 /* string -> PROPSPEC */
PropSpecSetStr(object str,PROPSPEC * pspec)4028 static void PropSpecSetStr (object str, PROPSPEC * pspec) {
4029 pspec->ulKind = PRSPEC_LPWSTR;
4030 { uintL str_len;
4031 uintL str_offset;
4032 object str_string = unpack_string_ro(str,&str_len,&str_offset);
4033 const chart* ptr1;
4034 unpack_sstring_alloca(str_string,str_len,str_offset, ptr1=);
4035 { uintL str_bytelen =
4036 cslen(Symbol_value(S(unicode_16_little_endian)),ptr1,str_len);
4037 pspec->lpwstr = (LPOLESTR)clisp_malloc(str_bytelen+2);
4038 begin_system_call();
4039 cstombs(Symbol_value(S(unicode_16_little_endian)),ptr1,str_len,
4040 (uintB *)pspec->lpwstr,str_bytelen);
4041 end_system_call();
4042 ((uintB *)pspec->lpwstr)[str_bytelen] = '\0';
4043 ((uintB *)pspec->lpwstr)[str_bytelen+1] = '\0';
4044 }
4045 }
4046 }
4047
4048 /* list (ID STRING) -> PROPSPEC(ID), PROPSPEC(STR)
4049 STACK may don't match the pattern (then function returns false)
4050 any of pspec1, pspec2 can be NULL */
propspeclistp(object arg,PROPSPEC * pspec1,PROPSPEC * pspec2)4051 static int propspeclistp (object arg, PROPSPEC * pspec1,PROPSPEC * pspec2) {
4052 /* check if it is (INT STRING) */
4053 if (consp(arg) && !nullp(Cdr(arg)) && !nullp(Car(arg))
4054 && consp(Cdr(arg)) && nullp(Cdr(Cdr(arg)))
4055 && !nullp(Car(Cdr(arg)))
4056 && (integerp(Car(arg)) || symbolp(Car(arg)))
4057 && stringp(Car(Cdr(arg)))) {
4058 /* set pspec1 to ID and pspec2 to STRING */
4059 if (pspec1) {
4060 pspec1->ulKind = PRSPEC_PROPID;
4061 if (integerp(Car(arg)))
4062 pspec1->propid = I_to_UL(Car(arg));
4063 else {
4064 pspec1->propid = kwtopropid(Car(arg));
4065 if (pspec1->propid == (PROPID) -1)
4066 return 0;
4067 }
4068 }
4069 if (pspec2)
4070 PropSpecSetStr(Car(Cdr(arg)),pspec2);
4071 return 1;
4072 }
4073 return 0;
4074 }
4075
4076 /* (keyword, int, list (ID STRING) or string) -> PROPSPEC
4077 uses malloc to allocate memory for string specifiers
4078 (when ulKind == PRSPEC_LPWSTR)
4079 pspec2 can be NULL */
PropSpecSet(object arg,PROPSPEC * pspec1,PROPSPEC * pspec2)4080 static int PropSpecSet (object arg, PROPSPEC * pspec1, PROPSPEC * pspec2) {
4081 ZeroMemory(pspec1, sizeof(PROPSPEC));
4082 if (pspec2) ZeroMemory(pspec2, sizeof(PROPSPEC));
4083 if (symbolp(arg)) {
4084 pspec1->ulKind = PRSPEC_PROPID;
4085 pspec1->propid = kwtopropid(arg);
4086 if (pspec1->propid == (PROPID) -1) return 0;
4087 return 1;
4088 } else if (stringp(arg)) {
4089 PropSpecSetStr(arg,pspec1);
4090 return 1;
4091 } else if (integerp(arg)) {
4092 pspec1->ulKind = PRSPEC_PROPID;
4093 pspec1->propid = I_to_UL(arg);
4094 return 1;
4095 } else if (propspeclistp(arg,pspec1,pspec2)) return 2;
4096 return 0;
4097 }
4098
DecodeHRESULT(HRESULT hres)4099 static const char * DecodeHRESULT (HRESULT hres) {
4100 static char buf[128];
4101 #define msgcase(x) case x: return #x; break;
4102 switch (hres) {
4103 msgcase(E_UNEXPECTED)
4104 msgcase(STG_E_FILENOTFOUND)
4105 msgcase(STG_E_ACCESSDENIED)
4106 msgcase(STG_E_INSUFFICIENTMEMORY)
4107 msgcase(STG_E_INVALIDFUNCTION)
4108 msgcase(STG_E_REVERTED)
4109 msgcase(STG_E_INVALIDPARAMETER)
4110 msgcase(STG_E_INVALIDNAME)
4111 msgcase(S_FALSE)
4112 msgcase(STG_E_INVALIDPOINTER)
4113 msgcase(HRESULT_FROM_WIN32(ERROR_NO_UNICODE_TRANSLATION))
4114 msgcase(HRESULT_FROM_WIN32(ERROR_NOT_SUPPORTED))
4115 msgcase(STG_E_WRITEFAULT)
4116 msgcase(STG_E_MEDIUMFULL)
4117 msgcase(STG_E_PROPSETMISMATCHED)
4118 }
4119 #undef msgcase
4120 sprintf(buf,"0x%x",hres);
4121 return buf;
4122 }
4123
4124 #define with_string_0w(string,wcvar,statement) \
4125 do { uintL wcvar##_len; \
4126 uintL wcvar##_offset; \
4127 object wcvar##_string = unpack_string_ro(string,&wcvar##_len,&wcvar##_offset); \
4128 const chart* ptr1; \
4129 unpack_sstring_alloca(wcvar##_string,wcvar##_len,wcvar##_offset, ptr1=); \
4130 {uintL wcvar##_bytelen = \
4131 cslen(Symbol_value(S(unicode_16_little_endian)),ptr1,wcvar##_len); \
4132 DYNAMIC_ARRAY(wcvar##_data,uintB,wcvar##_bytelen+2); \
4133 cstombs(Symbol_value(S(unicode_16_little_endian)),ptr1,wcvar##_len,\
4134 &wcvar##_data[0],wcvar##_bytelen); \
4135 wcvar##_data[wcvar##_bytelen] = '\0'; \
4136 wcvar##_data[wcvar##_bytelen+1] = '\0'; \
4137 {WCHAR* wcvar = (WCHAR*) &wcvar##_data[0]; \
4138 statement \
4139 } \
4140 FREE_DYNAMIC_ARRAY(wcvar##_data); \
4141 }} while(0)
4142
4143 /* there's no PropVariantInit in my cygwin headers */
4144 #define MyPropVariantInit(ppv) begin_system_call(); \
4145 ZeroMemory(ppv,sizeof(PROPVARIANT));end_system_call()
4146
4147 /* (OS::FILE-PROPERTIES filename set [specifier value|:INITID init-id]*)
4148 Wrapper for Win32 IPropertyStorage functionality
4149 filename - a compound file name or (on NTFS) name of any file
4150 set - :BUILT-IN or :USER-DEFINED property set
4151 specifier - property specifier: integer, keyword, string or
4152 list of integer or keyword and string.
4153 Integer specifier - a property identifier
4154 Keyword: :CODEPAGE, :LOCALE, :TITLE, :SUBJECT, :AUTHOR,
4155 :KEYWORDS, :COMMENTS, :TEMPLATE, :LASTAUTHOR,
4156 :REVNUMBER, :EDITTIME, :LASTPRINTED,:CREATE-DTM,
4157 :LASTSAVE-DTM, :PAGECOUNT, :WORDCOUNT, :CHARCOUNT,
4158 :THUMBNAIL, :APPNAME, :DOC-SECURITY - predefined IDs.
4159 String: string property specifier. If no match is found, first
4160 ID >= init-id (which defaults to 2) is associated with the
4161 string and it's value is replaced with new value.
4162 (int|keyword string) - first element is used as specifier,
4163 string is associated with this ID.
4164 value - new value of the property, suitable lisp object, nil or list of
4165 keyword and value itself. If value is NIL, no assignment is done.
4166 :EMPTY and :NULL correspond VT_EMPTY and VT_NULL datatypes.
4167 Keyword in the list specifies the desired type of property being set.
4168 Supported types are :I1, :UI1, :I2, :UI2, :I4, :UI4, :UINT, :I8,
4169 :UI8, :R4, :R8, :DATE, :BSTR, :BOOL, :ERROR, :FILETIME,
4170 :LPSTR, :LPWSTR. FILETIMEs are converted to/from universal time format,
4171 while DATEs are not.
4172
4173 returns multiple values - property contents before assignment. */
4174 DEFUN(POSIX::FILE-PROPERTIES, file set &rest pairs)
4175 { /* TODO: close interfaces even on errors;
4176 support more datatypes
4177 use IPropertySetStorage::Create when it doesn't exist */
4178 IPropertyStorage * ppropstg = NULL;
4179 IPropertySetStorage * ppropsetstg = NULL;
4180 HRESULT hres;
4181 FMTID const * fmtid = NULL;
4182 PROPSPEC * pspecrd = NULL;
4183 PROPSPEC * pspecwr = NULL;
4184 PROPVARIANT * pvarrd = NULL;
4185 PROPVARIANT * pvarwr = NULL;
4186 PROPID * propidwpnvec = NULL; /* args for WritePropertyNames */
4187 LPWSTR * lpwstrwpnvec = NULL;
4188 int ifile = argcount + 1;
4189 int iset = argcount;
4190 int i;
4191 unsigned int initid = 2;
4192 int use_wpn = 0; /* should WritePropertyNames be used ? */
4193 int nproprd = 0, npropwr = 0; /* npropd >= npropwr */
4194 int cproprd = 0, cpropwr = 0;
4195 int cwpnpar = 0;
4196 /* argcount is (length pairs), not the total arg count */
4197 /* no &rest ? no sense. */
4198 if (argcount == 0) {
4199 skipSTACK(2);
4200 VALUES0;
4201 return;
4202 }
4203 /* count the number of r/rw props, checking arglist sanity */
4204 if (argcount % 2)
4205 error_key_odd(argcount,TheSubr(subr_self)->name);
4206 for(i=argcount-1;i>=0;i--) {
4207 if (i % 2) { /* specifier */
4208 if (!symbolp(STACK_(i)) && !stringp(STACK_(i))
4209 && !posfixnump(STACK_(i))) {
4210 if (!propspeclistp(STACK_(i),NULL,NULL)) {
4211 pushSTACK(TheSubr(subr_self)->name);
4212 error(program_error,
4213 GETTEXT("~S: bad property specifier - it must be string, "
4214 "positive number, list or keyword"));
4215 } else { use_wpn++; nproprd++; }
4216 } else if (symbolp(STACK_(i)) && eq(STACK_(i),`:INITID`)) initid = 0;
4217 else nproprd++;
4218 } else { /* value */
4219 if (!initid) {
4220 if (integerp(STACK_(i))) initid = I_to_UL(STACK_(i));
4221 else {
4222 pushSTACK(STACK_(i));
4223 pushSTACK(TheSubr(subr_self)->name);
4224 error(program_error,GETTEXT("~S: bad INITID specifier: ~S"));
4225 }
4226 } else if (!nullp(STACK_(i))) npropwr++;
4227 }
4228 }
4229 if (!StgOpenStorageExFunc) {
4230 begin_system_call();
4231 SetLastError(ERROR_INVALID_FUNCTION);
4232 end_system_call();
4233 OS_error();
4234 }
4235 STACK_(ifile) = physical_namestring(STACK_(ifile));
4236 with_string_0w(STACK_(ifile), filename, {
4237 begin_blocking_system_call();
4238 hres = StgOpenStorageExFunc(filename,
4239 ((npropwr||use_wpn)?STGM_READWRITE:STGM_READ)
4240 | STGM_SHARE_EXCLUSIVE,
4241 4 /* STGFMT_ANY */, 0, NULL /*&stgOp*/, 0,
4242 &IID_IPropertySetStorage,
4243 (void **)&ppropsetstg);
4244 end_blocking_system_call();
4245 });
4246 if (FAILED(hres)) {
4247 pushSTACK(STACK_(ifile));
4248 pushSTACK(TheSubr(subr_self)->name);
4249 switch(hres) {
4250 case STG_E_FILENOTFOUND:
4251 error(file_error,GETTEXT("~S: file ~S does not exist"));
4252 case STG_E_FILEALREADYEXISTS:
4253 error(file_error,GETTEXT("~S: file ~S is not a compound file nor it is on the NTFS file system"));
4254 default:
4255 error(file_error,GETTEXT("~S: StgOpenStorageEx() failed on file ~S"));
4256 }
4257 }
4258 if (eq(STACK_(iset),`:USER-DEFINED`))
4259 fmtid = &FMTID_UserDefinedProperties;
4260 else if (eq(STACK_(iset),`:BUILT-IN`))
4261 fmtid = &FMTID_SummaryInformation;
4262 else {
4263 pushSTACK(STACK_(iset));
4264 pushSTACK(TheSubr(subr_self)->name);
4265 error(file_error,GETTEXT("~S: invalid property set specifier ~S"));
4266 }
4267 begin_blocking_system_call();
4268 hres = ppropsetstg->lpVtbl->Open(ppropsetstg, fmtid,
4269 ((npropwr||use_wpn)?STGM_READWRITE:STGM_READ)
4270 | STGM_SHARE_EXCLUSIVE, &ppropstg);
4271 end_blocking_system_call();
4272 if (FAILED(hres)) {
4273 pushSTACK(safe_to_string(DecodeHRESULT(hres)));
4274 pushSTACK(STACK_(ifile+1));
4275 pushSTACK(STACK_(iset+2));
4276 pushSTACK(TheSubr(subr_self)->name);
4277 error(file_error,GETTEXT("~S: unable to open ~S IPropertySetStorage of ~S: error ~S"));
4278 }
4279 /* fill the specifiers, init the variables */
4280 pspecrd = (PROPSPEC *)clisp_malloc(sizeof(PROPSPEC) * nproprd);
4281 pvarrd = (PROPVARIANT *)clisp_malloc(sizeof(PROPVARIANT) * nproprd);
4282 pspecwr = (PROPSPEC *)clisp_malloc(sizeof(PROPSPEC) * npropwr);
4283 pvarwr = (PROPVARIANT *)clisp_malloc(sizeof(PROPVARIANT) * npropwr);
4284 if (use_wpn) {
4285 propidwpnvec = (PROPID *)clisp_malloc(sizeof(PROPID)*use_wpn);
4286 lpwstrwpnvec = (LPWSTR *)clisp_malloc(sizeof(LPWSTR)*use_wpn);
4287 }
4288 for(i=0;i<argcount;i+=2) {
4289 /* i+1 - specifier, i - value */
4290 PROPSPEC second;
4291 int pssresult;
4292 if (symbolp(STACK_(i+1)) && eq(STACK_(i+1),`:INITID`)) continue;
4293 pssresult = PropSpecSet(STACK_(i+1),pspecrd+nproprd-cproprd-1,&second);
4294 MyPropVariantInit(pvarrd+nproprd-cproprd-1);
4295 if (!nullp(STACK_(i))) {
4296 PropSpecSet(STACK_(i+1),pspecwr+npropwr-cpropwr-1,NULL);
4297 MyPropVariantInit(pvarwr+npropwr-cpropwr-1);
4298 pushSTACK(STACK_(i));
4299 if (!LispToPropVariant(pvarwr+npropwr-cpropwr-1)) {
4300 pushSTACK(STACK_(i));
4301 pushSTACK(TheSubr(subr_self)->name);
4302 error(error_condition,GETTEXT("~S: cannot convert ~S to PROPVARIANT"));
4303 }
4304 cpropwr++;
4305 }
4306 if (use_wpn && pssresult == 2) {
4307 propidwpnvec[cwpnpar] = pspecrd[nproprd-cproprd-1].propid;
4308 lpwstrwpnvec[cwpnpar] = second.lpwstr;
4309 cwpnpar++;
4310 }
4311 cproprd++;
4312 }
4313 hres = ppropstg->lpVtbl->ReadMultiple(ppropstg,nproprd, pspecrd, pvarrd);
4314 if(FAILED(hres)) {
4315 pushSTACK(safe_to_string(DecodeHRESULT(hres)));
4316 pushSTACK(TheSubr(subr_self)->name);
4317 error(error_condition,GETTEXT("~S: ReadMultiple error: ~S"));
4318 }
4319 if (npropwr > 0) {
4320 begin_blocking_system_call();
4321 hres = ppropstg->lpVtbl->WriteMultiple(ppropstg,npropwr,pspecwr,pvarwr,
4322 initid);
4323 end_blocking_system_call();
4324 if(FAILED(hres)) {
4325 pushSTACK(safe_to_string(DecodeHRESULT(hres)));
4326 pushSTACK(TheSubr(subr_self)->name);
4327 error(error_condition,GETTEXT("~S: WriteMultiple error: ~S"));
4328 }
4329 }
4330 for (i=0;i<nproprd;i++)
4331 if (!PropVariantToLisp(pvarrd+i)) {
4332 pushSTACK(fixnum(i));
4333 pushSTACK(TheSubr(subr_self)->name);
4334 error(error_condition,GETTEXT("~S: cannot convert value ~S to Lisp datatype"));
4335 }
4336 if (use_wpn) {
4337 hres = ppropstg->lpVtbl->WritePropertyNames(ppropstg,use_wpn,propidwpnvec,lpwstrwpnvec);
4338 if (FAILED(hres)) {
4339 pushSTACK(safe_to_string(DecodeHRESULT(hres)));
4340 pushSTACK(TheSubr(subr_self)->name);
4341 error(error_condition,GETTEXT("~S: WritePropertyNames: ~S"));
4342 }
4343 }
4344 if (sizeof(mv_space)/sizeof(mv_space[0]) < nproprd) {
4345 pushSTACK(TheSubr(subr_self)->name);
4346 error(program_error,GETTEXT("~S: multiple value count limit reached"));
4347 }
4348 mv_count = nproprd;
4349 for (i=0;i<nproprd;i++) mv_space[nproprd-i-1] = popSTACK();
4350 skipSTACK(argcount+2); /* two first args */
4351 begin_system_call();
4352 for (i=0;i<nproprd;i++) {
4353 PropVariantClear(pvarrd+i);
4354 if (pspecrd[i].ulKind == PRSPEC_LPWSTR) free(pspecrd[i].lpwstr);
4355 }
4356 for (i=0;i<npropwr;i++) {
4357 if (pvarwr[i].vt == VT_LPWSTR || pvarwr[i].vt == VT_BSTR)
4358 SysFreeString(pvarwr[i].pwszVal);
4359 if (pvarwr[i].vt == VT_LPSTR)
4360 SysFreeString((BSTR)pvarwr[i].pszVal);
4361 if (pspecwr[i].ulKind == PRSPEC_LPWSTR) free(pspecwr[i].lpwstr);
4362 }
4363 for (i=0;i<use_wpn;i++) free(lpwstrwpnvec[i]);
4364 free(pspecrd); free(pvarrd); free(pspecwr); free(pvarwr);
4365 free(propidwpnvec); free(lpwstrwpnvec);
4366 ppropstg->lpVtbl->Release(ppropstg);
4367 ppropsetstg->lpVtbl->Release(ppropsetstg);
4368 end_system_call();
4369 }
4370
4371 #define SIDBUFSZ 256
4372
4373 /* (POSIX::GET-USER-SID &optional USERNAME)
4374 USERNAME: string representing user's name, possibly
4375 containing a domain name. Current process user's SID
4376 is returned if no USERNAME is specified.
4377 Returns string representation of user's security
4378 identifier (SID) in S-R-I-S-S notation.
4379 Function could be used in conjunction with file-owner */
4380
4381 DEFUN(POSIX::GET-USER-SID, &optional username) {
4382 char buf[SIDBUFSZ];
4383 PSID psid;
4384 LPSTR sidstr;
4385
4386 if (!missingp(STACK_0)) {
4387 WCHAR domain[SIDBUFSZ];
4388 DWORD sz = SIDBUFSZ, domsz = SIDBUFSZ;
4389 SID_NAME_USE use;
4390
4391 with_string_0w(check_string(STACK_0),wstr, {
4392 if (!LookupAccountNameW(NULL, wstr, (PSID) buf, &sz, domain, &domsz, &use))
4393 OS_error();
4394 psid = (PSID) buf;
4395 });
4396 } else {
4397 HANDLE token_handle = NULL;
4398 TOKEN_USER * tu = ((TOKEN_USER *) buf);
4399 DWORD required = 0;
4400
4401 if (!OpenProcessToken(GetCurrentProcess(),
4402 TOKEN_ADJUST_PRIVILEGES|TOKEN_QUERY,
4403 &token_handle))
4404 OS_error();
4405 if (!GetTokenInformation(token_handle, TokenUser, tu, SIDBUFSZ, &required))
4406 OS_error();
4407 psid = tu->User.Sid;
4408 }
4409 if (!initialized_sid_apis)
4410 initialize_sid_apis();
4411 if (!ConvertSidToStringSidFunc) {
4412 pushSTACK(TheSubr(subr_self)->name);
4413 error(error_condition,GETTEXT("~S: SID management library is not initialized"));
4414 }
4415 if (!ConvertSidToStringSidFunc(psid, &sidstr)) OS_error();
4416 VALUES1(asciz_to_string(sidstr,GLO(misc_encoding)));
4417 LocalFree(sidstr);
4418 skipSTACK(1);
4419 }
4420
4421 /* helpers for CLIPBOARD and %SET-CLIPBOARD */
4422
nlines_a(const char * s)4423 static int nlines_a (const char * s) {
4424 int result = 1;
4425 while (*s) if (*s++ == '\n') result++;
4426 return result;
4427 }
4428
nlines_w(PWSTR s)4429 static int nlines_w (PWSTR s) {
4430 int result = 1;
4431 while (*s) if (*s++ == (WCHAR)'\n') result++;
4432 return result;
4433 }
4434
4435 /* copy string and convert "\n" to "\r\n" */
4436
strzcpy12_a(char * dest,const char * src)4437 static void strzcpy12_a (char * dest, const char * src) {
4438 do {
4439 if (*src == '\n') *dest++ = '\r';
4440 *dest = *src;
4441 if (!*src) break;
4442 dest++; src++;
4443 } while(true);
4444 }
4445
strzcpy12_w(PWSTR dest,PCWSTR src)4446 static void strzcpy12_w (PWSTR dest, PCWSTR src) {
4447 do {
4448 if (*src == (WCHAR)'\n') *dest++ = (WCHAR)'\r';
4449 *dest = *src;
4450 if (!*src) break;
4451 dest++; src++;
4452 } while(true);
4453 }
4454
4455 /* copy string and convert "\r\n" to "\n" */
4456
strzcpy21_a(char * dest,const char * src)4457 static void strzcpy21_a (char * dest, const char * src) {
4458 do {
4459 *dest = *src;
4460 if (!*src) break;
4461 if (*src != '\r') dest++;
4462 src++;
4463 } while(true);
4464 }
4465
strzcpy21_w(PWSTR dest,PCWSTR src)4466 static void strzcpy21_w (PWSTR dest, PCWSTR src) {
4467 do {
4468 *dest = *src;
4469 if (!*src) break;
4470 if (*src != (WCHAR)'\r') dest++;
4471 src++;
4472 } while(true);
4473 }
4474
4475 /* %SET-CLIPBOARD: set the contents of Windows clipboard to the printed
4476 representation of argument (PRINC-TO-STRING is used). Returns T on
4477 success, NIL on failure. */
4478 DEFUN(OS::%SET-CLIPBOARD, str) {
4479 int textset = 0;
4480 pushSTACK(STACK_0); /* to return from %SET-CLIPBOARD */
4481 funcall(L(princ_to_string), 1);
4482 begin_system_call();
4483 if (OpenClipboard(NULL)) {
4484 if( EmptyClipboard() ) {
4485 #ifdef ENABLE_UNICODE
4486 OSVERSIONINFO v;
4487 v.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
4488 if (GetVersionEx(&v)) {
4489 if (v.dwPlatformId == VER_PLATFORM_WIN32_NT) { /* Windows NT */
4490 with_string_0w(value1, wstr, {
4491 HGLOBAL sglobal =
4492 GlobalAlloc(GMEM_MOVEABLE|GMEM_DDESHARE,
4493 (wstr_bytelen + nlines_w(wstr) + 2)
4494 * sizeof(WCHAR));
4495 if (sglobal != NULL) {
4496 void * slocal = GlobalLock(sglobal);
4497 if (slocal != NULL) {
4498 end_system_call();
4499 strzcpy12_w(slocal, wstr);
4500 begin_system_call();
4501 if ( SetClipboardData( CF_UNICODETEXT, sglobal ) != NULL ) {
4502 GlobalUnlock(sglobal);
4503 textset = 1;
4504 } else {
4505 DWORD last = GetLastError();
4506 GlobalFree(sglobal);
4507 SetLastError(last);
4508 }
4509 }
4510 }
4511 });
4512 } else { /* Win95/98/Me - try ASCII */
4513 #else
4514 { {
4515 #endif
4516 with_string_0( value1, GLO(misc_encoding), cstr, {
4517 HGLOBAL sglobal =
4518 GlobalAlloc(GMEM_MOVEABLE|GMEM_DDESHARE, cstr_bytelen + nlines_a(cstr) + 1);
4519 if (sglobal != NULL) {
4520 void * slocal = GlobalLock(sglobal);
4521 if (slocal != NULL) {
4522 end_system_call();
4523 strzcpy12_a(slocal, cstr);
4524 begin_system_call();
4525 if (SetClipboardData( CF_TEXT, sglobal ) != NULL ) {
4526 GlobalUnlock(sglobal);
4527 textset = 1;
4528 } else { /* GlobalFree only if SetClipboardData failed */
4529 DWORD last = GetLastError();
4530 GlobalFree(sglobal);
4531 SetLastError(last);
4532 }
4533 }
4534 }
4535 });
4536 #ifdef ENABLE_UNICODE
4537 } /* v.dwPlatformId */
4538 } /* GetVersionEx */
4539 #else
4540 } } /* for MODPREP all brackets should be
4541 balanced like there are no ifdefs */
4542 #endif
4543 CloseClipboard();
4544 } /* EmptyClipboard */
4545 } /* OpenClipboard */
4546 end_system_call();
4547 if (!textset) OS_error(); /* !textset => some system call failed
4548 && LastError contain this error code */
4549 VALUES1(popSTACK());
4550 }
4551
4552 /* CLIPBOARD: Returns the textual contents of Windows clipboard
4553 as a string. First try to get it as CF_UNICODETEXT, then CF_TEXT.
4554 On failure or when no text is available NIL is returned. */
4555 DEFUN(OS:CLIPBOARD,) {
4556 VALUES1(NIL);
4557 begin_blocking_system_call();
4558 if (OpenClipboard(NULL)) {
4559 #ifdef ENABLE_UNICODE
4560 HGLOBAL gltext = GetClipboardData(CF_UNICODETEXT);
4561 if (gltext != NULL) { /* UNICODE TEXT */
4562 PWSTR wstr = (PWSTR)GlobalLock(gltext);
4563 if (wstr != NULL) {
4564 DYNAMIC_ARRAY(buf, WCHAR, wcslen(wstr) + 1);
4565 end_blocking_system_call();
4566 strzcpy21_w(buf, wstr);
4567 VALUES1(n_char_to_string((const char *)buf, wcslen(buf) * sizeof(WCHAR),
4568 Symbol_value(S(unicode_16_little_endian))));
4569 FREE_DYNAMIC_ARRAY(buf);
4570 begin_blocking_system_call();
4571 GlobalUnlock(gltext);
4572 }
4573 } else { /* Probably system just do not support UNICODE */
4574 #endif
4575 gltext = GetClipboardData(CF_TEXT); /* ANSI TEXT */
4576 if (gltext != NULL) {
4577 const char * str = (const char *)GlobalLock(gltext);
4578 if (str != NULL) {
4579 DYNAMIC_ARRAY(buf, char, strlen(str) + 1);
4580 end_blocking_system_call();
4581 strzcpy21_a(buf, str);
4582 VALUES1(asciz_to_string(buf, GLO(misc_encoding)));
4583 FREE_DYNAMIC_ARRAY(buf);
4584 begin_blocking_system_call();
4585 GlobalUnlock(gltext);
4586 }
4587 }
4588 #ifdef ENABLE_UNICODE
4589 }
4590 #endif
4591 CloseClipboard();
4592 }
4593 end_blocking_system_call();
4594 }
4595
4596 /* http://gnuwin32.sourceforge.net/version.c.txt */
file_version(char * pathz)4597 static Values /*maygc*/ file_version (char *pathz) {
4598 DWORD dwHandle, dwLen;
4599 UINT BufLen;
4600 LPTSTR lpData, lpBuffer;
4601 VS_FIXEDFILEINFO *pFileInfo;
4602 BOOL status;
4603 begin_system_call();
4604 dwLen = GetFileVersionInfoSize(pathz,&dwHandle);
4605 if (dwLen == 0)
4606 OS_error();
4607 lpData = (LPTSTR)malloc(dwLen);
4608 if (lpData == NULL)
4609 OS_error();
4610 if (!GetFileVersionInfo(pathz,dwHandle,dwLen,lpData)) {
4611 free(lpData);
4612 OS_error();
4613 }
4614 if (!VerQueryValue(lpData,"\\",(LPVOID*)&pFileInfo,(PUINT)&BufLen)) {
4615 end_system_call();
4616 pushSTACK(data_to_sb8vector(lpData,dwLen));
4617 begin_system_call();
4618 free(lpData);
4619 end_system_call();
4620 pushSTACK(asciz_to_string(pathz,GLO(pathname_encoding)));
4621 pushSTACK(TheSubr(subr_self)->name);
4622 error(error_condition,GETTEXT("~S(~S): No root block in ~S"));
4623 }
4624 pushSTACK(UL_to_I(HIWORD(pFileInfo->dwFileVersionMS)));
4625 pushSTACK(UL_to_I(LOWORD(pFileInfo->dwFileVersionMS)));
4626 pushSTACK(UL_to_I(HIWORD(pFileInfo->dwFileVersionLS)));
4627 pushSTACK(UL_to_I(LOWORD(pFileInfo->dwFileVersionLS)));
4628 #if defined(ENABLE_UNICODE)
4629 # define SUBBLOCK "\\StringFileInfo\\040904B0\\"
4630 #else
4631 # define SUBBLOCK "\\StringFileInfo\\04090000\\"
4632 #endif
4633 #define TO_STACK(info) \
4634 begin_system_call(); \
4635 status = VerQueryValue(lpData,SUBBLOCK info,(LPVOID*)&lpBuffer, \
4636 (PUINT)&BufLen); \
4637 end_system_call(); \
4638 while(lpBuffer[BufLen-1]==0) BufLen--; \
4639 pushSTACK(status?n_char_to_string(lpBuffer,BufLen,GLO(misc_encoding)):NIL)
4640 TO_STACK("Comments");
4641 TO_STACK("CompanyName");
4642 TO_STACK("FileDescription");
4643 TO_STACK("FileVersion");
4644 TO_STACK("InternalName");
4645 TO_STACK("LegalCopyright");
4646 TO_STACK("LegalTrademarks");
4647 TO_STACK("OriginalFilename");
4648 TO_STACK("ProductName");
4649 TO_STACK("ProductVersion");
4650 TO_STACK("PrivateBuild");
4651 TO_STACK("SpecialBuild");
4652 begin_system_call(); free(lpData); end_system_call();
4653 funcall(`POSIX::MKFILEVER`,16);
4654 #undef TO_STACK
4655 #undef SUBBLOCK
4656 }
4657 DEFUN(OS:FILE-VERSION,filename) {
4658 with_string_0(physical_namestring(popSTACK()),GLO(pathname_encoding),pathz,{
4659 file_version(pathz);
4660 });
4661 }
4662 #endif /* WIN32_NATIVE || UNIX_CYGWIN */
4663
4664 /* STDIO inteface for postgresql et al and to access wild files like 'foo*' */
DEFUN(POSIX::FOPEN,path mode)4665 DEFUN(POSIX::FOPEN, path mode) {
4666 STACK_0 = check_string(STACK_0);
4667 STACK_1 = check_string(STACK_1);
4668 with_string_0(STACK_1, GLO(pathname_encoding), pathz, {
4669 with_string_0(STACK_0, GLO(misc_encoding), modez, {
4670 FILE *fp;
4671 begin_blocking_system_call();
4672 fp = fopen(pathz,modez);
4673 end_blocking_system_call();
4674 if (fp) STACK_0 = allocate_fpointer((FOREIGN)fp);
4675 else ANSIC_error();
4676 });
4677 });
4678 VALUES1(STACK_0); skipSTACK(2);
4679 }
DEFUN(POSIX::FDOPEN,fd mode)4680 DEFUN(POSIX::FDOPEN, fd mode) {
4681 STACK_0 = check_string(STACK_0);
4682 STACK_1 = check_sint(STACK_1);
4683 with_string_0(STACK_0, GLO(misc_encoding), modez, {
4684 FILE *fp;
4685 begin_blocking_system_call();
4686 fp = fdopen(I_to_sint(STACK_1),modez);
4687 end_blocking_system_call();
4688 if (fp) STACK_0 = allocate_fpointer((FOREIGN)fp);
4689 else ANSIC_error();
4690 });
4691 VALUES1(STACK_0); skipSTACK(2);
4692 }
DEFUN(POSIX::FREOPEN,path mode file)4693 DEFUN(POSIX::FREOPEN, path mode file) {
4694 STACK_2 = check_string(STACK_2); /* path */
4695 STACK_1 = check_string(STACK_1); /* mode */
4696 STACK_0 = check_fpointer(STACK_0,1); /* file */
4697 with_string_0(STACK_2, GLO(pathname_encoding), pathz, {
4698 with_string_0(STACK_1, GLO(misc_encoding), modez, {
4699 FILE *fp;
4700 begin_blocking_system_call();
4701 fp = freopen(pathz,modez,(FILE*)TheFpointer(STACK_0)->fp_pointer);
4702 end_blocking_system_call();
4703 if (fp) TheFpointer(STACK_0)->fp_pointer = fp;
4704 else ANSIC_error();
4705 });
4706 });
4707 VALUES0; skipSTACK(3);
4708 }
4709 #define FILE_FUNCTION(fun,finish) \
4710 int ret; \
4711 STACK_0 = check_fpointer(STACK_0,1); \
4712 begin_blocking_system_call(); \
4713 ret = fun((FILE*)TheFpointer(STACK_0)->fp_pointer); \
4714 end_blocking_system_call(); \
4715 finish; skipSTACK(1)
DEFUN(POSIX::FILENO,fp)4716 DEFUN(POSIX::FILENO, fp)
4717 { FILE_FUNCTION(fileno,{ if(ret==-1)ANSIC_error(); VALUES1(sint_to_I(ret));});}
DEFUN(POSIX::FEOF,fp)4718 DEFUN(POSIX::FEOF, fp) { FILE_FUNCTION(feof,VALUES_IF(ret)); }
DEFUN(POSIX::FERROR,fp)4719 DEFUN(POSIX::FERROR, fp) { FILE_FUNCTION(ferror,VALUES_IF(ret)); }
DEFUN(POSIX::FCLOSE,fp)4720 DEFUN(POSIX::FCLOSE, fp)
4721 { FILE_FUNCTION(fclose,{ if (ret == EOF) ANSIC_error(); VALUES0; }); }
DEFUN(POSIX::FFLUSH,fp)4722 DEFUN(POSIX::FFLUSH, fp)
4723 { FILE_FUNCTION(fflush,{ if (ret == EOF) ANSIC_error(); VALUES0; }); }
4724 /* no fputs & fgets because they will mess with encodings &c */
DEFUN(POSIX::CLEARERR,fp)4725 DEFUN(POSIX::CLEARERR, fp) {
4726 STACK_0 = check_fpointer(STACK_0,1);
4727 begin_blocking_system_call();
4728 clearerr((FILE*)TheFpointer(STACK_0)->fp_pointer);
4729 end_blocking_system_call();
4730 VALUES0; skipSTACK(1);
4731 }
4732
4733 /* --- testing only! not exported! --- */
4734 /* fgetc returns -1 on EOF instead of signaling an error. or signal?! */
4735 DEFUN(POSIX::%FGETC, fp) { FILE_FUNCTION(fgetc,VALUES1(sint_to_I(ret))); }
4736 #define FILE_FUNCTION2(fun) \
4737 int ret; \
4738 STACK_0 = check_fpointer(STACK_0,1); \
4739 STACK_1 = check_sint(STACK_1); \
4740 begin_blocking_system_call(); \
4741 ret = fun(I_to_sint(STACK_1),(FILE*)TheFpointer(STACK_0)->fp_pointer); \
4742 end_blocking_system_call(); \
4743 VALUES1(sint_to_I(ret)); skipSTACK(2)
4744 DEFUN(POSIX::%FPUTC, c fp) { FILE_FUNCTION2(fputc); }
4745 DEFUN(POSIX::%UNGETC, c fp) { FILE_FUNCTION2(ungetc); }
4746
4747 /* standard objects */
DEFVAR(my_stdin,allocate_fpointer (NULL))4748 DEFVAR(my_stdin,allocate_fpointer(NULL))
4749 DEFVAR(my_stdout,allocate_fpointer(NULL))
4750 DEFVAR(my_stderr,allocate_fpointer(NULL))
4751 static void init_stdio (void) {
4752 TheFpointer(O(my_stdin))->fp_pointer = stdin;
4753 mark_fp_valid(TheFpointer(O(my_stdin)));
4754 TheFpointer(O(my_stdout))->fp_pointer = stdout;
4755 mark_fp_valid(TheFpointer(O(my_stdout)));
4756 TheFpointer(O(my_stderr))->fp_pointer = stderr;
4757 mark_fp_valid(TheFpointer(O(my_stderr)));
4758 }
4759 DEFUN(POSIX::%STDIO, &optional which) {
4760 stdio_restart:
4761 if (missingp(STACK_0)) {
4762 init_stdio();
4763 VALUES0;
4764 } else {
4765 int which = I_to_sint(STACK_0 = check_sint(STACK_0));
4766 switch (which) {
4767 case 0: VALUES1(O(my_stdin)); break;
4768 case 1: VALUES1(O(my_stdout)); break;
4769 case 2: VALUES1(O(my_stderr)); break;
4770 default:
4771 pushSTACK(NIL); /* no PLACE */
4772 pushSTACK(STACK_1); /* TYPE-ERROR slot DATUM */
4773 pushSTACK(`(MEMBER 0 1 2)`); /* EXPECTED-TYPE */
4774 pushSTACK(STACK_0); pushSTACK(STACK_2);
4775 pushSTACK(TheSubr(subr_self)->name);
4776 check_value(type_error,GETTEXT("~S: ~S is not a ~S"));
4777 STACK_0 = value1;
4778 goto stdio_restart;
4779 }
4780 }
4781 skipSTACK(1);
4782 }
4783
4784 /* ========================= OS error printing ========================= */
4785 #if defined(WIN32_NATIVE) || defined(UNIX_CYGWIN)
4786 # include <winerror.h>
4787 /* http://cygwin.com/cgi-bin/cvsweb.cgi/src/winsup/w32api/include/winerror.h */
4788 /* http://msdn.microsoft.com/en-us/library/aa914935.aspx */
4789 DEFCHECKER(check_last_error,type=DWORD, \
4790 ERROR_INVALID_FUNCTION ERROR_FILE_NOT_FOUND ERROR_PATH_NOT_FOUND \
4791 ERROR_TOO_MANY_OPEN_FILES ERROR_ACCESS_DENIED \
4792 ERROR_INVALID_HANDLE ERROR_ARENA_TRASHED ERROR_NOT_ENOUGH_MEMORY \
4793 ERROR_INVALID_BLOCK ERROR_BAD_ENVIRONMENT ERROR_BAD_FORMAT \
4794 ERROR_INVALID_ACCESS ERROR_INVALID_DATA ERROR_OUTOFMEMORY \
4795 ERROR_INVALID_DRIVE ERROR_CURRENT_DIRECTORY ERROR_NOT_SAME_DEVICE \
4796 ERROR_NO_MORE_FILES ERROR_WRITE_PROTECT ERROR_BAD_UNIT \
4797 ERROR_NOT_READY ERROR_BAD_COMMAND ERROR_CRC ERROR_BAD_LENGTH \
4798 ERROR_SEEK ERROR_NOT_DOS_DISK ERROR_SECTOR_NOT_FOUND \
4799 ERROR_OUT_OF_PAPER ERROR_WRITE_FAULT ERROR_READ_FAULT \
4800 ERROR_GEN_FAILURE ERROR_SHARING_VIOLATION ERROR_LOCK_VIOLATION \
4801 ERROR_WRONG_DISK ERROR_SHARING_BUFFER_EXCEEDED ERROR_HANDLE_EOF \
4802 ERROR_HANDLE_DISK_FULL ERROR_NOT_SUPPORTED ERROR_REM_NOT_LIST \
4803 ERROR_DUP_NAME ERROR_BAD_NETPATH ERROR_NETWORK_BUSY \
4804 ERROR_DEV_NOT_EXIST ERROR_TOO_MANY_CMDS ERROR_ADAP_HDW_ERR \
4805 ERROR_BAD_NET_RESP ERROR_UNEXP_NET_ERR ERROR_BAD_REM_ADAP \
4806 ERROR_PRINTQ_FULL ERROR_NO_SPOOL_SPACE ERROR_PRINT_CANCELLED \
4807 ERROR_NETNAME_DELETED ERROR_NETWORK_ACCESS_DENIED \
4808 ERROR_BAD_DEV_TYPE ERROR_BAD_NET_NAME ERROR_TOO_MANY_NAMES \
4809 ERROR_TOO_MANY_SESS ERROR_SHARING_PAUSED ERROR_REQ_NOT_ACCEP \
4810 ERROR_REDIR_PAUSED ERROR_FILE_EXISTS ERROR_CANNOT_MAKE \
4811 ERROR_FAIL_I24 ERROR_OUT_OF_STRUCTURES ERROR_ALREADY_ASSIGNED \
4812 ERROR_INVALID_PASSWORD ERROR_INVALID_PARAMETER \
4813 ERROR_NET_WRITE_FAULT ERROR_NO_PROC_SLOTS \
4814 ERROR_TOO_MANY_SEMAPHORES ERROR_EXCL_SEM_ALREADY_OWNED \
4815 ERROR_SEM_IS_SET ERROR_TOO_MANY_SEM_REQUESTS \
4816 ERROR_INVALID_AT_INTERRUPT_TIME ERROR_SEM_OWNER_DIED \
4817 ERROR_SEM_USER_LIMIT ERROR_DISK_CHANGE ERROR_DRIVE_LOCKED \
4818 ERROR_BROKEN_PIPE ERROR_OPEN_FAILED ERROR_BUFFER_OVERFLOW \
4819 ERROR_DISK_FULL ERROR_NO_MORE_SEARCH_HANDLES \
4820 ERROR_INVALID_TARGET_HANDLE ERROR_INVALID_CATEGORY \
4821 ERROR_INVALID_VERIFY_SWITCH ERROR_BAD_DRIVER_LEVEL \
4822 ERROR_CALL_NOT_IMPLEMENTED ERROR_SEM_TIMEOUT \
4823 ERROR_INSUFFICIENT_BUFFER ERROR_INVALID_NAME ERROR_INVALID_LEVEL \
4824 ERROR_NO_VOLUME_LABEL ERROR_MOD_NOT_FOUND ERROR_PROC_NOT_FOUND \
4825 ERROR_WAIT_NO_CHILDREN ERROR_CHILD_NOT_COMPLETE \
4826 ERROR_DIRECT_ACCESS_HANDLE ERROR_NEGATIVE_SEEK \
4827 ERROR_SEEK_ON_DEVICE ERROR_IS_JOIN_TARGET ERROR_IS_JOINED \
4828 ERROR_IS_SUBSTED ERROR_NOT_JOINED ERROR_NOT_SUBSTED \
4829 ERROR_JOIN_TO_JOIN ERROR_SUBST_TO_SUBST ERROR_JOIN_TO_SUBST \
4830 ERROR_SUBST_TO_JOIN ERROR_BUSY_DRIVE ERROR_SAME_DRIVE \
4831 ERROR_DIR_NOT_ROOT ERROR_DIR_NOT_EMPTY ERROR_IS_SUBST_PATH \
4832 ERROR_IS_JOIN_PATH ERROR_PATH_BUSY ERROR_IS_SUBST_TARGET \
4833 ERROR_SYSTEM_TRACE ERROR_INVALID_EVENT_COUNT \
4834 ERROR_TOO_MANY_MUXWAITERS ERROR_INVALID_LIST_FORMAT \
4835 ERROR_LABEL_TOO_LONG ERROR_TOO_MANY_TCBS ERROR_SIGNAL_REFUSED \
4836 ERROR_DISCARDED ERROR_NOT_LOCKED ERROR_BAD_THREADID_ADDR \
4837 ERROR_BAD_ARGUMENTS ERROR_BAD_PATHNAME ERROR_SIGNAL_PENDING \
4838 ERROR_MAX_THRDS_REACHED ERROR_LOCK_FAILED ERROR_BUSY \
4839 ERROR_CANCEL_VIOLATION ERROR_ATOMIC_LOCKS_NOT_SUPPORTED \
4840 ERROR_INVALID_SEGMENT_NUMBER ERROR_INVALID_ORDINAL \
4841 ERROR_ALREADY_EXISTS ERROR_INVALID_FLAG_NUMBER \
4842 ERROR_SEM_NOT_FOUND ERROR_INVALID_STARTING_CODESEG \
4843 ERROR_INVALID_STACKSEG ERROR_INVALID_MODULETYPE \
4844 ERROR_INVALID_EXE_SIGNATURE ERROR_EXE_MARKED_INVALID \
4845 ERROR_BAD_EXE_FORMAT ERROR_ITERATED_DATA_EXCEEDS_64k \
4846 ERROR_INVALID_MINALLOCSIZE ERROR_DYNLINK_FROM_INVALID_RING \
4847 ERROR_IOPL_NOT_ENABLED ERROR_INVALID_SEGDPL \
4848 ERROR_AUTODATASEG_EXCEEDS_64k ERROR_RING2SEG_MUST_BE_MOVABLE \
4849 ERROR_RELOC_CHAIN_XEEDS_SEGLIM ERROR_INFLOOP_IN_RELOC_CHAIN \
4850 ERROR_ENVVAR_NOT_FOUND ERROR_NO_SIGNAL_SENT \
4851 ERROR_FILENAME_EXCED_RANGE ERROR_RING2_STACK_IN_USE \
4852 ERROR_META_EXPANSION_TOO_LONG ERROR_INVALID_SIGNAL_NUMBER \
4853 ERROR_THREAD_1_INACTIVE ERROR_LOCKED ERROR_TOO_MANY_MODULES \
4854 ERROR_NESTING_NOT_ALLOWED ERROR_EXE_MACHINE_TYPE_MISMATCH \
4855 ERROR_EXE_CANNOT_MODIFY_SIGNED_BINARY \
4856 ERROR_EXE_CANNOT_MODIFY_STRONG_SIGNED_BINARY ERROR_BAD_PIPE \
4857 ERROR_PIPE_BUSY ERROR_NO_DATA ERROR_PIPE_NOT_CONNECTED \
4858 ERROR_MORE_DATA ERROR_VC_DISCONNECTED ERROR_INVALID_EA_NAME \
4859 ERROR_EA_LIST_INCONSISTENT WAIT_TIMEOUT ERROR_NO_MORE_ITEMS \
4860 ERROR_CANNOT_COPY ERROR_DIRECTORY ERROR_EAS_DIDNT_FIT \
4861 ERROR_EA_FILE_CORRUPT ERROR_EA_TABLE_FULL ERROR_INVALID_EA_HANDLE \
4862 ERROR_EAS_NOT_SUPPORTED ERROR_NOT_OWNER ERROR_TOO_MANY_POSTS \
4863 ERROR_PARTIAL_COPY ERROR_OPLOCK_NOT_GRANTED \
4864 ERROR_INVALID_OPLOCK_PROTOCOL ERROR_DISK_TOO_FRAGMENTED \
4865 ERROR_DELETE_PENDING ERROR_MR_MID_NOT_FOUND ERROR_SCOPE_NOT_FOUND \
4866 ERROR_INVALID_ADDRESS ERROR_ARITHMETIC_OVERFLOW \
4867 ERROR_PIPE_CONNECTED ERROR_PIPE_LISTENING ERROR_EA_ACCESS_DENIED \
4868 ERROR_OPERATION_ABORTED ERROR_IO_INCOMPLETE ERROR_IO_PENDING \
4869 ERROR_NOACCESS ERROR_SWAPERROR ERROR_STACK_OVERFLOW \
4870 ERROR_INVALID_MESSAGE ERROR_CAN_NOT_COMPLETE \
4871 ERROR_INVALID_FLAGS ERROR_UNRECOGNIZED_VOLUME \
4872 ERROR_FILE_INVALID ERROR_FULLSCREEN_MODE ERROR_NO_TOKEN \
4873 ERROR_BADDB ERROR_BADKEY ERROR_CANTOPEN ERROR_CANTREAD \
4874 ERROR_CANTWRITE ERROR_REGISTRY_RECOVERED ERROR_REGISTRY_CORRUPT \
4875 ERROR_REGISTRY_IO_FAILED ERROR_NOT_REGISTRY_FILE \
4876 ERROR_KEY_DELETED ERROR_NO_LOG_SPACE ERROR_KEY_HAS_CHILDREN \
4877 ERROR_CHILD_MUST_BE_VOLATILE ERROR_NOTIFY_ENUM_DIR \
4878 ERROR_DEPENDENT_SERVICES_RUNNING ERROR_INVALID_SERVICE_CONTROL \
4879 ERROR_SERVICE_REQUEST_TIMEOUT ERROR_SERVICE_NO_THREAD \
4880 ERROR_SERVICE_DATABASE_LOCKED ERROR_SERVICE_ALREADY_RUNNING \
4881 ERROR_INVALID_SERVICE_ACCOUNT ERROR_SERVICE_DISABLED \
4882 ERROR_CIRCULAR_DEPENDENCY ERROR_SERVICE_DOES_NOT_EXIST \
4883 ERROR_SERVICE_CANNOT_ACCEPT_CTRL ERROR_SERVICE_NOT_ACTIVE \
4884 ERROR_FAILED_SERVICE_CONTROLLER_CONNECT \
4885 ERROR_EXCEPTION_IN_SERVICE ERROR_DATABASE_DOES_NOT_EXIST \
4886 ERROR_SERVICE_SPECIFIC_ERROR ERROR_PROCESS_ABORTED \
4887 ERROR_SERVICE_DEPENDENCY_FAIL ERROR_SERVICE_LOGON_FAILED \
4888 ERROR_SERVICE_START_HANG ERROR_INVALID_SERVICE_LOCK \
4889 ERROR_SERVICE_MARKED_FOR_DELETE ERROR_SERVICE_EXISTS \
4890 ERROR_ALREADY_RUNNING_LKG ERROR_SERVICE_DEPENDENCY_DELETED \
4891 ERROR_BOOT_ALREADY_ACCEPTED ERROR_SERVICE_NEVER_STARTED \
4892 ERROR_DUPLICATE_SERVICE_NAME ERROR_DIFFERENT_SERVICE_ACCOUNT \
4893 ERROR_CANNOT_DETECT_DRIVER_FAILURE \
4894 ERROR_CANNOT_DETECT_PROCESS_ABORT \
4895 ERROR_NO_RECOVERY_PROGRAM ERROR_SERVICE_NOT_IN_EXE \
4896 ERROR_NOT_SAFEBOOT_SERVICE ERROR_END_OF_MEDIA \
4897 ERROR_FILEMARK_DETECTED ERROR_BEGINNING_OF_MEDIA \
4898 ERROR_SETMARK_DETECTED ERROR_NO_DATA_DETECTED \
4899 ERROR_PARTITION_FAILURE ERROR_INVALID_BLOCK_LENGTH \
4900 ERROR_DEVICE_NOT_PARTITIONED ERROR_UNABLE_TO_LOCK_MEDIA \
4901 ERROR_UNABLE_TO_UNLOAD_MEDIA ERROR_MEDIA_CHANGED ERROR_BUS_RESET \
4902 ERROR_NO_MEDIA_IN_DRIVE ERROR_NO_UNICODE_TRANSLATION \
4903 ERROR_DLL_INIT_FAILED ERROR_SHUTDOWN_IN_PROGRESS \
4904 ERROR_NO_SHUTDOWN_IN_PROGRESS ERROR_IO_DEVICE \
4905 ERROR_SERIAL_NO_DEVICE ERROR_IRQ_BUSY ERROR_MORE_WRITES \
4906 ERROR_COUNTER_TIMEOUT ERROR_FLOPPY_ID_MARK_NOT_FOUND \
4907 ERROR_FLOPPY_WRONG_CYLINDER ERROR_FLOPPY_UNKNOWN_ERROR \
4908 ERROR_FLOPPY_BAD_REGISTERS ERROR_DISK_RECALIBRATE_FAILED \
4909 ERROR_DISK_OPERATION_FAILED ERROR_DISK_RESET_FAILED \
4910 ERROR_EOM_OVERFLOW ERROR_NOT_ENOUGH_SERVER_MEMORY \
4911 ERROR_POSSIBLE_DEADLOCK ERROR_MAPPED_ALIGNMENT \
4912 ERROR_SET_POWER_STATE_VETOED ERROR_SET_POWER_STATE_FAILED \
4913 ERROR_TOO_MANY_LINKS ERROR_OLD_WIN_VERSION \
4914 ERROR_APP_WRONG_OS ERROR_SINGLE_INSTANCE_APP ERROR_RMODE_APP \
4915 ERROR_INVALID_DLL ERROR_NO_ASSOCIATION ERROR_DDE_FAIL \
4916 ERROR_DLL_NOT_FOUND ERROR_NO_MORE_USER_HANDLES \
4917 ERROR_MESSAGE_SYNC_ONLY ERROR_SOURCE_ELEMENT_EMPTY \
4918 ERROR_DESTINATION_ELEMENT_FULL ERROR_ILLEGAL_ELEMENT_ADDRESS \
4919 ERROR_MAGAZINE_NOT_PRESENT ERROR_DEVICE_REINITIALIZATION_NEEDED \
4920 ERROR_DEVICE_REQUIRES_CLEANING ERROR_DEVICE_DOOR_OPEN \
4921 ERROR_DEVICE_NOT_CONNECTED ERROR_NOT_FOUND ERROR_NO_MATCH \
4922 ERROR_SET_NOT_FOUND ERROR_POINT_NOT_FOUND \
4923 ERROR_NO_TRACKING_SERVICE ERROR_NO_VOLUME_ID \
4924 ERROR_UNABLE_TO_REMOVE_REPLACED ERROR_UNABLE_TO_MOVE_REPLACEMENT \
4925 ERROR_UNABLE_TO_MOVE_REPLACEMENT_2 \
4926 ERROR_JOURNAL_DELETE_IN_PROGRESS ERROR_JOURNAL_NOT_ACTIVE \
4927 ERROR_POTENTIAL_FILE_FOUND ERROR_JOURNAL_ENTRY_DELETED \
4928 ERROR_BAD_DEVICE ERROR_CONNECTION_UNAVAIL \
4929 ERROR_DEVICE_ALREADY_REMEMBERED ERROR_NO_NET_OR_BAD_PATH \
4930 ERROR_BAD_PROVIDER ERROR_CANNOT_OPEN_PROFILE ERROR_BAD_PROFILE \
4931 ERROR_NOT_CONTAINER ERROR_EXTENDED_ERROR ERROR_INVALID_GROUPNAME \
4932 ERROR_INVALID_COMPUTERNAME ERROR_INVALID_EVENTNAME \
4933 ERROR_INVALID_DOMAINNAME ERROR_INVALID_SERVICENAME \
4934 ERROR_INVALID_NETNAME ERROR_INVALID_SHARENAME \
4935 ERROR_INVALID_PASSWORDNAME ERROR_INVALID_MESSAGENAME \
4936 ERROR_INVALID_MESSAGEDEST ERROR_SESSION_CREDENTIAL_CONFLICT \
4937 ERROR_REMOTE_SESSION_LIMIT_EXCEEDED ERROR_DUP_DOMAINNAME \
4938 ERROR_NO_NETWORK ERROR_CANCELLED ERROR_USER_MAPPED_FILE \
4939 ERROR_CONNECTION_REFUSED ERROR_GRACEFUL_DISCONNECT \
4940 ERROR_ADDRESS_ALREADY_ASSOCIATED ERROR_ADDRESS_NOT_ASSOCIATED \
4941 ERROR_CONNECTION_INVALID ERROR_CONNECTION_ACTIVE \
4942 ERROR_NETWORK_UNREACHABLE ERROR_HOST_UNREACHABLE \
4943 ERROR_PROTOCOL_UNREACHABLE ERROR_PORT_UNREACHABLE \
4944 ERROR_REQUEST_ABORTED ERROR_CONNECTION_ABORTED ERROR_RETRY \
4945 ERROR_CONNECTION_COUNT_LIMIT ERROR_LOGIN_TIME_RESTRICTION \
4946 ERROR_LOGIN_WKSTA_RESTRICTION ERROR_INCORRECT_ADDRESS \
4947 ERROR_ALREADY_REGISTERED ERROR_SERVICE_NOT_FOUND \
4948 ERROR_NOT_AUTHENTICATED ERROR_NOT_LOGGED_ON ERROR_CONTINUE \
4949 ERROR_ALREADY_INITIALIZED ERROR_NO_MORE_DEVICES \
4950 ERROR_NO_SUCH_SITE ERROR_DOMAIN_CONTROLLER_EXISTS \
4951 ERROR_ONLY_IF_CONNECTED ERROR_OVERRIDE_NOCHANGES \
4952 ERROR_BAD_USER_PROFILE ERROR_NOT_SUPPORTED_ON_SBS \
4953 ERROR_SERVER_SHUTDOWN_IN_PROGRESS ERROR_HOST_DOWN \
4954 ERROR_NON_ACCOUNT_SID ERROR_NON_DOMAIN_SID \
4955 ERROR_APPHELP_BLOCK ERROR_ACCESS_DISABLED_BY_POLICY \
4956 ERROR_REG_NAT_CONSUMPTION ERROR_CSCSHARE_OFFLINE \
4957 ERROR_PKINIT_FAILURE ERROR_SMARTCARD_SUBSYSTEM_FAILURE \
4958 ERROR_DOWNGRADE_DETECTED SEC_E_SMARTCARD_CERT_REVOKED \
4959 SEC_E_ISSUING_CA_UNTRUSTED SEC_E_REVOCATION_OFFLINE_C \
4960 SEC_E_PKINIT_CLIENT_FAILUR SEC_E_SMARTCARD_CERT_EXPIRED \
4961 ERROR_MACHINE_LOCKED ERROR_CALLBACK_SUPPLIED_INVALID_DATA \
4962 ERROR_SYNC_FOREGROUND_REFRESH_REQUIRED ERROR_DRIVER_BLOCKED \
4963 ERROR_INVALID_IMPORT_OF_NON_DLL ERROR_ACCESS_DISABLED_WEBBLADE \
4964 ERROR_ACCESS_DISABLED_WEBBLADE_TAMPER ERROR_RECOVERY_FAILURE \
4965 ERROR_ALREADY_FIBER ERROR_ALREADY_THREAD \
4966 ERROR_STACK_BUFFER_OVERRUN ERROR_PARAMETER_QUOTA_EXCEEDED \
4967 ERROR_DEBUGGER_INACTIVE ERROR_NOT_ALL_ASSIGNED \
4968 ERROR_SOME_NOT_MAPPED ERROR_NO_QUOTAS_FOR_ACCOUNT \
4969 ERROR_LOCAL_USER_SESSION_KEY ERROR_NULL_LM_PASSWORD \
4970 ERROR_UNKNOWN_REVISION ERROR_REVISION_MISMATCH \
4971 ERROR_INVALID_OWNER ERROR_INVALID_PRIMARY_GROUP \
4972 ERROR_NO_IMPERSONATION_TOKEN ERROR_CANT_DISABLE_MANDATORY \
4973 ERROR_NO_LOGON_SERVERS ERROR_NO_SUCH_LOGON_SESSION \
4974 ERROR_NO_SUCH_PRIVILEGE ERROR_PRIVILEGE_NOT_HELD \
4975 ERROR_INVALID_ACCOUNT_NAME ERROR_USER_EXISTS ERROR_NO_SUCH_USER \
4976 ERROR_GROUP_EXISTS ERROR_NO_SUCH_GROUP ERROR_MEMBER_IN_GROUP \
4977 ERROR_MEMBER_NOT_IN_GROUP ERROR_LAST_ADMIN ERROR_WRONG_PASSWORD \
4978 ERROR_ILL_FORMED_PASSWORD ERROR_PASSWORD_RESTRICTION \
4979 ERROR_LOGON_FAILURE ERROR_ACCOUNT_RESTRICTION \
4980 ERROR_INVALID_LOGON_HOURS ERROR_INVALID_WORKSTATION \
4981 ERROR_PASSWORD_EXPIRED ERROR_ACCOUNT_DISABLED ERROR_NONE_MAPPED \
4982 ERROR_TOO_MANY_LUIDS_REQUESTED ERROR_LUIDS_EXHAUSTED \
4983 ERROR_INVALID_SUB_AUTHORITY ERROR_INVALID_ACL ERROR_INVALID_SID \
4984 ERROR_INVALID_SECURITY_DESCR ERROR_BAD_INHERITANCE_ACL \
4985 ERROR_SERVER_DISABLED ERROR_SERVER_NOT_DISABLED \
4986 ERROR_INVALID_ID_AUTHORITY ERROR_ALLOTTED_SPACE_EXCEEDED \
4987 ERROR_INVALID_GROUP_ATTRIBUTES ERROR_BAD_IMPERSONATION_LEVEL \
4988 ERROR_CANT_OPEN_ANONYMOUS ERROR_BAD_VALIDATION_CLASS \
4989 ERROR_BAD_TOKEN_TYPE ERROR_NO_SECURITY_ON_OBJECT \
4990 ERROR_CANT_ACCESS_DOMAIN_INFO ERROR_INVALID_SERVER_STATE \
4991 ERROR_INVALID_DOMAIN_STATE ERROR_INVALID_DOMAIN_ROLE \
4992 ERROR_NO_SUCH_DOMAIN ERROR_DOMAIN_EXISTS \
4993 ERROR_DOMAIN_LIMIT_EXCEEDED ERROR_INTERNAL_DB_CORRUPTION \
4994 ERROR_INTERNAL_ERROR ERROR_GENERIC_NOT_MAPPED \
4995 ERROR_BAD_DESCRIPTOR_FORMAT ERROR_NOT_LOGON_PROCESS \
4996 ERROR_LOGON_SESSION_EXISTS ERROR_NO_SUCH_PACKAGE \
4997 ERROR_BAD_LOGON_SESSION_STATE ERROR_LOGON_SESSION_COLLISION \
4998 ERROR_INVALID_LOGON_TYPE ERROR_CANNOT_IMPERSONATE \
4999 ERROR_RXACT_INVALID_STATE ERROR_RXACT_COMMIT_FAILURE \
5000 ERROR_SPECIAL_ACCOUNT ERROR_SPECIAL_GROUP ERROR_SPECIAL_USER \
5001 ERROR_MEMBERS_PRIMARY_GROUP ERROR_TOKEN_ALREADY_IN_USE \
5002 ERROR_NO_SUCH_ALIAS ERROR_MEMBER_NOT_IN_ALIAS \
5003 ERROR_MEMBER_IN_ALIAS ERROR_ALIAS_EXISTS ERROR_LOGON_NOT_GRANTED \
5004 ERROR_TOO_MANY_SECRETS ERROR_SECRET_TOO_LONG \
5005 ERROR_INTERNAL_DB_ERROR ERROR_TOO_MANY_CONTEXT_IDS \
5006 ERROR_LOGON_TYPE_NOT_GRANTED ERROR_NT_CROSS_ENCRYPTION_REQUIRED \
5007 ERROR_NO_SUCH_MEMBER ERROR_INVALID_MEMBER \
5008 ERROR_TOO_MANY_SIDS ERROR_LM_CROSS_ENCRYPTION_REQUIRED \
5009 ERROR_NO_INHERITANCE ERROR_FILE_CORRUPT ERROR_DISK_CORRUPT \
5010 ERROR_NO_USER_SESSION_KEY ERROR_LICENSE_QUOTA_EXCEEDED \
5011 ERROR_WRONG_TARGET_NAME ERROR_MUTUAL_AUTH_FAILED ERROR_TIME_SKEW \
5012 ERROR_CURRENT_DOMAIN_NOT_ALLOWED ERROR_INVALID_WINDOW_HANDLE \
5013 ERROR_INVALID_MENU_HANDLE ERROR_INVALID_CURSOR_HANDLE \
5014 ERROR_INVALID_ACCEL_HANDLE ERROR_INVALID_HOOK_HANDLE \
5015 ERROR_INVALID_DWP_HANDLE ERROR_TLW_WITH_WSCHILD \
5016 ERROR_CANNOT_FIND_WND_CLASS ERROR_WINDOW_OF_OTHER_THREAD \
5017 ERROR_HOTKEY_ALREADY_REGISTERED ERROR_CLASS_ALREADY_EXISTS \
5018 ERROR_CLASS_DOES_NOT_EXIST ERROR_CLASS_HAS_WINDOWS \
5019 ERROR_INVALID_INDEX ERROR_INVALID_ICON_HANDLE \
5020 ERROR_PRIVATE_DIALOG_INDEX ERROR_LISTBOX_ID_NOT_FOUND \
5021 ERROR_NO_WILDCARD_CHARACTERS ERROR_CLIPBOARD_NOT_OPEN \
5022 ERROR_HOTKEY_NOT_REGISTERED ERROR_WINDOW_NOT_DIALOG \
5023 ERROR_CONTROL_ID_NOT_FOUND ERROR_INVALID_COMBOBOX_MESSAGE \
5024 ERROR_WINDOW_NOT_COMBOBOX ERROR_INVALID_EDIT_HEIGHT \
5025 ERROR_DC_NOT_FOUND ERROR_INVALID_HOOK_FILTER \
5026 ERROR_INVALID_FILTER_PROC ERROR_HOOK_NEEDS_HMOD \
5027 ERROR_GLOBAL_ONLY_HOOK ERROR_JOURNAL_HOOK_SET \
5028 ERROR_HOOK_NOT_INSTALLED ERROR_INVALID_LB_MESSAGE \
5029 ERROR_SETCOUNT_ON_BAD_LB ERROR_LB_WITHOUT_TABSTOPS \
5030 ERROR_DESTROY_OBJECT_OF_OTHER_THREAD ERROR_CHILD_WINDOW_MENU \
5031 ERROR_NO_SYSTEM_MENU ERROR_INVALID_MSGBOX_STYLE \
5032 ERROR_INVALID_SPI_VALUE ERROR_SCREEN_ALREADY_LOCKED \
5033 ERROR_HWNDS_HAVE_DIFF_PARENT ERROR_NOT_CHILD_WINDOW \
5034 ERROR_INVALID_GW_COMMAND ERROR_INVALID_THREAD_ID \
5035 ERROR_NON_MDICHILD_WINDOW ERROR_POPUP_ALREADY_ACTIVE \
5036 ERROR_NO_SCROLLBARS ERROR_INVALID_SCROLLBAR_RANGE \
5037 ERROR_INVALID_SHOWWIN_COMMAND ERROR_NO_SYSTEM_RESOURCES \
5038 ERROR_NONPAGED_SYSTEM_RESOURCES ERROR_PAGED_SYSTEM_RESOURCES \
5039 ERROR_WORKING_SET_QUOTA ERROR_PAGEFILE_QUOTA \
5040 ERROR_COMMITMENT_LIMIT ERROR_MENU_ITEM_NOT_FOUND \
5041 ERROR_INVALID_KEYBOARD_HANDLE ERROR_HOOK_TYPE_NOT_ALLOWED \
5042 ERROR_REQUIRES_INTERACTIVE_WINDOWSTATION ERROR_TIMEOUT \
5043 ERROR_INVALID_MONITOR_HANDLE ERROR_EVENTLOG_FILE_CORRUPT \
5044 ERROR_EVENTLOG_CANT_START ERROR_LOG_FILE_FULL \
5045 ERROR_EVENTLOG_FILE_CHANGED ERROR_INSTALL_SERVICE_FAILURE \
5046 ERROR_INSTALL_USEREXIT ERROR_INSTALL_FAILURE \
5047 ERROR_INSTALL_SUSPEND ERROR_UNKNOWN_PRODUCT ERROR_UNKNOWN_FEATURE \
5048 ERROR_UNKNOWN_COMPONENT ERROR_UNKNOWN_PROPERTY \
5049 ERROR_INVALID_HANDLE_STATE ERROR_BAD_CONFIGURATION \
5050 ERROR_INDEX_ABSENT ERROR_INSTALL_SOURCE_ABSENT \
5051 ERROR_INSTALL_PACKAGE_VERSION ERROR_PRODUCT_UNINSTALLED \
5052 ERROR_BAD_QUERY_SYNTAX ERROR_INVALID_FIELD ERROR_DEVICE_REMOVED \
5053 ERROR_INSTALL_ALREADY_RUNNING ERROR_INSTALL_PACKAGE_OPEN_FAILED \
5054 ERROR_INSTALL_PACKAGE_INVALID ERROR_INSTALL_UI_FAILURE \
5055 ERROR_INSTALL_LOG_FAILURE ERROR_INSTALL_LANGUAGE_UNSUPPORTED \
5056 ERROR_INSTALL_TRANSFORM_FAILURE ERROR_INSTALL_PACKAGE_REJECTED \
5057 ERROR_FUNCTION_NOT_CALLED ERROR_FUNCTION_FAILED \
5058 ERROR_INVALID_TABLE ERROR_DATATYPE_MISMATCH \
5059 ERROR_UNSUPPORTED_TYPE ERROR_CREATE_FAILED \
5060 ERROR_INSTALL_TEMP_UNWRITABLE ERROR_INSTALL_PLATFORM_UNSUPPORTED \
5061 ERROR_INSTALL_NOTUSED ERROR_PATCH_PACKAGE_OPEN_FAILED \
5062 ERROR_PATCH_PACKAGE_INVALID ERROR_PATCH_PACKAGE_UNSUPPORTED \
5063 ERROR_PRODUCT_VERSION ERROR_INVALID_COMMAND_LINE \
5064 ERROR_INSTALL_REMOTE_DISALLOWED ERROR_SUCCESS_REBOOT_INITIATED \
5065 ERROR_PATCH_TARGET_NOT_FOUND ERROR_PATCH_PACKAGE_REJECTED \
5066 ERROR_INSTALL_TRANSFORM_REJECTED ERROR_INSTALL_REMOTE_PROHIBITED \
5067 RPC_S_INVALID_STRING_BINDING RPC_S_WRONG_KIND_OF_BINDING \
5068 RPC_S_INVALID_BINDING RPC_S_PROTSEQ_NOT_SUPPORTED \
5069 RPC_S_INVALID_RPC_PROTSEQ RPC_S_INVALID_STRING_UUID \
5070 RPC_S_INVALID_ENDPOINT_FORMAT RPC_S_INVALID_NET_ADDR \
5071 RPC_S_NO_ENDPOINT_FOUND RPC_S_INVALID_TIMEOUT \
5072 RPC_S_OBJECT_NOT_FOUND RPC_S_ALREADY_REGISTERED \
5073 RPC_S_TYPE_ALREADY_REGISTERED RPC_S_ALREADY_LISTENING \
5074 RPC_S_NO_PROTSEQS_REGISTERED RPC_S_NOT_LISTENING \
5075 RPC_S_UNKNOWN_MGR_TYPE RPC_S_UNKNOWN_IF RPC_S_NO_BINDINGS \
5076 RPC_S_NO_PROTSEQS RPC_S_CANT_CREATE_ENDPOINT \
5077 RPC_S_OUT_OF_RESOURCES RPC_S_SERVER_UNAVAILABLE \
5078 RPC_S_SERVER_TOO_BUSY RPC_S_INVALID_NETWORK_OPTIONS \
5079 RPC_S_NO_CALL_ACTIVE RPC_S_CALL_FAILED RPC_S_CALL_FAILED_DNE \
5080 RPC_S_PROTOCOL_ERROR RPC_S_UNSUPPORTED_TRANS_SYN \
5081 RPC_S_UNSUPPORTED_TYPE RPC_S_INVALID_TAG RPC_S_INVALID_BOUND \
5082 RPC_S_NO_ENTRY_NAME RPC_S_INVALID_NAME_SYNTAX \
5083 RPC_S_UNSUPPORTED_NAME_SYNTAX RPC_S_UUID_NO_ADDRESS \
5084 RPC_S_DUPLICATE_ENDPOINT RPC_S_UNKNOWN_AUTHN_TYPE \
5085 RPC_S_MAX_CALLS_TOO_SMALL RPC_S_STRING_TOO_LONG \
5086 RPC_S_PROTSEQ_NOT_FOUND RPC_S_PROCNUM_OUT_OF_RANGE \
5087 RPC_S_BINDING_HAS_NO_AUTH RPC_S_UNKNOWN_AUTHN_SERVICE \
5088 RPC_S_UNKNOWN_AUTHN_LEVEL RPC_S_INVALID_AUTH_IDENTITY \
5089 RPC_S_UNKNOWN_AUTHZ_SERVICE EPT_S_INVALID_ENTRY \
5090 EPT_S_CANT_PERFORM_OP EPT_S_NOT_REGISTERED \
5091 RPC_S_NOTHING_TO_EXPORT RPC_S_INCOMPLETE_NAME \
5092 RPC_S_INVALID_VERS_OPTION RPC_S_NO_MORE_MEMBERS \
5093 RPC_S_NOT_ALL_OBJS_UNEXPORTED RPC_S_INTERFACE_NOT_FOUND \
5094 RPC_S_ENTRY_ALREADY_EXISTS RPC_S_ENTRY_NOT_FOUND \
5095 RPC_S_NAME_SERVICE_UNAVAILABLE RPC_S_INVALID_NAF_ID \
5096 RPC_S_CANNOT_SUPPORT RPC_S_NO_CONTEXT_AVAILABLE \
5097 RPC_S_INTERNAL_ERROR RPC_S_ZERO_DIVIDE RPC_S_ADDRESS_ERROR \
5098 RPC_S_FP_DIV_ZERO RPC_S_FP_UNDERFLOW RPC_S_FP_OVERFLOW \
5099 RPC_X_NO_MORE_ENTRIES RPC_X_SS_CHAR_TRANS_OPEN_FAIL \
5100 RPC_X_SS_CHAR_TRANS_SHORT_FILE RPC_X_SS_IN_NULL_CONTEXT \
5101 RPC_X_SS_CONTEXT_DAMAGED RPC_X_SS_HANDLES_MISMATCH \
5102 RPC_X_SS_CANNOT_GET_CALL_HANDLE RPC_X_NULL_REF_POINTER \
5103 RPC_X_ENUM_VALUE_OUT_OF_RANGE RPC_X_BYTE_COUNT_TOO_SMALL \
5104 RPC_X_BAD_STUB_DATA ERROR_INVALID_USER_BUFFER \
5105 ERROR_UNRECOGNIZED_MEDIA ERROR_NO_TRUST_LSA_SECRET \
5106 ERROR_NO_TRUST_SAM_ACCOUNT ERROR_TRUSTED_DOMAIN_FAILURE \
5107 ERROR_TRUSTED_RELATIONSHIP_FAILURE ERROR_TRUST_FAILURE \
5108 RPC_S_CALL_IN_PROGRESS ERROR_NETLOGON_NOT_STARTED \
5109 ERROR_ACCOUNT_EXPIRED ERROR_REDIRECTOR_HAS_OPEN_HANDLES \
5110 ERROR_PRINTER_DRIVER_ALREADY_INSTALLED ERROR_UNKNOWN_PORT \
5111 ERROR_UNKNOWN_PRINTER_DRIVER ERROR_UNKNOWN_PRINTPROCESSOR \
5112 ERROR_INVALID_SEPARATOR_FILE ERROR_INVALID_PRIORITY \
5113 ERROR_INVALID_PRINTER_NAME ERROR_PRINTER_ALREADY_EXISTS \
5114 ERROR_INVALID_PRINTER_COMMAND ERROR_INVALID_DATATYPE \
5115 ERROR_INVALID_ENVIRONMENT RPC_S_NO_MORE_BINDINGS \
5116 ERROR_NOLOGON_INTERDOMAIN_TRUST_ACCOUNT \
5117 ERROR_NOLOGON_WORKSTATION_TRUST_ACCOUNT \
5118 ERROR_NOLOGON_SERVER_TRUST_ACCOUNT \
5119 ERROR_DOMAIN_TRUST_INCONSISTENT ERROR_SERVER_HAS_OPEN_HANDLES \
5120 ERROR_RESOURCE_DATA_NOT_FOUND ERROR_RESOURCE_TYPE_NOT_FOUND \
5121 ERROR_RESOURCE_NAME_NOT_FOUND ERROR_RESOURCE_LANG_NOT_FOUND \
5122 ERROR_NOT_ENOUGH_QUOTA RPC_S_NO_INTERFACES \
5123 RPC_S_CALL_CANCELLED RPC_S_BINDING_INCOMPLETE \
5124 RPC_S_COMM_FAILURE RPC_S_UNSUPPORTED_AUTHN_LEVEL \
5125 RPC_S_NO_PRINC_NAME RPC_S_NOT_RPC_ERROR RPC_S_UUID_LOCAL_ONLY \
5126 RPC_S_SEC_PKG_ERROR RPC_S_NOT_CANCELLED RPC_X_INVALID_ES_ACTION \
5127 RPC_X_WRONG_ES_VERSION RPC_X_WRONG_STUB_VERSION \
5128 RPC_X_INVALID_PIPE_OBJECT RPC_X_WRONG_PIPE_ORDER \
5129 RPC_X_WRONG_PIPE_VERSION RPC_S_GROUP_MEMBER_NOT_FOUND \
5130 EPT_S_CANT_CREATE RPC_S_INVALID_OBJECT ERROR_INVALID_TIME \
5131 ERROR_INVALID_FORM_NAME ERROR_INVALID_FORM_SIZE \
5132 ERROR_ALREADY_WAITING ERROR_PRINTER_DELETED \
5133 ERROR_INVALID_PRINTER_STATE ERROR_PASSWORD_MUST_CHANGE \
5134 ERROR_DOMAIN_CONTROLLER_NOT_FOUND ERROR_ACCOUNT_LOCKED_OUT \
5135 OR_INVALID_OXID OR_INVALID_OID OR_INVALID_SET \
5136 RPC_S_SEND_INCOMPLETE RPC_S_INVALID_ASYNC_HANDLE \
5137 RPC_S_INVALID_ASYNC_CALL RPC_X_PIPE_CLOSED \
5138 RPC_X_PIPE_DISCIPLINE_ERROR RPC_X_PIPE_EMPTY ERROR_NO_SITENAME \
5139 ERROR_CANT_ACCESS_FILE ERROR_CANT_RESOLVE_FILENAME \
5140 RPC_S_ENTRY_TYPE_MISMATCH RPC_S_NOT_ALL_OBJS_EXPORTED \
5141 RPC_S_INTERFACE_NOT_EXPORTED RPC_S_PROFILE_NOT_ADDED \
5142 RPC_S_PRF_ELT_NOT_ADDED RPC_S_PRF_ELT_NOT_REMOVED \
5143 RPC_S_GRP_ELT_NOT_ADDED RPC_S_GRP_ELT_NOT_REMOVED \
5144 ERROR_KM_DRIVER_BLOCKED ERROR_CONTEXT_EXPIRED \
5145 ERROR_PER_USER_TRUST_QUOTA_EXCEEDED \
5146 ERROR_ALL_USER_TRUST_QUOTA_EXCEEDED \
5147 ERROR_USER_DELETE_TRUST_QUOTA_EXCEEDED ERROR_INVALID_PIXEL_FORMAT \
5148 ERROR_BAD_DRIVER ERROR_INVALID_WINDOW_STYLE \
5149 ERROR_METAFILE_NOT_SUPPORTED ERROR_TRANSFORM_NOT_SUPPORTED \
5150 ERROR_CLIPPING_NOT_SUPPORTED ERROR_INVALID_CMM \
5151 ERROR_INVALID_PROFILE ERROR_TAG_NOT_FOUND ERROR_TAG_NOT_PRESENT \
5152 ERROR_DUPLICATE_TAG ERROR_PROFILE_NOT_ASSOCIATED_WITH_DEVICE \
5153 ERROR_PROFILE_NOT_FOUND ERROR_INVALID_COLORSPACE \
5154 ERROR_ICM_NOT_ENABLED ERROR_DELETING_ICM_XFORM \
5155 ERROR_INVALID_TRANSFORM ERROR_COLORSPACE_MISMATCH \
5156 ERROR_INVALID_COLORINDEX ERROR_CONNECTED_OTHER_PASSWORD \
5157 ERROR_CONNECTED_OTHER_PASSWORD_DEFAULT \
5158 ERROR_BAD_USERNAME ERROR_NOT_CONNECTED ERROR_OPEN_FILES \
5159 ERROR_ACTIVE_CONNECTIONS ERROR_DEVICE_IN_USE \
5160 ERROR_UNKNOWN_PRINT_MONITOR ERROR_PRINTER_DRIVER_IN_USE \
5161 ERROR_SPOOL_FILE_NOT_FOUND ERROR_SPL_NO_STARTDOC \
5162 ERROR_SPL_NO_ADDJOB ERROR_PRINT_PROCESSOR_ALREADY_INSTALLED \
5163 ERROR_PRINT_MONITOR_ALREADY_INSTALLED ERROR_INVALID_PRINT_MONITOR \
5164 ERROR_PRINT_MONITOR_IN_USE ERROR_PRINTER_HAS_JOBS_QUEUED \
5165 ERROR_SUCCESS_REBOOT_REQUIRED ERROR_SUCCESS_RESTART_REQUIRED \
5166 ERROR_PRINTER_NOT_FOUND ERROR_PRINTER_DRIVER_WARNED \
5167 ERROR_PRINTER_DRIVER_BLOCKED ERROR_WINS_INTERNAL \
5168 ERROR_CAN_NOT_DEL_LOCAL_WINS ERROR_STATIC_INIT \
5169 ERROR_INC_BACKUP ERROR_FULL_BACKUP ERROR_REC_NON_EXISTENT \
5170 ERROR_RPL_NOT_ALLOWED ERROR_DHCP_ADDRESS_CONFLICT \
5171 ERROR_WMI_GUID_NOT_FOUND ERROR_WMI_INSTANCE_NOT_FOUND \
5172 ERROR_WMI_ITEMID_NOT_FOUND ERROR_WMI_TRY_AGAIN \
5173 ERROR_WMI_DP_NOT_FOUND ERROR_WMI_UNRESOLVED_INSTANCE_REF \
5174 ERROR_WMI_ALREADY_ENABLED ERROR_WMI_GUID_DISCONNECTED \
5175 ERROR_WMI_SERVER_UNAVAILABLE ERROR_WMI_DP_FAILED \
5176 ERROR_WMI_INVALID_MOF ERROR_WMI_INVALID_REGINFO \
5177 ERROR_WMI_ALREADY_DISABLED ERROR_WMI_READ_ONLY \
5178 ERROR_WMI_SET_FAILURE ERROR_INVALID_MEDIA ERROR_INVALID_LIBRARY \
5179 ERROR_INVALID_MEDIA_POOL ERROR_DRIVE_MEDIA_MISMATCH \
5180 ERROR_MEDIA_OFFLINE ERROR_LIBRARY_OFFLINE ERROR_EMPTY \
5181 ERROR_NOT_EMPTY ERROR_MEDIA_UNAVAILABLE ERROR_RESOURCE_DISABLED \
5182 ERROR_INVALID_CLEANER ERROR_UNABLE_TO_CLEAN \
5183 ERROR_OBJECT_NOT_FOUND ERROR_DATABASE_FAILURE ERROR_DATABASE_FULL \
5184 ERROR_MEDIA_INCOMPATIBLE ERROR_RESOURCE_NOT_PRESENT \
5185 ERROR_INVALID_OPERATION ERROR_MEDIA_NOT_AVAILABLE \
5186 ERROR_DEVICE_NOT_AVAILABLE ERROR_REQUEST_REFUSED \
5187 ERROR_INVALID_DRIVE_OBJECT ERROR_LIBRARY_FULL \
5188 ERROR_MEDIUM_NOT_ACCESSIBLE ERROR_UNABLE_TO_LOAD_MEDIUM \
5189 ERROR_UNABLE_TO_INVENTORY_DRIVE ERROR_UNABLE_TO_INVENTORY_SLOT \
5190 ERROR_UNABLE_TO_INVENTORY_TRANSPORT ERROR_TRANSPORT_FULL \
5191 ERROR_CONTROLLING_IEPORT ERROR_UNABLE_TO_EJECT_MOUNTED_MEDIA \
5192 ERROR_CLEANER_SLOT_SET ERROR_CLEANER_SLOT_NOT_SET \
5193 ERROR_CLEANER_CARTRIDGE_SPENT ERROR_UNEXPECTED_OMID \
5194 ERROR_CANT_DELETE_LAST_ITEM ERROR_MESSAGE_EXCEEDS_MAX_SIZE \
5195 ERROR_VOLUME_CONTAINS_SYS_FILES ERROR_INDIGENOUS_TYPE \
5196 ERROR_NO_SUPPORTING_DRIVES ERROR_CLEANER_CARTRIDGE_INSTALLED \
5197 ERROR_FILE_OFFLINE ERROR_REMOTE_STORAGE_NOT_ACTIVE \
5198 ERROR_REMOTE_STORAGE_MEDIA_ERROR ERROR_NOT_A_REPARSE_POINT \
5199 ERROR_REPARSE_ATTRIBUTE_CONFLICT ERROR_INVALID_REPARSE_DATA \
5200 ERROR_REPARSE_TAG_INVALID ERROR_REPARSE_TAG_MISMATCH \
5201 ERROR_VOLUME_NOT_SIS_ENABLED ERROR_DEPENDENT_RESOURCE_EXISTS \
5202 ERROR_DEPENDENCY_NOT_FOUND ERROR_DEPENDENCY_ALREADY_EXISTS \
5203 ERROR_RESOURCE_NOT_ONLINE ERROR_HOST_NODE_NOT_AVAILABLE \
5204 ERROR_RESOURCE_NOT_AVAILABLE ERROR_RESOURCE_NOT_FOUND \
5205 ERROR_SHUTDOWN_CLUSTER ERROR_CANT_EVICT_ACTIVE_NODE \
5206 ERROR_OBJECT_ALREADY_EXISTS ERROR_OBJECT_IN_LIST \
5207 ERROR_GROUP_NOT_AVAILABLE ERROR_GROUP_NOT_FOUND \
5208 ERROR_GROUP_NOT_ONLINE ERROR_HOST_NODE_NOT_RESOURCE_OWNER \
5209 ERROR_HOST_NODE_NOT_GROUP_OWNER ERROR_RESMON_CREATE_FAILED \
5210 ERROR_RESMON_ONLINE_FAILED ERROR_RESOURCE_ONLINE \
5211 ERROR_QUORUM_RESOURCE ERROR_NOT_QUORUM_CAPABLE \
5212 ERROR_CLUSTER_SHUTTING_DOWN ERROR_INVALID_STATE \
5213 ERROR_RESOURCE_PROPERTIES_STORED ERROR_NOT_QUORUM_CLASS \
5214 ERROR_CORE_RESOURCE ERROR_QUORUM_RESOURCE_ONLINE_FAILED \
5215 ERROR_QUORUMLOG_OPEN_FAILED ERROR_CLUSTERLOG_CORRUPT \
5216 ERROR_CLUSTERLOG_RECORD_EXCEEDS_MAXSIZE \
5217 ERROR_CLUSTERLOG_EXCEEDS_MAXSIZE \
5218 ERROR_CLUSTERLOG_CHKPOINT_NOT_FOUND \
5219 ERROR_CLUSTERLOG_NOT_ENOUGH_SPACE ERROR_QUORUM_OWNER_ALIVE \
5220 ERROR_NETWORK_NOT_AVAILABLE ERROR_NODE_NOT_AVAILABLE \
5221 ERROR_ALL_NODES_NOT_AVAILABLE ERROR_RESOURCE_FAILED \
5222 ERROR_CLUSTER_INVALID_NODE ERROR_CLUSTER_NODE_EXISTS \
5223 ERROR_CLUSTER_JOIN_IN_PROGRESS ERROR_CLUSTER_NODE_NOT_FOUND \
5224 ERROR_CLUSTER_LOCAL_NODE_NOT_FOUND ERROR_CLUSTER_NETWORK_EXISTS \
5225 ERROR_CLUSTER_NETWORK_NOT_FOUND ERROR_CLUSTER_NETINTERFACE_EXISTS \
5226 ERROR_CLUSTER_NETINTERFACE_NOT_FOUND \
5227 ERROR_CLUSTER_INVALID_REQUEST \
5228 ERROR_CLUSTER_INVALID_NETWORK_PROVIDER ERROR_CLUSTER_NODE_DOWN \
5229 ERROR_CLUSTER_NODE_UNREACHABLE ERROR_CLUSTER_NODE_NOT_MEMBER \
5230 ERROR_CLUSTER_JOIN_NOT_IN_PROGRESS ERROR_CLUSTER_INVALID_NETWORK \
5231 ERROR_CLUSTER_NODE_UP ERROR_CLUSTER_IPADDR_IN_USE \
5232 ERROR_CLUSTER_NODE_NOT_PAUSED ERROR_CLUSTER_NO_SECURITY_CONTEXT \
5233 ERROR_CLUSTER_NETWORK_NOT_INTERNAL \
5234 ERROR_CLUSTER_NODE_ALREADY_UP ERROR_CLUSTER_NODE_ALREADY_DOWN \
5235 ERROR_CLUSTER_NETWORK_ALREADY_ONLINE \
5236 ERROR_CLUSTER_NETWORK_ALREADY_OFFLINE \
5237 ERROR_CLUSTER_NODE_ALREADY_MEMBER \
5238 ERROR_CLUSTER_LAST_INTERNAL_NETWORK \
5239 ERROR_CLUSTER_NETWORK_HAS_DEPENDENTS \
5240 ERROR_INVALID_OPERATION_ON_QUORUM ERROR_DEPENDENCY_NOT_ALLOWED \
5241 ERROR_CLUSTER_NODE_PAUSED ERROR_NODE_CANT_HOST_RESOURCE \
5242 ERROR_CLUSTER_NODE_NOT_READY ERROR_CLUSTER_NODE_SHUTTING_DOWN \
5243 ERROR_CLUSTER_JOIN_ABORTED ERROR_CLUSTER_INCOMPATIBLE_VERSIONS \
5244 ERROR_CLUSTER_MAXNUM_OF_RESOURCES_EXCEEDED \
5245 ERROR_CLUSTER_SYSTEM_CONFIG_CHANGED \
5246 ERROR_CLUSTER_RESOURCE_TYPE_NOT_FOUND \
5247 ERROR_CLUSTER_RESTYPE_NOT_SUPPORTED \
5248 ERROR_CLUSTER_RESNAME_NOT_FOUND \
5249 ERROR_CLUSTER_NO_RPC_PACKAGES_REGISTERED \
5250 ERROR_CLUSTER_OWNER_NOT_IN_PREFLIST \
5251 ERROR_CLUSTER_DATABASE_SEQMISMATCH \
5252 ERROR_RESMON_INVALID_STATE ERROR_CLUSTER_GUM_NOT_LOCKER \
5253 ERROR_QUORUM_DISK_NOT_FOUND ERROR_DATABASE_BACKUP_CORRUPT \
5254 ERROR_CLUSTER_NODE_ALREADY_HAS_DFS_ROOT \
5255 ERROR_RESOURCE_PROPERTY_UNCHANGEABLE \
5256 ERROR_CLUSTER_MEMBERSHIP_INVALID_STATE \
5257 ERROR_CLUSTER_QUORUMLOG_NOT_FOUND ERROR_CLUSTER_MEMBERSHIP_HALT \
5258 ERROR_CLUSTER_INSTANCE_ID_MISMATCH \
5259 ERROR_CLUSTER_NETWORK_NOT_FOUND_FOR_IP \
5260 ERROR_CLUSTER_PROPERTY_DATA_TYPE_MISMATCH \
5261 ERROR_CLUSTER_EVICT_WITHOUT_CLEANUP \
5262 ERROR_CLUSTER_PARAMETER_MISMATCH \
5263 ERROR_NODE_CANNOT_BE_CLUSTERED ERROR_CLUSTER_WRONG_OS_VERSION \
5264 ERROR_CLUSTER_CANT_CREATE_DUP_CLUSTER_NAME \
5265 ERROR_CLUSCFG_ALREADY_COMMITTED ERROR_CLUSCFG_ROLLBACK_FAILED \
5266 ERROR_CLUSCFG_SYSTEM_DISK_DRIVE_LETTER_CONFLICT \
5267 ERROR_CLUSTER_OLD_VERSION \
5268 ERROR_CLUSTER_MISMATCHED_COMPUTER_ACCT_NAME \
5269 ERROR_ENCRYPTION_FAILED ERROR_DECRYPTION_FAILED \
5270 ERROR_FILE_ENCRYPTED ERROR_NO_RECOVERY_POLICY ERROR_NO_EFS \
5271 ERROR_WRONG_EFS ERROR_NO_USER_KEYS ERROR_FILE_NOT_ENCRYPTED \
5272 ERROR_NOT_EXPORT_FORMAT ERROR_FILE_READ_ONLY \
5273 ERROR_DIR_EFS_DISALLOWED ERROR_EFS_SERVER_NOT_TRUSTED \
5274 ERROR_BAD_RECOVERY_POLICY ERROR_EFS_ALG_BLOB_TOO_BIG \
5275 ERROR_VOLUME_NOT_SUPPORT_EFS ERROR_EFS_DISABLED \
5276 ERROR_EFS_VERSION_NOT_SUPPORT ERROR_NO_BROWSER_SERVERS_FOUND \
5277 SCHED_E_SERVICE_NOT_LOCALSYSTEM ERROR_CTX_WINSTATION_NAME_INVALID \
5278 ERROR_CTX_INVALID_PD ERROR_CTX_PD_NOT_FOUND \
5279 ERROR_CTX_WD_NOT_FOUND ERROR_CTX_CANNOT_MAKE_EVENTLOG_ENTRY \
5280 ERROR_CTX_SERVICE_NAME_COLLISION ERROR_CTX_CLOSE_PENDING \
5281 ERROR_CTX_NO_OUTBUF ERROR_CTX_MODEM_INF_NOT_FOUND \
5282 ERROR_CTX_INVALID_MODEMNAME ERROR_CTX_MODEM_RESPONSE_ERROR \
5283 ERROR_CTX_MODEM_RESPONSE_TIMEOUT \
5284 ERROR_CTX_MODEM_RESPONSE_NO_CARRIER \
5285 ERROR_CTX_MODEM_RESPONSE_NO_DIALTONE \
5286 ERROR_CTX_MODEM_RESPONSE_BUSY ERROR_CTX_MODEM_RESPONSE_VOICE \
5287 ERROR_CTX_TD_ERROR ERROR_CTX_WINSTATION_NOT_FOUND \
5288 ERROR_CTX_WINSTATION_ALREADY_EXISTS ERROR_CTX_WINSTATION_BUSY \
5289 ERROR_CTX_BAD_VIDEO_MODE ERROR_CTX_GRAPHICS_INVALID \
5290 ERROR_CTX_LOGON_DISABLED ERROR_CTX_NOT_CONSOLE \
5291 ERROR_CTX_CLIENT_QUERY_TIMEOUT ERROR_CTX_CONSOLE_DISCONNECT \
5292 ERROR_CTX_CONSOLE_CONNECT ERROR_CTX_SHADOW_DENIED \
5293 ERROR_CTX_WINSTATION_ACCESS_DENIED ERROR_CTX_INVALID_WD \
5294 ERROR_CTX_SHADOW_INVALID ERROR_CTX_SHADOW_DISABLED \
5295 ERROR_CTX_CLIENT_LICENSE_IN_USE ERROR_CTX_CLIENT_LICENSE_NOT_SET \
5296 ERROR_CTX_LICENSE_NOT_AVAILABLE ERROR_CTX_LICENSE_CLIENT_INVALID \
5297 ERROR_CTX_LICENSE_EXPIRED ERROR_CTX_SHADOW_NOT_RUNNING \
5298 ERROR_CTX_SHADOW_ENDED_BY_MODE_CHANGE \
5299 ERROR_ACTIVATION_COUNT_EXCEEDED FRS_ERR_INVALID_API_SEQUENCE \
5300 FRS_ERR_STARTING_SERVICE FRS_ERR_STOPPING_SERVICE \
5301 FRS_ERR_INTERNAL_API FRS_ERR_INTERNAL \
5302 FRS_ERR_SERVICE_COMM FRS_ERR_INSUFFICIENT_PRIV \
5303 FRS_ERR_AUTHENTICATION FRS_ERR_PARENT_INSUFFICIENT_PRIV \
5304 FRS_ERR_PARENT_AUTHENTICATION FRS_ERR_CHILD_TO_PARENT_COMM \
5305 FRS_ERR_PARENT_TO_CHILD_COMM FRS_ERR_SYSVOL_POPULATE \
5306 FRS_ERR_SYSVOL_POPULATE_TIMEOUT FRS_ERR_SYSVOL_IS_BUSY \
5307 FRS_ERR_SYSVOL_DEMOTE FRS_ERR_INVALID_SERVICE_PARAMETER \
5308 ERROR_DS_NOT_INSTALLED ERROR_DS_MEMBERSHIP_EVALUATED_LOCALLY \
5309 ERROR_DS_NO_ATTRIBUTE_OR_VALUE ERROR_DS_INVALID_ATTRIBUTE_SYNTAX \
5310 ERROR_DS_ATTRIBUTE_TYPE_UNDEFINED \
5311 ERROR_DS_ATTRIBUTE_OR_VALUE_EXISTS ERROR_DS_BUSY \
5312 ERROR_DS_UNAVAILABLE ERROR_DS_NO_RIDS_ALLOCATED \
5313 ERROR_DS_NO_MORE_RIDS ERROR_DS_INCORRECT_ROLE_OWNER \
5314 ERROR_DS_RIDMGR_INIT_ERROR ERROR_DS_OBJ_CLASS_VIOLATION \
5315 ERROR_DS_CANT_ON_NON_LEAF ERROR_DS_CANT_ON_RDN \
5316 ERROR_DS_CANT_MOD_OBJ_CLASS ERROR_DS_CROSS_DOM_MOVE_ERROR \
5317 ERROR_DS_GC_NOT_AVAILABLE ERROR_SHARED_POLICY \
5318 ERROR_POLICY_OBJECT_NOT_FOUND ERROR_POLICY_ONLY_IN_DS \
5319 ERROR_PROMOTION_ACTIVE ERROR_NO_PROMOTION_ACTIVE \
5320 ERROR_DS_OPERATIONS_ERROR ERROR_DS_PROTOCOL_ERROR \
5321 ERROR_DS_TIMELIMIT_EXCEEDED ERROR_DS_SIZELIMIT_EXCEEDED \
5322 ERROR_DS_ADMIN_LIMIT_EXCEEDED ERROR_DS_COMPARE_FALSE \
5323 ERROR_DS_COMPARE_TRUE ERROR_DS_AUTH_METHOD_NOT_SUPPORTED \
5324 ERROR_DS_STRONG_AUTH_REQUIRED \
5325 ERROR_DS_INAPPROPRIATE_AUTH ERROR_DS_AUTH_UNKNOWN \
5326 ERROR_DS_REFERRAL ERROR_DS_UNAVAILABLE_CRIT_EXTENSION \
5327 ERROR_DS_CONFIDENTIALITY_REQUIRED ERROR_DS_INAPPROPRIATE_MATCHING \
5328 ERROR_DS_CONSTRAINT_VIOLATION ERROR_DS_NO_SUCH_OBJECT \
5329 ERROR_DS_ALIAS_PROBLEM ERROR_DS_INVALID_DN_SYNTAX \
5330 ERROR_DS_IS_LEAF ERROR_DS_ALIAS_DEREF_PROBLEM \
5331 ERROR_DS_UNWILLING_TO_PERFORM ERROR_DS_LOOP_DETECT \
5332 ERROR_DS_NAMING_VIOLATION ERROR_DS_OBJECT_RESULTS_TOO_LARGE \
5333 ERROR_DS_AFFECTS_MULTIPLE_DSAS ERROR_DS_SERVER_DOWN \
5334 ERROR_DS_LOCAL_ERROR ERROR_DS_ENCODING_ERROR \
5335 ERROR_DS_DECODING_ERROR ERROR_DS_FILTER_UNKNOWN \
5336 ERROR_DS_PARAM_ERROR ERROR_DS_NOT_SUPPORTED \
5337 ERROR_DS_NO_RESULTS_RETURNED ERROR_DS_CONTROL_NOT_FOUND \
5338 ERROR_DS_CLIENT_LOOP ERROR_DS_REFERRAL_LIMIT_EXCEEDED \
5339 ERROR_DS_SORT_CONTROL_MISSING ERROR_DS_OFFSET_RANGE_ERROR \
5340 ERROR_DS_ROOT_MUST_BE_NC ERROR_DS_ADD_REPLICA_INHIBITED \
5341 ERROR_DS_ATT_NOT_DEF_IN_SCHEMA ERROR_DS_MAX_OBJ_SIZE_EXCEEDED \
5342 ERROR_DS_OBJ_STRING_NAME_EXISTS ERROR_DS_NO_RDN_DEFINED_IN_SCHEMA \
5343 ERROR_DS_RDN_DOESNT_MATCH_SCHEMA ERROR_DS_NO_REQUESTED_ATTS_FOUND \
5344 ERROR_DS_USER_BUFFER_TO_SMALL ERROR_DS_ATT_IS_NOT_ON_OBJ \
5345 ERROR_DS_ILLEGAL_MOD_OPERATION ERROR_DS_OBJ_TOO_LARGE \
5346 ERROR_DS_BAD_INSTANCE_TYPE ERROR_DS_MASTERDSA_REQUIRED \
5347 ERROR_DS_OBJECT_CLASS_REQUIRED ERROR_DS_MISSING_REQUIRED_ATT \
5348 ERROR_DS_ATT_NOT_DEF_FOR_CLASS ERROR_DS_ATT_ALREADY_EXISTS \
5349 ERROR_DS_CANT_ADD_ATT_VALUES ERROR_DS_SINGLE_VALUE_CONSTRAINT \
5350 ERROR_DS_RANGE_CONSTRAINT ERROR_DS_ATT_VAL_ALREADY_EXISTS \
5351 ERROR_DS_CANT_REM_MISSING_ATT ERROR_DS_CANT_REM_MISSING_ATT_VAL \
5352 ERROR_DS_ROOT_CANT_BE_SUBREF ERROR_DS_NO_CHAINING \
5353 ERROR_DS_NO_CHAINED_EVAL ERROR_DS_NO_PARENT_OBJECT \
5354 ERROR_DS_PARENT_IS_AN_ALIAS ERROR_DS_CANT_MIX_MASTER_AND_REPS \
5355 ERROR_DS_CHILDREN_EXIST ERROR_DS_OBJ_NOT_FOUND \
5356 ERROR_DS_ALIASED_OBJ_MISSING ERROR_DS_BAD_NAME_SYNTAX \
5357 ERROR_DS_ALIAS_POINTS_TO_ALIAS ERROR_DS_CANT_DEREF_ALIAS \
5358 ERROR_DS_OUT_OF_SCOPE ERROR_DS_OBJECT_BEING_REMOVED \
5359 ERROR_DS_CANT_DELETE_DSA_OBJ ERROR_DS_GENERIC_ERROR \
5360 ERROR_DS_DSA_MUST_BE_INT_MASTER ERROR_DS_CLASS_NOT_DSA \
5361 ERROR_DS_INSUFF_ACCESS_RIGHTS ERROR_DS_ILLEGAL_SUPERIOR \
5362 ERROR_DS_ATTRIBUTE_OWNED_BY_SAM ERROR_DS_NAME_TOO_MANY_PARTS \
5363 ERROR_DS_NAME_TOO_LONG ERROR_DS_NAME_VALUE_TOO_LONG \
5364 ERROR_DS_NAME_UNPARSEABLE ERROR_DS_NAME_TYPE_UNKNOWN \
5365 ERROR_DS_NOT_AN_OBJECT ERROR_DS_SEC_DESC_TOO_SHORT \
5366 ERROR_DS_SEC_DESC_INVALID ERROR_DS_NO_DELETED_NAME \
5367 ERROR_DS_SUBREF_MUST_HAVE_PARENT ERROR_DS_NCNAME_MUST_BE_NC \
5368 ERROR_DS_CANT_ADD_SYSTEM_ONLY ERROR_DS_CLASS_MUST_BE_CONCRETE \
5369 ERROR_DS_INVALID_DMD ERROR_DS_OBJ_GUID_EXISTS \
5370 ERROR_DS_NOT_ON_BACKLINK ERROR_DS_NO_CROSSREF_FOR_NC \
5371 ERROR_DS_SHUTTING_DOWN ERROR_DS_UNKNOWN_OPERATION \
5372 ERROR_DS_INVALID_ROLE_OWNER ERROR_DS_COULDNT_CONTACT_FSMO \
5373 ERROR_DS_CROSS_NC_DN_RENAME ERROR_DS_CANT_MOD_SYSTEM_ONLY \
5374 ERROR_DS_REPLICATOR_ONLY ERROR_DS_OBJ_CLASS_NOT_DEFINED \
5375 ERROR_DS_OBJ_CLASS_NOT_SUBCLASS ERROR_DS_NAME_REFERENCE_INVALID \
5376 ERROR_DS_CROSS_REF_EXISTS ERROR_DS_CANT_DEL_MASTER_CROSSREF \
5377 ERROR_DS_SUBTREE_NOTIFY_NOT_NC_HEAD \
5378 ERROR_DS_NOTIFY_FILTER_TOO_COMPLEX \
5379 ERROR_DS_DUP_RDN ERROR_DS_DUP_OID ERROR_DS_DUP_MAPI_ID \
5380 ERROR_DS_DUP_SCHEMA_ID_GUID ERROR_DS_DUP_LDAP_DISPLAY_NAME \
5381 ERROR_DS_SEMANTIC_ATT_TEST ERROR_DS_SYNTAX_MISMATCH \
5382 ERROR_DS_EXISTS_IN_MUST_HAVE ERROR_DS_EXISTS_IN_MAY_HAVE \
5383 ERROR_DS_NONEXISTENT_MAY_HAVE ERROR_DS_NONEXISTENT_MUST_HAVE \
5384 ERROR_DS_AUX_CLS_TEST_FAIL ERROR_DS_NONEXISTENT_POSS_SUP \
5385 ERROR_DS_SUB_CLS_TEST_FAIL ERROR_DS_BAD_RDN_ATT_ID_SYNTAX \
5386 ERROR_DS_EXISTS_IN_AUX_CLS ERROR_DS_EXISTS_IN_SUB_CLS \
5387 ERROR_DS_EXISTS_IN_POSS_SUP ERROR_DS_RECALCSCHEMA_FAILED \
5388 ERROR_DS_TREE_DELETE_NOT_FINISHED ERROR_DS_CANT_DELETE \
5389 ERROR_DS_ATT_SCHEMA_REQ_ID ERROR_DS_BAD_ATT_SCHEMA_SYNTAX \
5390 ERROR_DS_CANT_CACHE_ATT ERROR_DS_CANT_CACHE_CLASS \
5391 ERROR_DS_CANT_REMOVE_ATT_CACHE ERROR_DS_CANT_REMOVE_CLASS_CACHE \
5392 ERROR_DS_CANT_RETRIEVE_DN ERROR_DS_MISSING_SUPREF \
5393 ERROR_DS_CANT_RETRIEVE_INSTANCE ERROR_DS_CODE_INCONSISTENCY \
5394 ERROR_DS_DATABASE_ERROR ERROR_DS_GOVERNSID_MISSING \
5395 ERROR_DS_MISSING_EXPECTED_ATT ERROR_DS_NCNAME_MISSING_CR_REF \
5396 ERROR_DS_SECURITY_CHECKING_ERROR ERROR_DS_SCHEMA_NOT_LOADED \
5397 ERROR_DS_SCHEMA_ALLOC_FAILED ERROR_DS_ATT_SCHEMA_REQ_SYNTAX \
5398 ERROR_DS_GCVERIFY_ERROR ERROR_DS_DRA_SCHEMA_MISMATCH \
5399 ERROR_DS_CANT_FIND_DSA_OBJ ERROR_DS_CANT_FIND_EXPECTED_NC \
5400 ERROR_DS_CANT_FIND_NC_IN_CACHE ERROR_DS_CANT_RETRIEVE_CHILD \
5401 ERROR_DS_SECURITY_ILLEGAL_MODIFY ERROR_DS_CANT_REPLACE_HIDDEN_REC \
5402 ERROR_DS_BAD_HIERARCHY_FILE ERROR_DS_BUILD_HIERARCHY_TABLE_FAILED \
5403 ERROR_DS_CONFIG_PARAM_MISSING ERROR_DS_COUNTING_AB_INDICES_FAILED \
5404 ERROR_DS_HIERARCHY_TABLE_MALLOC_FAILED ERROR_DS_INTERNAL_FAILURE \
5405 ERROR_DS_UNKNOWN_ERROR ERROR_DS_ROOT_REQUIRES_CLASS_TOP \
5406 ERROR_DS_REFUSING_FSMO_ROLES ERROR_DS_MISSING_FSMO_SETTINGS \
5407 ERROR_DS_UNABLE_TO_SURRENDER_ROLES ERROR_DS_DRA_GENERIC \
5408 ERROR_DS_DRA_INVALID_PARAMETER ERROR_DS_DRA_BUSY \
5409 ERROR_DS_DRA_BAD_DN ERROR_DS_DRA_BAD_NC ERROR_DS_DRA_DN_EXISTS \
5410 ERROR_DS_DRA_INTERNAL_ERROR ERROR_DS_DRA_INCONSISTENT_DIT \
5411 ERROR_DS_DRA_CONNECTION_FAILED ERROR_DS_DRA_BAD_INSTANCE_TYPE \
5412 ERROR_DS_DRA_OUT_OF_MEM ERROR_DS_DRA_MAIL_PROBLEM \
5413 ERROR_DS_DRA_REF_ALREADY_EXISTS ERROR_DS_DRA_REF_NOT_FOUND \
5414 ERROR_DS_DRA_OBJ_IS_REP_SOURCE ERROR_DS_DRA_DB_ERROR \
5415 ERROR_DS_DRA_NO_REPLICA ERROR_DS_DRA_ACCESS_DENIED \
5416 ERROR_DS_DRA_NOT_SUPPORTED ERROR_DS_DRA_RPC_CANCELLED \
5417 ERROR_DS_DRA_SOURCE_DISABLED ERROR_DS_DRA_SINK_DISABLED \
5418 ERROR_DS_DRA_NAME_COLLISION ERROR_DS_DRA_SOURCE_REINSTALLED \
5419 ERROR_DS_DRA_MISSING_PARENT ERROR_DS_DRA_PREEMPTED \
5420 ERROR_DS_DRA_ABANDON_SYNC ERROR_DS_DRA_SHUTDOWN \
5421 ERROR_DS_DRA_INCOMPATIBLE_PARTIAL_SET \
5422 ERROR_DS_DRA_SOURCE_IS_PARTIAL_REPLICA \
5423 ERROR_DS_DRA_EXTN_CONNECTION_FAILED \
5424 ERROR_DS_INSTALL_SCHEMA_MISMATCH \
5425 ERROR_DS_DUP_LINK_ID ERROR_DS_NAME_ERROR_RESOLVING \
5426 ERROR_DS_NAME_ERROR_NOT_FOUND ERROR_DS_NAME_ERROR_NOT_UNIQUE \
5427 ERROR_DS_NAME_ERROR_NO_MAPPING ERROR_DS_NAME_ERROR_DOMAIN_ONLY \
5428 ERROR_DS_NAME_ERROR_NO_SYNTACTICAL_MAPPING \
5429 ERROR_DS_CONSTRUCTED_ATT_MOD ERROR_DS_WRONG_OM_OBJ_CLASS \
5430 ERROR_DS_DRA_REPL_PENDING ERROR_DS_DS_REQUIRED \
5431 ERROR_DS_INVALID_LDAP_DISPLAY_NAME \
5432 ERROR_DS_NON_BASE_SEARCH ERROR_DS_CANT_RETRIEVE_ATTS \
5433 ERROR_DS_BACKLINK_WITHOUT_LINK ERROR_DS_EPOCH_MISMATCH \
5434 ERROR_DS_SRC_NAME_MISMATCH ERROR_DS_SRC_AND_DST_NC_IDENTICAL \
5435 ERROR_DS_DST_NC_MISMATCH ERROR_DS_NOT_AUTHORITIVE_FOR_DST_NC \
5436 ERROR_DS_SRC_GUID_MISMATCH ERROR_DS_CANT_MOVE_DELETED_OBJECT \
5437 ERROR_DS_PDC_OPERATION_IN_PROGRESS \
5438 ERROR_DS_CROSS_DOMAIN_CLEANUP_REQD \
5439 ERROR_DS_ILLEGAL_XDOM_MOVE_OPERATION \
5440 ERROR_DS_CANT_WITH_ACCT_GROUP_MEMBERSHPS \
5441 ERROR_DS_NC_MUST_HAVE_NC_PARENT \
5442 ERROR_DS_CR_IMPOSSIBLE_TO_VALIDATE ERROR_DS_DST_DOMAIN_NOT_NATIVE \
5443 ERROR_DS_MISSING_INFRASTRUCTURE_CONTAINER \
5444 ERROR_DS_CANT_MOVE_ACCOUNT_GROUP \
5445 ERROR_DS_CANT_MOVE_RESOURCE_GROUP ERROR_DS_INVALID_SEARCH_FLAG \
5446 ERROR_DS_NO_TREE_DELETE_ABOVE_NC \
5447 ERROR_DS_COULDNT_LOCK_TREE_FOR_DELETE \
5448 ERROR_DS_COULDNT_IDENTIFY_OBJECTS_FOR_TREE_DELETE \
5449 ERROR_DS_SAM_INIT_FAILURE ERROR_DS_SENSITIVE_GROUP_VIOLATION \
5450 ERROR_DS_CANT_MOD_PRIMARYGROUPID ERROR_DS_ILLEGAL_BASE_SCHEMA_MOD \
5451 ERROR_DS_NONSAFE_SCHEMA_CHANGE ERROR_DS_SCHEMA_UPDATE_DISALLOWED \
5452 ERROR_DS_CANT_CREATE_UNDER_SCHEMA \
5453 ERROR_DS_INSTALL_NO_SRC_SCH_VERSION \
5454 ERROR_DS_INSTALL_NO_SCH_VERSION_IN_INIFILE \
5455 ERROR_DS_INVALID_GROUP_TYPE \
5456 ERROR_DS_NO_NEST_GLOBALGROUP_IN_MIXEDDOMAIN \
5457 ERROR_DS_NO_NEST_LOCALGROUP_IN_MIXEDDOMAIN \
5458 ERROR_DS_GLOBAL_CANT_HAVE_LOCAL_MEMBER \
5459 ERROR_DS_GLOBAL_CANT_HAVE_UNIVERSAL_MEMBER \
5460 ERROR_DS_UNIVERSAL_CANT_HAVE_LOCAL_MEMBER \
5461 ERROR_DS_GLOBAL_CANT_HAVE_CROSSDOMAIN_MEMBER \
5462 ERROR_DS_LOCAL_CANT_HAVE_CROSSDOMAIN_LOCAL_MEMBER \
5463 ERROR_DS_HAVE_PRIMARY_MEMBERS \
5464 ERROR_DS_STRING_SD_CONVERSION_FAILED \
5465 ERROR_DS_NAMING_MASTER_GC ERROR_DS_LOOKUP_FAILURE \
5466 ERROR_DS_COULDNT_UPDATE_SPNS ERROR_DS_CANT_RETRIEVE_SD \
5467 ERROR_DS_KEY_NOT_UNIQUE ERROR_DS_WRONG_LINKED_ATT_SYNTAX \
5468 ERROR_DS_SAM_NEED_BOOTKEY_PASSWORD \
5469 ERROR_DS_SAM_NEED_BOOTKEY_FLOPPY ERROR_DS_CANT_START \
5470 ERROR_DS_INIT_FAILURE ERROR_DS_NO_PKT_PRIVACY_ON_CONNECTION \
5471 ERROR_DS_SOURCE_DOMAIN_IN_FOREST \
5472 ERROR_DS_DESTINATION_DOMAIN_NOT_IN_FOREST \
5473 ERROR_DS_DESTINATION_AUDITING_NOT_ENABLED \
5474 ERROR_DS_CANT_FIND_DC_FOR_SRC_DOMAIN \
5475 ERROR_DS_SRC_OBJ_NOT_GROUP_OR_USER \
5476 ERROR_DS_SRC_SID_EXISTS_IN_FOREST \
5477 ERROR_DS_SRC_AND_DST_OBJECT_CLASS_MISMATCH \
5478 ERROR_SAM_INIT_FAILURE ERROR_DS_DRA_SCHEMA_INFO_SHIP \
5479 ERROR_DS_DRA_SCHEMA_CONFLICT ERROR_DS_DRA_EARLIER_SCHEMA_CONLICT \
5480 ERROR_DS_DRA_OBJ_NC_MISMATCH ERROR_DS_NC_STILL_HAS_DSAS \
5481 ERROR_DS_GC_REQUIRED ERROR_DS_LOCAL_MEMBER_OF_LOCAL_ONLY \
5482 ERROR_DS_NO_FPO_IN_UNIVERSAL_GROUPS \
5483 ERROR_DS_CANT_ADD_TO_GC ERROR_DS_NO_CHECKPOINT_WITH_PDC \
5484 ERROR_DS_SOURCE_AUDITING_NOT_ENABLED \
5485 ERROR_DS_CANT_CREATE_IN_NONDOMAIN_NC \
5486 ERROR_DS_INVALID_NAME_FOR_SPN \
5487 ERROR_DS_FILTER_USES_CONTRUCTED_ATTRS \
5488 ERROR_DS_UNICODEPWD_NOT_IN_QUOTES \
5489 ERROR_DS_MACHINE_ACCOUNT_QUOTA_EXCEEDED \
5490 ERROR_DS_MUST_BE_RUN_ON_DST_DC \
5491 ERROR_DS_SRC_DC_MUST_BE_SP4_OR_GREATER \
5492 ERROR_DS_CANT_TREE_DELETE_CRITICAL_OBJ \
5493 ERROR_DS_INIT_FAILURE_CONSOLE ERROR_DS_SAM_INIT_FAILURE_CONSOLE \
5494 ERROR_DS_FOREST_VERSION_TOO_HIGH ERROR_DS_DOMAIN_VERSION_TOO_HIGH \
5495 ERROR_DS_FOREST_VERSION_TOO_LOW ERROR_DS_DOMAIN_VERSION_TOO_LOW \
5496 ERROR_DS_INCOMPATIBLE_VERSION ERROR_DS_LOW_DSA_VERSION \
5497 ERROR_DS_NO_BEHAVIOR_VERSION_IN_MIXEDDOMAIN \
5498 ERROR_DS_NOT_SUPPORTED_SORT_ORDER ERROR_DS_NAME_NOT_UNIQUE \
5499 ERROR_DS_MACHINE_ACCOUNT_CREATED_PRENT4 \
5500 ERROR_DS_OUT_OF_VERSION_STORE ERROR_DS_INCOMPATIBLE_CONTROLS_USED \
5501 ERROR_DS_NO_REF_DOMAIN ERROR_DS_RESERVED_LINK_ID \
5502 ERROR_DS_LINK_ID_NOT_AVAILABLE \
5503 ERROR_DS_AG_CANT_HAVE_UNIVERSAL_MEMBER \
5504 ERROR_DS_MODIFYDN_DISALLOWED_BY_INSTANCE_TYPE \
5505 ERROR_DS_NO_OBJECT_MOVE_IN_SCHEMA_NC \
5506 ERROR_DS_MODIFYDN_DISALLOWED_BY_FLAG \
5507 ERROR_DS_MODIFYDN_WRONG_GRANDPARENT \
5508 ERROR_DS_NAME_ERROR_TRUST_REFERRAL \
5509 ERROR_NOT_SUPPORTED_ON_STANDARD_SERVER \
5510 ERROR_DS_CANT_ACCESS_REMOTE_PART_OF_AD \
5511 ERROR_DS_CR_IMPOSSIBLE_TO_VALIDATE_V2 \
5512 ERROR_DS_THREAD_LIMIT_EXCEEDED ERROR_DS_NOT_CLOSEST \
5513 ERROR_DS_CANT_DERIVE_SPN_WITHOUT_SERVER_REF \
5514 ERROR_DS_SINGLE_USER_MODE_FAILED \
5515 ERROR_DS_NTDSCRIPT_SYNTAX_ERROR ERROR_DS_NTDSCRIPT_PROCESS_ERROR \
5516 ERROR_DS_DIFFERENT_REPL_EPOCHS ERROR_DS_DRS_EXTENSIONS_CHANGED \
5517 ERROR_DS_REPLICA_SET_CHANGE_NOT_ALLOWED_ON_DISABLED_CR \
5518 ERROR_DS_NO_MSDS_INTID ERROR_DS_DUP_MSDS_INTID \
5519 ERROR_DS_EXISTS_IN_RDNATTID \
5520 ERROR_DS_AUTHORIZATION_FAILED ERROR_DS_INVALID_SCRIPT \
5521 ERROR_DS_REMOTE_CROSSREF_OP_FAILED ERROR_DS_CROSS_REF_BUSY \
5522 ERROR_DS_CANT_DERIVE_SPN_FOR_DELETED_DOMAIN \
5523 ERROR_DS_CANT_DEMOTE_WITH_WRITEABLE_NC \
5524 ERROR_DS_DUPLICATE_ID_FOUND \
5525 ERROR_DS_INSUFFICIENT_ATTR_TO_CREATE_OBJECT \
5526 ERROR_DS_GROUP_CONVERSION_ERROR \
5527 ERROR_DS_CANT_MOVE_APP_BASIC_GROUP \
5528 ERROR_DS_CANT_MOVE_APP_QUERY_GROUP ERROR_DS_ROLE_NOT_VERIFIED \
5529 ERROR_DS_WKO_CONTAINER_CANNOT_BE_SPECIAL \
5530 ERROR_DS_DOMAIN_RENAME_IN_PROGRESS ERROR_DS_EXISTING_AD_CHILD_NC \
5531 DNS_ERROR_RCODE_FORMAT_ERROR DNS_ERROR_RCODE_SERVER_FAILURE \
5532 DNS_ERROR_RCODE_NAME_ERROR DNS_ERROR_RCODE_NOT_IMPLEMENTED \
5533 DNS_ERROR_RCODE_REFUSED DNS_ERROR_RCODE_YXDOMAIN \
5534 DNS_ERROR_RCODE_YXRRSET DNS_ERROR_RCODE_NXRRSET \
5535 DNS_ERROR_RCODE_NOTAUTH DNS_ERROR_RCODE_NOTZONE \
5536 DNS_ERROR_RCODE_BADSIG DNS_ERROR_RCODE_BADKEY \
5537 DNS_ERROR_RCODE_BADTIME DNS_INFO_NO_RECORDS DNS_ERROR_BAD_PACKET \
5538 DNS_ERROR_NO_PACKET DNS_ERROR_RCODE DNS_ERROR_UNSECURE_PACKET \
5539 DNS_ERROR_INVALID_TYPE DNS_ERROR_INVALID_IP_ADDRESS \
5540 DNS_ERROR_INVALID_PROPERTY DNS_ERROR_TRY_AGAIN_LATER \
5541 DNS_ERROR_NOT_UNIQUE DNS_ERROR_NON_RFC_NAME DNS_STATUS_FQDN \
5542 DNS_STATUS_DOTTED_NAME DNS_STATUS_SINGLE_PART_NAME \
5543 DNS_ERROR_INVALID_NAME_CHAR DNS_ERROR_NUMERIC_NAME \
5544 DNS_ERROR_NOT_ALLOWED_ON_ROOT_SERVER \
5545 DNS_ERROR_NOT_ALLOWED_UNDER_DELEGATION \
5546 DNS_ERROR_CANNOT_FIND_ROOT_HINTS \
5547 DNS_ERROR_INCONSISTENT_ROOT_HINTS DNS_ERROR_ZONE_DOES_NOT_EXIST \
5548 DNS_ERROR_NO_ZONE_INFO DNS_ERROR_INVALID_ZONE_OPERATION \
5549 DNS_ERROR_ZONE_CONFIGURATION_ERROR \
5550 DNS_ERROR_ZONE_HAS_NO_SOA_RECORD \
5551 DNS_ERROR_ZONE_HAS_NO_NS_RECORDS DNS_ERROR_ZONE_LOCKED \
5552 DNS_ERROR_ZONE_CREATION_FAILED DNS_ERROR_ZONE_ALREADY_EXISTS \
5553 DNS_ERROR_AUTOZONE_ALREADY_EXISTS DNS_ERROR_INVALID_ZONE_TYPE \
5554 DNS_ERROR_SECONDARY_REQUIRES_MASTER_IP \
5555 DNS_ERROR_ZONE_NOT_SECONDARY DNS_ERROR_NEED_SECONDARY_ADDRESSES \
5556 DNS_ERROR_WINS_INIT_FAILED DNS_ERROR_NEED_WINS_SERVERS \
5557 DNS_ERROR_NBSTAT_INIT_FAILED DNS_ERROR_SOA_DELETE_INVALID \
5558 DNS_ERROR_FORWARDER_ALREADY_EXISTS \
5559 DNS_ERROR_ZONE_REQUIRES_MASTER_IP \
5560 DNS_ERROR_ZONE_IS_SHUTDOWN DNS_ERROR_PRIMARY_REQUIRES_DATAFILE \
5561 DNS_ERROR_INVALID_DATAFILE_NAME DNS_ERROR_DATAFILE_OPEN_FAILURE \
5562 DNS_ERROR_FILE_WRITEBACK_FAILED DNS_ERROR_DATAFILE_PARSING \
5563 DNS_ERROR_RECORD_DOES_NOT_EXIST DNS_ERROR_RECORD_FORMAT \
5564 DNS_ERROR_NODE_CREATION_FAILED DNS_ERROR_UNKNOWN_RECORD_TYPE \
5565 DNS_ERROR_RECORD_TIMED_OUT DNS_ERROR_NAME_NOT_IN_ZONE \
5566 DNS_ERROR_CNAME_LOOP DNS_ERROR_NODE_IS_CNAME \
5567 DNS_ERROR_CNAME_COLLISION DNS_ERROR_RECORD_ONLY_AT_ZONE_ROOT \
5568 DNS_ERROR_RECORD_ALREADY_EXISTS DNS_ERROR_SECONDARY_DATA \
5569 DNS_ERROR_NO_CREATE_CACHE_DATA DNS_ERROR_NAME_DOES_NOT_EXIST \
5570 DNS_WARNING_PTR_CREATE_FAILED DNS_WARNING_DOMAIN_UNDELETED \
5571 DNS_ERROR_DS_UNAVAILABLE DNS_ERROR_DS_ZONE_ALREADY_EXISTS \
5572 DNS_ERROR_NO_BOOTFILE_IF_DS_ZONE DNS_INFO_AXFR_COMPLETE \
5573 DNS_ERROR_AXFR DNS_INFO_ADDED_LOCAL_WINS \
5574 DNS_STATUS_CONTINUE_NEEDED DNS_ERROR_NO_TCPIP \
5575 DNS_ERROR_NO_DNS_SERVERS DNS_ERROR_DP_DOES_NOT_EXIST \
5576 DNS_ERROR_DP_ALREADY_EXISTS DNS_ERROR_DP_NOT_ENLISTED \
5577 DNS_ERROR_DP_ALREADY_ENLISTED DNS_ERROR_DP_NOT_AVAILABLE \
5578 WSABASEERR WSAEINTR WSAEBADF WSAEACCES WSAEFAULT WSAEINVAL \
5579 WSAEMFILE WSAEWOULDBLOCK WSAEINPROGRESS WSAEALREADY WSAENOTSOCK \
5580 WSAEDESTADDRREQ WSAEMSGSIZE WSAEPROTOTYPE WSAENOPROTOOPT \
5581 WSAEPROTONOSUPPORT WSAESOCKTNOSUPPORT WSAEOPNOTSUPP \
5582 WSAEPFNOSUPPORT WSAEAFNOSUPPORT WSAEADDRINUSE WSAEADDRNOTAVAIL \
5583 WSAENETDOWN WSAENETUNREACH WSAENETRESET WSAECONNABORTED \
5584 WSAECONNRESET WSAENOBUFS WSAEISCONN WSAENOTCONN WSAESHUTDOWN \
5585 WSAETOOMANYREFS WSAETIMEDOUT WSAECONNREFUSED WSAELOOP \
5586 WSAENAMETOOLONG WSAEHOSTDOWN WSAEHOSTUNREACH WSAENOTEMPTY \
5587 WSAEPROCLIM WSAEUSERS WSAEDQUOT WSAESTALE WSAEREMOTE \
5588 WSASYSNOTREADY WSAVERNOTSUPPORTED WSANOTINITIALISED WSAEDISCON \
5589 WSAENOMORE WSAECANCELLED WSAEINVALIDPROCTABLE WSAEINVALIDPROVIDER \
5590 WSAEPROVIDERFAILEDINIT WSASYSCALLFAILURE WSASERVICE_NOT_FOUND \
5591 WSATYPE_NOT_FOUND WSA_E_NO_MORE WSA_E_CANCELLED WSAEREFUSED \
5592 WSAHOST_NOT_FOUND WSATRY_AGAIN WSANO_RECOVERY WSANO_DATA \
5593 WSA_QOS_RECEIVERS WSA_QOS_SENDERS WSA_QOS_NO_SENDERS \
5594 WSA_QOS_NO_RECEIVERS WSA_QOS_REQUEST_CONFIRMED \
5595 WSA_QOS_ADMISSION_FAILURE WSA_QOS_POLICY_FAILURE \
5596 WSA_QOS_BAD_STYLE WSA_QOS_BAD_OBJECT WSA_QOS_TRAFFIC_CTRL_ERROR \
5597 WSA_QOS_GENERIC_ERROR WSA_QOS_ESERVICETYPE WSA_QOS_EFLOWSPEC \
5598 WSA_QOS_EPROVSPECBUF WSA_QOS_EFILTERSTYLE WSA_QOS_EFILTERTYPE \
5599 WSA_QOS_EFILTERCOUNT WSA_QOS_EOBJLENGTH WSA_QOS_EFLOWCOUNT \
5600 WSA_QOS_EUNKNOWNPSOBJ WSA_QOS_EPOLICYOBJ WSA_QOS_EFLOWDESC \
5601 WSA_QOS_EPSFLOWSPEC WSA_QOS_EPSFILTERSPEC WSA_QOS_ESDMODEOBJ \
5602 WSA_QOS_ESHAPERATEOBJ WSA_QOS_RESERVED_PETYPE \
5603 ERROR_IPSEC_QM_POLICY_EXISTS ERROR_IPSEC_QM_POLICY_NOT_FOUND \
5604 ERROR_IPSEC_QM_POLICY_IN_USE ERROR_IPSEC_MM_POLICY_EXISTS \
5605 ERROR_IPSEC_MM_POLICY_NOT_FOUND ERROR_IPSEC_MM_POLICY_IN_USE \
5606 ERROR_IPSEC_MM_FILTER_EXISTS ERROR_IPSEC_MM_FILTER_NOT_FOUND \
5607 ERROR_IPSEC_TRANSPORT_FILTER_EXISTS \
5608 ERROR_IPSEC_TRANSPORT_FILTER_NOT_FOUND ERROR_IPSEC_MM_AUTH_EXISTS \
5609 ERROR_IPSEC_MM_AUTH_NOT_FOUND ERROR_IPSEC_MM_AUTH_IN_USE \
5610 ERROR_IPSEC_DEFAULT_MM_POLICY_NOT_FOUND \
5611 ERROR_IPSEC_DEFAULT_MM_AUTH_NOT_FOUND \
5612 ERROR_IPSEC_DEFAULT_QM_POLICY_NOT_FOUND \
5613 ERROR_IPSEC_TUNNEL_FILTER_EXISTS \
5614 ERROR_IPSEC_TUNNEL_FILTER_NOT_FOUND \
5615 ERROR_IPSEC_MM_FILTER_PENDING_DELETION \
5616 ERROR_IPSEC_TRANSPORT_FILTER_PENDING_DELETION \
5617 ERROR_IPSEC_TUNNEL_FILTER_PENDING_DELETION \
5618 ERROR_IPSEC_MM_POLICY_PENDING_DELETION \
5619 ERROR_IPSEC_MM_AUTH_PENDING_DELETION \
5620 ERROR_IPSEC_QM_POLICY_PENDING_DELETION \
5621 WARNING_IPSEC_MM_POLICY_PRUNED WARNING_IPSEC_QM_POLICY_PRUNED \
5622 ERROR_IPSEC_IKE_AUTH_FAIL ERROR_IPSEC_IKE_ATTRIB_FAIL \
5623 ERROR_IPSEC_IKE_NEGOTIATION_PENDING \
5624 ERROR_IPSEC_IKE_GENERAL_PROCESSING_ERROR \
5625 ERROR_IPSEC_IKE_TIMED_OUT ERROR_IPSEC_IKE_NO_CERT \
5626 ERROR_IPSEC_IKE_SA_DELETED ERROR_IPSEC_IKE_SA_REAPED \
5627 ERROR_IPSEC_IKE_MM_ACQUIRE_DROP ERROR_IPSEC_IKE_QM_ACQUIRE_DROP \
5628 ERROR_IPSEC_IKE_QUEUE_DROP_MM ERROR_IPSEC_IKE_QUEUE_DROP_NO_MM \
5629 ERROR_IPSEC_IKE_DROP_NO_RESPONSE ERROR_IPSEC_IKE_MM_DELAY_DROP \
5630 ERROR_IPSEC_IKE_QM_DELAY_DROP ERROR_IPSEC_IKE_ERROR \
5631 ERROR_IPSEC_IKE_CRL_FAILED ERROR_IPSEC_IKE_INVALID_KEY_USAGE \
5632 ERROR_IPSEC_IKE_INVALID_CERT_TYPE \
5633 ERROR_IPSEC_IKE_NO_PRIVATE_KEY ERROR_IPSEC_IKE_DH_FAIL \
5634 ERROR_IPSEC_IKE_INVALID_HEADER ERROR_IPSEC_IKE_NO_POLICY \
5635 ERROR_IPSEC_IKE_INVALID_SIGNATURE ERROR_IPSEC_IKE_KERBEROS_ERROR \
5636 ERROR_IPSEC_IKE_NO_PUBLIC_KEY ERROR_IPSEC_IKE_PROCESS_ERR \
5637 ERROR_IPSEC_IKE_PROCESS_ERR_SA ERROR_IPSEC_IKE_PROCESS_ERR_PROP \
5638 ERROR_IPSEC_IKE_PROCESS_ERR_TRANS ERROR_IPSEC_IKE_PROCESS_ERR_KE \
5639 ERROR_IPSEC_IKE_PROCESS_ERR_ID ERROR_IPSEC_IKE_PROCESS_ERR_CERT \
5640 ERROR_IPSEC_IKE_PROCESS_ERR_CERT_REQ \
5641 ERROR_IPSEC_IKE_PROCESS_ERR_HASH ERROR_IPSEC_IKE_PROCESS_ERR_SIG \
5642 ERROR_IPSEC_IKE_PROCESS_ERR_NONCE \
5643 ERROR_IPSEC_IKE_PROCESS_ERR_NOTIFY \
5644 ERROR_IPSEC_IKE_PROCESS_ERR_DELETE \
5645 ERROR_IPSEC_IKE_PROCESS_ERR_VENDOR \
5646 ERROR_IPSEC_IKE_INVALID_PAYLOAD \
5647 ERROR_IPSEC_IKE_LOAD_SOFT_SA ERROR_IPSEC_IKE_SOFT_SA_TORN_DOWN \
5648 ERROR_IPSEC_IKE_INVALID_COOKIE ERROR_IPSEC_IKE_NO_PEER_CERT \
5649 ERROR_IPSEC_IKE_PEER_CRL_FAILED ERROR_IPSEC_IKE_POLICY_CHANGE \
5650 ERROR_IPSEC_IKE_NO_MM_POLICY ERROR_IPSEC_IKE_NOTCBPRIV \
5651 ERROR_IPSEC_IKE_SECLOADFAIL ERROR_IPSEC_IKE_FAILSSPINIT \
5652 ERROR_IPSEC_IKE_FAILQUERYSSP ERROR_IPSEC_IKE_SRVACQFAIL \
5653 ERROR_IPSEC_IKE_SRVQUERYCRED ERROR_IPSEC_IKE_GETSPIFAIL \
5654 ERROR_IPSEC_IKE_INVALID_FILTER ERROR_IPSEC_IKE_OUT_OF_MEMORY \
5655 ERROR_IPSEC_IKE_ADD_UPDATE_KEY_FAILED \
5656 ERROR_IPSEC_IKE_INVALID_POLICY ERROR_IPSEC_IKE_UNKNOWN_DOI \
5657 ERROR_IPSEC_IKE_INVALID_SITUATION ERROR_IPSEC_IKE_DH_FAILURE \
5658 ERROR_IPSEC_IKE_INVALID_GROUP ERROR_IPSEC_IKE_ENCRYPT \
5659 ERROR_IPSEC_IKE_DECRYPT ERROR_IPSEC_IKE_POLICY_MATCH \
5660 ERROR_IPSEC_IKE_UNSUPPORTED_ID ERROR_IPSEC_IKE_INVALID_HASH \
5661 ERROR_IPSEC_IKE_INVALID_HASH_ALG \
5662 ERROR_IPSEC_IKE_INVALID_HASH_SIZE \
5663 ERROR_IPSEC_IKE_INVALID_ENCRYPT_ALG \
5664 ERROR_IPSEC_IKE_INVALID_AUTH_ALG \
5665 ERROR_IPSEC_IKE_INVALID_SIG ERROR_IPSEC_IKE_LOAD_FAILED \
5666 ERROR_IPSEC_IKE_RPC_DELETE ERROR_IPSEC_IKE_BENIGN_REINIT \
5667 ERROR_IPSEC_IKE_INVALID_RESPONDER_LIFETIME_NOTIFY \
5668 ERROR_IPSEC_IKE_INVALID_CERT_KEYLEN ERROR_IPSEC_IKE_MM_LIMIT \
5669 ERROR_IPSEC_IKE_NEGOTIATION_DISABLED \
5670 ERROR_IPSEC_IKE_NEG_STATUS_END \
5671 ERROR_SXS_SECTION_NOT_FOUND ERROR_SXS_CANT_GEN_ACTCTX \
5672 ERROR_SXS_INVALID_ACTCTXDATA_FORMAT ERROR_SXS_ASSEMBLY_NOT_FOUND \
5673 ERROR_SXS_MANIFEST_FORMAT_ERROR ERROR_SXS_MANIFEST_PARSE_ERROR \
5674 ERROR_SXS_ACTIVATION_CONTEXT_DISABLED ERROR_SXS_KEY_NOT_FOUND \
5675 ERROR_SXS_VERSION_CONFLICT ERROR_SXS_WRONG_SECTION_TYPE \
5676 ERROR_SXS_THREAD_QUERIES_DISABLED \
5677 ERROR_SXS_PROCESS_DEFAULT_ALREADY_SET \
5678 ERROR_SXS_UNKNOWN_ENCODING_GROUP ERROR_SXS_UNKNOWN_ENCODING \
5679 ERROR_SXS_INVALID_XML_NAMESPACE_URI \
5680 ERROR_SXS_ROOT_MANIFEST_DEPENDENCY_NOT_INSTALLED \
5681 ERROR_SXS_LEAF_MANIFEST_DEPENDENCY_NOT_INSTALLED \
5682 ERROR_SXS_INVALID_ASSEMBLY_IDENTITY_ATTRIBUTE \
5683 ERROR_SXS_MANIFEST_MISSING_REQUIRED_DEFAULT_NAMESPACE \
5684 ERROR_SXS_MANIFEST_INVALID_REQUIRED_DEFAULT_NAMESPACE \
5685 ERROR_SXS_PRIVATE_MANIFEST_CROSS_PATH_WITH_REPARSE_POINT \
5686 ERROR_SXS_DUPLICATE_DLL_NAME ERROR_SXS_DUPLICATE_WINDOWCLASS_NAME \
5687 ERROR_SXS_DUPLICATE_CLSID ERROR_SXS_DUPLICATE_IID \
5688 ERROR_SXS_DUPLICATE_TLBID ERROR_SXS_DUPLICATE_PROGID \
5689 ERROR_SXS_DUPLICATE_ASSEMBLY_NAME \
5690 ERROR_SXS_FILE_HASH_MISMATCH ERROR_SXS_POLICY_PARSE_ERROR \
5691 ERROR_SXS_XML_E_MISSINGQUOTE ERROR_SXS_XML_E_COMMENTSYNTAX \
5692 ERROR_SXS_XML_E_BADSTARTNAMECHAR ERROR_SXS_XML_E_BADNAMECHAR \
5693 ERROR_SXS_XML_E_BADCHARINSTRING ERROR_SXS_XML_E_XMLDECLSYNTAX \
5694 ERROR_SXS_XML_E_BADCHARDATA ERROR_SXS_XML_E_MISSINGWHITESPACE \
5695 ERROR_SXS_XML_E_EXPECTINGTAGEND ERROR_SXS_XML_E_MISSINGSEMICOLON \
5696 ERROR_SXS_XML_E_UNBALANCEDPAREN ERROR_SXS_XML_E_INTERNALERROR \
5697 ERROR_SXS_XML_E_UNEXPECTED_WHITESPACE \
5698 ERROR_SXS_XML_E_INCOMPLETE_ENCODING \
5699 ERROR_SXS_XML_E_MISSING_PAREN ERROR_SXS_XML_E_EXPECTINGCLOSEQUOTE \
5700 ERROR_SXS_XML_E_MULTIPLE_COLONS ERROR_SXS_XML_E_INVALID_DECIMAL \
5701 ERROR_SXS_XML_E_INVALID_HEXIDECIMAL \
5702 ERROR_SXS_XML_E_INVALID_UNICODE \
5703 ERROR_SXS_XML_E_WHITESPACEORQUESTIONMARK \
5704 ERROR_SXS_XML_E_UNEXPECTEDENDTAG ERROR_SXS_XML_E_UNCLOSEDTAG \
5705 ERROR_SXS_XML_E_DUPLICATEATTRIBUTE ERROR_SXS_XML_E_MULTIPLEROOTS \
5706 ERROR_SXS_XML_E_INVALIDATROOTLEVEL ERROR_SXS_XML_E_BADXMLDECL \
5707 ERROR_SXS_XML_E_MISSINGROOT ERROR_SXS_XML_E_UNEXPECTEDEOF \
5708 ERROR_SXS_XML_E_BADPEREFINSUBSET ERROR_SXS_XML_E_UNCLOSEDSTARTTAG \
5709 ERROR_SXS_XML_E_UNCLOSEDENDTAG ERROR_SXS_XML_E_UNCLOSEDSTRING \
5710 ERROR_SXS_XML_E_UNCLOSEDCOMMENT ERROR_SXS_XML_E_UNCLOSEDDECL \
5711 ERROR_SXS_XML_E_UNCLOSEDCDATA ERROR_SXS_XML_E_RESERVEDNAMESPACE \
5712 ERROR_SXS_XML_E_INVALIDENCODING ERROR_SXS_XML_E_INVALIDSWITCH \
5713 ERROR_SXS_XML_E_BADXMLCASE ERROR_SXS_XML_E_INVALID_STANDALONE \
5714 ERROR_SXS_XML_E_UNEXPECTED_STANDALONE \
5715 ERROR_SXS_XML_E_INVALID_VERSION ERROR_SXS_XML_E_MISSINGEQUALS \
5716 ERROR_SXS_PROTECTION_RECOVERY_FAILED \
5717 ERROR_SXS_PROTECTION_PUBLIC_KEY_TOO_SHORT \
5718 ERROR_SXS_PROTECTION_CATALOG_NOT_VALID \
5719 ERROR_SXS_UNTRANSLATABLE_HRESULT \
5720 ERROR_SXS_PROTECTION_CATALOG_FILE_MISSING \
5721 ERROR_SXS_MISSING_ASSEMBLY_IDENTITY_ATTRIBUTE \
5722 ERROR_SXS_INVALID_ASSEMBLY_IDENTITY_ATTRIBUTE_NAME \
5723 )
5724 object errno_to_symbol_w (long code);
errno_to_symbol_w(long code)5725 object errno_to_symbol_w (long code) {return check_last_error_reverse(code);}
5726 DEFUN(OS::LAST-ERROR, &optional newval) {
5727 if (eq(T,STACK_0)) { /* all known error codes */
5728 int pos = 0;
5729 for (; pos < check_last_error_map.size; pos++) {
5730 pushSTACK(allocate_cons());
5731 Car(STACK_0) = uint32_to_I(check_last_error_map.table[pos].c_const);
5732 Cdr(STACK_0) = *check_last_error_map.table[pos].l_const;
5733 }
5734 VALUES1(listof(check_last_error_map.size));
5735 } else {
5736 DWORD error_code;
5737 if (missingp(STACK_0)) {
5738 begin_system_call();
5739 error_code = GetLastError();
5740 end_system_call();
5741 VALUES1(check_last_error_reverse(error_code));
5742 } else {
5743 if (uint32_p(STACK_0)) {
5744 error_code = I_to_uint32(STACK_0);
5745 VALUES1(check_last_error_reverse(error_code));
5746 } else {
5747 error_code = check_last_error(STACK_0);
5748 VALUES1(uint32_to_I(error_code));
5749 }
5750 begin_system_call();
5751 SetLastError(error_code);
5752 end_system_call();
5753 }
5754 VALUES1(check_last_error_reverse(error_code));
5755 }
5756 skipSTACK(1);
5757 }
5758 DEFUN(SYS::FORMAT-MESSAGE, &optional error_code) {
5759 DWORD error_code;
5760 if (missingp(STACK_0)) {
5761 begin_system_call();
5762 error_code = GetLastError();
5763 end_system_call();
5764 } else error_code = check_last_error(STACK_0);
5765 STACK_0 = UL_to_I(error_code);
5766 funcall(L(format_message),1);
5767 }
5768 #endif /* WIN32_NATIVE || UNIX_CYGWIN */
5769
5770 /* http://opengroup.org/onlinepubs/9699919799/basedefs/errno.h.html */
5771 DEFCHECKER(check_errno, E2BIG EACCES EADDRINUSE EADDRNOTAVAIL EAFNOSUPPORT \
5772 EAGAIN EALREADY EBADF EBADMSG EBUSY ECANCELED ECHILD ECONNABORTED \
5773 ECONNREFUSED ECONNRESET EDEADLK EDESTADDRREQ EDOM EDQUOT EEXIST \
5774 EFAULT EFBIG EHOSTUNREACH EIDRM EILSEQ EINPROGRESS EINTR EINVAL \
5775 EIO EISCONN EISDIR ELOOP EMFILE EMLINK EMSGSIZE EMULTIHOP \
5776 ENAMETOOLONG ENETDOWN ENETRESET ENETUNREACH ENFILE ENOBUFS ENODATA \
5777 ENODEV ENOENT ENOEXEC ENOLCK ENOLINK ENOMEM ENOMSG ENOPROTOOPT \
5778 ENOSPC ENOSR ENOSTR ENOSYS ENOTCONN ENOTDIR ENOTEMPTY ENOTSOCK \
5779 ENOTSUP ENOTTY ENXIO EOPNOTSUPP EOVERFLOW EPERM EPIPE EPROTO \
5780 EPROTONOSUPPORT EPROTOTYPE ERANGE EROFS ESPIPE ESRCH ESTALE ETIME \
5781 ETIMEDOUT ETXTBSY EWOULDBLOCK EXDEV \
5782 /* clisp/src/errunix.d */ ERREMOTE \
5783 /* Linux extras */ \
5784 EADV EBADE EBADFD EBADR EBADRQC EBADSLT EBFONT ECHRNG ECOMM \
5785 EDEADLOCK EDOTDOT EHOSTDOWN EISNAM EL2HLT EL2NSYNC EL3HLT EL3RST \
5786 ELIBACC ELIBBAD ELIBEXEC ELIBMAX ELIBSCN ELNRNG EMEDIUMTYPE \
5787 ENAVAIL ENOANO ENOCSI ENOMEDIUM ENONET ENOPKG ENOTBLK ENOTNAM \
5788 ENOTUNIQ EPFNOSUPPORT EREMCHG EREMOTE EREMOTEIO ERESTART ESHUTDOWN \
5789 ESOCKTNOSUPPORT ESRMNT ESTRPIPE ETOOMANYREFS EUCLEAN EUNATCH \
5790 EUSERS EXFULL ENOKEY EKEYEXPIRED EKEYREVOKED EKEYREJECTED \
5791 ERFKILL EHWPOISON \
5792 /* Win32 extras */ \
5793 STRUNCATE ECASECLASH EFTYPE ELBIN ENMFILE ENOFILE ENOSHARE EPROCLIM \
5794 /* FreeBSD extras */ \
5795 EAUTH EBADRPC EDIRIOCTL EDOOFUS EJUSTRETURN ELAST ENEEDAUTH ENOATTR \
5796 ENOIOCTL EPROCUNAVAIL EPROGMISMATCH EPROGUNAVAIL ERPCMISMATCH \
5797 /* Solaris extras */ \
5798 ELOCKUNMAPPED ENOTACTIVE ENOTRECOVERABLE EOWNERDEAD \
5799 /* http://www.google.com/codesearch?q=+file:errno.h */ \
5800 EALIGN EDIRTY EDUPPKG EINIT EISNAME ENET ENOSYM EREMDEV \
5801 EREMOTERELEASE EVERSION EAIO ECLONEME EFAIL EINPROG EMTIMERS \
5802 ERESTARTNOHAND ERESTARTNOINTR ERESTARTSYS \
5803 )
5804 object errno_to_symbol_a (long code);
errno_to_symbol_a(long code)5805 object errno_to_symbol_a (long code) { return check_errno_reverse(code); }
5806 DEFUN(POSIX::ERRNO, &optional newval) {
5807 if (eq(T,STACK_0)) { /* all known error codes */
5808 unsigned int pos = 0;
5809 for (; pos < check_errno_map.size; pos++) {
5810 pushSTACK(allocate_cons());
5811 Car(STACK_0) = sint_to_I(check_errno_map.table[pos].c_const);
5812 Cdr(STACK_0) = *check_errno_map.table[pos].l_const;
5813 }
5814 VALUES1(listof(check_errno_map.size));
5815 } else {
5816 int error_code;
5817 if (missingp(STACK_0)) {
5818 begin_system_call();
5819 error_code = errno;
5820 end_system_call();
5821 VALUES1(check_errno_reverse(error_code));
5822 } else {
5823 if (sint_p(STACK_0)) {
5824 error_code = I_to_sint(STACK_0);
5825 VALUES1(check_errno_reverse(error_code));
5826 } else {
5827 error_code = check_errno(STACK_0);
5828 VALUES1(sint_to_I(error_code));
5829 }
5830 begin_system_call();
5831 errno = error_code;
5832 end_system_call();
5833 }
5834 }
5835 skipSTACK(1);
5836 }
5837 DEFUN(SYS::STRERROR, &optional error_code) {
5838 int error_code;
5839 if (missingp(STACK_0)) {
5840 /* errno access must be guarded with begin/end_system_call */
5841 begin_system_call();
5842 error_code = errno;
5843 end_system_call();
5844 } else error_code = check_errno(STACK_0);
5845 STACK_0 = L_to_I(error_code);
5846 funcall(L(strerror),1);
5847 }
5848
5849 /* ========================= wildcard matching ========================= */
5850 DEFFLAGSET(fnm_flags, !FNM_CASEFOLD FNM_PATHNAME FNM_PERIOD FNM_NOESCAPE)
5851 DEFUN(POSIX:FNMATCH, pattern string &key \
5852 :CASE-SENSITIVE PATHNAME PERIOD NOESCAPE) {
5853 int flags = fnm_flags();
5854 STACK_0 = check_string(STACK_0);
5855 STACK_1 = check_string(STACK_1);
5856 with_string_0(STACK_0,GLO(misc_encoding),stringz, {
5857 with_string_0(STACK_1,GLO(misc_encoding),patternz, {
5858 begin_system_call();
5859 flags = fnmatch(patternz,stringz,flags);
5860 end_system_call();
5861 });
5862 });
5863 switch (flags) {
5864 case 0: VALUES1(T); break;
5865 case FNM_NOMATCH: VALUES1(NIL); break;
5866 default: pushSTACK(fixnum(flags));
5867 error(error_condition,GETTEXT("fnmatch: error ~S"));
5868 }
5869 skipSTACK(2);
5870 }
5871
5872 #if defined(DEBUG_SPVW)
5873 /* internal playground - see spvd.d & spvw_debug.d */
5874 extern unsigned int get_constsym_count (void);
5875 extern object get_constsym (unsigned int);
5876 DEFUN(CONSTSYM, &optional pos) {
5877 VALUES1(missingp(STACK_0) ? fixnum(get_constsym_count())
5878 : get_constsym(I_to_uint(check_uint(STACK_0))));
5879 skipSTACK(1);
5880 }
5881 #endif
5882
5883 void module__syscalls__init_function_2 (module_t* module);
module__syscalls__init_function_2(module_t * module)5884 void module__syscalls__init_function_2 (module_t* module) {
5885 module__syscalls__init_function_2__modprep(module);
5886 #if defined(WIN32_NATIVE)
5887 init_win32_link();
5888 #endif
5889 #if defined(WIN32_NATIVE) || defined(UNIX_CYGWIN)
5890 init_win32_cygwin_open_storage();
5891 #endif
5892 #if defined(HAVE_FFI)
5893 init_stdio();
5894 #endif
5895 /* The getdate() functions needs some configuration file, and the DATEMSK
5896 environment variable is supposed to point to it. See
5897 <http://pubs.opengroup.org/onlinepubs/9699919799/functions/getdate.html>.
5898 We ship such a configuration file. Here we set the DATEMSK environment
5899 variable if the user has not already set it. */
5900 { char* envval = getenv("DATEMSK");
5901 if (envval == NULL || envval[0] == '\0') {
5902 with_string_0(physical_namestring(GLO(lib_dir)),GLO(pathname_encoding),libdir_asciz, {
5903 const char* part1 = libdir_asciz;
5904 const char* part2 = "syscalls/datemsk";
5905 /* Concatenate these two parts. */
5906 size_t part1_len = asciz_length(part1);
5907 size_t part2_len = asciz_length(part2);
5908 DYNAMIC_ARRAY(datemsk_filename,char,part1_len+1+part2_len+1);
5909 { char* p = datemsk_filename;
5910 memcpy(p,part1,part1_len); p += part1_len;
5911 if (!(part1_len > 0 && part1[part1_len-1] == '/')) { *p++ = '/'; }
5912 memcpy(p,part2,part2_len); p += part2_len;
5913 *p = '\0';
5914 }
5915 setenv("DATEMSK",datemsk_filename,1);
5916 FREE_DYNAMIC_ARRAY(datemsk_filename);
5917 });
5918 }
5919 }
5920 }
5921