Its so quiet on this list! Here's a PPP monitor/dialer for Linux
written in STk. Is there a sleep function in STk?
#!/usr/local/bin/stk -f
(define out (current-output-port))
(define (get-ppp-pid)
; (format out "Reading ppp0.pid file.\n")
(if (file-exists? "/var/run/ppp0.pid")
(let* ((port (open-input-file "/var/run/ppp0.pid"))
(pid (read port))) ; Hey, its a scheme expression!
(close-input-port port)
;(format out "Setting pid to ~s\n" pid)
pid)
#f))
(define (down?)
(and (not dialing) (not (number? pid))))
(define (running?)
(and (not dialing)
(number? pid)
(file-exists? (string-append "/proc/" (number->string pid)))))
(define (died?)
(and (number? pid)
(not (file-exists? (string-append "/proc/" (number->string pid))))))
(define (dial)
;(format out "Dialing...\n")
(set! dialing #t)
(system "ls -l /var/log/messages | awk '{print $5}' > /tmp/pppmon")
(system "/usr/sbin/pppd&"))
(define (exited?)
(= (system
(string-append
"tail +`cat /tmp/pppmon`c < /var/log/messages "
"| grep 'pppd.* Exit\.' > /dev/null")) 0))
(define (routed?)
(= (system
(string-append
"tail +`cat /tmp/pppmon`c < /var/log/messages "
"| grep 'pppd.* remote IP address\.' > /dev/null")) 0))
(define (hangup)
;(format out "Hanging up...\n")
(if (number? pid)
(system (string-append "kill " (number->string pid)))))
(define pid (get-ppp-pid))
(define red "#ff0000")
(define yellow "#ffb000")
(define green "#00c000")
(define dialing #f)
(let ((status 'unknown)
(Color "#000000"))
[frame '.f :relief "raised" :bd 2]
[button '.f.start :text "Dial" :command dial]
[button '.f.hangup :text "Hang Up" :command hangup]
[button '.f.exit :text "Exit" :command (lambda () (exit 0))]
; (pack .f.start .f.hangup .f.exit :fill "x" :side "left" :expand #t)
; (pack [frame '.status :width 180 :height 50 :bg Color] .f)
(pack .f.start .f.hangup .f.exit :expand #t :fill "x")
(pack [frame '.status :width 50 :height 94 :bg Color] .f :fill "x" :side "left")
(let loop ()
; If process dies reset pid
(if (died?)
(begin
;(format out "Process died, resetting pid.\n")
(set! pid #f)))
(let ((new-color
(cond ((down?)
;(format out "down.\n")
(system "sleep 5")
red)
((running?)
;(format out "running.\n")
(system "sleep 5")
green)
((died?)
;(format out "died.\n")
(set! pid #f)
red)
((exited?)
;(format out "exited.\n")
(set! dialing #f)
(set! pid #f)
red)
((routed?)
;(format out "routed.\n")
(set! pid (get-ppp-pid))
(if pid (begin (set! dialing #f) green) yellow))
(else
;(format out "still dialing.\n")
(system "sleep 1")
yellow))))
(if (not (string=? new-color Color))
(begin
(set! Color new-color)
(tk-set! .status :bg Color))))
(update)
(loop)))
--
David Fox http://found.cs.nyu.edu/fox xoF divaD
NYU Media Research Lab fox_at_cs.nyu.edu baL hcraeseR aideM UYN
Received on Mon Nov 25 1996 - 12:14:24 CET