mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-20 22:29:16 +02:00
54 lines
2.2 KiB
Text
54 lines
2.2 KiB
Text
|
|
(module (chibi process)
|
|
(export exit sleep alarm fork kill execute waitpid system
|
|
process-command-line process-running?
|
|
set-signal-action! make-signal-set signal-set-contains?
|
|
signal-set-fill! signal-set-add! signal-set-delete!
|
|
current-signal-mask
|
|
signal-mask-block! signal-mask-unblock! signal-mask-set!
|
|
signal/hang-up signal/interrupt signal/quit
|
|
signal/illegal signal/abort signal/fpe
|
|
signal/kill signal/segv signal/pipe
|
|
signal/alarm signal/term signal/user1
|
|
signal/user2 signal/child signal/continue
|
|
signal/stop signal/tty-stop signal/tty-input
|
|
signal/tty-output wait/no-hang)
|
|
(import (scheme))
|
|
(cond-expand (threads (import (srfi 18))) (else #f))
|
|
(include-shared "process")
|
|
(body
|
|
(define (system cmd . args)
|
|
(let ((pid (fork)))
|
|
(if (zero? pid)
|
|
(execute cmd (cons cmd args))
|
|
(waitpid pid 0)))))
|
|
(cond-expand
|
|
(bsd #f)
|
|
(else
|
|
(body
|
|
(define (process-command-line pid)
|
|
(call-with-current-continuation
|
|
(lambda (return)
|
|
(with-exception-handler
|
|
(lambda (exn) (return #f))
|
|
(lambda ()
|
|
(let ((file (string-append "/proc/" (number->string pid) "/cmdline")))
|
|
(call-with-input-file file
|
|
(lambda (in)
|
|
(let lp ((arg '()) (res '()))
|
|
(let ((ch (read-char in)))
|
|
(if (or (eof-object? ch) (eqv? (char->integer ch) 0))
|
|
(let ((res (cons (list->string (reverse arg)) res))
|
|
(ch2 (peek-char in)))
|
|
(if (or (eof-object? ch2) (eqv? (char->integer ch2) 0))
|
|
(reverse res)
|
|
(lp '() res)))
|
|
(lp (cons ch arg) res)))))))))))))))
|
|
(body
|
|
(define (process-running? pid . o)
|
|
(let ((cmdline (process-command-line pid)))
|
|
(and (pair? cmdline)
|
|
(or (null? o)
|
|
(not (car o))
|
|
(equal? (car o) (car cmdline))))))))
|
|
|