mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 22:10:21 +02:00
Code Activity

Merge remote-tracking branch 'origin/stable-2.0'

Browse source
This commit is contained in:
Andy Wingo 2012-02-11 18:28:37 +01:00
commit e4c785f5df
1 changed files with 8 additions and 16 deletions
Download patch file Download diff file Expand all files Collapse all files

24
module/web/server.scm
View file

@ -1,6 +1,6 @@
;;; Web server ;;; Web server
;; 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 ;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public ;; modify it under the terms of the GNU Lesser General Public
@ -159,11 +159,8 @@ values."
(lambda () (lambda ()
((server-impl-read impl) server)) ((server-impl-read impl) server))
#:pass-keys '(quit interrupt) #:pass-keys '(quit interrupt)
#:on-error (if (batch-mode?) 'pass 'debug) #:on-error (if (batch-mode?) 'backtrace 'debug)
#:post-error #:post-error (lambda _ (values #f #f #f))))
(lambda (k . args)
(warn "Error while accepting client" k args)
(values #f #f #f))))
;; like call-with-output-string, but actually closes the port (doh) ;; like call-with-output-string, but actually closes the port (doh)
(define (call-with-output-string* proc) (define (call-with-output-string* proc)
@ -306,11 +303,9 @@ in, allowing the user's handler to explicitly manage its state."
(debug-elapsed 'sanitize) (debug-elapsed 'sanitize)
(values response body state)))))) (values response body state))))))
#:pass-keys '(quit interrupt) #:pass-keys '(quit interrupt)
#:on-error (if (batch-mode?) 'pass 'debug) #:on-error (if (batch-mode?) 'backtrace 'debug)
#:post-error #:post-error (lambda _
(lambda (k . args) (values (build-response #:code 500) #f state))))
(warn "Error handling request" k args)
(values (build-response #:code 500) #f state))))
;; -> unspecified values ;; -> unspecified values
(define (write-client impl server client response body) (define (write-client impl server client response body)
@ -322,11 +317,8 @@ attaching it to the @var{server} argument somehow."
(lambda () (lambda ()
((server-impl-write impl) server client response body)) ((server-impl-write impl) server client response body))
#:pass-keys '(quit interrupt) #:pass-keys '(quit interrupt)
#:on-error (if (batch-mode?) 'pass 'debug) #:on-error (if (batch-mode?) 'backtrace 'debug)
#:post-error #:post-error (lambda _ (values))))
(lambda (k . args)
(warn "Error while writing response" k args)
(values))))
;; -> unspecified values ;; -> unspecified values
(define (close-server impl server) (define (close-server impl server)