Re: Are there any way to mimic Bash's exit traps in Guile?

[Михаил Бахтерев]

Many thanks for the very educational answer

On Sat, May 25, 2019 at 09:24:10AM -0400, Mark H Weaver wrote:
> Hello again,
> 
> Mark H Weaver <address@hidden> writes:
> 
> > Михаил Бахтерев <address@hidden> writes:
> >
> >> I use in one of my bash-scripts the following construction
> >>
> >>   trap "kill -s TERM 0" EXIT
> 
> In my earlier reply, I somehow failed to notice that you're killing the
> entire process group by passing 0 to kill.  This simplifies things quite
> a bit.
> 
> >> to terminate all spawned processes when master process exits or is
> >> aborted by any reason. Is equivalent technique possible in Guile?
> >
> > Guile doesn't provide anything like this out-of-the-box, but you should
> > be able to accomplish something similar in Guile by installing signal
> > handlers for all terminating signals, and additionally wrapping the main
> > program within (catch #t ...).  This should catch most exit modes,
> > including calls within Scheme to 'exit' or 'quit'.
> 
> See below for an example Guile script that does something reasonably
> close to what Bash does when you install an EXIT trap in a
> non-interactive shell.
> 
> Note that in my example 'exit-handler' below, I arrange for SIGTERM to
> be ignored in the current process before killing the process group, to
> avoid killing the master process with SIGTERM.
> 
> In 'term-signal-handler', after running 'exit-handler', I restore the
> default handler for the signal that we originally caught, and then send
> that signal to the master process.  These last steps are exactly what
> Bash does at the end of 'termsig_handler' in sig.c.
> 
> This way, if we receive a terminating signal, we report back to our
> parent process (via waitpid) the original signal number that killed us.
> 
>       Mark
> 
> 
> --8<---------------cut here---------------start------------->8---
> (use-modules (srfi srfi-1)   ; list library
>              (ice-9 match))
> 
> (define terminating-signal-names
>   '(SIGHUP SIGINT SIGILL SIGTRAP SIGIOT SIGDANGER
>     SIGEMT SIGFPE SIGBUS SIGSEGV SIGSYS SIGPIPE
>     SIGALRM SIGTERM SIGXCPU SIGXFSZ SIGVTALRM
>     SIGLOST SIGUSR1 SIGUSR2))
> 
> (define terminating-signals
>   (let ((mod (resolve-module '(guile))))
>     (filter-map (lambda (sig-name)
>                   (and=> (module-variable mod sig-name)
>                          variable-ref))
>                 terminating-signal-names)))
> 
> (define (exit-handler)
>   (sigaction SIGTERM SIG_IGN)
>   (kill 0 SIGTERM)
>   (display "exit-handler")
>   (newline)
>   (force-output))
> 
> (define (term-signal-handler sig)
>   (restore-signals)
>   (exit-handler)
>   (sigaction sig SIG_DFL)
>   (kill (getpid) sig))
> 
> (define (install-signal-handlers)
>   (for-each (lambda (sig)
>               (match (sigaction sig)
>                 ((handler . flags)
>                  (when (eqv? handler SIG_DFL)
>                    (sigaction sig term-signal-handler)))))
>             terminating-signals))
> 
> (define (call-with-exit-handler thunk)
>   (install-signal-handlers)
>   (catch #t
>     thunk
>     (lambda (key . args)
>       (exit-handler)
>       (apply throw key args)))
>   (exit-handler))
> 
> (call-with-exit-handler
>  (lambda ()
>    (let loop ((i 0))
>      (display i)
>      (newline)
>      (loop (+ i 1)))))
> --8<---------------cut here---------------end--------------->8---