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@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))