Hi,
I worked hard to isolate one of my bugs and I found a rather disturbing minimal example that reproduces the bug. It can be observed in all the latests versions of Gambit (including 4.2.1).
Basically, I start a minimal multithread web server and in another thread I start a loop that calls a serie of open-tcp-client to different ips in the local network. The default web browser is launched to get the page served by the web server.
On MacOSX Leopard everything is fine. On WindowsXP (MingW compiled version of Gambit) the page takes an unnaceptable loooong time to load. The website index.html must require multiple HTTP GET to render (a page with multiple pictures for example).
What is the most disturbing is that if I replace the calls to "read-u8- line" by simple "read-line", the bug disapears. The bug is therefore somehow related to "read-u8".
Here is the sample code. You have to define "Server-ROOT" at the top so it points to a website on your local hard-drive. I didn't try on Linux but to try it the code will have to be adapted a little bit (how to launch the default browser on Linux?).
What could lead to this huge difference between a sequence of read-u8 and read-line on WinXP???
Thank you, Francois Magnan
;;; Gambit Networking Test Example ;;; ;;; Minimal web server that gets incredibly slow on WinXP (MinGW) if it is run in parallel with another thread that does a network scan. ;;; ;;; If the "read-u8-line" calls are replaced by "read-line" the bug disapears. ;;; ;;; On MacOSX Leopard the bug is not present. ;;; ;;; Was tested with versions: Gambit-C 4.0.1, 4.1.2, 4.2.1 ;;;
;;; ;;;; Server-ROOT ;;;
;;; ******************* ;;; Put here the path to a static website with many files to load to render index.html ;;; *******************
;(define Server-ROOT "/Users/magnan/TELOS/interface/TELOS-Desktop") (define Server-ROOT "C:/TELOS/interface/TELOS-Desktop")
;;; ;;;; main ;;;
(define (main) (start-server) (start-broadcast) (start-client) )
;;; ;;;; Minimal Web Server ;;;
(define (start-server) (let ((rpc-command-queue (open-tcp-server (list port-number: 8000)))) (thread-start! (make-thread (lambda () (let loop () (let ((incoming-connection (read rpc-command-queue))) (force-output) (serve-connection incoming-connection)) (loop)))))))
(define (serve-connection incoming-connection) (thread-start! (make-thread (lambda () (let* ((line (read-u8-line incoming-connection)) (splitted (split-string line #\space)) (path (cadr splitted))) (read-all-headers incoming-connection) (force-output) (with-exception-catcher (lambda (e) (##display-exception e (current-output-port))) (lambda () (serve-file path incoming-connection))))))))
(define (read-all-headers incoming-connection) (let ((line (read-u8-line incoming-connection))) (pp (list "read header line" line)) (force-output) (if (not (equal? line "")) (read-all-headers incoming-connection))))
(define (split-string str sep-char) (call-with-input-string str (lambda (p) (read-fields p sep-char #f))))
(define (read-fields port sep inc-sep?) (read-all port (lambda (p) (read-line p sep inc-sep?))))
(define (serve-file path incoming-connection) (let* ((complete-path (string-append Server-ROOT path)) (fileInfo (file-info complete-path)) (size (file-info-size fileInfo)) (mimetype (compute-mimetype complete-path)) (header (compute-get-result-header size mimetype))) (display header incoming-connection) (output-file-data complete-path incoming-connection) (close-port incoming-connection)))
(define (compute-get-result-header size mimetype) (string-append "HTTP/1.0 200 OK\r\n" "Content-type: " mimetype "\r\n" "Content-length: " (number->string size) "\r\n" "\r\n"))
(define (output-file-data filePath connection) (with-input-from-file filePath (lambda () (letrec ((output-file-data-rec (lambda () (let ((rc (read-char))) (if (not (equal? rc #!eof)) (begin (write-char rc connection) (output-file-data-rec))))))) (output-file-data-rec)))))
(define (compute-mimetype filePath) (let* ((ext (path-extension filePath)) (rext (and (string? ext) (substring ext 1 (string-length ext))))) (case (string->symbol rext) ((jpg jpeg JPG JPEG) "image/jpeg") ((gif GIF) "image/gif") ((png PNG) "image/png") ((html HTML htm HTM) "text/html") ((js JS) "text/javascript") ((css CSS) "text/css") (else "application/octet-stream" ))))
;;; ;;;; start-broadcast ;;;
(define (start-broadcast) (thread-start! (make-thread (lambda () (let* ((hostname (host-name)) (hi (host-info hostname)) (host-ips (host-info-addresses hi)) (host-ip (car host-ips))) (letrec ((network-broadcast (lambda (i) (if (= i 255) #t (begin (u8vector-set! host-ip 3 i) (call-addr host-ip) (thread-sleep! 0.2) (network-broadcast (+ i 1))))))) (network-broadcast 1)))))))
(define (call-addr target-addr) (pp (list "trying to reach" target-addr)) (with-exception-catcher (lambda (e) #f) (lambda () (let ((port (open-tcp-client (list server-address: target-addr port-number: 5000)))) (with-exception-catcher (lambda (e) #f) (lambda () (input-port-timeout-set! port 0.1) (output-port-timeout-set! port 0.1) (write (list 1 2 3) port))) (close-port port)))))
;;; ;;;; Client ;;;
(define (start-client) (if (equal? (get-host-os) "WinXP") (shell-command "start http://localhost:8000/index.html") (shell-command "open "http://localhost:8000/index.html%5C"")))
(define (get-host-os) (with-exception-handler (lambda (e) "WinXP") (lambda () (let* ((p (open-process '(path: "/usr/bin/uname" arguments: ("-s")))) (r (read-line p))) (close-port p) r))))
;;; ;;;; read-u8-line ;;;
(define (read-u8-line port) (letrec ((read-loop (lambda (acc) (let ((b (read-u8 port))) (if (or (equal? b 13) (equal? b 10) (equal? b #!eof)) (begin (read-u8 port) acc) (read-loop (string-append acc (list-
string (list (integer->char b))))))))))
(read-loop "")))
;;; ;;;; start main ;;;
(main)
Afficher les réponses par date
François Magnan wrote:
What could lead to this huge difference between a sequence of read-u8 and read-line on WinXP???
Just an idea (I don't run windows and am too tired to study the code in detail): you might be miscalculating the reply length, compared to what's actually being sent, since possibly you/the runtime might be decoding/encoding utf8 twice or something, and then the individual requests might only be "finished" when some part timeouts (the browser might be closing the connection after some timeout). I'd check what goes over the wire (and when) with some tool that can do that (something like GNU/Linux' strace or tcpdump).
I forgot to mention the other thing that came to mind: note the bug on OS X that has been reported and fixed some time ago about the high resolution timer (timer triggering much too often, thus leaving almost no time for actual processing). This comes to mind because you're saying it only happens with multiple threads. If you're seeing your server process taking up all cpu time then it's likely rather something like that.
Christian.
Hi Christian,
Thank you for your help. The "Content-Length" header is not the issue here because the faulty code does byte-by-byte IO (read-u8, write-u8) so I know exactly how many bytes I output and there is no encoding/ decoding taking place without my knowledge. In fact it works very well if I disable the concurrent calls to open-tcp-client. It also always work perfectly on MacOSX so I doubt there is an enconding issue.
About your second thought, the clock resolution problem on OSX is not the problem since it works on OSX like I said above.
For me, it looks like read-u8 and write-u8 in MinGW are somehow blocked when there is too much parallel network activity. I could not drill it down to a simpler case that the one I sent.
In the meantime, I will avoid using read-u8 and write-u8 on WinXP.
Thank you, Francois Magnan
On 10-Feb-08, at 6:17 PM, Christian Jaeger wrote:
François Magnan wrote:
What could lead to this huge difference between a sequence of read- u8 and read-line on WinXP???
Just an idea (I don't run windows and am too tired to study the code in detail): you might be miscalculating the reply length, compared to what's actually being sent, since possibly you/the runtime might be decoding/encoding utf8 twice or something, and then the individual requests might only be "finished" when some part timeouts (the browser might be closing the connection after some timeout). I'd check what goes over the wire (and when) with some tool that can do that (something like GNU/Linux' strace or tcpdump).
You might want to try out changeset 102 which fixes a nasty I/O bug on Windows (thank you Guillaume Cartier for pointing out the problem and helping me debug it).
Marc
On 11-Feb-08, at 10:05 AM, François Magnan wrote:
Hi Christian,
Thank you for your help. The "Content-Length" header is not the issue here because the faulty code does byte-by-byte IO (read-u8, write-u8) so I know exactly how many bytes I output and there is no encoding/ decoding taking place without my knowledge. In fact it works very well if I disable the concurrent calls to open-tcp-client. It also always work perfectly on MacOSX so I doubt there is an enconding issue.
About your second thought, the clock resolution problem on OSX is not the problem since it works on OSX like I said above.
For me, it looks like read-u8 and write-u8 in MinGW are somehow blocked when there is too much parallel network activity. I could not drill it down to a simpler case that the one I sent.
In the meantime, I will avoid using read-u8 and write-u8 on WinXP.
Regarding this previous problem I submitted, I worked on isolating it to simpler terms. I found another IO problem on Gambit 4.2.5 on WindowsXP (MinGW). I don't know if they are related in any way.
The problem occurs when I do an open-process on a dummy bat script that: outputs two lines and loop indefinitely. I read the the lines in the process port and after that, all IO is blocked in Gambit. To show this, I run a dummy tcp server and a loop of clients calls to this server concurrently and this loop gets stuck when all IO is blocked.
Strangely, if I send a (read-line) in the process port; It unblocks the IO even if there is actually nothing to read in the port.
Here is the code to reproduce it on Windows (MingW):
----- Simple BAT script ---------------------------
@ECHO OFF
ECHO A ECHO B
:loop IF 1==1 GOTO loop
--------------------------------------------------------
----- Gambit 4.2.5 Code ---------------------------
(define n 0)
;;; ;;;; main ;;;
(define (main) (start-server) (start-open-process) (start-clients))
;;; ;;;; Minimal Server ;;;
(define (start-server) (let ((rpc-command-queue (open-tcp-server (list port-number: 8001)))) (thread-start! (make-thread (lambda () (let loop () (let ((incoming-connection (read rpc-command-queue))) (serve-connection incoming-connection)) (loop)))))))
(define (serve-connection incoming-connection) (thread-start! (make-thread (lambda () (let* ((line (read-line incoming-connection))) (pp (list "read in server" line)) (force-output) (set! n (+ 1 n)) (display (string-append "connection " (number->string n) "\n") incoming-connection) (close-port incoming-connection))))))
;;; ;;;; Client ;;;
(define (start-clients) (let loop () (let ((p (open-tcp-client (list server-address: "127.0.0.1" port-number: 8001)))) (display "anything\n" p) (force-output p) (pp (list "read from server" (read-line p))) (force-output) (close-port p)) (thread-sleep! 0.1) (if (< n 50) (loop))))
;;; ;;;; start-open-process ;;;
(define (start-open-process) (thread-start! (make-thread (lambda () (let ((p (open-process (list path: "processDos.bat" pseudo-terminal: #t stderr-redirection: #f eol-encoding: 'cr-lf ))))
(pp (list (read-line p) "1")) (pp (list (read-line p) "2")) ; Uncomment the following line to unblock IO ;(pp (list (read-line p) "3")) )))))
;;; ;;;; start main ;;;
(main)
--------------------------------------------------------
This phenomenon is not present on MacOSX version.
Thank you, Francois Magnan
On 8-Feb-08, at 4:51 PM, François Magnan wrote:
Hi,
I worked hard to isolate one of my bugs and I found a rather disturbing minimal example that reproduces the bug. It can be observed in all the latests versions of Gambit (including 4.2.1).
Basically, I start a minimal multithread web server and in another thread I start a loop that calls a serie of open-tcp-client to different ips in the local network. The default web browser is launched to get the page served by the web server.
On MacOSX Leopard everything is fine. On WindowsXP (MingW compiled version of Gambit) the page takes an unnaceptable loooong time to load. The website index.html must require multiple HTTP GET to render (a page with multiple pictures for example).
What is the most disturbing is that if I replace the calls to "read- u8-line" by simple "read-line", the bug disapears. The bug is therefore somehow related to "read-u8".
Here is the sample code. You have to define "Server-ROOT" at the top so it points to a website on your local hard-drive. I didn't try on Linux but to try it the code will have to be adapted a little bit (how to launch the default browser on Linux?).
What could lead to this huge difference between a sequence of read- u8 and read-line on WinXP???
Thank you, Francois Magnan
;;; Gambit Networking Test Example ;;; ;;; Minimal web server that gets incredibly slow on WinXP (MinGW) if it is run in parallel with another thread that does a network scan. ;;; ;;; If the "read-u8-line" calls are replaced by "read-line" the bug disapears. ;;; ;;; On MacOSX Leopard the bug is not present. ;;; ;;; Was tested with versions: Gambit-C 4.0.1, 4.1.2, 4.2.1 ;;;
;;; ;;;; Server-ROOT ;;;
;;; ******************* ;;; Put here the path to a static website with many files to load to render index.html ;;; *******************
;(define Server-ROOT "/Users/magnan/TELOS/interface/TELOS-Desktop") (define Server-ROOT "C:/TELOS/interface/TELOS-Desktop")
;;; ;;;; main ;;;
(define (main) (start-server) (start-broadcast) (start-client) )
;;; ;;;; Minimal Web Server ;;;
(define (start-server) (let ((rpc-command-queue (open-tcp-server (list port-number: 8000)))) (thread-start! (make-thread (lambda () (let loop () (let ((incoming-connection (read rpc-command-queue))) (force-output) (serve-connection incoming-connection)) (loop)))))))
(define (serve-connection incoming-connection) (thread-start! (make-thread (lambda () (let* ((line (read-u8-line incoming-connection)) (splitted (split-string line #\space)) (path (cadr splitted))) (read-all-headers incoming-connection) (force-output) (with-exception-catcher (lambda (e) (##display-exception e (current-output-port))) (lambda () (serve-file path incoming-connection))))))))
(define (read-all-headers incoming-connection) (let ((line (read-u8-line incoming-connection))) (pp (list "read header line" line)) (force-output) (if (not (equal? line "")) (read-all-headers incoming-connection))))
(define (split-string str sep-char) (call-with-input-string str (lambda (p) (read-fields p sep-char #f))))
(define (read-fields port sep inc-sep?) (read-all port (lambda (p) (read-line p sep inc-sep?))))
(define (serve-file path incoming-connection) (let* ((complete-path (string-append Server-ROOT path)) (fileInfo (file-info complete-path)) (size (file-info-size fileInfo)) (mimetype (compute-mimetype complete-path)) (header (compute-get-result-header size mimetype))) (display header incoming-connection) (output-file-data complete-path incoming-connection) (close-port incoming-connection)))
(define (compute-get-result-header size mimetype) (string-append "HTTP/1.0 200 OK\r\n" "Content-type: " mimetype "\r\n" "Content-length: " (number->string size) "\r\n" "\r\n"))
(define (output-file-data filePath connection) (with-input-from-file filePath (lambda () (letrec ((output-file-data-rec (lambda () (let ((rc (read-char))) (if (not (equal? rc #!eof)) (begin (write-char rc connection) (output-file-data-rec))))))) (output-file-data-rec)))))
(define (compute-mimetype filePath) (let* ((ext (path-extension filePath)) (rext (and (string? ext) (substring ext 1 (string-length ext))))) (case (string->symbol rext) ((jpg jpeg JPG JPEG) "image/jpeg") ((gif GIF) "image/gif") ((png PNG) "image/png") ((html HTML htm HTM) "text/html") ((js JS) "text/javascript") ((css CSS) "text/css") (else "application/octet-stream" ))))
;;; ;;;; start-broadcast ;;;
(define (start-broadcast) (thread-start! (make-thread (lambda () (let* ((hostname (host-name)) (hi (host-info hostname)) (host-ips (host-info-addresses hi)) (host-ip (car host-ips))) (letrec ((network-broadcast (lambda (i) (if (= i 255) #t (begin (u8vector-set! host-ip 3 i) (call-addr host-ip) (thread-sleep! 0.2) (network-broadcast (+ i 1))))))) (network-broadcast 1)))))))
(define (call-addr target-addr) (pp (list "trying to reach" target-addr)) (with-exception-catcher (lambda (e) #f) (lambda () (let ((port (open-tcp-client (list server-address: target-addr port-number: 5000)))) (with-exception-catcher (lambda (e) #f) (lambda () (input-port-timeout-set! port 0.1) (output-port-timeout-set! port 0.1) (write (list 1 2 3) port))) (close-port port)))))
;;; ;;;; Client ;;;
(define (start-client) (if (equal? (get-host-os) "WinXP") (shell-command "start http://localhost:8000/index.html") (shell-command "open "http://localhost:8000/index.html%5C"")))
(define (get-host-os) (with-exception-handler (lambda (e) "WinXP") (lambda () (let* ((p (open-process '(path: "/usr/bin/uname" arguments: ("-s")))) (r (read-line p))) (close-port p) r))))
;;; ;;;; read-u8-line ;;;
(define (read-u8-line port) (letrec ((read-loop (lambda (acc) (let ((b (read-u8 port))) (if (or (equal? b 13) (equal? b 10) (equal? b #!eof)) (begin (read-u8 port) acc) (read-loop (string-append acc (list-
string (list (integer->char b))))))))))
(read-loop "")));;; ;;;; start main ;;;
(main)
Gambit-list mailing list Gambit-list@iro.umontreal.ca https://webmail.iro.umontreal.ca/mailman/listinfo/gambit-list
-
Christian Jaeger -
François Magnan -
Marc Feeley