[Guile-commits] GNU Guile branch, wip-ethreads, updated. v2.0.5-112-gae8cc53

[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=ae8cc531c72d831f00a7f387aacb50baad3ee7d8

The branch, wip-ethreads has been updated
       via  ae8cc531c72d831f00a7f387aacb50baad3ee7d8 (commit)
       via  a916fbae8c6d6006f9c6406c765ddc7bc9a419dc (commit)
       via  a605be5a1c8e11be7f59c33adf42c919dbbb8e92 (commit)
      from  00efdc12708735c8db863ec6171816052a31974d (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 ae8cc531c72d831f00a7f387aacb50baad3ee7d8
Author: Andy Wingo <address@hidden>
Date:   Tue Mar 27 22:24:10 2012 +0200

    (web server ethreads) TCP_NODELAY tweak
    
    * module/web/server/ethreads.scm (client-loop, socket-loop): Instead of
      corking and uncorking the client, just turn on TCP_NODELAY always.

commit a916fbae8c6d6006f9c6406c765ddc7bc9a419dc
Author: Andy Wingo <address@hidden>
Date:   Tue Mar 27 20:46:02 2012 +0200

    getsockopt: allow raw file descriptors
    
    * libguile/socket.c (scm_getsockopt): Allow raw file descriptors.

commit a605be5a1c8e11be7f59c33adf42c919dbbb8e92
Author: Andy Wingo <address@hidden>
Date:   Tue Mar 27 16:15:36 2012 +0200

    eports: add put-utf8-char, put-utf8-string
    
    * module/ice-9/eports.scm (put-latin1-string): Fix a bug.
      (put-utf8-char, put-utf8-string): New functions.

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

Summary of changes:
 libguile/socket.c              |   11 ++++++++---
 module/ice-9/eports.scm        |   15 +++++++++++++--
 module/web/server/ethreads.scm |   25 ++++++-------------------
 3 files changed, 27 insertions(+), 24 deletions(-)

diff --git a/libguile/socket.c b/libguile/socket.c
index 66ba576..e8ccd18 100644
--- a/libguile/socket.c
+++ b/libguile/socket.c
@@ -535,12 +535,17 @@ SCM_DEFINE (scm_getsockopt, "getsockopt", 3, 0, 0,
   int ilevel;
   int ioptname;
 
-  sock = SCM_COERCE_OUTPORT (sock);
-  SCM_VALIDATE_OPFPORT (1, sock);
+  if (scm_is_integer (sock))
+    fd = scm_to_int (sock);
+  else
+    {
+      sock = SCM_COERCE_OUTPORT (sock);
+      SCM_VALIDATE_OPFPORT (1, sock);
+      fd = SCM_FPORT_FDES (sock);
+    }
   ilevel = scm_to_int (level);
   ioptname = scm_to_int (optname);
 
-  fd = SCM_FPORT_FDES (sock);
   if (getsockopt (fd, ilevel, ioptname, (void *) &optval, &optlen) == -1)
     SCM_SYSERROR;
 
diff --git a/module/ice-9/eports.scm b/module/ice-9/eports.scm
index d125612..4fe9845 100644
--- a/module/ice-9/eports.scm
+++ b/module/ice-9/eports.scm
@@ -55,7 +55,10 @@
             get-latin1-string-n!
             get-latin1-string-delimited
             put-latin1-char
-            put-latin1-string))
+            put-latin1-string
+
+            put-utf8-char
+            put-utf8-string))
 
 (define-record-type <eport>
   (make-eport fd readbuf writebuf file-port)
@@ -546,10 +549,18 @@
 
 (define (put-latin1-string eport str)
   (if (string-every (lambda (c) (< (char->integer c) 128)) str)
-      (put-bytevector eport (string->utf8 eport))
+      (put-bytevector eport (string->utf8 str))
       ;; Need a string->latin1.
       (let ((len (string-length str)))
         (let lp ((n 0))
           (when (< n len)
             (put-u8 eport (char->integer (string-ref str n)))
             (lp (1+ n)))))))
+
+(define (put-utf8-char eport c)
+  (if (< (char->integer c) 128)
+      (put-u8 eport (char->integer c))
+      (put-utf8-string eport (string c))))
+
+(define (put-utf8-string eport str)
+  (put-bytevector eport (string->utf8 str)))
diff --git a/module/web/server/ethreads.scm b/module/web/server/ethreads.scm
index 7c45661..b803c01 100644
--- a/module/web/server/ethreads.scm
+++ b/module/web/server/ethreads.scm
@@ -137,21 +137,6 @@
               ((0) (memq 'keep-alive (response-connection response)))))
            (else #f)))))
 
-(define cork!
-  (cond
-   ((defined? 'TCP_NODELAY)
-    (lambda (fd cork?)
-      ;; Always disable Nagle's algorithm, as we handle buffering
-      ;; ourselves.  Don't bother disabling if cork? is #f.
-      (when cork?
-        (setsockopt fd IPPROTO_TCP TCP_NODELAY 0))))
-   ((defined? 'TCP_CORK)
-    ;; If we don't have TCP_NODELAY, the Linux-specific TCP_CORK will
-    ;; do.
-    (lambda (fd cork?)
-      (setsockopt fd IPPROTO_TCP TCP_CORK (if cork? 1 0))))
-   (else (lambda (fd cork?) #t))))
-
 (define (client-loop client have-request)
   (with-throw-handler #t
     (lambda ()
@@ -172,7 +157,6 @@
                                           #:headers '((content-length . 0)))
                           #vu8()))))
           (lambda (response body)
-            (cork! (eport-fd client) #t)
             (put-bytevector client
                             (call-with-output-bytevector
                              (lambda (port) (write-response response port))))
@@ -180,9 +164,7 @@
               (put-bytevector client body))
             (drain-output client)
             (if (and (keep-alive? response)
-                     (begin
-                       (cork! (eport-fd client) #f)
-                       (not (eof-object? (lookahead-u8 client)))))
+                     (not (eof-object? (lookahead-u8 client))))
                 (loop)
                 (close-eport client))))))
     (lambda (k . args)
@@ -199,6 +181,11 @@
   (let loop ()
     (let ((client (accept-eport esocket)))
       (setsockopt (eport-fd client) SOL_SOCKET SO_SNDBUF (* 12 1024))
+      ;; Always disable Nagle's algorithm, as we handle buffering
+      ;; ourselves.  Ignore exceptions if it's not a TCP port, or
+      ;; TCP_NODELAY is not defined on this platform.
+      (false-if-exception
+       (setsockopt (eport-fd client) IPPROTO_TCP TCP_NODELAY 0))
       (spawn (lambda () (client-loop client have-request)))
       (loop))))
 


hooks/post-receive
-- 
GNU Guile