[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. release_1-9-13-113-gd
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] GNU Guile branch, master, updated. release_1-9-13-113-gd9fff48 |
|
Date: |
Thu, 02 Dec 2010 16:33:52 +0000 |
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=d9fff48e4c8139e410b7bca26503d5c01d2dddec
The branch, master has been updated
via d9fff48e4c8139e410b7bca26503d5c01d2dddec (commit)
via 8bf6cfea71c1f5c3408e48b084b38c31290f39e4 (commit)
via bb90ce2cbc3e2a0f0c6ab28c9eb7690903836c6a (commit)
via e1ee45e78b7787ba433bf16347a7e61d73b9d8a7 (commit)
via af0da6ebe737c707b0e40d4035efb342829cad93 (commit)
via ee3a800f4661f656abf10e78b22f7f1452360714 (commit)
from a0ad8ad16c14adbf13e0ead3dafd833fb3c8f0d3 (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 d9fff48e4c8139e410b7bca26503d5c01d2dddec
Author: Andy Wingo <address@hidden>
Date: Thu Dec 2 17:25:46 2010 +0100
sxml->xml writes directly to a port
* module/sxml/simple.scm: Remove "universal-sxslt-rules" -- it was a bad
interface, and I couldn't find any users of it.
(sxml->xml): Rewrite so that instead of generating another tree of
data, we write the data directly to a port.
commit 8bf6cfea71c1f5c3408e48b084b38c31290f39e4
Author: Andy Wingo <address@hidden>
Date: Thu Dec 2 13:36:04 2010 +0100
add some debugging to (web server)
* module/web/server.scm: Add some basic elapsed-time debugging, but only
if you flip a switch to turn it on at expand-time.
commit bb90ce2cbc3e2a0f0c6ab28c9eb7690903836c6a
Author: Andy Wingo <address@hidden>
Date: Thu Dec 2 13:33:49 2010 +0100
better socket buffering on http web server backend
* module/web/server/http.scm (http-read, http-write): Line-buffer the
port while we're reading the request, and block-buffer it otherwise
Use the default block size.
commit e1ee45e78b7787ba433bf16347a7e61d73b9d8a7
Author: Andy Wingo <address@hidden>
Date: Thu Dec 2 12:46:15 2010 +0100
indentation fix in ports.c
* libguile/ports.c (scm_i_get_conversion_strategy): Indentation fix.
commit af0da6ebe737c707b0e40d4035efb342829cad93
Author: Andy Wingo <address@hidden>
Date: Thu Dec 2 12:28:35 2010 +0100
(web server) supports non-utf-8 charsets
* module/web/server.scm (sanitize-response): Support charsets other than
utf-8. Oddly collecting a string and converting it to utf-8 appears to
be faster than collecting a utf-8 bytevector directly.
commit ee3a800f4661f656abf10e78b22f7f1452360714
Author: Andy Wingo <address@hidden>
Date: Thu Dec 2 11:47:19 2010 +0100
add simple web app examples
* examples/web/hello.scm:
* examples/web/debug-sxml.scm: New examples, for simple web
applications.
* examples/README:
* examples/Makefile.am: Add new files.
-----------------------------------------------------------------------
Summary of changes:
examples/Makefile.am | 6 +-
examples/README | 2 +
examples/web/debug-sxml.scm | 59 +++++++++++
examples/web/hello.scm | 29 +++++
libguile/ports.c | 2 +-
module/sxml/simple.scm | 240 +++++++++++++++++++++++++++----------------
module/web/server.scm | 68 +++++++++++--
module/web/server/http.scm | 21 +++-
8 files changed, 319 insertions(+), 108 deletions(-)
create mode 100644 examples/web/debug-sxml.scm
create mode 100644 examples/web/hello.scm
diff --git a/examples/Makefile.am b/examples/Makefile.am
index 99a0a90..233eee9 100644
--- a/examples/Makefile.am
+++ b/examples/Makefile.am
@@ -1,6 +1,6 @@
## Process this file with Automake to create Makefile.in
##
-## Copyright (C) 2001, 2006, 2008, 2009 Free Software Foundation, Inc.
+## Copyright (C) 2001, 2006, 2008, 2009, 2010 Free Software Foundation, Inc.
##
## This file is part of GUILE.
##
@@ -36,7 +36,9 @@ EXTRA_DIST = README ChangeLog-2008 check.test
\
modules/README modules/module-0.scm modules/module-1.scm \
modules/module-2.scm modules/main \
\
- safe/README safe/safe safe/untrusted.scm safe/evil.scm
+ safe/README safe/safe safe/untrusted.scm safe/evil.scm
\
+ \
+ web/hello.scm web/debug-sxml.scm
AM_CFLAGS = `PATH=$(bindir)$(PATH_SEPARATOR)$$PATH
PKG_CONFIG_PATH=$(libdir)/pkgconfig $(bindir)/guile-config compile`
AM_LIBS = `PATH=$(bindir)$(PATH_SEPARATOR)$$PATH
PKG_CONFIG_PATH=$(libdir)/pkgconfig $(bindir)/guile-config link`
diff --git a/examples/README b/examples/README
index f6d645c..1c6a95a 100644
--- a/examples/README
+++ b/examples/README
@@ -35,6 +35,8 @@ modules Examples for writing and using
Guile modules.
safe Examples for creating and using safe environments.
+web Simple web servers.
+
compat autoconf code for making a Guile extension
compatible with older versions of Guile.
diff --git a/examples/web/debug-sxml.scm b/examples/web/debug-sxml.scm
new file mode 100644
index 0000000..4e6afc2
--- /dev/null
+++ b/examples/web/debug-sxml.scm
@@ -0,0 +1,59 @@
+;;; Commentary:
+
+;;; A simple debugging server that responds to all responses with a
+;;; table containing the headers given in the request.
+;;;
+;;; As a novelty, this server uses a little micro-framework to build up
+;;; the response as SXML. Instead of a string, the `respond' helper
+;;; returns a procedure for the body, which allows the `(web server)'
+;;; machinery to collect the output as a bytevector in the desired
+;;; encoding, instead of building an intermediate output string.
+;;;
+;;; In the future this will also allow for chunked transfer-encoding,
+;;; for HTTP/1.1 clients.
+
+;;; Code:
+
+(use-modules (web server)
+ (web request)
+ (web response)
+ (sxml simple))
+
+(define html5-doctype "<!DOCTYPE html>\n")
+(define default-title "Hello hello!")
+
+(define* (templatize #:key (title "No title") (body '((p "No body"))))
+ `(html (head (title ,title))
+ (body ,@body)))
+
+(define* (respond #:optional body #:key
+ (status 200)
+ (title default-title)
+ (doctype html5-doctype)
+ (content-type-params '(("charset" . "utf-8")))
+ (content-type "text/html")
+ (extra-headers '())
+ (sxml (and body (templatize #:title title #:body body))))
+ (values (build-response
+ #:code status
+ #:headers `((content-type . (,content-type ,@content-type-params))
+ ,@extra-headers))
+ (lambda (port)
+ (if sxml
+ (begin
+ (if doctype (display doctype port))
+ (sxml->xml sxml port))))))
+
+(define (debug-page request body)
+ (respond `((h1 "hello world!")
+ (table
+ (tr (th "header") (th "value"))
+ ,@(map (lambda (pair)
+ `(tr (td (tt ,(with-output-to-string
+ (lambda () (display (car pair))))))
+ (td (tt ,(with-output-to-string
+ (lambda ()
+ (write (cdr pair))))))))
+ (request-headers request))))))
+
+(run-server debug-page)
diff --git a/examples/web/hello.scm b/examples/web/hello.scm
new file mode 100644
index 0000000..db17b9b
--- /dev/null
+++ b/examples/web/hello.scm
@@ -0,0 +1,29 @@
+;;; Commentary:
+
+;;; A simple web server that responds to all requests with the eponymous
+;;; string. Visit http://localhost:8080 to test.
+
+;;; Code:
+
+(use-modules (web server))
+
+;; A handler receives two values as arguments: the request object, and
+;; the request body. It returns two values also: the response object,
+;; and the response body.
+;;
+;; In this simple example we don't actually access the request object,
+;; but if we wanted to, we would use the procedures from the `(web
+;; request)' module. If there is no body given in the request, the body
+;; argument will be false.
+;;
+;; To create a response object, use the `build-response' procedure from
+;; `(web response)'. Here we take advantage of a shortcut, in which we
+;; return an alist of headers for the response instead of returning a
+;; proper response object. In this case, a response object will be made
+;; for us with a 200 OK status.
+;;
+(define (handler request body)
+ (values '((content-type . ("text/plain")))
+ "Hello, World!"))
+
+(run-server handler)
diff --git a/libguile/ports.c b/libguile/ports.c
index 7fabc81..ff40a33 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -2170,7 +2170,7 @@ scm_i_get_conversion_strategy (SCM port)
{
scm_t_port *pt;
pt = SCM_PTAB_ENTRY (port);
- return pt->ilseq_handler;
+ return pt->ilseq_handler;
}
}
diff --git a/module/sxml/simple.scm b/module/sxml/simple.scm
index 115098c..be1dc4e 100644
--- a/module/sxml/simple.scm
+++ b/module/sxml/simple.scm
@@ -30,41 +30,146 @@
#:use-module (sxml transform)
#:use-module (ice-9 optargs)
#:use-module (srfi srfi-13)
- #:export (xml->sxml sxml->xml sxml->string universal-sxslt-rules))
+ #:export (xml->sxml sxml->xml sxml->string))
(define* (xml->sxml #:optional (port (current-input-port)))
"Use SSAX to parse an XML document into SXML. Takes one optional
argument, @var{port}, which defaults to the current input port."
(ssax:xml->sxml port '()))
-;; Universal transformation rules. Works for all XML.
-(define universal-sxslt-rules
- #;
- "A set of @code{pre-post-order} rules that transform any SXML tree
-into a form suitable for XML serialization by @code{(sxml transform)}'s
address@hidden:send-reply}. Used internally by @code{sxml->xml}."
- `((@
- ((*default* . ,(lambda (attr-key . value) ((enattr attr-key) value))))
- . ,(lambda (trigger . value) (list '@ value)))
- (*TOP* . ,(lambda (tag . xml) xml))
- (*ENTITY* . ,(lambda (tag name) (list "&" name ";")))
- (*PI* . ,(lambda (pi tag str) (list "<?" tag " " str "?>")))
- ;; Is this right for entities? I don't have a reference for
- ;; public-id/system-id at the moment...
- (*default* . ,(lambda (tag . elems) (apply (entag tag) elems)))
- (*text* . ,(lambda (trigger str)
- (if (string? str) (string->escaped-xml str) str)))))
+(define check-name
+ (let ((*good-cache* (make-hash-table)))
+ (lambda (name)
+ (if (not (hashq-ref *good-cache* name))
+ (let* ((str (symbol->string name))
+ (i (string-index str #\:))
+ (head (or (and i (substring str 0 i)) str))
+ (tail (and i (substring str (1+ i)))))
+ (and i (string-index (substring str (1+ i)) #\:)
+ (error "Invalid QName: more than one colon" name))
+ (for-each
+ (lambda (s)
+ (and s
+ (or (char-alphabetic? (string-ref s 0))
+ (eq? (string-ref s 0) #\_)
+ (error "Invalid name starting character" s name))
+ (string-for-each
+ (lambda (c)
+ (or (char-alphabetic? c) (string-index "0123456789.-_"
c)
+ (error "Invalid name character" c s name)))
+ s)))
+ (list head tail))
+ (hashq-set! *good-cache* name #t))))))
+
+;; The following two functions serialize tags and attributes. They are
+;; being used in the node handlers for the post-order function, see
+;; below.
+
+(define (attribute-value->xml value port)
+ (cond
+ ((pair? value)
+ (attribute-value->xml (car value) port)
+ (attribute-value->xml (cdr value) port))
+ ((string? value)
+ (string->escaped-xml value port))
+ ((procedure? value)
+ (with-output-to-port port value))
+ (else
+ (string->escaped-xml
+ (call-with-output-string (lambda (port) (display value port)))
+ port))))
+
+(define (attribute->xml attr value port)
+ (check-name attr)
+ (display attr port)
+ (display "=\"" port)
+ (attribute-value->xml value port)
+ (display #\" port))
+
+(define (element->xml tag attrs body port)
+ (check-name tag)
+ (display #\< port)
+ (display tag port)
+ (if attrs
+ (let lp ((attrs attrs))
+ (if (pair? attrs)
+ (let ((attr (car attrs)))
+ (display #\space port)
+ (if (pair? attr)
+ (attribute->xml (car attr) (cdr attr) port)
+ (error "bad attribute" tag attr))
+ (lp (cdr attrs)))
+ (if (not (null? attrs))
+ (error "bad attributes" tag attrs)))))
+ (if (pair? body)
+ (begin
+ (display #\> port)
+ (let lp ((body body))
+ (cond
+ ((pair? body)
+ (sxml->xml (car body) port)
+ (lp (cdr body)))
+ ((null? body)
+ (display "</" port)
+ (display tag port)
+ (display ">" port))
+ (else
+ (error "bad element body" tag body)))))
+ (display " />" port)))
+
+;; FIXME: ensure name is valid
+(define (entity->xml name port)
+ (display #\& port)
+ (display name port)
+ (display #\; port))
+
+;; FIXME: ensure tag and str are valid
+(define (pi->xml tag str port)
+ (display "<?" port)
+ (display tag port)
+ (display #\space port)
+ (display str port)
+ (display "?>" port))
(define* (sxml->xml tree #:optional (port (current-output-port)))
"Serialize the sxml tree @var{tree} as XML. The output will be written
to the current output port, unless the optional argument @var{port} is
present."
- (with-output-to-port port
- (lambda ()
- (SRV:send-reply
- (post-order
- tree
- universal-sxslt-rules)))))
+ (cond
+ ((pair? tree)
+ (if (symbol? (car tree))
+ ;; An element.
+ (let ((tag (car tree)))
+ (case tag
+ ((*TOP*)
+ (sxml->xml (cdr tree) port))
+ ((*ENTITY*)
+ (if (and (list? (cdr tree)) (= (length (cdr tree)) 1))
+ (entity->xml (cadr tree) port)
+ (error "bad *ENTITY* args" (cdr tree))))
+ ((*PI*)
+ (if (and (list? (cdr tree)) (= (length (cdr tree)) 2))
+ (pi->xml (cadr tree) (caddr tree) port)
+ (error "bad *PI* args" (cdr tree))))
+ (else
+ (let* ((elems (cdr tree))
+ (attrs (and (pair? elems) (pair? (car elems))
+ (eq? '@ (caar elems))
+ (cdar elems))))
+ (element->xml tag attrs (if attrs (cdr elems) elems) port)))))
+ ;; A nodelist.
+ (for-each (lambda (x) (sxml->xml x port)) tree)))
+ ((string? tree)
+ (string->escaped-xml tree port))
+ ((null? tree) *unspecified*)
+ ((not tree) *unspecified*)
+ ((eqv? tree #t) *unspecified*)
+ ((procedure? tree)
+ (with-output-to-port port tree))
+ (else
+ (string->escaped-xml
+ (call-with-output-string (lambda (port) (display tree port)))
+ port))))
(define (sxml->string sxml)
"Detag an sxml tree @var{sxml} into a string. Does not perform any
@@ -80,81 +185,34 @@ formatting."
'()
sxml)))
-;; The following two functions serialize tags and attributes. They are
-;; being used in the node handlers for the post-order function, see
-;; above.
-
-(define (check-name name)
- (let* ((str (symbol->string name))
- (i (string-index str #\:))
- (head (or (and i (substring str 0 i)) str))
- (tail (and i (substring str (1+ i)))))
- (and i (string-index (substring str (1+ i)) #\:)
- (error "Invalid QName: more than one colon" name))
- (for-each
- (lambda (s)
- (and s
- (or (char-alphabetic? (string-ref s 0))
- (eq? (string-ref s 0) #\_)
- (error "Invalid name starting character" s name))
- (string-for-each
- (lambda (c)
- (or (char-alphabetic? c) (string-index "0123456789.-_" c)
- (error "Invalid name character" c s name)))
- s)))
- (list head tail))))
-
-(define (entag tag)
- (check-name tag)
- (lambda elems
- (if (and (pair? elems) (pair? (car elems)) (eq? '@ (caar elems)))
- (list #\< tag (cdar elems)
- (if (pair? (cdr elems))
- (list #\> (cdr elems) "</" tag #\>)
- " />"))
- (list #\< tag
- (if (pair? elems)
- (list #\> elems "</" tag #\>)
- " />")))))
-
-(define (enattr attr-key)
- (check-name attr-key)
- (let ((attr-str (symbol->string attr-key)))
- (lambda (value)
- (list #\space attr-str
- "=\"" (and (not (null? value)) value) #\"))))
-
(define (make-char-quotator char-encoding)
- (let ((bad-chars (map car char-encoding)))
+ (let ((bad-chars (list->char-set (map car char-encoding))))
;; Check to see if str contains one of the characters in charset,
;; from the position i onward. If so, return that character's index.
;; otherwise, return #f
(define (index-cset str i charset)
- (let loop ((i i))
- (and (< i (string-length str))
- (if (memv (string-ref str i) charset) i
- (loop (+ 1 i))))))
-
+ (string-index str charset i))
+
;; The body of the function
- (lambda (str)
+ (lambda (str port)
(let ((bad-pos (index-cset str 0 bad-chars)))
- (if (not bad-pos) str ; str had all good chars
- (string-concatenate-reverse
- (let loop ((from 0) (to bad-pos) (out '()))
- (cond
- ((>= from (string-length str)) out)
- ((not to)
- (cons (substring str from (string-length str)) out))
- (else
- (let ((quoted-char
- (cdr (assv (string-ref str to) char-encoding)))
- (new-to
- (index-cset str (+ 1 to) bad-chars)))
- (loop (1+ to) new-to
- (if (< from to)
- (cons* quoted-char (substring str from to) out)
- (cons quoted-char out)))))))))))))
+ (if (not bad-pos)
+ (display str port) ; str had all good chars
+ (let loop ((from 0) (to bad-pos))
+ (cond
+ ((>= from (string-length str)) *unspecified*)
+ ((not to)
+ (display (substring str from (string-length str)) port))
+ (else
+ (let ((quoted-char
+ (cdr (assv (string-ref str to) char-encoding)))
+ (new-to
+ (index-cset str (+ 1 to) bad-chars)))
+ (if (< from to)
+ (display (substring str from to) port))
+ (display quoted-char port)
+ (loop (1+ to) new-to))))))))))
;; Given a string, check to make sure it does not contain characters
;; such as '<' or '&' that require encoding. Return either the original
diff --git a/module/web/server.scm b/module/web/server.scm
index bb7ce4d..8fd63c8 100644
--- a/module/web/server.scm
+++ b/module/web/server.scm
@@ -85,6 +85,7 @@
(define-module (web server)
#:use-module (srfi srfi-9)
#:use-module (rnrs bytevectors)
+ #:use-module (rnrs io ports)
#:use-module (web request)
#:use-module (web response)
#:use-module (system repl error-handling)
@@ -100,6 +101,24 @@
serve-one-client
run-server))
+(define *timer* (gettimeofday))
+(define (print-elapsed who)
+ (let ((t (gettimeofday)))
+ (pk who (+ (* (- (car t) (car *timer*)) 1000000)
+ (- (cdr t) (cdr *timer*))))
+ (set! *timer* t)))
+
+(eval-when (expand)
+ (define *time-debug?* #f))
+
+(define-syntax debug-elapsed
+ (lambda (x)
+ (syntax-case x ()
+ ((_ who)
+ (if *time-debug?*
+ #'(print-elapsed who)
+ #'*unspecified*)))))
+
(define-record-type server-impl
(make-server-impl name open read write close)
server-impl?
@@ -142,10 +161,25 @@
(warn "Error while accepting client" k args)
(values keep-alive #f #f #f))))
+(define (call-with-encoded-output-string charset proc)
+ (if (and (string-ci=? charset "utf-8") #f)
+ ;; I don't know why, but this appears to be faster; at least for
+ ;; examples/debug-sxml.scm (650 reqs/s versus 510 reqs/s).
+ (string->utf8 (call-with-output-string proc))
+ (call-with-values
+ (lambda ()
+ (open-bytevector-output-port))
+ (lambda (port get-bytevector)
+ (set-port-encoding! port charset)
+ (proc port)
+ (get-bytevector)))))
+
(define (encode-string str charset)
- (case charset
- ((utf-8) (string->utf8 str))
- (else (error "unknown charset" charset))))
+ (if (string-ci=? charset "utf-8")
+ (string->utf8 str)
+ (call-with-encoded-output-string charset
+ (lambda (port)
+ (display str port)))))
;; -> response body
(define (sanitize-response request response body)
@@ -166,19 +200,26 @@
(let* ((type (response-content-type response
'("text/plain")))
(declared-charset (assoc-ref (cdr type) "charset"))
- (charset (if declared-charset
- (string->symbol
- (string-downcase declared-charset))
- 'utf-8)))
+ (charset (or declared-charset "utf-8")))
(sanitize-response
request
(if declared-charset
response
(extend-response response 'content-type
- `(,@type ("charset" . ,(symbol->string charset)))))
+ `(,@type ("charset" . ,charset))))
(encode-string body charset))))
((procedure? body)
- (sanitize-response request response (call-with-output-string body)))
+ (let* ((type (response-content-type response
+ '("text/plain")))
+ (declared-charset (assoc-ref (cdr type) "charset"))
+ (charset (or declared-charset "utf-8")))
+ (sanitize-response
+ request
+ (if declared-charset
+ response
+ (extend-response response 'content-type
+ `(,@type ("charset" . ,charset))))
+ (call-with-encoded-output-string charset body))))
((bytevector? body)
;; check length; assert type; add other required fields?
(values (let ((rlen (response-content-length response))
@@ -203,8 +244,10 @@
(apply handler request body state))))
(lambda (response body . state)
(call-with-values (lambda ()
+ (debug-elapsed 'handler)
(sanitize-response request response body))
(lambda (response body)
+ (debug-elapsed 'sanitize)
(values response body state))))))
#:pass-keys '(quit interrupt)
#:on-error (if (batch-mode?) 'pass 'debug)
@@ -260,17 +303,22 @@
;; -> new keep-alive new-state
(define (serve-one-client handler impl server keep-alive state)
+ (debug-elapsed 'serve-again)
(call-with-values
(lambda ()
(read-client impl server keep-alive))
(lambda (keep-alive client request body)
+ (debug-elapsed 'read-client)
(if client
(call-with-values
(lambda ()
(handle-request handler request body state))
(lambda (response body state)
+ (debug-elapsed 'handle-request)
(values
- (and-cons (write-client impl server client response body)
+ (and-cons (let ((x (write-client impl server client response
body)))
+ (debug-elapsed 'write-client)
+ x)
keep-alive)
state)))
(values keep-alive state)))))
diff --git a/module/web/server/http.scm b/module/web/server/http.scm
index 5632fdc..6ec414b 100644
--- a/module/web/server/http.scm
+++ b/module/web/server/http.scm
@@ -65,9 +65,15 @@
#f #f #f))
((memq server readable)
;; FIXME: meta to read-request
- (let* ((client (accept server))
+ (let* ((client (let ((pair (accept server)))
+ ;; line buffered for request
+ (setvbuf (car pair) _IOLBF)
+ pair))
(req (read-request (car client)))
- (body-str (read-request-body/latin-1 req)))
+ (body-str (begin
+ ;; block buffered for body and response
+ (setvbuf (car client) _IOFBF)
+ (read-request-body/latin-1 req))))
(values keep-alive (car client) req body-str)))
((pair? readable)
;; FIXME: preserve meta for keep-alive
@@ -79,8 +85,12 @@
(values keep-alive #f #f #f))
(call-with-error-handling
(lambda ()
+ ;; http-write already left p in line-buffered state
(let* ((req (read-request p))
- (body-str (read-request-body/latin-1 req)))
+ (body-str (begin
+ ;; block buffered for body and response
+ (setvbuf p _IOFBF)
+ (read-request-body/latin-1 req))))
(values keep-alive p req body-str)))
#:pass-keys '(quit interrupt)
#:on-error (if (batch-mode?) 'pass 'debug)
@@ -113,7 +123,10 @@
(error "Expected a string or bytevector for body" body)))
(force-output (response-port response))
(if (keep-alive? response)
- (response-port response)
+ (let ((p (response-port response)))
+ ;; back to line buffered
+ (setvbuf p _IOLBF)
+ p)
(begin
(close-port (response-port response))
#f))))
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. release_1-9-13-113-gd9fff48,
Andy Wingo <=