Preliminary work towards threads on win32
[sbcl.git] / src / runtime / wrap.c
1 /*
2  * wrappers around low-level operations to provide a simpler interface
3  * to the operations that Lisp (and some contributed modules) needs.
4  *
5  * The functions in this file are typically called directly from Lisp.
6  * Thus, when their signature changes, they don't need updates in a .h
7  * file somewhere, but they do need updates in the Lisp code. FIXME:
8  * It would be nice to enforce this at compile time. It mighn't even
9  * be all that hard: make the cross-compiler versions of DEFINE-ALIEN-FOO
10  * macros accumulate strings in a list which then gets written out at
11  * the end of sbcl2.h at the end of cross-compilation, then rerun
12  * 'make' in src/runtime/ using the new sbcl2.h as sbcl.h (and make
13  * sure that all the files in src/runtime/ include sbcl.h). */
14
15 /*
16  * This software is part of the SBCL system. See the README file for
17  * more information.
18  *
19  * This software is derived from the CMU CL system, which was
20  * written at Carnegie Mellon University and released into the
21  * public domain. The software is in the public domain and is
22  * provided with absolutely no warranty. See the COPYING and CREDITS
23  * files for more information.
24  */
25
26 #include "sbcl.h"
27
28 #include <sys/types.h>
29 #include <dirent.h>
30 #include <sys/stat.h>
31 #include <stdlib.h>
32 #include <string.h>
33 #include <ctype.h>
34 #include <unistd.h>
35 #include <errno.h>
36 #include <limits.h>
37 #include <fcntl.h>
38
39 #ifndef LISP_FEATURE_WIN32
40 #include <pwd.h>
41 #include <sys/wait.h>
42 #include <netdb.h>
43 #endif
44 #include <stdio.h>
45
46 #if defined(LISP_FEATURE_WIN32)
47 #define WIN32_LEAN_AND_MEAN
48 #include <errno.h>
49 #endif
50
51 #include "runtime.h"
52 #include "util.h"
53 #include "wrap.h"
54
55 /* Although it might seem as though this should be in some standard
56    Unix header, according to Perry E. Metzger, in a message on
57    sbcl-devel dated 2004-03-29, this is the POSIXly-correct way of
58    using environ: by an explicit declaration.  -- CSR, 2004-03-30 */
59 extern char **environ;
60 \f
61 /*
62  * stuff needed by CL:DIRECTORY and other Lisp directory operations
63  */
64
65 \f
66 /*
67  * readlink(2) stuff
68  */
69
70 #ifndef LISP_FEATURE_WIN32
71 /* a wrapped version of readlink(2):
72  *   -- If path isn't a symlink, or is a broken symlink, return 0.
73  *   -- If path is a symlink, return a newly allocated string holding
74  *      the thing it's linked to. */
75 char *
76 wrapped_readlink(char *path)
77 {
78     int bufsiz = strlen(path) + 16;
79     while (1) {
80         char *result = malloc(bufsiz);
81         int n_read = readlink(path, result, bufsiz);
82         if (n_read < 0) {
83             free(result);
84             return 0;
85         } else if (n_read < bufsiz) {
86             result[n_read] = 0;
87             return result;
88         } else {
89             free(result);
90             bufsiz *= 2;
91         }
92     }
93 }
94 #endif
95 \f
96 /*
97  * realpath(3), including a wrapper for Windows.
98  */
99 char * sb_realpath (char *path)
100 {
101 #ifndef LISP_FEATURE_WIN32
102     char *ret;
103     int errnum;
104
105     if ((ret = calloc(PATH_MAX, sizeof(char))) == NULL)
106         return NULL;
107     if (realpath(path, ret) == NULL) {
108         errnum = errno;
109         free(ret);
110         errno = errnum;
111         return NULL;
112     }
113     return(ret);
114 #else
115     char *ret;
116     char *cp;
117     int errnum;
118
119     if ((ret = calloc(MAX_PATH, sizeof(char))) == NULL)
120         return NULL;
121     if (GetFullPathName(path, MAX_PATH, ret, &cp) == 0) {
122         errnum = errno;
123         free(ret);
124         errno = errnum;
125         return NULL;
126     }
127     return(ret);
128 #endif
129 }
130 \f
131 /* readdir, closedir, and dirent name accessor. The first three are not strictly
132  * necessary, but should save us some #!+netbsd in the build, and this also allows
133  * building Windows versions using the non-ANSI variants of FindFirstFile &co
134  * under the same API. (Use a structure that appends the handle to the WIN32_FIND_DATA
135  * as the return value from sb_opendir, on sb_readdir grab the name from the previous
136  * call and save the new one.) Nikodemus thought he would have to do that to support
137  * DIRECTORY on UNC paths, but turns out opendir &co do TRT on Windows already -- so
138  * leaving that bit of tedium for a later date, once we figure out the whole *A vs. *W
139  * issue out properly. ...FIXME, obviously, as per above.
140  *
141  * Once that is done, the lisp side functions are best named OS-OPENDIR, etc.
142  */
143 extern DIR *
144 sb_opendir(char * name)
145 {
146     return opendir(name);
147 }
148
149 extern struct dirent *
150 sb_readdir(DIR * dirp)
151 {
152     return readdir(dirp);
153 }
154
155 extern int
156 sb_closedir(DIR * dirp)
157 {
158     return closedir(dirp);
159 }
160
161 extern char *
162 sb_dirent_name(struct dirent * ent)
163 {
164     return ent->d_name;
165 }
166 \f
167 /*
168  * stat(2) stuff
169  */
170
171 static void
172 copy_to_stat_wrapper(struct stat_wrapper *to, struct stat *from)
173 {
174 #define FROB(stem) to->wrapped_st_##stem = from->st_##stem
175 #ifndef LISP_FEATURE_WIN32
176 #define FROB2(stem) to->wrapped_st_##stem = from->st_##stem
177 #else
178 #define FROB2(stem) to->wrapped_st_##stem = 0;
179 #endif
180     FROB(dev);
181     FROB2(ino);
182     FROB(mode);
183     FROB(nlink);
184     FROB2(uid);
185     FROB2(gid);
186     FROB(rdev);
187     FROB(size);
188     FROB2(blksize);
189     FROB2(blocks);
190     FROB(atime);
191     FROB(mtime);
192     FROB(ctime);
193 #undef FROB
194 }
195
196 int
197 stat_wrapper(const char *file_name, struct stat_wrapper *buf)
198 {
199     struct stat real_buf;
200     int ret;
201
202 #ifdef LISP_FEATURE_WIN32
203     /*
204      * Windows won't match the last component of a pathname if there
205      * is a trailing #\/ or #\\, except if it's <drive>:\ or <drive>:/
206      * in which case it behaves the other way around. So we remove the
207      * trailing directory separator unless we are being passed just a
208      * drive name (e.g. "c:\\").  Some, but not all, of this
209      * strangeness is documented at Microsoft's support site (as of
210      * 2006-01-08, at
211      * <http://support.microsoft.com/default.aspx?scid=kb;en-us;168439>)
212      */
213     char file_buf[MAX_PATH];
214     strcpy(file_buf, file_name);
215     int len = strlen(file_name);
216     if (len != 0 && (file_name[len-1] == '/' || file_name[len-1] == '\\') &&
217         !(len == 3 && file_name[1] == ':' && isalpha(file_name[0])))
218         file_buf[len-1] = '\0';
219     file_name = file_buf;
220 #endif
221
222     if ((ret = stat(file_name,&real_buf)) >= 0)
223         copy_to_stat_wrapper(buf, &real_buf);
224     return ret;
225 }
226
227 #ifndef LISP_FEATURE_WIN32
228 int
229 lstat_wrapper(const char *file_name, struct stat_wrapper *buf)
230 {
231     struct stat real_buf;
232     int ret;
233     if ((ret = lstat(file_name,&real_buf)) >= 0)
234         copy_to_stat_wrapper(buf, &real_buf);
235     return ret;
236 }
237 #else
238 /* cleaner to do it here than in Lisp */
239 int lstat_wrapper(const char *file_name, struct stat_wrapper *buf)
240 {
241     return stat_wrapper(file_name, buf);
242 }
243 #endif
244
245 int
246 fstat_wrapper(int filedes, struct stat_wrapper *buf)
247 {
248     struct stat real_buf;
249     int ret;
250     if ((ret = fstat(filedes,&real_buf)) >= 0)
251         copy_to_stat_wrapper(buf, &real_buf);
252     return ret;
253 }
254 \f
255 /* A wrapper for mkstemp(3), for two reasons: (1) mkstemp does not
256    exist on Windows; (2) by passing down a mode_t, we don't need a
257    binding to chmod in SB-UNIX, and need not concern ourselves with
258    umask issues if we want to use mkstemp to make new files in
259    OPEN. */
260 int sb_mkstemp (char *template, mode_t mode) {
261 #ifdef LISP_FEATURE_WIN32
262 #define PATHNAME_BUFFER_SIZE MAX_PATH
263 #define MKTEMP _mktemp
264 #else
265 #define PATHNAME_BUFFER_SIZE PATH_MAX
266 #define MKTEMP mktemp
267 #endif
268   int fd;
269   char buf[PATHNAME_BUFFER_SIZE];
270
271   while (1) {
272     /* Fruit fallen from the tree: for people who like
273        microoptimizations, we might not need to copy the whole
274        template on every loop, but only the last several characters.
275        But I didn't feel like testing the boundary cases in Windows's
276        _mktemp. */
277     strncpy(buf, template, PATHNAME_BUFFER_SIZE);
278     buf[PATHNAME_BUFFER_SIZE-1]=0; /* force NULL-termination */
279     if (MKTEMP(buf)) {
280       if ((fd=open(buf, O_CREAT|O_EXCL|O_RDWR, mode))!=-1) {
281         strcpy(template, buf);
282         return (fd);
283       } else
284         if (errno != EEXIST)
285           return (-1);
286     } else
287       return (-1);
288   }
289 #undef MKTEMP
290 #undef PATHNAME_BUFFER_SIZE
291 }
292
293 \f
294 /*
295  * getpwuid() stuff
296  */
297
298 #ifndef LISP_FEATURE_WIN32
299 /* Return a newly-allocated string holding the username for "uid", or
300  * NULL if there's no such user.
301  *
302  * KLUDGE: We also return NULL if malloc() runs out of memory
303  * (returning strdup() result) since it's not clear how to handle that
304  * error better. -- WHN 2001-12-28 */
305 char *
306 uid_username(int uid)
307 {
308     struct passwd *p = getpwuid(uid);
309     if (p) {
310         /* The object *p is a static struct which'll be overwritten by
311          * the next call to getpwuid(), so it'd be unsafe to return
312          * p->pw_name without copying. */
313         return strdup(p->pw_name);
314     } else {
315         return 0;
316     }
317 }
318
319 char *
320 passwd_homedir(struct passwd *p)
321 {
322     if (p) {
323         /* Let's be careful about this, shall we? */
324         size_t len = strlen(p->pw_dir);
325         if (p->pw_dir[len-1] == '/') {
326             return strdup(p->pw_dir);
327         } else {
328             char *result = malloc(len + 2);
329             if (result) {
330                 unsigned int nchars = sprintf(result,"%s/",p->pw_dir);
331                 if (nchars == len + 1) {
332                     return result;
333                 } else {
334                     return 0;
335                 }
336             } else {
337                 return 0;
338             }
339         }
340     } else {
341         return 0;
342     }
343 }
344
345 char *
346 user_homedir(char *name)
347 {
348     return passwd_homedir(getpwnam(name));
349 }
350
351 char *
352 uid_homedir(uid_t uid)
353 {
354     return passwd_homedir(getpwuid(uid));
355 }
356 #endif /* !LISP_FEATURE_WIN32 */
357 \f
358 /*
359  * functions to get miscellaneous C-level variables
360  *
361  * (Doing this by calling functions lets us borrow the smarts of the C
362  * linker, so that things don't blow up when libc versions and thus
363  * variable locations change between compile time and run time.)
364  */
365
366 char **
367 wrapped_environ()
368 {
369     return environ;
370 }
371
372 #ifdef LISP_FEATURE_WIN32
373 #include <windows.h>
374 #include <time.h>
375 /*
376  * faked-up implementation of select(). Right now just enough to get through
377  * second genesis.
378  */
379 int select(int top_fd, DWORD *read_set, DWORD *write_set, DWORD *except_set, time_t *timeout)
380 {
381     /*
382      * FIXME: Going forward, we may want to use MsgWaitForMultipleObjects
383      * in order to support a windows message loop inside serve-event.
384      */
385     HANDLE handles[MAXIMUM_WAIT_OBJECTS];
386     int fds[MAXIMUM_WAIT_OBJECTS];
387     int num_handles;
388     int i;
389     DWORD retval;
390     int polling_write;
391     DWORD win_timeout;
392
393     num_handles = 0;
394     polling_write = 0;
395     for (i = 0; i < top_fd; i++) {
396         if (except_set) except_set[i >> 5] = 0;
397         if (write_set && (write_set[i >> 5] & (1 << (i & 31)))) polling_write = 1;
398         if (read_set[i >> 5] & (1 << (i & 31))) {
399             read_set[i >> 5] &= ~(1 << (i & 31));
400             fds[num_handles] = i;
401             handles[num_handles++] = (HANDLE) _get_osfhandle(i);
402         }
403     }
404
405     win_timeout = INFINITE;
406     if (timeout) win_timeout = (timeout[0] * 1000) + timeout[1];
407
408     /* Last parameter here is timeout in milliseconds. */
409     /* retval = WaitForMultipleObjects(num_handles, handles, 0, INFINITE); */
410     retval = WaitForMultipleObjects(num_handles, handles, 0, win_timeout);
411
412     if (retval < WAIT_ABANDONED) {
413         /* retval, at this point, is the index of the single live HANDLE/fd. */
414         read_set[fds[retval] >> 5] |= (1 << (fds[retval] & 31));
415         return 1;
416     }
417     return polling_write;
418 }
419
420 /*
421  * Windows doesn't have gettimeofday(), and we need it for the compiler,
422  * for serve-event, and for a couple other things. We don't need a timezone
423  * yet, however, and the closest we can easily get to a timeval is the
424  * seconds part. So that's what we do.
425  */
426 #define UNIX_EPOCH_FILETIME 116444736000000000ULL
427
428 int gettimeofday(long *timeval, long *timezone)
429 {
430     FILETIME ft;
431     ULARGE_INTEGER uft;
432     GetSystemTimeAsFileTime(&ft);
433     uft.LowPart = ft.dwLowDateTime;
434     uft.HighPart = ft.dwHighDateTime;
435     uft.QuadPart -= UNIX_EPOCH_FILETIME;
436     timeval[0] = uft.QuadPart / 10000000;
437     timeval[1] = (uft.QuadPart % 10000000)/10;
438
439     return 0;
440 }
441 #endif
442
443
444 /* We will need to define these things or their equivalents for Win32
445    eventually, but for now let's get it working for everyone else. */
446 #ifndef LISP_FEATURE_WIN32
447 /* From SB-BSD-SOCKETS, to get h_errno */
448 int get_h_errno()
449 {
450     return h_errno;
451 }
452
453 /* From SB-POSIX, wait-macros */
454 int wifexited(int status) {
455     return WIFEXITED(status);
456 }
457 int wexitstatus(int status) {
458     return WEXITSTATUS(status);
459 }
460 int wifsignaled(int status) {
461     return WIFSIGNALED(status);
462 }
463 int wtermsig(int status) {
464     return WTERMSIG(status);
465 }
466 int wifstopped(int status) {
467     return WIFSTOPPED(status);
468 }
469 int wstopsig(int status) {
470     return WSTOPSIG(status);
471 }
472 /* FIXME: POSIX also defines WIFCONTINUED, but that appears not to
473    exist on at least Linux... */
474 #endif  /* !LISP_FEATURE_WIN32 */
475
476 /* From SB-POSIX, stat-macros */
477 int s_isreg(mode_t mode)
478 {
479     return S_ISREG(mode);
480 }
481 int s_isdir(mode_t mode)
482 {
483     return S_ISDIR(mode);
484 }
485 int s_ischr(mode_t mode)
486 {
487     return S_ISCHR(mode);
488 }
489 int s_isblk(mode_t mode)
490 {
491     return S_ISBLK(mode);
492 }
493 int s_isfifo(mode_t mode)
494 {
495     return S_ISFIFO(mode);
496 }
497 #ifndef LISP_FEATURE_WIN32
498 int s_islnk(mode_t mode)
499 {
500 #ifdef S_ISLNK
501     return S_ISLNK(mode);
502 #else
503     return ((mode & S_IFMT) == S_IFLNK);
504 #endif
505 }
506 int s_issock(mode_t mode)
507 {
508 #ifdef S_ISSOCK
509     return S_ISSOCK(mode);
510 #else
511     return ((mode & S_IFMT) == S_IFSOCK);
512 #endif
513 }
514 #endif /* !LISP_FEATURE_WIN32 */