picolisp

Unnamed repository; edit this file to name it for gitweb.
git clone https://logand.com/git/picolisp.git/
Log | Files | Refs | README | LICENSE

watchdog (2211B)

      1 #!bin/picolisp lib.l
      2 # 09mar08abu
      3 # (c) Software Lab. Alexander Burger
      4 # Use: bin/watchdog <host> <port> <from> <to1> <to2> ..
      5 
      6 (load "@lib/misc.l")
      7 
      8 # *MailHost *MailPort *MailFrom *MailTo *Watch
      9 
     10 (argv *MailHost *MailPort *MailFrom .  *MailTo)
     11 (setq *MailPort (format *MailPort))
     12 
     13 (unless (call 'test "-p" "fifo/beat")
     14    (call 'mkdir "-p" "fifo")
     15    (call 'rm "-f" "fifo/beat")
     16    (call 'mkfifo "fifo/beat") )
     17 
     18 (push1 '*Bye '(call 'rm "fifo/beat"))
     19 
     20 (de *Err
     21    (prin (stamp))
     22    (space)
     23    (println *Watch) )
     24 
     25 (task (open "fifo/beat")
     26    (in @
     27       (let X (rd)
     28          (cond
     29             ((not X) (bye))
     30             ((num? X)
     31                (del (assoc X *Watch) '*Watch) )
     32             ((atom X)  # bin/picolisp -"out 'fifo/beat (pr '$(tty))" -bye
     33                (let D (+ (* 86400 (date T)) (time T))
     34                   (out X
     35                      (for W *Watch
     36                         (prinl
     37                            (align 5 (car W))
     38                            " "
     39                            (- (cadr W) D)
     40                            " "
     41                            (or (caddr W) "o")
     42                            " "
     43                            (cdddr W) ) ) ) ) )
     44             ((assoc (car X) *Watch)    # X = (Pid Tim . Any)
     45                (let W @                # W = (Pid Tim Flg . Any)
     46                   (when (caddr W)
     47                      (msg (car W) " " (stamp) " resumed") )
     48                   (set (cdr W) (cadr X))
     49                   (set (cddr W))
     50                   (con (cddr W) (or (cddr X) (cdddr W))) ) )
     51             (T (push '*Watch (list (car X) (cadr X) NIL (cddr X)))) ) ) ) )
     52 
     53 (task -54321 54321
     54    (let D (+ (* 86400 (date T)) (time T))
     55       (for W (filter '((X) (> D (cadr X))) *Watch)
     56          (if (caddr W)
     57             (prog
     58                (msg (car W) " " (stamp)
     59                   (if (kill (car W) 15) " killed" " gone") )
     60                (del W '*Watch) )
     61             (inc (cdr W) 3600)
     62             (set (cddr W) T)
     63             (let Sub (pack "Timeout " (car W) " " (cdddr W))
     64                (msg (car W) " " (stamp))
     65                (unless (mail *MailHost *MailPort *MailFrom *MailTo Sub)
     66                   (msg (cons Sub *MailTo) " mail failed " (stamp)) ) ) ) ) ) )
     67 
     68 (wait)