door v.1

[Thien-Thi Nguyen]

please find below a simple daemon that tracks incoming host via
finger(1), useful when run on the colo box for finding your home box in
the presence of dynamic IPs.  your home box needs to ssh into the colo
box periodically and do "kill -USR1 PIDFILE" (perhaps via ~/.bashrc or
the like).  munge *track-file* to taste.

thi


_____________________________
#!/bin/sh
# aside from this initial boilerplate, this is actually -*- scheme -*- code
main='(module-ref (resolve-module '\''(door)) '\'main')'
exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
!#
;;; Copyright (C) 2002 Thien-Thi Nguyen
;;; This program is available under the terms of the GNU GPL.
;;; See http://www.fsf.org/copyleft/gpl.html for details.

;;; Commentary:

;; Usage: door --daemon PIDFILE
;;        door --kill PIDFILE
;;        door --recheck PIDFILE
;;        kill -USR1 `cat PIDFILE`
;;
;; Writes door.log in current directory.  Writes *track-file*, q.v.

;;; Code:

(define-module (door)
  :use-module (scripts PROGRAM)
  :autoload (scripts slurp) (slurp)
  :autoload (ice-9 popen) (open-pipe)
  :autoload (ice-9 regex) (string-match match:substring))

(define (shell-command->string command)         ; yuk!
  (system (format #f "~A > /tmp/ZZZ" command))
  (let ((retval (slurp "/tmp/ZZZ")))
    (delete-file "/tmp/ZZZ")
    retval))

(define (now-string)
  (strftime "%Y-%m-%d %H:%M:%S" (localtime (current-time))))

(define *track-file* "/home/ttn/www.glug.org/<CENSORED>")

(define *cache* "")

(define (check log)
  (let* ((finger-info (shell-command->string "finger -s ttn"))
         (host (cond ((string-match "\\(([^\n]+)\\)" finger-info)
                      => (lambda (m) (match:substring m 1)))
                     (else *cache*))))
    (cond ((string=? *cache* host))
          (else
           (format log "~A: host change: ~A\n" (now-string) host)
           (format (open-output-file *track-file*)
                   "~A\n(last changed ~A)\n"
                   host (now-string))
           (flush-all-ports)
           (set! *cache* host)))))

(define (daemon pidfile)
  (write (getpid) (open-output-file pidfile))
  (flush-all-ports)
  (let ((alive? #f)
        (log (open-file "door.log" "a")))
    (format log "\n~A: restart pid=~A\n" (now-string) (getpid))
    (sleep 2)
    (let ((bye-handler (lambda (sig)
                         (format log "~A: got signal: ~A\n" (now-string) sig)
                         (format log "~A: bye! (~A deletion ~A)\n"
                                 (now-string)
                                 pidfile
                                 (if (delete-file pidfile) "ok" "failed"))
                         (set! alive? #f))))
      (for-each (lambda (sig)
                  (sigaction sig bye-handler))
                (list SIGINT SIGHUP SIGQUIT SIGALRM)))
    (sigaction SIGUSR1 (lambda (ignore) (check log)))
    (sigaction SIGUSR2 (lambda (ignore)
                         (format log "~A: clearing cache for recheck\n"
                                 (now-string))
                         (set! *cache* "")
                         (check log)))
    (format log "~A: becoming alive now\n" (now-string))
    (set! alive? #t)
    (let loop () (flush-all-ports) (pause) (and alive? (loop)))))

(define (door-main/qop qop)
  (cond ((qop 'daemon #f) => (lambda (pidfile)
                               (and (= 0 (primitive-fork))
                                    (daemon pidfile))))
        ((qop 'recheck #f) => (lambda (pidfile)
                                (kill (string->number (slurp pidfile))
                                      SIGUSR2)))
        ((qop 'kill #f) => (lambda (pidfile)
                             (kill (string->number (slurp pidfile))
                                   SIGQUIT)))))

(define (main . args)
  (script-MAIN args "door" door-main/qop
               '(usage . commentary)
               '(version . 1)
               '(option-spec (daemon (value #t))
                             (recheck (value #t))
                             (kill (value #t))))
  #t)

;;; door ends here