ping.ss
#lang scheme/base

(require "later.ss"
         scheme/tcp
         scheme/class)

(define (listen db)
  (thread
   (λ ()
     (let ((listener (tcp-listen 12453 4 #t)))
       (let loop ()
         (let-values (((input output) (tcp-accept/enable-break listener)))
           (close-input-port input)
           (close-output-port output))
         (send db set-db-modified!))))))

(define ping
  (later
   1
   (λ ()
     (with-handlers
         ((exn:fail:network? (λ (e) (void))))
       (let-values (((input output) (tcp-connect "localhost" 12453)))
         (close-input-port input)
         (close-output-port output))))))

(provide ping listen)