>From 6498b3217ee524cc8cc3e945b8a23b89d4949753 Mon Sep 17 00:00:00 2001 From: Evan Hanson Date: Tue, 17 Mar 2015 20:57:16 +1300 Subject: [PATCH] Move C_path_to_executable into runtime and add executable-pathname procedure Moves the logic from `C_path_to_executable` into a new function `C_resolve_executable_pathname` that returns the executable's full pathname, exposes this as a library procedure `executable-pathname`, and redefines `C_path_to_executable` as a wrapper for the new function that simply drops the filename part of the resolved path. Resolves the executable once, at startup, on platforms that require searching for it. Uses realpath to resolve pathnames, where supported. Handles some additional error cases and frees the allocated buffer when `C_resolve_executable_pathname` fails. Removes the dependency on CoreFoundation when compiling with a private repository on Mac OS X by using _NSGetExecutablePath instead of the CoreFoundation framework's Bundle- and URL-related functions. Fixes #971. --- NEWS | 2 + chicken.h | 216 +++++++++++---------------------------------- csc.scm | 5 +- distribution/manifest | 1 + library.scm | 1 + manual/Unit library | 7 ++ runtime.c | 154 +++++++++++++++++++++++++++++++- tests/executable-tests.scm | 27 ++++++ tests/runtests.bat | 6 ++ tests/runtests.sh | 4 + types.db | 1 + 11 files changed, 256 insertions(+), 168 deletions(-) create mode 100644 tests/executable-tests.scm diff --git a/NEWS b/NEWS index 8f3c94c..9ce43cd 100644 --- a/NEWS +++ b/NEWS @@ -4,6 +4,8 @@ - Removed support for memory-mapped files (posix), queues (data-structures), binary-search (data-structures) and object-eviction (lolevel). These are now available as eggs. + - Added the `executable-pathname` procedure for retrieving a path to + the currently-running executable. - Module system - The compiler has been modularised, for improved namespacing. This diff --git a/chicken.h b/chicken.h index 69e0b95..a0af44a 100644 --- a/chicken.h +++ b/chicken.h @@ -1,4 +1,3 @@ - /* chicken.h - General headerfile for compiler generated executables ; ; Copyright (c) 2008-2014, The CHICKEN Team @@ -330,6 +329,22 @@ void *alloca (); # define C_GENERIC_CONSOLE #endif +/** + * HAVE_EXE_PATH is defined on platforms on which there's a simple way + * to retrieve a path to the current executable (such as reading + * "/proc//exe" or some similar trick). + * + * SEARCH_EXE_PATH is defined on platforms on which we must search for + * the current executable. Because this search is sensitive to things + * like CWD, PATH, and so on, it's done once at startup and saved in + * `C_main_exe`. + */ +#if defined(__linux__) || defined(__sun) || defined(C_MACOSX) || defined(__HAIKU__) || (defined(_WIN32) && !defined(__CYGWIN__)) +# define HAVE_EXE_PATH +#elif defined(__unix__) || defined(C_XXXBSD) || defined(_AIX) +# define SEARCH_EXE_PATH +#endif + /* Needed for pre-emptive threading */ #define C_TIMER_INTERRUPTS @@ -734,14 +749,16 @@ static inline int isinf_ld (long double x) # define C_SOFTWARE_VERSION "aix" #elif defined(__GNU__) # define C_SOFTWARE_VERSION "hurd" -/* This is as silly as the other limits, there is no PATH_MAX in The Hurd */ -# define PATH_MAX 1024 #else # define C_SOFTWARE_VERSION "unknown" #endif -#define C_MAX_PATH PATH_MAX - +/* There is no PATH_MAX in The Hurd. */ +#ifdef PATH_MAX +# define C_MAX_PATH PATH_MAX +#else +# define C_MAX_PATH 1024 +#endif /* Types: */ @@ -961,6 +978,7 @@ DECL_C_PROC_p0 (128, 1,0,0,0,0,0,0,0) # define C_fopen fopen # define C_fclose fclose # define C_strpbrk strpbrk +# define C_strcspn strcspn # define C_snprintf snprintf # define C_printf printf # define C_fprintf fprintf @@ -1688,6 +1706,9 @@ C_varextern C_TLS C_uword C_heap_shrinkage; C_varextern C_TLS char **C_main_argv, +#ifdef SEARCH_EXE_PATH + *C_main_exe, +#endif *C_dlerror; C_varextern C_TLS C_uword C_maximal_heap_size; C_varextern C_TLS int (*C_gc_mutation_hook)(C_word *slot, C_word val); @@ -1819,6 +1840,9 @@ C_fctexport int C_do_unregister_finalizer(C_word x); C_fctexport C_word C_dbg_hook(C_word x); C_fctexport void C_use_private_repository(C_char *path); C_fctexport C_char *C_private_repository_path(); +C_fctexport C_char *C_executable_pathname(); +C_fctexport C_char *C_path_to_executable(C_char *fname); +C_fctexport C_char *C_resolve_executable_pathname(C_char *fname); C_fctimport void C_ccall C_toplevel(C_word c, C_word self, C_word k) C_noret; C_fctimport void C_ccall C_invalid_procedure(int c, C_word self, ...) C_noret; @@ -2012,7 +2036,6 @@ C_fctexport C_word C_fcall C_i_foreign_unsigned_integer64_argumentp(C_word x) C_ C_fctexport C_char *C_lookup_procedure_id(void *ptr); C_fctexport void *C_lookup_procedure_ptr(C_char *id); -C_fctexport C_char *C_executable_path(); #ifdef C_SIXTY_FOUR C_fctexport void C_ccall C_peek_signed_integer_32(C_word c, C_word closure, C_word k, C_word v, C_word index) C_noret; @@ -2934,169 +2957,36 @@ C_inline size_t C_strlcat(char *dst, const char *src, size_t sz) } #endif - -#ifdef C_PRIVATE_REPOSITORY -# if defined(C_MACOSX) && defined(C_GUI) -# include -# elif defined(__HAIKU__) -# include -# endif - -C_inline C_char * -C_path_to_executable(C_char *fname) +/* Safe realpath usage depends on a reliable PATH_MAX. */ +#ifdef PATH_MAX +# define C_realpath realpath +#else +C_inline char *C_realpath(const char *path, char *resolved) { - C_char *buffer = (C_char *)C_malloc(C_MAX_PATH); - - if(buffer == NULL) return NULL; - -# if defined(__linux__) || defined(__sun) - C_char linkname[64]; /* /proc//exe */ - pid_t pid; - int ret; - - pid = C_getpid(); -# ifdef __linux__ - C_snprintf(linkname, sizeof(linkname), "/proc/%i/exe", pid); -# else - C_snprintf(linkname, sizeof(linkname), "/proc/%i/path/a.out", pid); /* SunOS / Solaris */ -# endif - ret = C_readlink(linkname, buffer, C_MAX_PATH - 1); - - if(ret == -1 || ret >= C_MAX_PATH - 1) - return NULL; - - for(--ret; ret > 0 && buffer[ ret ] != '/'; --ret); - - buffer[ ret ] = '\0'; - return buffer; -# elif defined(_WIN32) && !defined(__CYGWIN__) - int i; - int n = GetModuleFileName(NULL, buffer, C_MAX_PATH - 1); - - if(n == 0 || n >= C_MAX_PATH - 1) - return NULL; - - for(i = n - 1; i >= 0 && buffer[ i ] != '\\'; --i); - - buffer[ i ] = '\0'; - return buffer; -# elif defined(C_MACOSX) && defined(C_GUI) - CFBundleRef bundle = CFBundleGetMainBundle(); - CFURLRef url = CFBundleCopyExecutableURL(bundle); - int i; - - if(CFURLGetFileSystemRepresentation(url, true, buffer, C_MAX_PATH)) { - for(i = C_strlen(buffer); i >= 0 && buffer[ i ] != '/'; --i); - - buffer[ i ] = '\0'; - return buffer; - } - else return NULL; -# elif defined(__unix__) || defined(__unix) || defined(C_XXXBSD) || defined(_AIX) - int i, j, k, l; - C_char *path, *dname; - - /* found on stackoverflow.com: */ - - /* no name given (execve) */ - if(fname == NULL) return NULL; - - i = C_strlen(fname) - 1; - - while(i >= 0 && fname[ i ] != '/') --i; - - /* absolute path */ - if(*fname == '/') { - fname[ i ] = '\0'; - C_strlcpy(buffer, fname, C_MAX_PATH); - return buffer; - } - else { - /* try current dir */ - if(C_getcwd(buffer, C_MAX_PATH - 1) == NULL) - return NULL; - - C_strlcat(buffer, "/", C_MAX_PATH); - C_strlcat(buffer, fname, C_MAX_PATH); - - if(C_access(buffer, F_OK) == 0) { - for(i = C_strlen(buffer); i >= 0 && buffer[ i ] != '/'; --i); - - buffer[ i ] = '\0'; - return buffer; - } - - /* walk PATH */ - path = C_getenv("PATH"); - - if(path == NULL) return NULL; - - for(l = j = k = 0; !l; ++k) { - switch(path[ k ]) { - - case '\0': - if(k == 0) return NULL; /* empty PATH */ - else l = 1; - /* fall through */ - - case ':': - C_strncpy(buffer, path + j, k - j); - buffer[ k - j ] = '\0'; - C_strlcat(buffer, "/", C_MAX_PATH); - C_strlcat(buffer, fname, C_MAX_PATH); - - if(C_access(buffer, F_OK) == 0) { - dname = C_strdup(buffer); - l = C_readlink(dname, buffer, C_MAX_PATH - 1); - - if(l == -1) { - /* not a symlink (we ignore other errors here */ - buffer[ k - j ] = '\0'; - } - else { - while(l > 0 && buffer[ l ] != '/') --l; - - C_free(dname); - buffer[ l ] = '\0'; - } - - return buffer; - } - else j = k + 1; - - break; - - default: ; - } - } - +# if _POSIX_C_SOURCE >= 200809L + char *p; + size_t n; + if((p = realpath(path, NULL)) == NULL) return NULL; - } -# elif defined(__HAIKU__) -{ - image_info info; - int32 cookie = 0; - int32 i; - - while (get_next_image_info(0, &cookie, &info) == B_OK) { - if (info.type == B_APP_IMAGE) { - C_strlcpy(buffer, info.name, C_MAX_PATH); - - for(i = C_strlen(buffer); i >= 0 && buffer[ i ] != '/'; --i); - - buffer[ i ] = '\0'; - - return buffer; - } - } -} - return NULL; -# else - return NULL; + n = C_strlcpy(resolved, p, C_MAX_PATH); + C_free(p); + if(n < C_MAX_PATH) + return resolved; # endif + return NULL; } #endif +/* For image_info retrieval */ +#if defined(__HAIKU__) +# include +#endif + +/* For _NSGetExecutablePath */ +#if defined(C_MACOSX) +# include +#endif + C_END_C_DECLS #endif /* ___CHICKEN */ diff --git a/csc.scm b/csc.scm index d38cc27..1b82c11 100644 --- a/csc.scm +++ b/csc.scm @@ -527,10 +527,7 @@ EOF (set! shared #t) ) (define (use-private-repository) - (set! compile-options (cons "-DC_PRIVATE_REPOSITORY" compile-options)) - (when osx - ;; needed for C_path_to_executable (see chicken.h): - (set! link-options (cons "-framework CoreFoundation" link-options)))) + (set! compile-options (cons "-DC_PRIVATE_REPOSITORY" compile-options))) (let loop ((args args)) (cond [(null? args) diff --git a/distribution/manifest b/distribution/manifest index 370e275..89f81b3 100644 --- a/distribution/manifest +++ b/distribution/manifest @@ -121,6 +121,7 @@ tests/embedded1.c tests/embedded2.scm tests/embedded3.c tests/embedded4.scm +tests/executable-tests.scm tests/condition-tests.scm tests/fixnum-tests.scm tests/numbers-string-conversion-tests.scm diff --git a/library.scm b/library.scm index fb85c86..68fdbac 100644 --- a/library.scm +++ b/library.scm @@ -200,6 +200,7 @@ EOF (define (current-gc-milliseconds) (##sys#fudge 31)) (define ##sys#decode-seconds (##core#primitive "C_decode_seconds")) (define get-environment-variable (foreign-lambda c-string "C_getenv" c-string)) +(define executable-pathname (foreign-lambda c-string* "C_executable_pathname")) (define (##sys#start-timer) (##sys#gc #t) diff --git a/manual/Unit library b/manual/Unit library index 8a318c1..f446c2e 100644 --- a/manual/Unit library +++ b/manual/Unit library @@ -447,6 +447,13 @@ the list is a string containing the name of the executing program. The other items are the arguments passed to the application. It depends on the host-shell whether arguments are expanded ('globbed') or not. +==== executable-pathname + +(executable-pathname) + +Returns a full pathname of the currently-running executable, or {{#f}} +if it couldn't be determined. When evaluating code in the interpreter, +this will be a path to {{csi}}. ==== exit diff --git a/runtime.c b/runtime.c index 96cef6a..e9ea017 100644 --- a/runtime.c +++ b/runtime.c @@ -368,6 +368,9 @@ C_TLS C_uword C_maximal_heap_size; C_TLS time_t C_startup_time_seconds; C_TLS char **C_main_argv, +#ifdef SEARCH_EXE_PATH + *C_main_exe = NULL, +#endif *C_dlerror; static C_TLS TRACE_INFO @@ -1219,6 +1222,11 @@ void CHICKEN_parse_command_line(int argc, char *argv[], C_word *heap, C_word *st C_main_argc = argc; C_main_argv = argv; + +#ifdef SEARCH_EXE_PATH + C_main_exe = C_resolve_executable_pathname(argv[0]); +#endif + *heap = DEFAULT_HEAP_SIZE; *stack = DEFAULT_STACK_SIZE; *symbols = DEFAULT_SYMBOL_TABLE_SIZE; @@ -8945,7 +8953,7 @@ C_decode_literal(C_word **ptr, C_char *str) void C_use_private_repository(C_char *path) { - private_repository = path == NULL ? NULL : C_strdup(path); + private_repository = path; } @@ -8955,6 +8963,150 @@ C_private_repository_path() return private_repository; } +C_char * +C_executable_pathname() { +#ifdef SEARCH_EXE_PATH + return C_main_exe == NULL ? NULL : C_strdup(C_main_exe); +#else + return C_resolve_executable_pathname(C_main_argv[0]); +#endif +} + +C_char * +C_path_to_executable(C_char *fname) { + int len; + C_char *path; + + if((path = C_resolve_executable_pathname(fname)) == NULL) + return NULL; + +#if defined(_WIN32) && !defined(__CYGWIN__) + for(len = C_strlen(path); len >= 0 && path[len] != '\\'; len--); +#else + for(len = C_strlen(path); len >= 0 && path[len] != '/'; len--); +#endif + + path[len] = '\0'; + return path; +} + +C_char * +C_resolve_executable_pathname(C_char *fname) +{ + int n; + C_char *buffer = (C_char *) C_malloc(C_MAX_PATH); + + if(buffer == NULL) return NULL; + +#if defined(__linux__) || defined(__sun) + C_char linkname[64]; /* /proc//exe */ + pid_t pid = C_getpid(); + +# ifdef __linux__ + C_snprintf(linkname, sizeof(linkname), "/proc/%i/exe", pid); +# else + C_snprintf(linkname, sizeof(linkname), "/proc/%i/path/a.out", pid); /* SunOS / Solaris */ +# endif + + n = C_readlink(linkname, buffer, C_MAX_PATH); + if(n < 0 || n >= C_MAX_PATH) + goto error; + + buffer[n] = '\0'; + return buffer; +#elif defined(_WIN32) && !defined(__CYGWIN__) + n = GetModuleFileName(NULL, buffer, C_MAX_PATH); + if(n == 0 || n >= C_MAX_PATH) + goto error; + + return buffer; +#elif defined(C_MACOSX) + C_char buf[C_MAX_PATH]; + C_u32 size = C_MAX_PATH; + + if(_NSGetExecutablePath(buf, &size) != 0) + goto error; + + if(C_realpath(buf, buffer) == NULL) + goto error; + + return buffer; +#elif defined(__HAIKU__) +{ + image_info info; + int32 cookie = 0; + + while (get_next_image_info(0, &cookie, &info) == B_OK) { + if (info.type == B_APP_IMAGE) { + C_strlcpy(buffer, info.name, C_MAX_PATH); + return buffer; + } + } +} +#elif defined(SEARCH_EXE_PATH) + int len; + C_char *path, buf[C_MAX_PATH]; + + /* no name given (execve) */ + if(fname == NULL) + goto error; + + /* absolute pathname */ + if(fname[0] == '/') { + if(C_realpath(fname, buffer) == NULL) + goto error; + else + return buffer; + } + + /* current directory */ + if(C_strchr(fname, '/') != NULL) { + if(C_getcwd(buffer, C_MAX_PATH) == NULL) + goto error; + + n = C_snprintf(buf, C_MAX_PATH, "%s/%s", buffer, fname); + if(n < 0 || n >= C_MAX_PATH) + goto error; + + if(C_access(buf, X_OK) == 0) { + if(C_realpath(buf, buffer) == NULL) + goto error; + else + return buffer; + } + } + + /* walk PATH */ + if((path = C_getenv("PATH")) == NULL) + goto error; + + do { + /* check PATH entry length */ + len = C_strcspn(path, ":"); + if(len == 0 || len >= C_MAX_PATH) + continue; + + /* "/" to buf */ + C_strncpy(buf, path, len); + n = C_snprintf(buf + len, C_MAX_PATH - len, "/%s", fname); + if(n < 0 || n + len >= C_MAX_PATH) + continue; + + if(C_access(buf, X_OK) != 0) + continue; + + /* fname found, resolve links */ + if(C_realpath(buf, buffer) != NULL) + return buffer; + + /* seek next entry, skip colon */ + } while (path += len, *path++); +#endif + +error: + C_free(buffer); + return NULL; +} C_regparm C_word C_fcall C_i_getprop(C_word sym, C_word prop, C_word def) diff --git a/tests/executable-tests.scm b/tests/executable-tests.scm new file mode 100644 index 0000000..78695ec --- /dev/null +++ b/tests/executable-tests.scm @@ -0,0 +1,27 @@ +;;; Compiled executable tests + +(include "test.scm") + +(use files posix) + +(define program-path + (car (command-line-arguments))) + +(define (read-symbolic-link* p) + (cond-expand + ((and windows (not cygwin)) p) + (else (read-symbolic-link p #t)))) + +(test-begin "executable tests") + +(let ((p (program-name))) + (test-equal "program-name" + (pathname-strip-directory p) + (pathname-strip-directory program-path))) + +(and-let* ((p (executable-pathname))) + (test-equal "executable-pathname" + (read-symbolic-link* p) + (read-symbolic-link* program-path))) + +(test-end) diff --git a/tests/runtests.bat b/tests/runtests.bat index e94fd10..b962d68 100644 --- a/tests/runtests.bat +++ b/tests/runtests.bat @@ -443,6 +443,12 @@ if errorlevel 1 exit /b 1 echo ======================================== syntax-rules stress test ... %interpret% -bnq syntax-rule-stress-test.scm +echo "======================================== executable tests ..." +%compile% executable-tests.scm +if errorlevel 1 exit /b 1 +a.out %TEST_DIR%\a.out +if errorlevel 1 exit /b 1 + echo ======================================== embedding (1) ... %compile% embedded1.c if errorlevel 1 exit /b 1 diff --git a/tests/runtests.sh b/tests/runtests.sh index 5e970a6..c663999 100755 --- a/tests/runtests.sh +++ b/tests/runtests.sh @@ -364,6 +364,10 @@ $compile locative-stress-test.scm echo "======================================== syntax-rules stress test ..." time $interpret -bnq syntax-rule-stress-test.scm +echo "======================================== executable tests ..." +$compile executable-tests.scm +./a.out "$TEST_DIR/a.out" + echo "======================================== embedding (1) ..." $compile embedded1.c ./a.out diff --git a/types.db b/types.db index 177d2a8..472ac8c 100644 --- a/types.db +++ b/types.db @@ -830,6 +830,7 @@ (error (procedure error (* #!rest) noreturn)) (##sys#error (procedure ##sys#error (* #!rest) noreturn)) (##sys#signal-hook (procedure ##sys#signal-hook (* #!rest) noreturn)) +(executable-pathname (#(procedure #:pure) executable-pathname () (or string false))) (exit (procedure exit (#!optional fixnum) noreturn)) (exit-handler (#(procedure #:clean #:enforce) exit-handler (#!optional (procedure (fixnum) . *)) procedure)) (expand (procedure expand (* #!optional list) *)) -- 2.1.4