From bcc553cea272c99cb375f9d17ffc713989106772 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. Adds some missing buffer size checks, fixes some overly-conservative ones, handles a few additional error cases and frees the allocated buffer when `C_resolve_executable_pathname` fails. Fixes #971. --- NEWS | 2 + chicken.h | 158 +-------------------------------------------- csc.scm | 2 +- distribution/manifest | 1 + library.scm | 1 + manual/Unit library | 9 +++ runtime.c | 129 ++++++++++++++++++++++++++++++++++++ tests/executable-tests.scm | 14 ++++ tests/runtests.bat | 6 ++ tests/runtests.sh | 4 ++ types.db | 1 + 11 files changed, 171 insertions(+), 156 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..9e137fd 100644 --- a/chicken.h +++ b/chicken.h @@ -961,6 +961,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 @@ -1819,6 +1820,8 @@ 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_path_to_executable(C_char *fname); +C_fctexport C_char *C_executable_pathname(); 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 +2015,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; @@ -2941,160 +2943,6 @@ C_inline size_t C_strlcat(char *dst, const char *src, size_t sz) # elif defined(__HAIKU__) # include # endif - -C_inline C_char * -C_path_to_executable(C_char *fname) -{ - 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: ; - } - } - - 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; -# endif -} #endif C_END_C_DECLS diff --git a/csc.scm b/csc.scm index d38cc27..7055ba9 100644 --- a/csc.scm +++ b/csc.scm @@ -529,7 +529,7 @@ EOF (define (use-private-repository) (set! compile-options (cons "-DC_PRIVATE_REPOSITORY" compile-options)) (when osx - ;; needed for C_path_to_executable (see chicken.h): + ;; needed for C_path_to_executable (see runtime.c): (set! link-options (cons "-framework CoreFoundation" link-options)))) (let loop ((args 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..8f26de3 100644 --- a/manual/Unit library +++ b/manual/Unit library @@ -447,6 +447,15 @@ 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}}. + +The resulting pathname is not guaranteed to be normalized. ==== exit diff --git a/runtime.c b/runtime.c index 96cef6a..8a0f71c 100644 --- a/runtime.c +++ b/runtime.c @@ -8955,6 +8955,135 @@ C_private_repository_path() return private_repository; } +C_char * +C_resolve_executable_pathname(C_char *fname) +{ + 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 + + int n = C_readlink(linkname, buffer, C_MAX_PATH); + + if(n == -1 || n >= C_MAX_PATH) + goto error; + + buffer[n] = '\0'; + return buffer; +# elif defined(_WIN32) && !defined(__CYGWIN__) + int n = GetModuleFileName(NULL, buffer, C_MAX_PATH); + + if(n == 0 || n >= C_MAX_PATH) + goto error; + + return buffer; +# elif defined(C_MACOSX) && defined(C_GUI) + CFBundleRef bundle = CFBundleGetMainBundle(); + CFURLRef url = CFBundleCopyExecutableURL(bundle); + + if(!CFURLGetFileSystemRepresentation(url, true, buffer, C_MAX_PATH)) + goto error; + + return buffer; +# elif defined(__unix__) || defined(__unix) || defined(C_XXXBSD) || defined(_AIX) + int n, len; + C_char *path, buf[C_MAX_PATH]; + + /* no name given (execve) */ + if(fname == NULL) goto error; + + /* absolute path */ + if(*fname == '/') + return C_strncpy(buffer, fname, C_MAX_PATH); + + /* try current dir */ + if(C_getcwd(buf, C_MAX_PATH) == NULL) + goto error; + + n = C_snprintf(buffer, C_MAX_PATH, "%s/%s", buf, fname); + if(n == -1 || n >= C_MAX_PATH) + goto error; + + if(C_access(buffer, F_OK) == 0) + return buffer; + + /* try 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 buffer */ + C_strncpy(buffer, path, len); + n = C_snprintf(buffer + len, C_MAX_PATH - len, "/%s", fname); + if(n == -1 || n + len >= C_MAX_PATH) + continue; + + /* fname found, resolve link */ + if(C_access(buffer, F_OK) == 0) { + n = C_readlink(buffer, buf, C_MAX_PATH); + if(n >= C_MAX_PATH) continue; + if(n >= 0) return C_strncpy(buffer, buf, C_MAX_PATH); + if(errno == EINVAL) return buffer; + } + + /* seek next entry, skip colon */ + } while (path += len, *path++); +# 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); + return buffer; + } + } +} +# endif + +error: + C_free(buffer); + return NULL; +} + +C_char * +C_path_to_executable(C_char *fname) { + int len; + C_char *path = C_resolve_executable_pathname(fname); + + if(path == 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_executable_pathname() { + if(C_main_argc == 0) return NULL; + return C_resolve_executable_pathname(C_main_argv[0]); +} 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..ed78168 --- /dev/null +++ b/tests/executable-tests.scm @@ -0,0 +1,14 @@ +;;; Compiled executable tests + +(use (only files normalize-pathname)) + +(include "test.scm") + +(test-begin "executable tests") + +;; Test is invoked with program path as first argument. +(test-equal "executable-pathname" + (car (command-line-arguments)) + (normalize-pathname (executable-pathname))) + +(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