watchdog

A very small LISP implementation with several packages and demo programs.

#!bin/picolisp lib.l
# 13oct06abu
# (c) Software Lab. Alexander Burger
# Use: bin/watchdog <host> <port> <from> <to1> <to2> ..

(load "@lib/misc.l")

# *MailHost *MailPort *MailFrom *MailTo *Watch

(argv *MailHost *MailPort *MailFrom .  *MailTo)
(setq *MailPort (format *MailPort))

(unless (call 'test "-p" "fifo/beat")
   (call 'mkdir "-p" "fifo")
   (call 'rm "-f" "fifo/beat")
   (call 'mkfifo "fifo/beat") )

(push1 '*Bye '(call 'rm "fifo/beat"))

(de *Err
   (prin (stamp))
   (space)
   (println *Watch) )

(task (open "fifo/beat")
   (in @
      (let X (rd)
         (cond
            ((not X) (bye))
            ((num? X)
               (del (assoc X *Watch) '*Watch) )
            ((atom X)  # bin/picolisp -"out 'fifo/beat (pr '$(tty))" -bye
               (let D (+ (time T) (* 86400 (date T)))
                  (out X
                     (for W *Watch
                        (prinl
                           (align 5 (car W))
                           " "
                           (- (cadr W) D)
                           " "
                           (or (caddr W) "o")
                           " "
                           (cdddr W) ) ) ) ) )
            ((assoc (car X) *Watch)    # X = (Pid Tim . Any)
               (let W @                # W = (Pid Tim Flg . Any)
                  (when (caddr W)
                     (msg (car W) " " (stamp) " resumed") )
                  (set (cdr W) (cadr X))
                  (set (cddr W))
                  (con (cddr W) (or (cddr X) (cdddr W))) ) )
            (T (push '*Watch (list (car X) (cadr X) NIL (cddr X)))) ) ) ) )

(task -54321 54321
   (let D (+ (time T) (* 86400 (date T)))
      (for W (filter '((X) (> D (cadr X))) *Watch)
         (if (caddr W)
            (prog
               (msg (car W) " " (stamp)
                  (if (kill (car W) 15) " killed" " gone") )
               (del W '*Watch) )
            (inc (cdr W) 3600)
            (set (cddr W) T)
            (let Sub (pack "Timeout " (car W) " " (cdddr W))
               (msg (car W) " " (stamp))
               (for To *MailTo
                  (unless (mail *MailHost *MailPort *MailFrom To Sub)
                     (msg (list *MailHost *MailPort *MailFrom To Sub)
                        " mail failed "
                        (stamp) ) ) ) ) ) ) ) )

(wait)