diff options
| -rw-r--r-- | Makefile | 1 | ||||
| -rwxr-xr-x | configure | 39 | ||||
| -rw-r--r-- | ftw.c | 177 | ||||
| -rw-r--r-- | ftw.h | 29 | ||||
| -rw-r--r-- | lib.c | 4 | ||||
| -rw-r--r-- | txr.1 | 194 |
6 files changed, 444 insertions, 0 deletions
@@ -50,6 +50,7 @@ OBJS += args.o lisplib.o cadr.o struct.o jmp.o OBJS-$(debug_support) += debug.o OBJS-$(have_syslog) += syslog.o OBJS-$(have_glob) += glob.o +OBJS-$(have_ftw) += ftw.o OBJS-$(have_posix_sigs) += signal.o OBJS-$(have_sockets) += socket.o OBJS-$(have_termios) += linenoise/linenoise.o @@ -125,6 +125,7 @@ have_unistd= have_sys_time= have_syslog= have_glob= +have_ftw= have_windows_h= have_windres= have_posix_sigs= @@ -660,6 +661,9 @@ have_syslog := $have_syslog # do we compile in glob support? have_glob := $have_glob +# do we compile in ftwsupport? +have_ftw := $have_ftw + # do we modern posix signal handling? have_posix_sigs := $have_posix_sigs @@ -2096,6 +2100,41 @@ else printf "no\n" fi +printf "Checking for nftw ... " + +cat > conftest.c <<! +#include <ftw.h> +#include <stdlib.h> + +static int callback(const char *fpath, const struct stat *sb, + int tflag, struct FTW *ftwbuf) +{ + switch (tflag) { + case FTW_D: + case FTW_DP: + case FTW_NS: + case FTW_SLN: + break; + } + return 0; +} + +int main(int argc, char *argv[]) +{ + int flags = FTW_DEPTH | FTW_PHYS; + int res = nftw(argv[1], callback, 20, flags); + return (res == -1) ? EXIT_FAILURE : 0; +} +! + +if conftest ; then + printf "yes\n" + printf "#define HAVE_FTW 1\n" >> $config_h + have_ftw=y +else + printf "no\n" +fi + printf "Checking for windres ... " if output=$(windres -V 2> /dev/null) ; then @@ -0,0 +1,177 @@ +/* Copyright 2016 + * 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 <stdarg.h> +#include <wchar.h> +#include <signal.h> +#include <stdlib.h> +#include <stddef.h> +#define __USE_GNU +#include <ftw.h> +#include "config.h" +#include ALLOCA_H +#include "lib.h" +#include "gc.h" +#include "args.h" +#include "utf8.h" +#include "eval.h" +#include "signal.h" +#include "unwind.h" +#include "sysif.h" +#include "ftw.h" + +static val s_callback; +static uw_frame_t *s_exit_point; + +static int ftw_callback(const char *c_path, const struct stat *c_sb, + int c_type, struct FTW *fb) +{ + int c_result = 1; + uw_frame_t cont_guard; + + uw_push_guard(&cont_guard); + + uw_simple_catch_begin; + + sig_check_fast(); + + { + val path = string_utf8(c_path); + val type = num(c_type); + val sb = stat_to_struct(*c_sb); + val level = num(fb->level); + val base = num(fb->base); + val result; + + args_decl(args, ARGS_MIN); + args_add5(args, path, type, sb, level, base); + result = generic_funcall(s_callback, args); + c_result = if3(integerp(result), c_num(result), 0); + } + + uw_unwind { + s_exit_point = uw_curr_exit_point; + uw_curr_exit_point = 0; /* stops unwinding */ + } + + uw_catch_end; + + uw_pop_frame(&cont_guard); + + return c_result; +} + +val ftw_wrap(val dirpath, val fn, val flags_in, val nopenfd_in) +{ + if (s_callback) { + uw_throwf(error_s, lit("ftw: cannot be re-entered from " + "ftw callback"), nao); + } else { + int nopenfd = c_num(default_arg(nopenfd_in, num_fast(20))); + int flags = c_num(default_arg(flags_in, zero)); + char *dirpath_u8 = utf8_dup_to(c_str(dirpath)); + int res = (s_callback = fn, + nftw(dirpath_u8, ftw_callback, nopenfd, flags)); + s_callback = nil; + free(dirpath_u8); + + if (s_exit_point) { + uw_frame_t *ep = s_exit_point; + s_exit_point = 0; + uw_continue(ep); + } + + switch (res) { + case 0: + return t; + case -1: + return nil; + default: + return num(res); + } + } +} + +void ftw_init(void) +{ + prot1(&s_callback); + + /* ftw flags */ +#ifdef FTW_PHYS + reg_varl(intern(lit("ftw-phys"), user_package), num_fast(FTW_PHYS)); +#endif +#ifdef FTW_MOUNT + reg_varl(intern(lit("ftw-mount"), user_package), num_fast(FTW_MOUNT)); +#endif +#ifdef FTW_CHDIR + reg_varl(intern(lit("ftw-chdir"), user_package), num_fast(FTW_CHDIR)); +#endif +#ifdef FTW_DEPTH + reg_varl(intern(lit("ftw-depth"), user_package), num_fast(FTW_DEPTH)); +#endif +#ifdef FTW_ACTIONRETVAL + reg_varl(intern(lit("ftw-actionretval"), user_package), num_fast(FTW_ACTIONRETVAL)); +#endif + + /* callback type codes */ +#ifdef FTW_F + reg_varl(intern(lit("ftw-f"), user_package), num_fast(FTW_F)); +#endif +#ifdef FTW_D + reg_varl(intern(lit("ftw-d"), user_package), num_fast(FTW_D)); +#endif +#ifdef FTW_DNR + reg_varl(intern(lit("ftw-dnr"), user_package), num_fast(FTW_DNR)); +#endif +#ifdef FTW_NS + reg_varl(intern(lit("ftw-ns"), user_package), num_fast(FTW_NS)); +#endif +#ifdef FTW_SL + reg_varl(intern(lit("ftw-sl"), user_package), num_fast(FTW_SL)); +#endif +#ifdef FTW_DP + reg_varl(intern(lit("ftw-dp"), user_package), num_fast(FTW_DP)); +#endif +#ifdef FTW_SLN + reg_varl(intern(lit("ftw-sln"), user_package), num_fast(FTW_SLN)); +#endif + + /* callback return values */ +#ifdef FTW_CONTINUE + reg_varl(intern(lit("ftw-continue"), user_package), num_fast(FTW_CONTINUE)); +#endif +#ifdef FTW_STOP + reg_varl(intern(lit("ftw-stop"), user_package), num_fast(FTW_STOP)); +#endif +#ifdef FTW_SKIP_SUBTREE + reg_varl(intern(lit("ftw-skip-subtree"), user_package), num_fast(FTW_SKIP_SUBTREE)); +#endif +#ifdef FTW_SKIP_SIBLINGS + reg_varl(intern(lit("ftw-skip-siblings"), user_package), num_fast(FTW_SKIP_SIBLINGS)); +#endif + + reg_fun(intern(lit("ftw"), user_package), func_n4o(ftw_wrap, 2)); +} @@ -0,0 +1,29 @@ +/* Copyright 2016 + * 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. + */ + +val ftw_wrap(val dirpath, val fn, val nopenfd, val flags); +void ftw_init(void); + @@ -62,6 +62,7 @@ #include "parser.h" #include "syslog.h" #include "glob.h" +#include "ftw.h" #include "cadr.h" #include "struct.h" #include "txr.h" @@ -9329,6 +9330,9 @@ void init(const wchar_t *pn, mem_t *(*oom)(mem_t *, size_t), #if HAVE_GLOB glob_init(); #endif +#if HAVE_FTW + ftw_init(); +#endif cadr_init(); time_init(); @@ -37811,6 +37811,200 @@ function, and the meaning of all the .meta flags arguments are given in the documentation for the C function. +.SS* Unix Filesystem Traversal + +On platforms where the POSIX +.code nftw +function is available \*(TX provides this functionality in +the form of the analogous Lisp function +.codn ftw , +accompanied by some numeric constants. + +.coNP Variables @, ftw-phys @, ftw-mount @, ftw-chdir @ ftw-depth and @ ftw-actionretval +.desc +These variables hold numeric values that may be combined into a single +bitmask bitmask value using the +.code logior +function. This value is suitable as the +.meta flags +argument of the +.code ftw +function. + +These variables corresponds to the C constants +.codn FTW_PHYS , +.codn FTW_MOUNT , +et cetera. + +Note that +.code ftw-actionretval +is a GNU extension that is not available on all platforms. If the platform's +.code nftw +function doesn't have this feature, then this variable is not defined. + +.coNP Variables @, ftw-f @, ftw-d @, ftw-dnr @, ftw-ns @, ftw-sl @ ftw-dp and @ ftw-sln +.desc +These variables provide symbolic names for the integer values that are +passed as the +.code type +argument of the callback function called by +.codn ftw . +This argument classifies the kind of file system node visited, or +error condition encountered. + +These variables correspond to the C constants +.codn FTW_F , +.codn FTW_D , +et cetera. + +Not all of them are present. If the underlying platform doesn't have +a given constant, then the corresponding variable doesn't exist in \*(TX. + +.coNP Variables @, ftw-continue @, ftw-stop @ ftw-skip-subtree and @ ftw-skip-siblings +.desc +These variables are defined if the variable +.code ftw-actionretval +is defined. + +If the value of +.code ftw-actionretval +is included in the +.meta flags +argument of +.codn ftw , +then the callback function can use the values of these variables +as return codes. Ordinarily, the callback returns zero to continue +the search and nonzero to stop. + +These variables correspond to the C constants +.codn FTW_CONTINUE , +.codn FTW_STOP , +et cetera. + +.coNP Function @ ftw +.synb +.mets (ftw < path < callback-func >> [ flags <> [ nopenfd ]]) +.mets >> [ callback-func < path < type < stat-struct < level << base ] +.syne +.desc +The +.code ftw +function provides access to the +.code nftw +POSIX C library function. + +Note that the +.meta flags +and +.meta nopenfd +arguments are reversed with respect to the C language interface. +They are both optional; +.meta flags +defaults to zero, and +.meta nopenfd +defaults to 20. + +The +.code nftw +function walks the filesystem, as directed by the +.meta path +string and +.meta flags +bitmask arguments. + +For each visited entry, it calls the supplied +.meta callback-func +function, which receives five arguments. + +This function can continue the traversal by returning any non-integer value, +or the integer value zero. +If +.code ftw-actionretval +is included in the +.meta flags +bitmask, then the only integer code which continues the traversal without +any special semantics is +.code ftw-continue +and only +.code ftw-stop +stops the traversal. (Non-integer return values behave like +.codn ftw-continue ). + +The +.meta path +argument of the callback function gives the path of the +visited filesystem object. + +The +.meta type +argument is an integer code which indicates the kind of +object that is visited, or an error situation in visiting +that filesystem entry. See the documentation for +.code ftw-f +and +.code ftw-d +for possible values. + +The +.meta stat-struct +argument provides information about the filesystem object +as a +.code stat +structure, the same kind of object as what is returned by the +.code stat +function. + +The +.meta level +argument is an integer value representing the directory level +depth. This value is obtained from the C structure +.code FTW +in the +.code nftw +C API. + +The +.meta base +argument indicates the length of the directory part of the +.code path +argument. Characters in excess of this length are thus the base name of the +visited object, and the expression +.cblk +.meti >> [ path << base ..:] +.cble +calculates the base name. + +The +.code ftw +function returns +.code t +upon successful completion and +.code nil +on failure. If +.code ftw +is terminated by a return value from +.metn callback-func , +then that value is returned. Such a value is always a nonzero integer. + +The +.meta callback-func +may terminate the traversal by a nonlocal exit, such as by throwing +an exception or performing a block return. + +The +.meta callback-func +may not re-enter the +.code ftw +function. This situation is detected and diagnosed by an exception. + +The +.meta callback-func +may not capture a continuation across the callback boundary. That is to say, +code invoked from the callback may not capture a continuation up to a prompt +which surrounds the +.code ftw +call. Such an attempt is detected and diagnosed by an exception. + .SS* Unix Sockets On platforms where the underlying system interface is available, \*(TX provides |