[cl-soap-cvs] CVS update: cl-soap/src/http-client.lisp

[Sven Van Caekenberghe]

Update of /project/cl-soap/cvsroot/cl-soap/src
In directory common-lisp.net:/tmp/cvs-serv23437/src

Modified Files:
	http-client.lisp 
Log Message:
some code reformatting

Date: Mon Sep 26 13:08:42 2005
Author: scaekenberghe

Index: cl-soap/src/http-client.lisp
diff -u cl-soap/src/http-client.lisp:1.5 cl-soap/src/http-client.lisp:1.6
--- cl-soap/src/http-client.lisp:1.5	Thu Sep 15 15:30:44 2005
+++ cl-soap/src/http-client.lisp	Mon Sep 26 13:08:42 2005
@@ -1,6 +1,6 @@
 ;;;; -*- mode: lisp -*-
 ;;;;
-;;;; $Id: http-client.lisp,v 1.5 2005/09/15 13:30:44 scaekenberghe Exp $
+;;;; $Id: http-client.lisp,v 1.6 2005/09/26 11:08:42 scaekenberghe Exp $
 ;;;;
 ;;;; A basic HTTP client, somewhat API compatible with portableaserve's do-http-request
 ;;;; Copied from another project (basic authorization support removed)
@@ -58,7 +58,8 @@
 
 (defun response-read-headers (stream)
   (loop :for line = (read-line stream nil)
-        :until (or (zerop (length line))
+        :until (or (null line)
+                   (zerop (length line))
                    (char= (elt line 0) #\return)
                    (char= (elt line 0) #\linefeed))
         :collect (let ((colon (position #\: line)))
@@ -80,7 +81,8 @@
            (return)
          (let ((total-chunk-size 0))
            (loop (let ((size (read-sequence buffer stream 
-                                            :end (min (length buffer) (- chunk-size total-chunk-size)))))
+                                            :end (min (length buffer) 
+                                                      (- chunk-size total-chunk-size)))))
                    (incf total-chunk-size size)
                    (write-sequence buffer out :end size)
                    (when (= total-chunk-size chunk-size)
@@ -93,8 +95,10 @@
         (total-size 0))
     (with-output-to-string (out)
       (loop
-       (let ((size (read-sequence buffer stream :end (when length
-                                                       (min (length buffer) (- length total-size))))))
+       (let ((size (read-sequence buffer stream 
+                                  :end (when length
+                                         (min (length buffer) 
+                                              (- length total-size))))))
          (incf total-size size)
          (write-sequence buffer out :end size)
          (when (or (and length (= total-size length))
@@ -106,9 +110,11 @@
 (defmethod get-http-server-state ((http-client-state http-client-state) scheme-host-port)
   (with-slots (data) 
       http-client-state
-    (let ((server-state (find scheme-host-port data :key #'get-scheme-host-port :test #'string-equal)))
+    (let ((server-state (find scheme-host-port data 
+                              :key #'get-scheme-host-port :test #'string-equal)))
       (unless server-state
-        (push (setf server-state (make-instance 'http-server-state :scheme-host-port scheme-host-port))
+        (push (setf server-state (make-instance 'http-server-state 
+                                                :scheme-host-port scheme-host-port))
               data))
       server-state)))
                 
@@ -130,15 +136,19 @@
   #+clisp (when (eql scheme :http)
             (socket:socket-connect port host))
   #+cmu (when (eql scheme :http)
-          (sys:make-fd-stream (ext:connect-to-inet-socket host port) :input t :output t :buffering :none))
+          (sys:make-fd-stream (ext:connect-to-inet-socket host port) 
+                              :input t :output t :buffering :none))
   #+sbcl (when (eql scheme :http)
-           (let ((socket (make-instance 'sb-bsd-sockets:inet-socket :type :stream :protocol :tcp)))
+           (let ((socket (make-instance 'sb-bsd-sockets:inet-socket 
+                                        :type :stream :protocol :tcp)))
              (sb-bsd-sockets:socket-connect socket 
                                             (car 
                                              (sb-bsd-sockets:host-ent-addresses 
                                               (sb-bsd-sockets:get-host-by-name host))) 
                                             port)
-             (sb-bsd-sockets:socket-make-stream socket :element-type 'character :input t :output t :buffering :none))))
+             (sb-bsd-sockets:socket-make-stream socket 
+                                                :element-type 'character 
+                                                :input t :output t :buffering :none))))
 
 (defun get-open-connection (scheme host port state &key force-new)
   (if state
@@ -149,7 +159,8 @@
             (values connection :keep-alive)
           (progn 
             (when connection (ignore-errors (close connection)))
-            (values (setf (get-socket server-state) (open-socket-stream scheme host port)) :new))))
+            (values (setf (get-socket server-state) (open-socket-stream scheme host port)) 
+                    :new))))
     (values (open-socket-stream scheme host port) :new)))
 
 ;; high level HTTP protocol
@@ -180,7 +191,9 @@
   "Write an HTTP request, full header and body, to stream"
   (format-http-request-line stream 
                             "~a ~a~@[?~a~] HTTP/1.1" 
-                            method (if (puri:uri-path uri) (puri:uri-path uri) "/") (puri:uri-query uri))
+                            method (if (puri:uri-path uri) 
+                                       (puri:uri-path uri) "/") 
+                            (puri:uri-query uri))
   (format-http-request-line stream "Host: ~a:~d" (puri:uri-host uri) (puri:uri-port uri))
   (format-http-request-line stream "User-Agent: ~a" *http-client-agent*)
   (format-http-request-line stream "Accept: ~a" *http-client-accept*)
@@ -231,7 +244,8 @@
       (flet ((execute-request-response ()
                (values-list `(,@(multiple-value-list 
                                  (do-one-request-response connection uri method 
-                                                          :content content :content-type content-type 
+                                                          :content content 
+                                                          :content-type content-type 
                                                           :headers headers)) 
                               ,keep-alive))))
       (unwind-protect