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

(load "@lib/misc.l")

# *MailHost *MailPort *MailFrom *MailTo *Beat *Watch

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

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

(?push '*Bye '(call "rm" "fifo/beat"))

(de *Err
   (out NIL
      (prin (stamp))
      (space)
      (println *Watch) )
   (bye) )

(task (setq *Beat (open "fifo/beat"))
   (in *Beat
      (let X (rd)
         (cond
            ((not X) (bye))
            ((num? X)
               (setq *Watch (delete (assoc X *Watch) *Watch)) )
            ((atom X)  # bin/pico -"out 'fifo/beat (pr '$(tty))" -bye
               (let D (+ (time) (* 86400 (date)))
                  (out X
                     (mapc
                        '((W)
                           (prinl
                              (align 5 (car W))
                              " "
                              (- (cadr W) D)
                              " "
                              (or (caddr W) "o")
                              " "
                              (cdddr W) ) )
                        *Watch ) ) ) )
            ((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) (* 86400 (date)))
      (mapc
         '((W)
            (if (caddr W)
               (prog
                  (msg (car W) " " (stamp)
                     (if (kill (car W) 15) " killed" " gone") )
                  (setq *Watch (delete W *Watch)) )
               (inc (cdr W) 3600)
               (set (cddr W) T)
               (let Sub (pack "CRASH " (car W) " " (cdddr W))
                  (msg (car W) " " (stamp))
                  (mapc
                     '((To)
                        (unless (mail *MailHost *MailPort *MailFrom To Sub)
                           (msg (list *MailHost *MailPort *MailFrom To Sub)
                              " mail failed "
                              (stamp) ) ) )
                     *MailTo ) ) ) )
         (filter '((X) (> D (cadr X))) *Watch) ) ) )

(wait)
