scheme shell

From: Olin Shivers <>
Newsgroups: comp.lang.scheme.scsh
Subject: A little exercise in careful script-writing
Date: 01 Oct 1999 09:45:10 -0400
Organization: Artificial Intelligence Lab, MIT
Message-ID: <>

Friedrich posted the following little shell script, for doing a kind
of killall(1), and asked for comments:

    From: Friedrich Dominicus <>
    Subject: Is this quite reasonable scsh-programming?
    Date: Sun, 19 Sep 1999 18:03:57 +0200

    (define argc
      (length command-line-arguments))

    (define (main cmd-parameter)
      (define prog-name (argv 1))
      (if (not (= argc 2))
	      (usage prog-name)
	      ; else
	      (run-kill (argv 1) (argv 2))))

    (define (run-kill kill-signal program-name)
      (let ((pid-to-kill (get-pid-to-kill program-name)))
	    (if (> pid-to-kill 0)
		    (run (echo ,kill-signal ,pid-to-kill))
		    (format #t "There is no program ~a~%" program-name))))

      (define (get-pid-to-kill program-name)
	    (let ((line (run/string (| (ps aux)
				       (grep ,program-name)
				       (grep -v grep)
	      (if (not (string=? line ""))
		      (extract-pid line)

    (define (extract-pid line)
      (string->number (nth ((infix-splitter) line) 1)))

    (define (usage program-name)
      (format #t "~a <kill-signal> <program-to-kill> ~%" program-name))

    What should/can be improved?

I took this as a chance to go through a sample exercise in careful
script writing.  Here are my preferences, followed by the rewritten

I'd make the script an S48 module, with entry-point MAIN. I'd kill the
global ARGC var, and let MAIN calculate it itself. 

I always get confused as to whether or not the arg list includes the program
name. So I remove all confusion by *always* calling MAIN's parameter
PROG+ARGS, not ARGV or ARGL or ARGS. The contents are now obvious, given the

I'd globally define the infix splitter parser, so that it is only defined
once, even if you call this code multiple times from Scheme code (it doesn't
matter if you only use this as a script).

I also rewrote the regexp into SRE notation, which won't work on the current
release, but will work in 0.5.2, which we have had ready to release for over
a week. It should be out any day.

I would change GET-PID-TO-KILL to raise an error if it fails, not return 0. 
Alternately, have it return #f, intead of 0, then it's a simpler test.

Actually, I would change GET-PID-TO-KILL to return a *list* of pids matching
the program name -- you might have multiple processes around with the same

I would use scsh's string-processing tools instead of grep to pick out the
right lines from ps. Simpler, more lightweight, and more robust.

I would change the name, switching "kill" (which is a misnomer), to
the more correct "signal."

I would switch the order of the arguments from
    signal-all signal process-name
    signal-all process-name [signal]
which would allow you to make the signal option, defaulting it to SIGINT
(e.g., what a keyboard control-C generates).  However, note that this flips
the arg order from kill(1).

I would strip off any leading directory path from the program name as
reported by ps before comparing to the program name provided by the user.

If you try to kill a process you're not allowed to kill, scsh will raise
an error. There are three ways to address this:
   1. Leave as-is. It's an error.
      This is not good. Suppose you want to kill your latex, and someone
      else on the system is also running latex? Your script will blow up.

   2. Select out the user name or PID from the ps listing, and filter these.
      Hack the script so that we don't filter at all when running as root.
      I don't like this.

   3. Wrap a WITH-ERRNO-HANDLER around the SIGNAL-PROCESS call so that if
      an error is raised, we ignore it and quietly continue. This is what
      I did. So the procedure simply determines every process matching the
      given name, and takes a shot at all of them. You zap the ones the
      system lets you zap.

Finally, I'd let users specify the signal by *name* as well as number when
using the module as a script.

This gives us the following. 90 lines total:
     16 lines of whitespace & comments
     19 lines for the procedural core
     55 lines for for script-wrapper code: arg parsing, useage msg, 
        module gunk.
The result is useable both as a script and as a little code module for other
Scheme code.

#!/usr/local/bin/scsh \
-dm -m proc-signal-all -e main -s

;;; When used as a script:   signal-all <process-name> [<signal>]
;;;     -- <signal> defaults to 2 (SIGINT).
;;; When used as a procedure: (signal-all <process-name> <signal>)

(define-structure proc-signal-all (export signal-all)
  (open scsh
        string-lib	; Need string-ci=

(define (main prog+args)
  (let ((prog-name (car prog+args)))
    (case (length prog+args)
      ((2) (signal-all (second prog+args) signal/int))	; Default
      ((3) (signal-all (second prog+args) (arg->signal (third prog+args))))
      (else (usage prog-name)))))

(define (signal-all program sig)
  (for-each (lambda (pid) (with-errno-handler ((err packet) (else #f))
                            (signal-process pid sig)))
            (get-matching-pids program)))

;;; Returns a list of pids for processes whose command is exactly PROGRAM.
(define (get-matching-pids program)
  (let ((lines (cdr (run/strings (ps ax))))) ; Run ps, skip line 1.
    (filter-map (lambda (line)
                  (let ((m (regexp-search ps-re line)))
		    (and m
		         (string=? program 
                                   (file-name-nondirectory (match:substring m 2)))
			 (string->number (match:substring m 1)))))

;;; Match out the pid & command from a "ps ax" report.
(define ps-re (let ((token (rx (+ (~ white))))	; A run of non-whitespace chars
                    (sep (rx (+ white))))	; A run of whitespace
                (rx bos (* white)
                    (submatch ,token) ,sep	; pid
                    (= 3 ,token ,sep)		; tty status time
		    (submatch ,token))))	; command

(define (usage program-name)
  (format (error-output-port) "~a program-name [signal]~%" 
  (exit 1))

(define (arg->signal arg)
  (cond ((regexp-search? (rx bos (+ digit) eos) arg)	; if it's a numeral,
         (string->number arg))				; just use that.

	;; Otw, match against signal names
	((string-ci= "alrm"  arg) signal/alrm)
        ((string-ci= "int"   arg) signal/int)
        ((string-ci= "chld"  arg) signal/chld)
        ((string-ci= "cont"  arg) signal/cont)
        ((string-ci= "hup"   arg) signal/hup)
        ((string-ci= "quit"  arg) signal/quit)
        ((string-ci= "term"  arg) signal/term)
        ((string-ci= "tstp"  arg) signal/tstp)
        ((string-ci= "usr1"  arg) signal/usr1)
        ((string-ci= "usr2"  arg) signal/usr2)
        ((string-ci= "info"  arg) signal/info)
        ((string-ci= "io"    arg) signal/io)
        ((string-ci= "poll"  arg) signal/poll)
        ((string-ci= "prof"  arg) signal/prof)
        ((string-ci= "pwr"   arg) signal/pwr)
        ((string-ci= "urg"   arg) signal/urg)
        ((string-ci= "vtalrm" arg) signal/vtalrm)
        ((string-ci= "winch" arg) signal/winch)
        ((string-ci= "xcpu"  arg) signal/xcpu)
        ((string-ci= "xfsz"  arg) signal/xfsz)
        ((string-ci= "stop"  arg) signal/stop)
        ((string-ci= "kill"  arg) signal/kill)
        ((string-ci= "abrt"  arg) signal/abrt)
        ((string-ci= "fpe"   arg) signal/fpe)
        ((string-ci= "ill"   arg) signal/ill)
        ((string-ci= "pipe"  arg) signal/pipe)
        ((string-ci= "segv"  arg) signal/segv)
        ((string-ci= "ttin"  arg) signal/ttin)
        ((string-ci= "ttou"  arg) signal/ttou)
        ((string-ci= "bus"   arg) signal/bus)
        ((string-ci= "emt"   arg) signal/emt)
        ((string-ci= "iot"   arg) signal/iot)
        ((string-ci= "sys"   arg) signal/sys)
        ((string-ci= "trap"  arg) signal/trap)
	(else (error "Unknown signal name" arg))))

)) ; End of module