Re: [Chicken-users] Is there a way to get tcp-accept to time-out?

[felix winkelmann]

On Fri, 25 Feb 2005 10:40:03 -0500, Ed Watkeys <address@hidden> wrote:
> 
> I'm going to investigate using a signal handler to deal with my
> problem. After all, I don't care about returning from TCP-ACCEPT every
> x seconds. The point of timing-out is to check if someone has requested
> a server shutdown. I just need to make sure the appropriate
> (TCP-ACCEPT-ing) thread is interrupted by the signal.

Here is a solution that might work (sorry for the low-level hacks):

(use srfi-18 tcp)

(define l (tcp-listen 6502))

(define (wait t s)
  (thread-start!
   (lambda ()
     (print "sleeping...")
     (thread-sleep! s)
     (print "unblocking")
     (when (eq? 'blocked (thread-state t))
       (##sys#thread-unblock! t) ) ) ) )

(define (run)
  (thread-wait-for-i/o (tcp-listener-fileno l))
  (if (tcp-accept-ready? l)
      (begin
        (print "accepting...")
        (let-values ([(i o) (tcp-accept l)])
          (print (list i o)) ) )
      (print "timeout") ) )

(define (tcp-listener-fileno l)
  (##sys#check-structure l 'tcp-listener 'tcp-listener-fileno)
  (##sys#slot l 1) )

(define (thread-wait-for-i/o fd #!optional (input #t))
  (##sys#thread-block-for-i/o! (current-thread) fd input)
  (thread-yield!) )

(wait (current-thread) 2)
(run)
(wait (current-thread) 2)
(run)
(wait (current-thread) 2)
(run)


cheers,
felix