[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.5-89-g89d45e8

[Andy Wingo]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=89d45e850725e232ae685803ee476da5b046c2b0

The branch, stable-2.0 has been updated
       via  89d45e850725e232ae685803ee476da5b046c2b0 (commit)
       via  02360ed6050833d5436ea4f1b9b4f10f3783491b (commit)
      from  9adbf27f4e0656f489c8c9fa941da023ee4201ec (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 89d45e850725e232ae685803ee476da5b046c2b0
Author: Andy Wingo <address@hidden>
Date:   Mon Mar 12 16:58:15 2012 +0100

    web http: fix Ma -> Mar
    
    * module/web/http.scm (write-date): Fix serialization of Mar.  Oops.

commit 02360ed6050833d5436ea4f1b9b4f10f3783491b
Author: Andy Wingo <address@hidden>
Date:   Sun Mar 11 10:29:06 2012 +0100

    web server http: 400 Bad Request on bad requests
    
    * module/web/server/http.scm (bad-request, http-read): If an exception
      is raised while reading a response, write out a 400 Bad Request
      response before closing the port.

-----------------------------------------------------------------------

Summary of changes:
 module/web/http.scm        |    4 ++--
 module/web/server/http.scm |   16 ++++++++++++++--
 2 files changed, 16 insertions(+), 4 deletions(-)

diff --git a/module/web/http.scm b/module/web/http.scm
index c15bc3e..879923f 100644
--- a/module/web/http.scm
+++ b/module/web/http.scm
@@ -1,6 +1,6 @@
 ;;; HTTP messages
 
-;; Copyright (C)  2010, 2011 Free Software Foundation, Inc.
+;; Copyright (C)  2010, 2011, 2012 Free Software Foundation, Inc.
 
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
@@ -790,7 +790,7 @@ ordered alist."
              port)
     (display-digits (date-day date) 2 port)
     (display (case (date-month date)
-               ((1)  " Jan ") ((2)  " Feb ") ((3)  " Ma ")
+               ((1)  " Jan ") ((2)  " Feb ") ((3)  " Mar ")
                ((4)  " Apr ") ((5)  " May ") ((6)  " Jun ")
                ((7)  " Jul ") ((8)  " Aug ") ((9)  " Sep ")
                ((10) " Oct ") ((11) " Nov ") ((12) " Dec ")
diff --git a/module/web/server/http.scm b/module/web/server/http.scm
index a9a9049..cda44f4 100644
--- a/module/web/server/http.scm
+++ b/module/web/server/http.scm
@@ -1,6 +1,6 @@
 ;;; Web I/O: HTTP
 
-;; Copyright (C)  2010, 2011 Free Software Foundation, Inc.
+;; Copyright (C)  2010, 2011, 2012 Free Software Foundation, Inc.
 
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
@@ -69,6 +69,11 @@
     (poll-set-add! poll-set socket *events*)
     (make-http-server socket 0 poll-set)))
 
+(define (bad-request port)
+  (write-response (build-response #:version '(1 . 0) #:code 400
+                                  #:headers '((content-length . 0)))
+                  port))
+
 ;; -> (client request body | #f #f #f)
 (define (http-read server)
   (let* ((poll-set (http-poll-set server)))
@@ -123,7 +128,14 @@
                            req
                            (read-request-body req))))
                (lambda (k . args)
-                 (false-if-exception (close-port port)))))))))))))
+                 (define-syntax-rule (cleanup-catch statement)
+                   (catch #t
+                     (lambda () statement)
+                     (lambda (k . args)
+                       (format (current-error-port) "In ~a:\n" 'statement)
+                       (print-exception (current-error-port) #f k args))))
+                 (cleanup-catch (bad-request port))
+                 (cleanup-catch (close-port port)))))))))))))
 
 (define (keep-alive? response)
   (let ((v (response-version response)))


hooks/post-receive
-- 
GNU Guile