X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fruntime%2Fwrap.c;h=7c88568cc67d1136e14aedbdbedf69131a773b60;hb=4ba392170e98744f0ef0b8e08a5d42b988f1d0c9;hp=a3d88810df6cf8468a68a872473960e24a36ffc6;hpb=b48a0ada03337a26f59744ed1df794b21420ea90;p=sbcl.git diff --git a/src/runtime/wrap.c b/src/runtime/wrap.c index a3d8881..7c88568 100644 --- a/src/runtime/wrap.c +++ b/src/runtime/wrap.c @@ -1,6 +1,6 @@ /* * wrappers around low-level operations to provide a simpler interface - * to the operations that Lisp needs + * to the operations that Lisp (and some contributed modules) needs. * * The functions in this file are typically called directly from Lisp. * Thus, when their signature changes, they don't need updates in a .h @@ -23,99 +23,53 @@ * files for more information. */ +#include "sbcl.h" + #include #include #include #include #include +#include #include +#include +#include +#include + +#ifndef LISP_FEATURE_WIN32 #include +#include +#include +#include +#include +#endif #include +#if defined(LISP_FEATURE_WIN32) +#define WIN32_LEAN_AND_MEAN +#include +#endif + #include "runtime.h" -#include "sbcl.h" #include "util.h" +#include "wrap.h" -/* KLUDGE: Neither the OpenBSD nor the Linux man page give a header - * file to find this in (?). -- WHN 2002-02-07 */ +/* Although it might seem as though this should be in some standard + Unix header, according to Perry E. Metzger, in a message on + sbcl-devel dated 2004-03-29, this is the POSIXly-correct way of + using environ: by an explicit declaration. -- CSR, 2004-03-30 */ extern char **environ; - + /* * stuff needed by CL:DIRECTORY and other Lisp directory operations */ -/* Unix directory operations think of "." and ".." as filenames, but - * Lisp directory operations do not. */ -int -is_lispy_filename(const char *filename) -{ - return strcmp(filename, ".") && strcmp(filename, ".."); -} - -/* Return a zero-terminated array of strings holding the Lispy filenames - * (i.e. excluding the Unix magic "." and "..") in the named directory. */ -char** -alloc_directory_lispy_filenames(const char *directory_name) -{ - DIR *dir_ptr = opendir(directory_name); - char **result = 0; - - if (dir_ptr) { /* if opendir success */ - - struct voidacc va; - - if (0 == voidacc_ctor(&va)) { /* if voidacc_ctor success */ - struct dirent *dirent_ptr; - - while ( (dirent_ptr = readdir(dir_ptr)) ) { /* until end of data */ - char* original_name = dirent_ptr->d_name; - if (is_lispy_filename(original_name)) { - /* strdup(3) is in Linux and *BSD. If you port - * somewhere else that doesn't have it, it's easy - * to reimplement. */ - char* dup_name = strdup(original_name); - if (!dup_name) { /* if strdup failure */ - goto dtors; - } - if (voidacc_acc(&va, dup_name)) { /* if acc failure */ - goto dtors; - } - } - } - result = (char**)voidacc_give_away_result(&va); - } - - dtors: - voidacc_dtor(&va); - /* ignoring closedir(3) return code, since what could we do? - * - * "Never ask questions you don't want to know the answer to." - * -- William Irving Zumwalt (Rich Cook, _The Wizardry Quested_) */ - closedir(dir_ptr); - } - - return result; -} - -/* Free a result returned by alloc_directory_lispy_filenames(). */ -void -free_directory_lispy_filenames(char** directory_lispy_filenames) -{ - char** p; - - /* Free the strings. */ - for (p = directory_lispy_filenames; *p; ++p) { - free(*p); - } - - /* Free the table of strings. */ - free(directory_lispy_filenames); -} /* * readlink(2) stuff */ +#ifndef LISP_FEATURE_WIN32 /* a wrapped version of readlink(2): * -- If path isn't a symlink, or is a broken symlink, return 0. * -- If path is a symlink, return a newly allocated string holding @@ -125,76 +79,116 @@ wrapped_readlink(char *path) { int bufsiz = strlen(path) + 16; while (1) { - char *result = malloc(bufsiz); - int n_read = readlink(path, result, bufsiz); - if (n_read < 0) { - free(result); - return 0; - } else if (n_read < bufsiz) { - result[n_read] = 0; - return result; - } else { - free(result); - bufsiz *= 2; - } + char *result = malloc(bufsiz); + int n_read = readlink(path, result, bufsiz); + if (n_read < 0) { + free(result); + return 0; + } else if (n_read < bufsiz) { + result[n_read] = 0; + return result; + } else { + free(result); + bufsiz *= 2; + } } } +#endif /* - * stat(2) stuff + * realpath(3), including a wrapper for Windows. */ +char * sb_realpath (char *path) +{ +#ifndef LISP_FEATURE_WIN32 + char *ret; + int errnum; + + if ((ret = calloc(PATH_MAX, sizeof(char))) == NULL) + return NULL; + if (realpath(path, ret) == NULL) { + errnum = errno; + free(ret); + errno = errnum; + return NULL; + } + return(ret); +#else + char *ret; + char *cp; + int errnum; -/* As of 0.6.12, the FFI can't handle 64-bit values. For now, we use - * these munged-to-32-bits values for might-be-64-bit slots of - * stat_wrapper as a workaround, so that at least we can still work - * when values are small. + if ((ret = calloc(MAX_PATH, sizeof(char))) == NULL) + return NULL; + if (GetFullPathName(path, MAX_PATH, ret, &cp) == 0) { + errnum = errno; + free(ret); + errno = errnum; + return NULL; + } + return(ret); +#endif +} + +/* readdir, closedir, and dirent name accessor. The first three are not strictly + * necessary, but should save us some #!+netbsd in the build, and this also allows + * building Windows versions using the non-ANSI variants of FindFirstFile &co + * under the same API. (Use a structure that appends the handle to the WIN32_FIND_DATA + * as the return value from sb_opendir, on sb_readdir grab the name from the previous + * call and save the new one.) Nikodemus thought he would have to do that to support + * DIRECTORY on UNC paths, but turns out opendir &co do TRT on Windows already -- so + * leaving that bit of tedium for a later date, once we figure out the whole *A vs. *W + * issue out properly. ...FIXME, obviously, as per above. * - * FIXME: But of course we should fix the FFI so that we can use the - * actual 64-bit values instead. */ -typedef long ffi_dev_t; /* since Linux dev_t can be 64 bits */ -typedef u32 ffi_off_t; /* since OpenBSD 2.8 st_size is 64 bits */ - -/* a representation of stat(2) results which doesn't depend on CPU or OS */ -struct stat_wrapper { - /* KLUDGE: The verbose wrapped_st_ prefixes are to protect us from - * the C preprocessor as wielded by the fiends of OpenBSD, who do - * things like - * #define st_atime st_atimespec.tv_sec - * I remember when I was young and innocent, I read about how the - * C preprocessor isn't to be used to globally munge random - * lowercase symbols like this, because things like this could - * happen, and I nodded sagely. But now I know better.:-| This is - * another entry for Dan Barlow's ongoing episodic rant about C - * header files, I guess.. -- WHN 2001-05-10 */ - ffi_dev_t wrapped_st_dev; /* device */ - ino_t wrapped_st_ino; /* inode */ - mode_t wrapped_st_mode; /* protection */ - nlink_t wrapped_st_nlink; /* number of hard links */ - uid_t wrapped_st_uid; /* user ID of owner */ - gid_t wrapped_st_gid; /* group ID of owner */ - ffi_dev_t wrapped_st_rdev; /* device type (if inode device) */ - ffi_off_t wrapped_st_size; /* total size, in bytes */ - unsigned long wrapped_st_blksize; /* blocksize for filesystem I/O */ - unsigned long wrapped_st_blocks; /* number of blocks allocated */ - time_t wrapped_st_atime; /* time_t of last access */ - time_t wrapped_st_mtime; /* time_t of last modification */ - time_t wrapped_st_ctime; /* time_t of last change */ -}; - -static void + * Once that is done, the lisp side functions are best named OS-OPENDIR, etc. + */ +extern DIR * +sb_opendir(char * name) +{ + return opendir(name); +} + +extern struct dirent * +sb_readdir(DIR * dirp) +{ + return readdir(dirp); +} + +extern int +sb_closedir(DIR * dirp) +{ + return closedir(dirp); +} + +extern char * +sb_dirent_name(struct dirent * ent) +{ + return ent->d_name; +} + +/* + * stat(2) stuff + */ + +static void copy_to_stat_wrapper(struct stat_wrapper *to, struct stat *from) { #define FROB(stem) to->wrapped_st_##stem = from->st_##stem +#ifndef LISP_FEATURE_WIN32 +#define FROB2(stem) to->wrapped_st_##stem = from->st_##stem +#else +#define FROB2(stem) to->wrapped_st_##stem = 0; +#endif FROB(dev); - FROB(ino); + FROB2(ino); FROB(mode); FROB(nlink); - FROB(uid); - FROB(gid); + FROB2(uid); + FROB2(gid); FROB(rdev); FROB(size); - FROB(blksize); - FROB(blocks); + FROB2(blksize); + FROB2(blocks); FROB(atime); FROB(mtime); FROB(ctime); @@ -206,20 +200,49 @@ stat_wrapper(const char *file_name, struct stat_wrapper *buf) { struct stat real_buf; int ret; + +#ifdef LISP_FEATURE_WIN32 + /* + * Windows won't match the last component of a pathname if there + * is a trailing #\/ or #\\, except if it's :\ or :/ + * in which case it behaves the other way around. So we remove the + * trailing directory separator unless we are being passed just a + * drive name (e.g. "c:\\"). Some, but not all, of this + * strangeness is documented at Microsoft's support site (as of + * 2006-01-08, at + * ) + */ + char file_buf[MAX_PATH]; + strcpy(file_buf, file_name); + int len = strlen(file_name); + if (len != 0 && (file_name[len-1] == '/' || file_name[len-1] == '\\') && + !(len == 3 && file_name[1] == ':' && isalpha(file_name[0]))) + file_buf[len-1] = '\0'; + file_name = file_buf; +#endif + if ((ret = stat(file_name,&real_buf)) >= 0) - copy_to_stat_wrapper(buf, &real_buf); + copy_to_stat_wrapper(buf, &real_buf); return ret; } +#ifndef LISP_FEATURE_WIN32 int lstat_wrapper(const char *file_name, struct stat_wrapper *buf) { struct stat real_buf; int ret; - if ((ret = lstat(file_name,&real_buf)) >= 0) - copy_to_stat_wrapper(buf, &real_buf); + if ((ret = lstat(file_name,&real_buf)) >= 0) + copy_to_stat_wrapper(buf, &real_buf); return ret; } +#else +/* cleaner to do it here than in Lisp */ +int lstat_wrapper(const char *file_name, struct stat_wrapper *buf) +{ + return stat_wrapper(file_name, buf); +} +#endif int fstat_wrapper(int filedes, struct stat_wrapper *buf) @@ -227,14 +250,54 @@ fstat_wrapper(int filedes, struct stat_wrapper *buf) struct stat real_buf; int ret; if ((ret = fstat(filedes,&real_buf)) >= 0) - copy_to_stat_wrapper(buf, &real_buf); + copy_to_stat_wrapper(buf, &real_buf); return ret; } +/* A wrapper for mkstemp(3), for two reasons: (1) mkstemp does not + exist on Windows; (2) by passing down a mode_t, we don't need a + binding to chmod in SB-UNIX, and need not concern ourselves with + umask issues if we want to use mkstemp to make new files in + OPEN. */ +int sb_mkstemp (char *template, mode_t mode) { +#ifdef LISP_FEATURE_WIN32 +#define PATHNAME_BUFFER_SIZE MAX_PATH +#define MKTEMP _mktemp +#else +#define PATHNAME_BUFFER_SIZE PATH_MAX +#define MKTEMP mktemp +#endif + int fd; + char buf[PATHNAME_BUFFER_SIZE]; + + while (1) { + /* Fruit fallen from the tree: for people who like + microoptimizations, we might not need to copy the whole + template on every loop, but only the last several characters. + But I didn't feel like testing the boundary cases in Windows's + _mktemp. */ + strncpy(buf, template, PATHNAME_BUFFER_SIZE); + buf[PATHNAME_BUFFER_SIZE-1]=0; /* force NULL-termination */ + if (MKTEMP(buf)) { + if ((fd=open(buf, O_CREAT|O_EXCL|O_RDWR, mode))!=-1) { + strcpy(template, buf); + return (fd); + } else + if (errno != EEXIST) + return (-1); + } else + return (-1); + } +#undef MKTEMP +#undef PATHNAME_BUFFER_SIZE +} + + /* * getpwuid() stuff */ +#ifndef LISP_FEATURE_WIN32 /* Return a newly-allocated string holding the username for "uid", or * NULL if there's no such user. * @@ -246,41 +309,53 @@ uid_username(int uid) { struct passwd *p = getpwuid(uid); if (p) { - /* The object *p is a static struct which'll be overwritten by - * the next call to getpwuid(), so it'd be unsafe to return - * p->pw_name without copying. */ - return strdup(p->pw_name); + /* The object *p is a static struct which'll be overwritten by + * the next call to getpwuid(), so it'd be unsafe to return + * p->pw_name without copying. */ + return strdup(p->pw_name); } else { - return 0; + return 0; } } char * -uid_homedir(uid_t uid) +passwd_homedir(struct passwd *p) { - struct passwd *p = getpwuid(uid); - if(p) { - /* Let's be careful about this, shall we? */ - size_t len = strlen(p->pw_dir); - if (p->pw_dir[len-1] == '/') { - return strdup(p->pw_dir); - } else { - char *result = malloc(len + 2); - if (result) { - int nchars = sprintf(result,"%s/",p->pw_dir); - if (nchars == len + 1) { - return result; - } else { - return 0; - } - } else { - return 0; - } - } + if (p) { + /* Let's be careful about this, shall we? */ + size_t len = strlen(p->pw_dir); + if (p->pw_dir[len-1] == '/') { + return strdup(p->pw_dir); + } else { + char *result = malloc(len + 2); + if (result) { + unsigned int nchars = sprintf(result,"%s/",p->pw_dir); + if (nchars == len + 1) { + return result; + } else { + return 0; + } + } else { + return 0; + } + } } else { - return 0; + return 0; } } + +char * +user_homedir(char *name) +{ + return passwd_homedir(getpwnam(name)); +} + +char * +uid_homedir(uid_t uid) +{ + return passwd_homedir(getpwuid(uid)); +} +#endif /* !LISP_FEATURE_WIN32 */ /* * functions to get miscellaneous C-level variables @@ -295,3 +370,181 @@ wrapped_environ() { return environ; } + +#ifdef LISP_FEATURE_WIN32 +#include +#include +/* + * faked-up implementation of select(). Right now just enough to get through + * second genesis. + */ +int sb_select(int top_fd, DWORD *read_set, DWORD *write_set, DWORD *except_set, time_t *timeout) +{ + /* + * FIXME: Going forward, we may want to use MsgWaitForMultipleObjects + * in order to support a windows message loop inside serve-event. + */ + HANDLE handles[MAXIMUM_WAIT_OBJECTS]; + int fds[MAXIMUM_WAIT_OBJECTS]; + int num_handles; + int i; + DWORD retval; + int polling_write; + DWORD win_timeout; + + num_handles = 0; + polling_write = 0; + for (i = 0; i < top_fd; i++) { + if (except_set) except_set[i >> 5] = 0; + if (write_set && (write_set[i >> 5] & (1 << (i & 31)))) polling_write = 1; + if (read_set[i >> 5] & (1 << (i & 31))) { + read_set[i >> 5] &= ~(1 << (i & 31)); + fds[num_handles] = i; + handles[num_handles++] = (HANDLE) _get_osfhandle(i); + } + } + + win_timeout = INFINITE; + if (timeout) win_timeout = (timeout[0] * 1000) + timeout[1]; + + /* Last parameter here is timeout in milliseconds. */ + /* retval = WaitForMultipleObjects(num_handles, handles, 0, INFINITE); */ + retval = WaitForMultipleObjects(num_handles, handles, 0, win_timeout); + + if (retval < WAIT_ABANDONED) { + /* retval, at this point, is the index of the single live HANDLE/fd. */ + read_set[fds[retval] >> 5] |= (1 << (fds[retval] & 31)); + return 1; + } + return polling_write; +} + +/* + * Windows doesn't have gettimeofday(), and we need it for the compiler, + * for serve-event, and for a couple other things. We don't need a timezone + * yet, however, and the closest we can easily get to a timeval is the + * seconds part. So that's what we do. + */ +#define UNIX_EPOCH_FILETIME 116444736000000000ULL + +int sb_gettimeofday(long *timeval, long *timezone) +{ + FILETIME ft; + ULARGE_INTEGER uft; + GetSystemTimeAsFileTime(&ft); + uft.LowPart = ft.dwLowDateTime; + uft.HighPart = ft.dwHighDateTime; + uft.QuadPart -= UNIX_EPOCH_FILETIME; + timeval[0] = uft.QuadPart / 10000000; + timeval[1] = (uft.QuadPart % 10000000)/10; + + return 0; +} +#endif + + +/* We will need to define these things or their equivalents for Win32 + eventually, but for now let's get it working for everyone else. */ +#ifndef LISP_FEATURE_WIN32 +/* From SB-BSD-SOCKETS, to get h_errno */ +int get_h_errno() +{ + return h_errno; +} + +/* From SB-POSIX, wait-macros */ +int wifexited(int status) { + return WIFEXITED(status); +} +int wexitstatus(int status) { + return WEXITSTATUS(status); +} +int wifsignaled(int status) { + return WIFSIGNALED(status); +} +int wtermsig(int status) { + return WTERMSIG(status); +} +int wifstopped(int status) { + return WIFSTOPPED(status); +} +int wstopsig(int status) { + return WSTOPSIG(status); +} +/* FIXME: POSIX also defines WIFCONTINUED, but that appears not to + exist on at least Linux... */ +#endif /* !LISP_FEATURE_WIN32 */ + +/* From SB-POSIX, stat-macros */ +int s_isreg(mode_t mode) +{ + return S_ISREG(mode); +} +int s_isdir(mode_t mode) +{ + return S_ISDIR(mode); +} +int s_ischr(mode_t mode) +{ + return S_ISCHR(mode); +} +int s_isblk(mode_t mode) +{ + return S_ISBLK(mode); +} +int s_isfifo(mode_t mode) +{ + return S_ISFIFO(mode); +} +#ifndef LISP_FEATURE_WIN32 +int s_islnk(mode_t mode) +{ +#ifdef S_ISLNK + return S_ISLNK(mode); +#else + return ((mode & S_IFMT) == S_IFLNK); +#endif +} +int s_issock(mode_t mode) +{ +#ifdef S_ISSOCK + return S_ISSOCK(mode); +#else + return ((mode & S_IFMT) == S_IFSOCK); +#endif +} +#endif /* !LISP_FEATURE_WIN32 */ + +#ifndef LISP_FEATURE_WIN32 +int sb_getrusage(int who, struct rusage *rusage) +{ + return getrusage(who, rusage); +} + +int sb_gettimeofday(struct timeval *tp, void *tzp) +{ + return gettimeofday(tp, tzp); +} + +int sb_nanosleep(struct timespec *rqtp, struct timespec *rmtp) +{ + return nanosleep(rqtp, rmtp); +} + +int sb_select(int nfds, fd_set *readfds, fd_set *writefds, fd_set *exceptfds, + struct timeval *timeout) +{ + return select(nfds, readfds, writefds, exceptfds, timeout); +} + +int sb_getitimer(int which, struct itimerval *value) +{ + return getitimer(which, value); +} + +int sb_setitimer(int which, struct itimerval *value, struct itimerval *ovalue) +{ + return setitimer(which, value, ovalue); +} +#endif /* !LISP_FEATURE_WIN32 */ +