[plt-scheme] pipe-content-length: expects argument of type <pipe input port or output port>; given #<input-port:subprocess-stderr>

Hi folks,

I'm receiving the following error message when I attempt to use the  
procedure
(pipe-content-length pipe-port), from two threads which have been  
launched
to handle the i/o from bash launched with the procedure `subprocess'  
on an
OS X box.

At first I wasn't using the pipe-content-length procedure to inquire  
about the
port.   It was after isolating a problem I'm having, in the code  
below, where the
two threads were both blocking on a `read-char', instead of returning  
eof as they
should if there are no characters waiting to be read.  Since the two  
ports are
produced by the `subprocess' procedure, the doc indicates that they  
are each attached
to a pipe connected to stdout and stderr of the bash shell.  So, I  
did a search on pipe
in the help desk, and came up with `pipe-content-length' as a  
possible means of
diagnosing the problem.  Now that I'm getting an error regarding the  
type of port
being called into question, I thought I would see if anyone has dealt  
with the ports
returned from `subprocess', and wether I should be using something  
other than the
standard `read-char' to access them?

------------------------------------------------------------------------ 
------------
Welcome to DrScheme, version 369.100-svn13may2007 [3m].
Language: SchemeKeys.

. pipe-content-length: expects argument of type <pipe input port or  
output port>; given #<input-port:subprocess-stderr>
. pipe-content-length: expects argument of type <pipe input port or  
output port>; given #<input-port:subprocess-stdout>
bash for DrScheme is  running: pop-status #f pep-status #f
bash: "sending bash `exit'"
"waiting for bash to terminate"
"killing bash!"
"bash has terminated with exit code= " -1
"bash has terminated"
"terminating threads"
eof
------------------------------------------------------------------------ 
------------
I've included the code below if it will help.  Sorry, it's rather long.
Thanks,

--kyle

Kyle Smith
kyle at bellsouth dot net
schemekeys.blogspot.com
www.schemekeys.net
------------------------------------------------------------------------ 
------------
(module bash.ss mzscheme

   (provide (all-defined))

   (define (dp . x)
     (for-each (λ(n)(printf "~s " n)) x)(newline))
   (define (da . x)
     (for-each (λ(n)(printf "~a " n)) x)(newline))

   (define bash-path (string->path "/bin/bash"))
   (define sleep-interval 5)
   (define (bash-prompt) (display "bash: "))
   (define ill-formatted-cmd-msg
     "Commands must be a single string, within a list!  Recieved:")
   (define (go)
     (let-values ([(pid pop pip pep) (subprocess #f #f #f bash-path "- 
ls")])
       (if (not (and (input-port? pop) (input-port? pep) (output- 
port? pip)))
           (begin
             (dp "bad ports?")
             (subprocess-kill pid #t))
           (let ([pop-thread-id
                  (thread
                   (λ()
                     (da "stdout thread is up: "
                         'input-port? (input-port? pop)
                         'pipe-content-length (pipe-content-length pop))
                     (let loop ([ch (read-char pop)])
                       (if (not (eof-object? ch))
                           (display ch))
                       (let wait ([ready? (char-ready? pop)][tic 0])
                         (when (and (not ready?) (= tic 150))
                           (da "stdout thread is waiting: " ready?)
                           (set! tic 0))
                         (unless ready?
                           (sleep 0.1)
                           (wait (char-ready? pop) (add1 tic))))
                       (loop (read-char pop)))))]
                 [pep-thread-id
                  (thread
                   (λ()
                     (da "stderr thread is up"
                         'input-port? (input-port? pep)
                         'pipe-content-length (pipe-content-length pep))
                     (let loop ([ch (read-char pep)])
                       (if (not (eof-object? ch))
                           (display ch))
                       (let wait ([ready? (char-ready? pep)][tic 0])
                         (when (and  (not ready?) (= tic 150))
                           (da "stderr thread is waiting: " ready?)
                           (set! tic 0))
                         (unless ready?
                           (sleep 0.1)
                           (wait (char-ready? pep) (add1 tic))))
                       (loop (read-char pep)))))])
             (define (bash-status pid)
               (let ([status (subprocess-status pid)]
                     [pop-status (thread-running? pop-thread-id)]
                     [pep-status (thread-running? pep-thread-id)])
                 (cond
                   [(eq? status 'running)
                    (format "~a: ~a ~a ~a ~a"
                              'running
                              'pop-status
                              pop-status
                              'pep-status
                              pep-status)]
                   [else
                    (dp "bash has terminated with exit code= " status)
                    #f])))

             (sleep 1)
             (if (not (subprocess? pid))  ;;; isa? is rather a long  
procedure
                                          ;;; so I comment it out below.
                 (dp "subprocess returned an invalid pid: " pid #; 
(isa? pid))
                 (dynamic-wind
                  (λ() (da "bash for DrScheme is " (bash-status pid)))
                  (λ()
                    (let/ec break
                      (if (not (bash-status pid)) (break 'bash-is-down))
                      (bash-prompt)
                      (let loop ([cmd (read)])
                        (cond
                          [(eof-object? cmd) (break 'eof)]
                          [(not (list? cmd))
                           (dp ill-formatted-cmd-msg cmd)
                           (bash-prompt)
                           (loop (read))]
                          [(and (= (length cmd) 2)
                                (eqv? (car cmd) 'sleep))
                           (set! sleep-interval (cadr cmd))]
                          [(and (= (length cmd) 1)
                                (string? (car cmd)))
                           ;;; Send cmd onto bash
                           (dp 'cmd-sent-to-bash: (car cmd))
                           (display (car cmd) pip)
                           (display (newline) pip)
                           (sleep sleep-interval)
                           (if (not (bash-status pid)) (break 'bash- 
is-down))
                           (bash-prompt)
                           (loop (read))]
                          [else
                           (dp ill-formatted-cmd-msg cmd)
                           (bash-prompt)
                           (loop (read))]))))
                  (λ()
                    (cond
                      [(not (bash-status pid))
                       (dp "bash had terminated early!")]
                      [else
                       (dp "sending bash `exit'")
                       (display "exit\n" pip)
                       (dp "waiting for bash to terminate")
                       (sleep 3)
                       (if (bash-status pid)
                           (begin
                             (dp "killing bash!")
                             (subprocess-kill pid #t)
                             (sleep 3)))
                       (if (bash-status pid)
                           (dp "bash shell will not terminate,  
process-id= "
                               (subprocess-pid pid))
                           (dp "bash has terminated"))])
                    (dp "terminating threads")
                    (kill-thread pop-thread-id)
                    (kill-thread pep-thread-id)
                    ))))))
     )
   )
#|
<test-suite>
|#
(require bash.ss)
(go)
#|
</test-suite>


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.racket-lang.org/users/archive/attachments/20070522/8e8de0a5/attachment.html>