/* Copyright 2010-2015 * Kaz Kylheku * Vancouver, Canada * All rights reserved. * * Redistribution of this software in source and binary forms, with or without * modification, is permitted provided that the following two conditions are met. * * Use of this software in any manner constitutes agreement with the disclaimer * which follows the two conditions. * * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in * the documentation and/or other materials provided with the * distribution. * * THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED * WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. IN NO EVENT SHALL THE * COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DAMAGES, HOWEVER CAUSED, * AND UNDER ANY THEORY OF LIABILITY, ARISING IN ANY WAY OUT OF THE USE OF THIS * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ #include #include #include #include #include #include #include #include #include #include "config.h" #if HAVE_UNISTD_H #include #endif #if HAVE_FCNTL_H #include #endif #if HAVE_SYS_WAIT #include #endif #if HAVE_SYS_STAT #include #endif #if HAVE_WINDOWS_H #include #endif #if HAVE_MAKEDEV #include #endif #if HAVE_POLL #include #endif #include "lib.h" #include "stream.h" #include "hash.h" #include "signal.h" #include "utf8.h" #include "unwind.h" #include "gc.h" #include "eval.h" #include "sysif.h" static val errno_wrap(val newval) { val oldval = num(errno); if (default_bool_arg(newval)) errno = c_num(newval); return oldval; } #if HAVE_DAEMON static val daemon_wrap(val nochdir, val noclose) { int result = daemon(nochdir ? 1 : 0, noclose ? 1 : 0); return result == 0 ? t : nil; } #endif static val exit_wrap(val status) { int stat; if (status == nil) stat = EXIT_FAILURE; else if (status == t) stat = EXIT_SUCCESS; else stat = c_num(status); exit(stat); /* notreached */ return nil; } static val abort_wrap(void) { abort(); } static val usleep_wrap(val usec) { val retval; cnum u = c_num(usec); sig_save_enable; #if HAVE_POSIX_NANOSLEEP struct timespec ts; ts.tv_sec = u / 1000000; ts.tv_nsec = (u % 1000000) * 1000; retval = if3(nanosleep(&ts, 0) == 0, t, nil); #elif HAVE_POSIX_SLEEP && HAVE_POSIX_USLEEP retval = if2(sleep(u / 1000000) == 0 && usleep(u % 1000000) == 0, t); #elif HAVE_WINDOWS_H Sleep(u / 1000); retval = t; #else #error port me! #endif sig_restore_enable; return retval; } #if HAVE_UNISTD_H static val getpid_wrap(void) { return num(getpid()); } #if HAVE_GETPPID static val getppid_wrap(void) { return num(getppid()); } #endif #endif static val env_hash(void) { val env_strings = env(); val hash = make_hash(nil, nil, t); for (; env_strings; env_strings = cdr(env_strings)) { cons_bind (key, val_cons, split_str(car(env_strings), lit("="))); sethash(hash, key, car(val_cons)); } return hash; } #if HAVE_MKDIR static val mkdir_wrap(val path, val mode) { char *u8path = utf8_dup_to(c_str(path)); int err = mkdir(u8path, c_num(default_arg(mode, num_fast(0777)))); free(u8path); if (err < 0) uw_throwf(file_error_s, lit("mkdir ~a: ~a/~s"), path, num(errno), string_utf8(strerror(errno)), nao); return t; } #elif HAVE_WINDOWS_H static val mkdir_wrap(val path, val mode) { int err = _wmkdir(c_str(path)); (void) mode; if (err < 0) uw_throwf(file_error_s, lit("mkdir ~a: ~a/~s"), path, num(errno), string_utf8(strerror(errno)), nao); return t; } #endif #if HAVE_MKDIR || HAVE_WINDOWS_H static val mkdir_nothrow_exists(val path, val mode) { val ret = t; uw_catch_begin(cons(file_error_s, nil), esym, eobj); ret = mkdir_wrap(path, mode); uw_catch (esym, eobj) { switch (errno) { case EACCES: case EPERM: ret = num(errno); break; case EEXIST: break; default: uw_throw(esym, eobj); } } uw_unwind; uw_catch_end; return ret; } static val ensure_dir(val path, val mode) { #if HAVE_WINDOWS_H val sep = lit("\\"); val sep_set = lit("\\/"); #else val sep = lit("/"); val sep_set = lit("/"); #endif val split_path = split_str_set(path, sep_set); val partial_path = pop(&split_path); val ret = t; for (;;) { if (length(partial_path) != zero) ret = mkdir_nothrow_exists(partial_path, mode); if (!split_path) break; partial_path = format(nil, lit("~a~a~a"), partial_path, sep, pop(&split_path), nao); } if (ret != t) uw_throwf(file_error_s, lit("ensure-dir: ~a: ~a/~s"), path, ret, string_utf8(strerror(c_num(ret))), nao); return ret; } #endif #if HAVE_UNISTD_H static val chdir_wrap(val path) { char *u8path = utf8_dup_to(c_str(path)); int err = chdir(u8path); free(u8path); if (err < 0) uw_throwf(file_error_s, lit("chdir ~a: ~a/~s"), path, num(errno), string_utf8(strerror(errno)), nao); return t; } static val getcwd_wrap(void) { size_t guess = 256; for (;;) { char *u8buf = coerce(char *, chk_malloc(guess)); if (getcwd(u8buf, guess) == 0) { free(u8buf); if (errno != ERANGE) { uw_throwf(file_error_s, lit("getcwd: ~a/~s"), num(errno), string_utf8(strerror(errno)), nao); } if (2 * guess > guess) guess *= 2; else uw_throwf(file_error_s, lit("getcwd: weird problem"), nao); } else { val out = string_utf8(u8buf); free(u8buf); return out; } } } #endif #if HAVE_MAKEDEV static val makedev_wrap(val major, val minor) { return num(makedev(c_num(major), c_num(minor))); } static val minor_wrap(val dev) { return num(minor(c_num(dev))); } static val major_wrap(val dev) { return num(major(c_num(dev))); } #endif #if HAVE_MKNOD static val mknod_wrap(val path, val mode, val dev) { char *u8path = utf8_dup_to(c_str(path)); int err = mknod(u8path, c_num(mode), c_num(default_arg(dev, zero))); free(u8path); if (err < 0) #if HAVE_MAKEDEV uw_throwf(file_error_s, lit("mknod ~a ~a ~a (~a:~a): ~a/~s"), path, mode, dev, major_wrap(dev), minor_wrap(dev), num(errno), string_utf8(strerror(errno)), nao); #else uw_throwf(file_error_s, lit("mknod ~a ~a ~a: ~a/~s"), path, mode, dev, num(errno), string_utf8(strerror(errno)), nao); #endif return t; } #endif #if HAVE_CHMOD static val chmod_wrap(val path, val mode) { char *u8path = utf8_dup_to(c_str(path)); int err = chmod(u8path, c_num(mode)); free(u8path); if (err < 0) uw_throwf(file_error_s, lit("chmod ~a ~a: ~a/~s"), path, mode, num(errno), string_utf8(strerror(errno)), nao); return t; } #endif #if HAVE_SYMLINK static val symlink_wrap(val target, val to) { char *u8target = utf8_dup_to(c_str(target)); char *u8to = utf8_dup_to(c_str(to)); int err = symlink(u8target, u8to); free(u8target); free(u8to); if (err < 0) uw_throwf(file_error_s, lit("symlink ~a ~a: ~a/~s"), target, to, num(errno), string_utf8(strerror(errno)), nao); return t; } static val link_wrap(val target, val to) { char *u8target = utf8_dup_to(c_str(target)); char *u8to = utf8_dup_to(c_str(to)); int err = link(u8target, u8to); free(u8target); free(u8to); if (err < 0) uw_throwf(file_error_s, lit("link ~a ~a: ~a/~s"), target, to, num(errno), string_utf8(strerror(errno)), nao); return t; } static val readlink_wrap(val path) { char *u8path = utf8_dup_to(c_str(path)); ssize_t guess = 256; for (;;) { char *u8buf = coerce(char *, chk_malloc(guess)); ssize_t bytes = readlink(u8path, u8buf, guess); if (bytes >= guess) { free(u8buf); if (2 * guess > guess) guess *= 2; else uw_throwf(file_error_s, lit("readlink: weird problem"), nao); } else if (bytes <= 0) { free(u8buf); uw_throwf(file_error_s, lit("readlink ~a: ~a/~s"), path, num(errno), string_utf8(strerror(errno)), nao); } else { val out; u8buf[bytes] = 0; out = string_utf8(u8buf); free(u8buf); return out; } } } #endif #if HAVE_FORK_STUFF static val fork_wrap(void) { pid_t pid = fork(); if (pid < 0) return nil; return num(pid); } static val wait_wrap(val pid, val flags) { cnum p = c_num(default_arg(pid, negone)); cnum f = c_num(default_arg(flags, zero)); int status = 0, result = waitpid(p, &status, f); return if2(result >= 0, cons(num(result), num(status))); } static val wifexited(val status) { int s = c_num(if3(consp(status), cdr(status), status)); return c_true(WIFEXITED(s)); } static val wexitstatus(val status) { int s = c_num(if3(consp(status), cdr(status), status)); return num(WEXITSTATUS(s)); } static val wifsignaled(val status) { int s = c_num(if3(consp(status), cdr(status), status)); return c_true(WIFSIGNALED(s)); } static val wtermsig(val status) { int s = c_num(if3(consp(status), cdr(status), status)); return num(WTERMSIG(s)); } #ifdef WCOREDUMP static val wcoredump(val status) { int s = c_num(if3(consp(status), cdr(status), status)); return c_true(WCOREDUMP(s)); } #endif static val wifstopped(val status) { int s = c_num(if3(consp(status), cdr(status), status)); return c_true(WIFSTOPPED(s)); } static val wstopsig(val status) { int s = c_num(if3(consp(status), cdr(status), status)); return num(WSTOPSIG(s)); } #ifdef WIFCONTINUED static val wifcontinued(val status) { int s = c_num(if3(consp(status), cdr(status), status)); return c_true(WIFCONTINUED(s)); } #endif static val dup_wrap(val old, val new) { if (missingp(new)) return num(dup(c_num(old))); return num(dup2(c_num(old), c_num(new))); } static val exec_wrap(val file, val args_opt) { val args = default_bool_arg(args_opt); int nargs = c_num(length(args)) + 1; char **argv = coerce(char **, chk_malloc((nargs + 1) * sizeof *argv)); val iter; int i; for (i = 0, iter = cons(file, args); iter; i++, iter = cdr(iter)) { val arg = car(iter); argv[i] = utf8_dup_to(c_str(arg)); } argv[i] = 0; if (execvp(argv[0], argv) < 0) uw_throwf(file_error_s, lit("execvp ~a: ~a/~s"), file, num(errno), string_utf8(strerror(errno)), nao); uw_throwf(file_error_s, lit("execvp ~a returned"), file, nao); } static val exit_star_wrap(val status) { int stat; if (status == nil) stat = EXIT_FAILURE; else if (status == t) stat = EXIT_SUCCESS; else stat = c_num(status); _exit(stat); /* notreached */ return nil; } #endif #if HAVE_SYS_STAT static int w_stat(const wchar_t *wpath, struct stat *buf) { char *path = utf8_dup_to(wpath); int res = stat(path, buf); free(path); return res; } #endif val statf(val path) { #if HAVE_SYS_STAT struct stat st; int res = w_stat(c_str(path), &st); if (res == -1) uw_throwf(file_error_s, lit("unable to stat ~a: ~a/~s"), path, num(errno), string_utf8(strerror(errno)), nao); return list(dev_k, num(st.st_dev), ino_k, num(st.st_ino), mode_k, num(st.st_mode), nlink_k, num(st.st_nlink), uid_k, num(st.st_uid), gid_k, num(st.st_gid), rdev_k, num(st.st_rdev), size_k, num(st.st_size), #if !HAVE_WINDOWS_H blksize_k, num(st.st_blksize), blocks_k, num(st.st_blocks), #else blksize_k, zero, blocks_k, zero, #endif atime_k, num(st.st_atime), mtime_k, num(st.st_mtime), ctime_k, num(st.st_ctime), nao); #else uw_throwf(file_error_s, lit("stat is not implemented"), nao); #endif } #if HAVE_PIPE static val pipe_wrap(void) { int fd[2]; if (pipe(fd) < 0) uw_throwf(file_error_s, lit("pipe failed: ~a/~s"), num(errno), string_utf8(strerror(errno)), nao); return cons(num(fd[0]), num(fd[1])); } #endif static val getenv_wrap(val name) { char *nameu8 = utf8_dup_to(c_str(name)); char *lookup = getenv(nameu8); val result = lookup ? string_utf8(lookup) : nil; free(nameu8); return result; } static val setenv_wrap(val name, val value, val overwrite) { char *nameu8 = utf8_dup_to(c_str(name)); char *valu8 = utf8_dup_to(c_str(value)); setenv(nameu8, valu8, default_arg(overwrite, t) != nil); free(valu8); free(nameu8); return value; } static val unsetenv_wrap(val name) { char *nameu8 = utf8_dup_to(c_str(name)); unsetenv(nameu8); free(nameu8); return name; } #if HAVE_POLL static val poll_wrap(val poll_list, val timeout_in) { nfds_t i, len = c_num(length(poll_list)); val iter; struct pollfd *pfd = convert(struct pollfd *, chk_calloc(len, sizeof *pfd)); val timeout = default_arg(timeout_in, negone); int res; for (i = 0, iter = poll_list; iter; iter = cdr(iter), i++) { cons_bind (obj, events, car(iter)); pfd[i].events = c_num(events); switch (type(obj)) { case NUM: pfd[i].fd = c_num(obj); break; case COBJ: if (obj->co.cls == stream_s) { val fdval = stream_get_prop(obj, fd_k); if (!fdval) { free(pfd); uw_throwf(file_error_s, lit("poll: stream ~s doesn't have a file descriptor"), obj, nao); } pfd[i].fd = c_num(fdval); break; } /* fallthrough */ default: free(pfd); uw_throwf(file_error_s, lit("poll: ~s isn't a stream or file descriptor"), obj, nao); break; } } res = poll(pfd, len, c_num(timeout)); if (res < 0) { free(pfd); uw_throwf(file_error_s, lit("poll failed: ~a/~s"), num(errno), string_utf8(strerror(errno)), nao); } if (res == 0) { free(pfd); return nil; } { list_collect_decl (out, ptail); for (i = 0, iter = poll_list; iter; iter = cdr(iter), i++) { val pair = car(iter); if (pfd[i].revents) ptail = list_collect(ptail, cons(car(pair), num(pfd[i].revents))); } free(pfd); return out; } } #endif void sysif_init(void) { reg_fun(intern(lit("errno"), user_package), func_n1o(errno_wrap, 0)); reg_fun(intern(lit("exit"), user_package), func_n1(exit_wrap)); reg_fun(intern(lit("abort"), user_package), func_n0(abort_wrap)); reg_fun(intern(lit("usleep"), user_package), func_n1(usleep_wrap)); #if HAVE_UNISTD_H reg_fun(intern(lit("getpid"), user_package), func_n0(getpid_wrap)); #if HAVE_GETPPID reg_fun(intern(lit("getppid"), user_package), func_n0(getppid_wrap)); #endif #endif reg_fun(intern(lit("env"), user_package), func_n0(env)); reg_fun(intern(lit("env-hash"), user_package), func_n0(env_hash)); #if HAVE_DAEMON reg_fun(intern(lit("daemon"), user_package), func_n2(daemon_wrap)); #endif #if HAVE_MKDIR || HAVE_WINDOWS_H reg_fun(intern(lit("mkdir"), user_package), func_n2o(mkdir_wrap, 1)); reg_fun(intern(lit("ensure-dir"), user_package), func_n2o(ensure_dir, 1)); #endif #if HAVE_UNISTD_H reg_fun(intern(lit("chdir"), user_package), func_n1(chdir_wrap)); reg_fun(intern(lit("pwd"), user_package), func_n0(getcwd_wrap)); #endif #if HAVE_MAKEDEV reg_fun(intern(lit("makedev"), user_package), func_n2(makedev_wrap)); reg_fun(intern(lit("minor"), user_package), func_n1(minor_wrap)); reg_fun(intern(lit("major"), user_package), func_n1(major_wrap)); #endif #if HAVE_MKNOD reg_fun(intern(lit("mknod"), user_package), func_n3(mknod_wrap)); #endif #if HAVE_CHMOD reg_fun(intern(lit("chmod"), user_package), func_n2(chmod_wrap)); #endif #if HAVE_SYMLINK reg_fun(intern(lit("symlink"), user_package), func_n2(symlink_wrap)); reg_fun(intern(lit("link"), user_package), func_n2(link_wrap)); reg_fun(intern(lit("readlink"), user_package), func_n1(readlink_wrap)); #endif reg_fun(intern(lit("stat"), user_package), func_n1(statf)); #if HAVE_SYS_STAT #ifndef S_IFSOCK #define S_IFSOCK 0 #endif #ifndef S_IFLNK #define S_IFLNK 0 #endif #ifndef S_ISUID #define S_ISUID 0 #endif #ifndef S_ISGID #define S_ISGID 0 #endif #ifndef S_ISVTX #define S_ISVTX 0 #endif #ifndef S_IRWXG #define S_IRWXG 0 #endif #ifndef S_IRGRP #define S_IRGRP 0 #endif #ifndef S_IWGRP #define S_IWGRP 0 #endif #ifndef S_IXGRP #define S_IXGRP 0 #endif #ifndef S_IRWXO #define S_IRWXO 0 #endif #ifndef S_IROTH #define S_IROTH 0 #endif #ifndef S_IWOTH #define S_IWOTH 0 #endif #ifndef S_IXOTH #define S_IXOTH 0 #endif reg_var(intern(lit("s-ifmt"), user_package), num_fast(S_IFMT)); reg_var(intern(lit("s-ifsock"), user_package), num_fast(S_IFSOCK)); reg_var(intern(lit("s-iflnk"), user_package), num_fast(S_IFLNK)); reg_var(intern(lit("s-ifreg"), user_package), num_fast(S_IFREG)); reg_var(intern(lit("s-ifblk"), user_package), num_fast(S_IFBLK)); reg_var(intern(lit("s-ifdir"), user_package), num_fast(S_IFDIR)); reg_var(intern(lit("s-ifchr"), user_package), num_fast(S_IFCHR)); reg_var(intern(lit("s-ififo"), user_package), num_fast(S_IFIFO)); reg_var(intern(lit("s-isuid"), user_package), num_fast(S_ISUID)); reg_var(intern(lit("s-isgid"), user_package), num_fast(S_ISGID)); reg_var(intern(lit("s-isvtx"), user_package), num_fast(S_ISVTX)); reg_var(intern(lit("s-irwxu"), user_package), num_fast(S_IRWXU)); reg_var(intern(lit("s-irusr"), user_package), num_fast(S_IRUSR)); reg_var(intern(lit("s-iwusr"), user_package), num_fast(S_IWUSR)); reg_var(intern(lit("s-ixusr"), user_package), num_fast(S_IXUSR)); reg_var(intern(lit("s-irwxg"), user_package), num_fast(S_IRWXG)); reg_var(intern(lit("s-irgrp"), user_package), num_fast(S_IRGRP)); reg_var(intern(lit("s-iwgrp"), user_package), num_fast(S_IWGRP)); reg_var(intern(lit("s-ixgrp"), user_package), num_fast(S_IXGRP)); reg_var(intern(lit("s-irwxo"), user_package), num_fast(S_IRWXO)); reg_var(intern(lit("s-iroth"), user_package), num_fast(S_IROTH)); reg_var(intern(lit("s-iwoth"), user_package), num_fast(S_IWOTH)); reg_var(intern(lit("s-ixoth"), user_package), num_fast(S_IXOTH)); #endif #if HAVE_POLL reg_var(intern(lit("poll-in"), user_package), num_fast(POLLIN)); reg_var(intern(lit("poll-out"), user_package), num_fast(POLLOUT)); reg_var(intern(lit("poll-err"), user_package), num_fast(POLLERR)); #ifdef POLLPRI reg_var(intern(lit("poll-pri"), user_package), num_fast(POLLPRI)); #endif #ifdef POLLRDHUP reg_var(intern(lit("poll-rdhup"), user_package), num_fast(POLLRDHUP)); #endif #ifdef POLLNVAL reg_var(intern(lit("poll-nval"), user_package), num_fast(POLLNVAL)); #endif #ifdef POLLRDBAND reg_var(intern(lit("poll-rdband"), user_package), num_fast(POLLRDBAND)); #endif #ifdef POLLWRBAND reg_var(intern(lit("poll-wrband"), user_package), num_fast(POLLWRBAND)); #endif #endif #if HAVE_FORK_STUFF reg_fun(intern(lit("fork"), user_package), func_n0(fork_wrap)); reg_fun(intern(lit("wait"), user_package), func_n2o(wait_wrap, 0)); reg_fun(intern(lit("exec"), user_package), func_n2o(exec_wrap, 1)); reg_fun(intern(lit("exit*"), user_package), func_n1(exit_star_wrap)); reg_fun(intern(lit("w-ifexited"), user_package), func_n1(wifexited)); reg_fun(intern(lit("w-exitstatus"), user_package), func_n1(wexitstatus)); reg_fun(intern(lit("w-ifsignaled"), user_package), func_n1(wifsignaled)); reg_fun(intern(lit("w-termsig"), user_package), func_n1(wtermsig)); #ifdef WCOREDUMP reg_fun(intern(lit("w-coredump"), user_package), func_n1(wcoredump)); #endif reg_fun(intern(lit("w-ifstopped"), user_package), func_n1(wifstopped)); reg_fun(intern(lit("w-stopsig"), user_package), func_n1(wstopsig)); #ifdef WIFCONTINUED reg_fun(intern(lit("w-ifcontinued"), user_package), func_n1(wifcontinued)); #endif #ifdef WNOHANG reg_var(intern(lit("w-nohang"), user_package), num_fast(WNOHANG)); #endif #ifdef WUNTRACED reg_var(intern(lit("w-untraced"), user_package), num_fast(WUNTRACED)); #endif #ifdef WCONTINUED reg_var(intern(lit("w-continued"), user_package), num_fast(WCONTINUED)); #endif reg_fun(intern(lit("dupfd"), user_package), func_n2o(dup_wrap, 1)); #endif #if HAVE_PIPE reg_fun(intern(lit("pipe"), user_package), func_n0(pipe_wrap)); #endif reg_fun(intern(lit("getenv"), user_package), func_n1(getenv_wrap)); reg_fun(intern(lit("setenv"), user_package), func_n3o(setenv_wrap, 2)); reg_fun(intern(lit("unsetenv"), user_package), func_n1(unsetenv_wrap)); #if HAVE_POLL reg_fun(intern(lit("poll"), user_package), func_n2o(poll_wrap, 1)); #endif }