Thread + Socket + Pipes Bug?

[Robert Marlow <bobstopper@australispro.com.au>]

[-- Attachment #1: Type: text/plain, Size: 1084 bytes --]

Hi

I've been spending ages on this bug and can't figure it out. I'm pretty
sure it's not a bug in something I've done so I'm submitting it here as
a possible guile bug. If it's not a bug in guile, many apologies but
please let me know what's gone wrong. 

I've attached two trimmed-down scripts which reproduce the bug. If you
place them in the same directory and run buggy.scm then you should be
able to connect to tcp port 6008 and start dumping data. The bug occurs
when you do this, crashing with an error as follows:

ERROR: In procedure select:
ERROR: Bad file descriptor

In my playing around I seem to have narrowed it down to being caused by
select working on one thread and a pipe being written to on another
thread. I couldn't determine much more than that. I do know the bug
occurs on both Solaris and GNU/Linux.

I hate to be whiney but my progress here at work is pretty well at a
standstill until either this bug is resolved or I dump guile and settle
for something like perl (which I really, really don't want to do). So
please help.


-- 
Regards,

Robert Marlow




[-- Attachment #2: buggy.scm --]
[-- Type: text/x-scheme, Size: 1811 bytes --]

#!/usr/bin/guile \
-e main -s
!#

(use-modules (ice-9 threads)
             (ice-9 popen))

(define mutex (make-mutex))
(define message-ready (make-condition-variable))

(define message "")

(define (main args)
  (begin-thread (thread))
  (begin-thread (thread))
  (begin-thread (thread))
  (begin-thread (thread))
  (begin-thread (thread))
  (let ((sock #f)
        (fileno #f))
    (lock-mutex mutex)
    (set! sock (socket AF_INET SOCK_STREAM 0))
    (unlock-mutex mutex)
    (bind sock AF_INET INADDR_ANY 6008)
    (listen sock 5)
    (while
     #t
     (let* ((client-connection (accept/no-block sock))
            (client-details (cdr client-connection))
            (client (car client-connection)))
       (lock-mutex mutex)
       (do ((line (read-line client) (read-line client)))
           ((eof-object? line)
            (shutdown client 2))
         (set! message (string-append message line "\n")))
       (signal-condition-variable message-ready)
       (unlock-mutex mutex)))))


(define (thread)
  (while
   #t
   
   (lock-mutex mutex)
   (if (not (> (string-length message) 0))
       (wait-condition-variable message-ready mutex)
       (let ((outgoing message))
         (set! message "")
         (unlock-mutex mutex)
         (piper outgoing)))
   (unlock-mutex mutex)))


(define (piper message)
  (lock-mutex mutex)
  (let ((pipe (open-output-pipe "./buggy-companion.scm")))
    (display message pipe)
    (close-port pipe))
  (unlock-mutex mutex))
    



(define (accept/no-block s)
  (if (null? (car (select (vector s) '() '()))) ; This select complains
      (accept/no-block s)
      (let ((client #f))
        (lock-mutex mutex)
        (set! client (accept s))
        (unlock-mutex mutex)
        client)))

[-- Attachment #3: buggy-companion.scm --]
[-- Type: text/x-scheme, Size: 242 bytes --]

#!/usr/bin/guile \
-e main -s
!#

(define (main args)
  (let ((str ""))
    (do ((line (read-line) (read-line)))
	((eof-object? line))
      (set! str (string-append str line "\n")))
     (sleep 10)
     (display str)))
	    
    

[-- Attachment #4: Type: text/plain, Size: 136 bytes --]

_______________________________________________
Bug-guile mailing list
Bug-guile@gnu.org
http://mail.gnu.org/mailman/listinfo/bug-guile