/* 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 #include "lib.h" #include "stream.h" #include "hash.h" #include "signal.h" #include "utf8.h" #include "unwind.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_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_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_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 } 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)); #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_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 }