diff options
| -rw-r--r-- | ChangeLog | 31 | ||||
| -rw-r--r-- | Makefile | 2 | ||||
| -rw-r--r-- | dep.mk | 3 | ||||
| -rw-r--r-- | eval.c | 134 | ||||
| -rw-r--r-- | lib.c | 2 | ||||
| -rw-r--r-- | stream.c | 298 | ||||
| -rw-r--r-- | stream.h | 10 | ||||
| -rw-r--r-- | sysif.c | 487 | ||||
| -rw-r--r-- | sysif.h | 27 |
9 files changed, 550 insertions, 444 deletions
@@ -1,5 +1,36 @@ 2014-10-08 Kaz Kylheku <kaz@kylheku.com> + Moving system interface functions to separate module out of + the eval and stream modules. + + * Makefile (OBJS): Add sysif.o. + + * dep.mk: Regenerated. + + * eval.c (errno_wrap, daemon_wrap, exit_wrap, usleep_wrap, getpid_wrap, + getppid_wrap, env_hash): Functions moved to sysif.c and changed + to static functions. + (eval_init): Registrations of functions moved to sysif.c. + + * lib.c (init): Call sysif_init. + + * stream.c (w_stat, statf, mkdir_wrap, chdir_wrap, getcwd_wrap, + makedev_wrap, minor_wrap, major_wrap, mknod_wrap): Functions + moved to sysif.c and become static functions. + (stream_init): Registration of stat moved to sysif.c. + (open_files, open_files_star): Bugfix: no longer erroneously included + in #ifdef HAVE_UNISTD_H block. + + * stream.h (mkdir_wrap, chdir_wrap, getcwd_wrap, makedev_wrap, + minor_wrap, major_wrap, mknod_wrap, symlink_wrap, link_wrap, + readlink_wrap): Declarations removed. + + * sysif.c: New file. + + * sysif.h: New file. + +2014-10-08 Kaz Kylheku <kaz@kylheku.com> + Add test case for recent breakage. * tests/006/freeform-3.expected: New file. @@ -36,7 +36,7 @@ endif # TXR objects OBJS := txr.o lex.yy.o y.tab.o match.o lib.o regex.o gc.o unwind.o stream.o -OBJS += arith.o hash.o utf8.o filter.o eval.o rand.o combi.o +OBJS += arith.o hash.o utf8.o filter.o eval.o rand.o combi.o sysif.o OBJS-$(debug_support) += debug.o OBJS-$(have_syslog) += syslog.o OBJS-$(have_posix_sigs) += signal.o @@ -2,7 +2,7 @@ ./lex.yy.o: config.h $(top_srcdir)/./lib.h $(top_srcdir)/./gc.h $(top_srcdir)/./stream.h $(top_srcdir)/./utf8.h $(top_srcdir)/./signal.h $(top_srcdir)/./unwind.h $(top_srcdir)/./hash.h $(top_srcdir)/./parser.h y.tab.h ./y.tab.o: config.h $(top_srcdir)/./lib.h $(top_srcdir)/./signal.h $(top_srcdir)/./unwind.h $(top_srcdir)/./regex.h $(top_srcdir)/./utf8.h $(top_srcdir)/./match.h $(top_srcdir)/./hash.h $(top_srcdir)/./eval.h $(top_srcdir)/./stream.h $(top_srcdir)/./parser.h ./match.o: config.h $(top_srcdir)/./lib.h $(top_srcdir)/./gc.h $(top_srcdir)/./signal.h $(top_srcdir)/./unwind.h $(top_srcdir)/./regex.h $(top_srcdir)/./stream.h $(top_srcdir)/./parser.h $(top_srcdir)/./txr.h $(top_srcdir)/./utf8.h $(top_srcdir)/./filter.h $(top_srcdir)/./hash.h $(top_srcdir)/./debug.h $(top_srcdir)/./eval.h $(top_srcdir)/./match.h -./lib.o: config.h $(top_srcdir)/./lib.h $(top_srcdir)/./gc.h $(top_srcdir)/./arith.h $(top_srcdir)/./rand.h $(top_srcdir)/./hash.h $(top_srcdir)/./signal.h $(top_srcdir)/./unwind.h $(top_srcdir)/./stream.h $(top_srcdir)/./utf8.h $(top_srcdir)/./filter.h $(top_srcdir)/./eval.h $(top_srcdir)/./regex.h +./lib.o: config.h $(top_srcdir)/./lib.h $(top_srcdir)/./gc.h $(top_srcdir)/./arith.h $(top_srcdir)/./rand.h $(top_srcdir)/./hash.h $(top_srcdir)/./signal.h $(top_srcdir)/./unwind.h $(top_srcdir)/./stream.h $(top_srcdir)/./utf8.h $(top_srcdir)/./filter.h $(top_srcdir)/./eval.h $(top_srcdir)/./sysif.h $(top_srcdir)/./regex.h ./regex.o: config.h $(top_srcdir)/./lib.h $(top_srcdir)/./parser.h $(top_srcdir)/./signal.h $(top_srcdir)/./unwind.h $(top_srcdir)/./stream.h $(top_srcdir)/./gc.h $(top_srcdir)/./regex.h $(top_srcdir)/./txr.h ./gc.o: config.h $(top_srcdir)/./lib.h $(top_srcdir)/./stream.h $(top_srcdir)/./hash.h $(top_srcdir)/./txr.h $(top_srcdir)/./eval.h $(top_srcdir)/./gc.h $(top_srcdir)/./signal.h ./unwind.o: config.h $(top_srcdir)/./lib.h $(top_srcdir)/./gc.h $(top_srcdir)/./stream.h $(top_srcdir)/./txr.h $(top_srcdir)/./signal.h $(top_srcdir)/./eval.h $(top_srcdir)/./parser.h $(top_srcdir)/./unwind.h @@ -14,6 +14,7 @@ ./eval.o: config.h $(top_srcdir)/./lib.h $(top_srcdir)/./gc.h $(top_srcdir)/./arith.h $(top_srcdir)/./signal.h $(top_srcdir)/./unwind.h $(top_srcdir)/./regex.h $(top_srcdir)/./stream.h $(top_srcdir)/./parser.h $(top_srcdir)/./hash.h $(top_srcdir)/./debug.h $(top_srcdir)/./match.h $(top_srcdir)/./rand.h $(top_srcdir)/./txr.h $(top_srcdir)/./combi.h $(top_srcdir)/./eval.h ./rand.o: config.h $(top_srcdir)/./lib.h $(top_srcdir)/./signal.h $(top_srcdir)/./unwind.h $(top_srcdir)/./arith.h $(top_srcdir)/./rand.h $(top_srcdir)/./eval.h ./combi.o: config.h $(top_srcdir)/./lib.h $(top_srcdir)/./signal.h $(top_srcdir)/./unwind.h $(top_srcdir)/./eval.h $(top_srcdir)/./hash.h $(top_srcdir)/./combi.h +./sysif.o: config.h $(top_srcdir)/./lib.h $(top_srcdir)/./stream.h $(top_srcdir)/./hash.h $(top_srcdir)/./signal.h $(top_srcdir)/./utf8.h $(top_srcdir)/./unwind.h $(top_srcdir)/./eval.h $(top_srcdir)/./sysif.h mpi-1.8.6/mpi.o: config.h $(top_srcdir)/mpi-1.8.6/mpi.h $(top_srcdir)/mpi-1.8.6/logtab.h mpi-1.8.6/mplogic.o: config.h $(top_srcdir)/mpi-1.8.6/mplogic.h ./debug.o: config.h $(top_srcdir)/./lib.h $(top_srcdir)/./debug.h $(top_srcdir)/./gc.h $(top_srcdir)/./signal.h $(top_srcdir)/./unwind.h $(top_srcdir)/./stream.h $(top_srcdir)/./parser.h $(top_srcdir)/./txr.h @@ -27,7 +27,6 @@ #include <stdio.h> #include <stdlib.h> #include <string.h> -#include <errno.h> #include <dirent.h> #include <setjmp.h> #include <stdarg.h> @@ -35,12 +34,6 @@ #include <signal.h> #include <time.h> #include "config.h" -#ifdef HAVE_UNISTD_H -#include <unistd.h> -#endif -#ifdef HAVE_WINDOWS_H -#include <windows.h> -#endif #include "lib.h" #include "gc.h" #include "arith.h" @@ -3221,93 +3214,6 @@ static val force(val promise) return cdr(rplacd(promise, funcall(cdr(promise)))); } -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 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; -} - static void reg_op(val sym, opfun_t fun) { assert (sym != 0); @@ -3997,46 +3903,6 @@ void eval_init(void) reg_fun(intern(lit("make-time"), user_package), func_n7(make_time)); reg_fun(intern(lit("make-time-utc"), user_package), func_n7(make_time_utc)); - 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("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 - - reg_fun(intern(lit("chdir"), user_package), func_n1(chdir_wrap)); - reg_fun(intern(lit("pwd"), user_package), func_n0(getcwd_wrap)); - -#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("source-loc"), user_package), func_n1(source_loc)); reg_fun(intern(lit("source-loc-str"), user_package), func_n1(source_loc_str)); reg_fun(intern(lit("rlcp"), user_package), func_n2(rlcp)); @@ -55,6 +55,7 @@ #include "utf8.h" #include "filter.h" #include "eval.h" +#include "sysif.h" #include "regex.h" #define max(a, b) ((a) > (b) ? (a) : (b)) @@ -6768,6 +6769,7 @@ void init(const wchar_t *pn, mem_t *(*oom)(mem_t *, size_t), obj_init(); uw_init(); eval_init(); + sysif_init(); arith_init(); rand_init(); stream_init(); @@ -45,15 +45,9 @@ #if HAVE_SYS_WAIT #include <sys/wait.h> #endif -#if HAVE_SYS_STAT -#include <sys/stat.h> -#endif #if HAVE_WINDOWS_H #include <windows.h> #endif -#if HAVE_MAKEDEV -#include <sys/types.h> -#endif #include "lib.h" #include "gc.h" #include "signal.h" @@ -2055,50 +2049,6 @@ val get_string(val stream, val nchars) return get_string_from_stream(strstream); } -#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 -} - static DIR *w_opendir(const wchar_t *wname) { char *name = utf8_dup_to(wname); @@ -2552,173 +2502,6 @@ val rename_path(val from, val to) return t; } -#if HAVE_MKDIR -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 -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 -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; -} - -val getcwd_wrap(void) -{ - size_t guess = 256; - - for (;;) { - char *u8buf = (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; - } - } -} - -#if HAVE_MAKEDEV - -val makedev_wrap(val major, val minor) -{ - return num(makedev(c_num(major), c_num(minor))); -} - -val minor_wrap(val dev) -{ - return num(minor(c_num(dev))); -} - -val major_wrap(val dev) -{ - return num(major(c_num(dev))); -} - -#endif - -#if HAVE_MKNOD - -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 - -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; -} - -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; -} - -val readlink_wrap(val path) -{ - char *u8path = utf8_dup_to(c_str(path)); - ssize_t guess = 256; - - for (;;) { - char *u8buf = (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 - static val open_files(val file_list, val substitute_stream) { substitute_stream = default_bool_arg(substitute_stream); @@ -2744,8 +2527,6 @@ static val open_files_star(val file_list, val substitute_stream) } } -#endif - val abs_path_p(val path) { static val reg; @@ -2790,84 +2571,6 @@ void stream_init(void) name_k = intern(lit("name"), keyword_package); format_s = intern(lit("format"), user_package); -#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 - -#if HAVE_SYS_STAT - 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 - reg_var(stdin_s = intern(lit("*stdin*"), user_package), make_stdio_stream(stdin, lit("stdin"))); reg_var(stdout_s = intern(lit("*stdout*"), user_package), @@ -2901,7 +2604,6 @@ void stream_init(void) reg_fun(intern(lit("unget-byte"), user_package), func_n2o(unget_byte, 1)); reg_fun(intern(lit("flush-stream"), user_package), func_n1(flush_stream)); reg_fun(intern(lit("seek-stream"), user_package), func_n3(seek_stream)); - reg_fun(intern(lit("stat"), user_package), func_n1(statf)); reg_fun(intern(lit("streamp"), user_package), func_n1(streamp)); reg_fun(intern(lit("real-time-stream-p"), user_package), func_n1(real_time_stream_p)); reg_fun(intern(lit("stream-set-prop"), user_package), func_n3(stream_set_prop)); @@ -106,16 +106,6 @@ val open_process(val path, val mode_str, val args); val make_catenated_stream(val stream_list); val remove_path(val path); val rename_path(val from, val to); -val mkdir_wrap(val path, val mode); -val chdir_wrap(val path); -val getcwd_wrap(void); -val makedev_wrap(val major, val minor); -val minor_wrap(val dev); -val major_wrap(val dev); -val mknod_wrap(val path, val mode, val dev); -val symlink_wrap(val target, val to); -val link_wrap(val target, val to); -val readlink_wrap(val path); val abs_path_p(val path); void stream_init(void); diff --git a/sysif.c b/sysif.c new file mode 100644 index 00000000..03b75e97 --- /dev/null +++ b/sysif.c @@ -0,0 +1,487 @@ +/* Copyright 2010-2014 + * Kaz Kylheku <kaz@kylheku.com> + * 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 <stdio.h> +#include <stdlib.h> +#include <string.h> +#include <setjmp.h> +#include <wchar.h> +#include <signal.h> +#include <dirent.h> +#include <errno.h> +#include <time.h> +#include "config.h" +#if HAVE_UNISTD_H +#include <unistd.h> +#endif +#if HAVE_FCNTL_H +#include <fcntl.h> +#endif +#if HAVE_SYS_WAIT +#include <sys/wait.h> +#endif +#if HAVE_SYS_STAT +#include <sys/stat.h> +#endif +#if HAVE_WINDOWS_H +#include <windows.h> +#endif +#if HAVE_MAKEDEV +#include <sys/types.h> +#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 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 = (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 = (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("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 +} diff --git a/sysif.h b/sysif.h new file mode 100644 index 00000000..ef88f101 --- /dev/null +++ b/sysif.h @@ -0,0 +1,27 @@ +/* Copyright 2013-2014 + * Kaz Kylheku <kaz@kylheku.com> + * 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. + */ + +void sysif_init(void); |