#!bin/picolisp lib.l
# 10oct20 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)
               (let? W (assoc X *Watch)
                  (when (caddr W)
                     (msg (car W) " " (stamp) " bye") )
                  (del W '*Watch) ) )
            ((atom X)  # bin/picolisp -"out 'fifo/beat (pr '$(tty))" -bye
               (let D (+ (* 86400 (date T)) (time T))
                  (out X
                     (for W *Watch
                        (prinl
                           (align 7 (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 (+ (* 86400 (date T)) (time T))
      (for W *Watch
         (cond
            ((>= (cadr W) D))
            ((caddr W)
               (msg (car W) " " (stamp)
                  (if (kill (car W) 15) " killed" " gone") )
               (del W '*Watch) )
            (T
               (inc (cdr W) 3600)
               (set (cddr W) T)
               (let Sub (pack "Timeout " (car W) " " (cdddr W))
                  (msg (car W) " " (stamp))
                  (unless (mail *MailHost *MailPort *MailFrom *MailTo Sub)
                     (msg (cons Sub *MailTo) " mail failed " (stamp)) ) ) ) ) ) ) )

(wait)
