bug#15227: Possible bug in (web server)

[Shane Celis]

Hi all,

I found a bug in (web server) on Mac OS X, and when I compared against 
GNU/Linux I seem to have found a bug in (web client) there.  I've included a 
script and further details below.

#!/usr/local/bin/guile \
-e main -s
!#
;; guile-web-server-osx-bug.scm
;;
;; This script demonstrates a possible bug in Guile's web server on
;; Mac OS X.  And it demonstrates a possible bug in Guile's web client
;; on GNU/Linux.
;;
;; Problem
;; =======
;;
;; Using Guile's (web server) with an example program, I ran into the
;; following issue on Mac OS X: If I ran
;; "./guile-web-server-osx-bug.scm server" and pointed my browser at
;; http://localhost:8080, the first request would work and be
;; displayed in my browser.  The second request would timeout.  I
;; compared this with Guile on GNU/Linux and found that the (web
;; server) worked fine, but the (web client) did not seem to work.
;;
;;
;; Reproduction
;; ============
;;
;; The script takes an argument "server" or "client [hostname/ip]".
;; When run as a server, it will say hello with an incremented
;; counter.  When run as a client, it will grab a couple of known
;; sites gnu.org, fsf.org, and then try localhost or the given
;; hostname on port 8080 twice, because on Mac OS X I saw the web
;; server work on the first request but not the second. The
;; hostname/ip the client is contacting is presumed to be a Guile web
;; server on the other end but doesn't have to be.
;;
;; If there were no bugs, this script should work like this:
;; $ ./guile-web-server-osx-bug.scm server &
;; Web server replied 'Hello World! 0'.
;; Web server replied 'Hello World! 1'.
;;
;; $ ./guile-web-server-osx-bug.scm client
;; Getting http://gnu.org... response #<<response> [...]
;;
;; Getting http://fsf.org... response #<<response> [...]
;;
;; Getting http://localhost:8080... response #<<response> [...]
;;
;; Getting http://localhost:8080... response #<<response> [...]
;;
;; Mac OS X bug
;; ------------
;;
;; Info
;; ----
;; 
;; $ uname -a
;; Darwin mbp13.local 12.4.0 Darwin Kernel Version 12.4.0: Wed May  1 17:57:12 
PDT 2013; root:xnu-2050.24.15~1/RELEASE_X86_64 x86_64
;;
;; $ bash ./build-aux/config.guess
;; x86_64-apple-darwin12.4.0
;;
;; $ guile --version
;; guile (GNU Guile) 2.0.9 [...]
;;
;; $ ./config.status --config
;; 'LDFLAGS=-L/opt/local/lib' 'CPPFLAGS=-I/opt/local/include'
;;
;; Running
;; -------
;; 
;; $ ./guile-web-server-osx-bug.scm server 
;; Web server replied 'Hello World! 0'.
;;
;; --
;;
;; $ ./guile-web-server-osx-bug.scm client
;; Getting http://gnu.org... response #<<response> [...]
;;
;; Getting http://fsf.org... response #<<response> [...]
;;
;; Getting http://localhost:8080...SIGALRM called; timedout.
;; 
;; If I try to connect to http://localhost:8080 through a web browser,
;; it does not connect; however, the web server does report that it
;; has replied.
;;
;; GNU/Linux bug
;; ------------
;; 
;; Info
;; ----
;;
;; $ uname -a
;; Linux debian 3.2.0-4-686-pae #1 SMP Debian 3.2.46-1 i686 GNU/Linux
;;
;; $ guile --version
;; guile (GNU Guile) 2.0.9 [...]
;;
;; $ bash ./build-aux/config.guess
;; i686-pc-linux-gnu
;;
;; $ ./config.status --config
;;
;; Running
;; -------
;;
;; $ ./guile-web-server-osx-bug.scm server 
;; Web server replied 'Hello World! 0'.
;;
;; ---
;;
;; $ ./guile-web-server-osx-bug.scm client
;; Getting http://gnu.org... response #<<response> [...]
;;
;; Getting http://fsf.org... response #<<response> [...]
;;
;; Getting http://localhost:8080...SIGALRM called; timedout.
;;
;; If I try to connect to http://localhost:8080 through a web browser,
;; it works fine; so it seems like the (web client) is not working on
;; GNU/Linux and the (web server) is not working on Mac OS X.
;; 

(use-modules (web server)
             (web client)
             (ice-9 optargs))

(define count 0)

(define (hello-world-handler request request-body)
  (let ((reply (format #f "Hello World! ~a" count)))
    (set! count (1+ count))
    (format #t "Web server replied '~a'.~%" reply)
    (values '((content-type . (text/plain)))
            reply)))

(define (start-server)
   (run-server hello-world-handler 'http '(#:port 8080)))

(define (check-url url)
  (format #t "Getting ~a..." url)
  (format #t " response ~a~%~%" (http-get url)))

(define* (run-client #:optional (ip "localhost"))
  (alarm 10)
  ;; Test some URLs that should work.
  (check-url "http://gnu.org";)
  (check-url "http://fsf.org";)
  ;; Try the web server's URL now twice.
  (check-url (format #f "http://~a:8080"; ip))
  (check-url (format #f "http://~a:8080"; ip)))

(sigaction SIGALRM (lambda (sig)
                     (format #t "SIGALRM called; timedout.~%")
                     (exit 1)))


(define (main args)
  (unless (or (= 2 (length args))
              (= 3 (length args)))
    (format (current-error-port) "Usage: ~a <server|client [ip]>~%" (car args))
    (exit 2))
  (cond
   ((string= "server" (cadr args))
    (start-server))
   ((string= "client" (cadr args))
    (apply run-client (cddr args)))))