From 8f0f0abbca2013bc3f4a510d7138c269d615d3c1 Mon Sep 17 00:00:00 2001 From: Abdulaziz Ghuloum Date: Fri, 13 Jun 2008 05:43:17 -0700 Subject: [PATCH] Applied a patch supplied by Derick Eddington that provides enhanced functionality for waitpid (nonblocking waitpid and more status info) as well as the ability to send a signal to a process, e.g., (kill pid 'HUP). --- scheme/ikarus.posix.ss | 93 ++++++++++++++++++++++++++++--- scheme/ikarus.strings.ss | 7 ++- scheme/last-revision | 2 +- scheme/makefile.ss | 4 ++ src/ikarus-io.c | 2 +- src/ikarus-process.c | 115 ++++++++++++++++++++++++++++++++++++--- src/ikarus-runtime.c | 7 ++- 7 files changed, 206 insertions(+), 24 deletions(-) diff --git a/scheme/ikarus.posix.ss b/scheme/ikarus.posix.ss index a0f99bf..e1af19d 100644 --- a/scheme/ikarus.posix.ss +++ b/scheme/ikarus.posix.ss @@ -19,7 +19,8 @@ nanosleep getenv env environ file-ctime current-directory file-regular? file-directory? file-symbolic-link? make-symbolic-link directory-list make-directory delete-directory change-mode - strerror) + kill strerror + wstatus-pid wstatus-exit-status wstatus-received-signal) (import (rnrs bytevectors) (except (ikarus) @@ -28,7 +29,8 @@ getenv env environ file-ctime current-directory file-regular? file-directory? file-symbolic-link? make-symbolic-link directory-list make-directory delete-directory change-mode - strerror)) + kill strerror + wstatus-pid wstatus-exit-status wstatus-received-signal)) (define posix-fork (lambda () @@ -41,15 +43,88 @@ [(fx= pid 0) (child-proc)] [(fx< pid 0) (raise/strerror 'fork pid)] [else (parent-proc pid)])))) + + (module (signal-code->signal-name signal-name->signal-code) + + (define signal-names-al + ;; From ikarus-process.c + '((1 . SIGABRT) + (2 . SIGALRM) + (3 . SIGBUS) + (4 . SIGCHLD) + (5 . SIGCONT) + (6 . SIGFPE) + (7 . SIGHUP) + (8 . SIGILL) + (9 . SIGINT) + (10 . SIGKILL) + (11 . SIGPIPE) + (12 . SIGQUIT) + (13 . SIGSEGV) + (14 . SIGSTOP) + (15 . SIGTERM) + (16 . SIGTSTP) + (17 . SIGTTIN) + (18 . SIGTTOU) + (19 . SIGUSR1) + (20 . SIGUSR2) + (21 . SIGPOLL) + (22 . SIGPROF) + (23 . SIGSYS) + (24 . SIGTRAP) + (25 . SIGURG) + (26 . SIGVTALRM) + (27 . SIGXCPU) + (28 . SIGXFSZ))) + + (define signal-code->signal-name + (lambda (sigcode) + (cond + [(assv sigcode signal-names-al) => cdr] + [else sigcode]))) + + (define signal-name->signal-code + (lambda (signame) + (cond + [(find (lambda (p) (eqv? (cdr p) signame)) signal-names-al) => car] + [else #f]))) + ) + + (define kill + (lambda (pid signame) + (define who 'kill) + (unless (fixnum? pid) (die who "not a fixnum" pid)) + (unless (symbol? signame) (die who "not a symbol" signame)) + (let ([r (foreign-call "ikrt_kill" pid + (or (signal-name->signal-code signame) + (die who "invalid signal name" signame)))]) + (when (fx< r 0) + (error who (strerror r) pid signame))))) + + (define-struct wstatus (pid exit-status received-signal)) (define waitpid - (lambda (pid) - (unless (fixnum? pid) - (die 'waitpid "not a fixnum" pid)) - (let ([r (foreign-call "ikrt_waitpid" pid)]) - (if (fx< r 0) - (raise/strerror 'waitpid r) - r)))) + ;; If block? is #f and waitpid() would have blocked, + ;; or if want-error? is #f and there was an error, + ;; the value returned is #f + (case-lambda + [() (waitpid -1 #t #t)] + [(pid) (waitpid pid #t #t)] + [(pid block?) (waitpid pid block? #t)] + [(pid block? want-error?) + (define who 'waitpid) + (unless (fixnum? pid) (die who "not a fixnum" pid)) + (unless (boolean? block?) (die who "not a boolean" block?)) + (let ([r (foreign-call "ikrt_waitpid" (make-wstatus #f #f #f) pid block?)]) + (cond + [(wstatus? r) + (set-wstatus-received-signal! r + (signal-code->signal-name + (wstatus-received-signal r))) + r] + [want-error? + (error who (strerror r) pid)] + [else #f]))])) (define system (lambda (x) diff --git a/scheme/ikarus.strings.ss b/scheme/ikarus.strings.ss index ed89f8f..cf8949e 100644 --- a/scheme/ikarus.strings.ss +++ b/scheme/ikarus.strings.ss @@ -497,7 +497,8 @@ (define uuid (lambda () (let ([s ($make-bytevector 16)]) - (utf8->string - (or (foreign-call "ik_uuid" s) - (die 'uuid "failed!")))))) + (let ([r (foreign-call "ik_uuid" s)]) + (if (bytevector? r) + (utf8->string r) + (error 'uuid "cannot obtain unique id")))))) ) diff --git a/scheme/last-revision b/scheme/last-revision index 00b89bd..f34028d 100644 --- a/scheme/last-revision +++ b/scheme/last-revision @@ -1 +1 @@ -1514 +1515 diff --git a/scheme/makefile.ss b/scheme/makefile.ss index 1a2bc03..95bdf4c 100755 --- a/scheme/makefile.ss +++ b/scheme/makefile.ss @@ -393,6 +393,10 @@ [process i] [process-nonblocking i] [waitpid i] + [wstatus-pid i] + [wstatus-exit-status i] + [wstatus-received-signal i] + [kill i] [installed-libraries i] [library-path i] [library-extensions i] diff --git a/src/ikarus-io.c b/src/ikarus-io.c index 2a9116f..dfe238c 100644 --- a/src/ikarus-io.c +++ b/src/ikarus-io.c @@ -272,7 +272,7 @@ ikrt_accept(ikptr s, ikptr bv /*, ikpcb* pcb */){ } ikptr -ikrt_shutdown(ikptr s, ikpcb* pcb){ +ikrt_shutdown(ikptr s /*, ikpcb* pcb*/){ #ifdef __CYGWIN__ int err = close(unfix(s)); #else diff --git a/src/ikarus-process.c b/src/ikarus-process.c index e1ec74f..1905c61 100644 --- a/src/ikarus-process.c +++ b/src/ikarus-process.c @@ -23,6 +23,7 @@ #include #include #include +#include #include "ikarus-data.h" extern ikptr ik_errno_to_code(); @@ -91,14 +92,112 @@ ikrt_process(ikptr rvec, ikptr cmd, ikptr argv /*, ikpcb* pcb */){ } } -ikptr -ikrt_waitpid(ikptr pid /*, ikpcb* pcb */){ - int status; - pid_t r = waitpid(unfix(pid), &status, 0); - if(r >= 0){ - return fix(status); - } else { - return ik_errno_to_code(); +typedef struct signal_info { + int n; + ikptr c; +} signal_info; + +#define signal_info_table_len 28 + +static signal_info signal_info_table[signal_info_table_len] = { + /* Signals from POSIX */ + {SIGABRT, fix(1)}, + {SIGALRM, fix(2)}, + {SIGBUS, fix(3)}, + {SIGCHLD, fix(4)}, + {SIGCONT, fix(5)}, + {SIGFPE, fix(6)}, + {SIGHUP, fix(7)}, + {SIGILL, fix(8)}, + {SIGINT, fix(9)}, + {SIGKILL, fix(10)}, + {SIGPIPE, fix(11)}, + {SIGQUIT, fix(12)}, + {SIGSEGV, fix(13)}, + {SIGSTOP, fix(14)}, + {SIGTERM, fix(15)}, + {SIGTSTP, fix(16)}, + {SIGTTIN, fix(17)}, + {SIGTTOU, fix(18)}, + {SIGUSR1, fix(19)}, + {SIGUSR2, fix(20)}, +#ifdef SIGPOLL + {SIGPOLL, fix(21)}, +#else + {SIGEMT, fix(21)}, +#endif + {SIGPROF, fix(22)}, + {SIGSYS, fix(23)}, + {SIGTRAP, fix(24)}, + {SIGURG, fix(25)}, + {SIGVTALRM, fix(26)}, + {SIGXCPU, fix(27)}, + {SIGXFSZ, fix(28)} +}; + + +ikptr +ik_signal_num_to_code(int signum){ + signal_info* si; + int i; + for(i=0; i < signal_info_table_len; i++){ + si = &signal_info_table[i]; + if(si->n == signum){ + return si->c; + } } + fprintf(stderr, "\n*** ik_signal_num_to_code: Don't know signal %d ***\n\n", + signum); + return fix(99999); +} + +int +ik_signal_code_to_num(ikptr sigcode){ + signal_info* si; + int i; + for(i=0; i < signal_info_table_len; i++){ + si = &signal_info_table[i]; + if(si->c == sigcode){ + return si->n; + } + } + fprintf(stderr, "ik_signal_code_to_num: Don't know code %ld\n", + unfix(sigcode)); + exit(EXIT_FAILURE); + return 0; +} + +ikptr +ikrt_kill(ikptr pid, ikptr sigcode /*, ikpcb* pcb */){ + int r = kill((pid_t)unfix(pid), ik_signal_code_to_num(sigcode)); + if(r == 0){ + return fix(0); + } + return ik_errno_to_code(); +} + +ikptr +ikrt_waitpid(ikptr rvec, ikptr pid, ikptr block /*, ikpcb* pcb */){ + /* rvec is assumed to come in as #(#f #f #f) */ + int status, options = 0; + if(block == false_object){ + options = WNOHANG; + } + pid_t r = waitpid(unfix(pid), &status, options); + if(r > 0){ + ref(rvec, off_record_data+0*wordsize) = fix(r); + if(WIFEXITED(status)) { + ref(rvec, off_record_data+1*wordsize) = fix(WEXITSTATUS(status)); + } + if(WIFSIGNALED(status)) { + ref(rvec, off_record_data+2*wordsize) = + ik_signal_num_to_code(WTERMSIG(status)); + } + }else if(r == 0){ /* would have blocked */ + ; /* let rvec return as all #f's */ + }else { + return ik_errno_to_code(); + } + return rvec; } diff --git a/src/ikarus-runtime.c b/src/ikarus-runtime.c index b18ade3..1926d82 100644 --- a/src/ikarus-runtime.c +++ b/src/ikarus-runtime.c @@ -539,13 +539,16 @@ ikptr ik_uuid(ikptr bv){ if(fd == -1){ fd = open("/dev/urandom", O_RDONLY); if(fd == -1){ - return false_object; + return ik_errno_to_code(); } uuid_strlen = strlen(uuid_chars); } long int n = unfix(ref(bv, off_bytevector_length)); unsigned char* data = (unsigned char*)(long)(bv+off_bytevector_data); - read(fd, data, n); + int r = read(fd, data, n); + if(r < 0){ + return ik_errno_to_code(); + } unsigned char* p = data; unsigned char* q = data + n; while(p < q){