[Cl-darcs-cvs] r103 - cl-darcs/trunk

[mhenoch at common-lisp.net]

Author: mhenoch
Date: Sat Mar 10 16:13:10 2007
New Revision: 103

Modified:
   cl-darcs/trunk/cl-darcs.asd
   cl-darcs/trunk/upath.lisp
Log:
Use Drakma instead of Aserve


Modified: cl-darcs/trunk/cl-darcs.asd
==============================================================================
--- cl-darcs/trunk/cl-darcs.asd	(original)
+++ cl-darcs/trunk/cl-darcs.asd	Sat Mar 10 16:13:10 2007
@@ -12,7 +12,7 @@
   :author "Magnus Henoch <henoch at dtek.chalmers.se>"
   :depends-on (:split-sequence
 	       ;; HTTP client
-	       :aserve
+	       :drakma :puri
 	       :trivial-gray-streams
 	       ;; SHA1, hex etc
 	       :ironclad

Modified: cl-darcs/trunk/upath.lisp
==============================================================================
--- cl-darcs/trunk/upath.lisp	(original)
+++ cl-darcs/trunk/upath.lisp	Sat Mar 10 16:13:10 2007
@@ -72,77 +72,9 @@
   (ctypecase upath
     (net.uri:uri 
      (dformat "~&Opening ~A..." upath)
-     (let ((client-request (net.aserve.client:make-http-client-request upath :proxy *http-proxy*)))
-       (net.aserve.client:read-client-response-headers client-request)
-       (let ((code (net.aserve.client:client-request-response-code client-request)))
-	 (cond
-	   ((= code 200)
-	    (make-instance (if binary 'http-byte-input-stream 'http-char-input-stream)
-			   :client-request client-request))
-	   ((and (> redirect-max-depth 0) (member code '(301 302 303 307)))
-	    (let ((new-location (cdr (assoc :location (net.aserve.client:client-request-headers client-request)))))
-	      (dformat "~&Redirected to ~A." new-location)
-	      (net.aserve.client:client-request-close client-request)
-	      (open-upath
-	       (net.uri:uri new-location)
-	       :redirect-max-depth (1- redirect-max-depth) :binary binary)))
-	   (t
-	    (error "Couldn't read ~A: ~A ~A."
-		   upath
-		   (net.aserve.client:client-request-response-code client-request)
-		   (net.aserve.client:client-request-response-comment client-request)))))))
+     (apply #'drakma:http-request upath :redirect redirect-max-depth
+	    :want-stream t (when *http-proxy* `(:proxy ,*http-proxy*))))
 
     (pathname
      (open upath :direction :input :if-does-not-exist :error
 	   :element-type (if binary '(unsigned-byte 8) 'character)))))
-
-
-(defclass http-input-stream (trivial-gray-streams:trivial-gray-stream-mixin
-			     trivial-gray-streams:fundamental-input-stream)
-  ((client-request :initarg :client-request)
-   (binary)
-   (unread :initform nil))
-  (:documentation "A Gray stream wrapping an Allegroserve HTTP request."))
-
-(defclass http-char-input-stream (http-input-stream
-				  trivial-gray-streams:fundamental-character-input-stream)
-  ((binary :initform nil))
-  (:documentation "An HTTP input stream for characters."))
-
-(defclass http-byte-input-stream (http-input-stream
-				  trivial-gray-streams:fundamental-binary-input-stream)
-  ((binary :initform t))
-  (:documentation "An HTTP input stream for bytes."))
-
-(defmethod trivial-gray-streams:stream-read-sequence 
-    ((stream http-input-stream) sequence start end &key &allow-other-keys)
-  (if (slot-value stream 'binary)
-      (net.aserve.client:client-request-read-sequence 
-       sequence (slot-value stream 'client-request))
-      (let* ((buffer (make-array (- end start) :element-type '(unsigned-byte 8)))
-	     (len (net.aserve.client:client-request-read-sequence 
-		   buffer (slot-value stream 'client-request))))
-	(loop for i from 0 below len
-	   do (setf (elt sequence (+ i start)) (aref buffer i)))
-	len)))
-
-(defmethod trivial-gray-streams:stream-read-byte ((stream http-input-stream))
-  (let ((buffer (make-array 1 :element-type '(unsigned-byte 8))))
-    (if (= 1 (trivial-gray-streams:stream-read-sequence stream buffer 0 1))
-	(aref buffer 0)
-	:eof)))
-
-(defmethod trivial-gray-streams:stream-read-char ((stream http-input-stream))
-  (or (pop (slot-value stream 'unread))
-      (let ((byte (trivial-gray-streams:stream-read-byte stream)))
-	(if (eql byte :eof) byte (code-char byte)))))
-
-(defmethod trivial-gray-streams:stream-unread-char ((stream http-input-stream) char)
-  (push char (slot-value stream 'unread)))
-
-(defmethod stream-element-type ((stream http-input-stream))
-  (if (slot-value stream 'binary) '(unsigned-byte 8) 'character))
-
-(defmethod close ((stream http-input-stream) &key &allow-other-keys)
-  (net.aserve.client:client-request-close (slot-value stream 'client-request))
-  (call-next-method))