Sure, http://github.com/gonzojive/drakma/commit/869007460ae2eb804bcd1600faacf9bda27e3709 contains a diff. I also attached one.
- Red On Sat, Aug 7, 2010 at 1:26 PM, Edi Weitz <e...@agharta.de> wrote: > Hi Red, > > First of all, thanks for this, sounds good. Could you show us the > diff somehow so that it's easier to see what exactly you've added and > how? > > Edi. > > > On Sat, Aug 7, 2010 at 1:29 AM, Red Daly <redd...@gmail.com> wrote: >> I have modified Drakma to use a SOCKS5 proxy if desired. Before I >> submit a patch I'd like to know what is the preferred interface for >> this: >> >> 1. Modify http-request with a SOCKS-PROXY option analogous to the >> PROXY option. Introduce SOCKS5 protocol code (about 200 lines) into >> hunchentoot and rely on no external libraries >> >> 2. Modify http-request with a SOCKS-PROXY option analogous to the >> PROXY option. Introduce a dependency on an external SOCKS5 library. >> >> 3. Modify Drakma in some way that allows a user to establish a >> socks-proxy connection without explicitly supporting this in Drakma >> itself. >> >> The implementation requires that instead of establishing a socket >> connection to HOST/PORT, the socket connects to SOCKS-HOST/SOCKS-PORT >> instead and then sets up the socket to forward to HOST/PORT. >> >> The implementation is available here: >> http://github.com/gonzojive/drakma/tree/socks >> >> socks5 spec: http://www.faqs.org/rfcs/rfc1928.html >> >> Red >> >> _______________________________________________ >> drakma-devel mailing list >> drakma-devel@common-lisp.net >> http://common-lisp.net/cgi-bin/mailman/listinfo/drakma-devel >> > > _______________________________________________ > drakma-devel mailing list > drakma-devel@common-lisp.net > http://common-lisp.net/cgi-bin/mailman/listinfo/drakma-devel >
diff --git a/cl-socks.lisp b/cl-socks.lisp deleted file mode 100644 index ab29dc4..0000000 --- a/cl-socks.lisp +++ /dev/null @@ -1,186 +0,0 @@ -(defpackage :cl-socks - (:nicknames :socks) - (:use :cl) - (:export #:socks-connect)) - -(in-package :cl-socks) - - -(defconstant +socks5-no-authorization+ 0 - "Authentication method that requires no credentials.") - -(defconstant +socks5-version-byte+ 5 - "Authentication method that requires no credentials.") - -(defconstant +socks5-address-type-ipv4+ 1 - "IPV4") - -(defconstant +socks5-address-type-domainname+ 3 - "Domain name address type byte") - -(defconstant +socks5-address-type-ipv6+ 4 - "IPV6") - - -(defconstant +socks5-version-byte+ 5 - "Authentication method that requires no credentials.") - -(defconstant +socks5-version-byte+ 5 - "Authentication method that requires no credentials.") - -(defclass socks-client () - ((underlying-stream :initarg :underlying-stream :reader client-underlying-stream - :documentation "The STREAM object this object wraps") - )) - -(defun wrap-stream (wrapper-class underlying-stream &rest initargs) - (apply 'make-instance wrapper-class :underlying-stream underlying-stream initargs)) - -(defun socks-connect (stream destination-address destination-port) - "Establishes a SOCKS5 connection to DESTINATION-ADDRESS on - DESTINATION-PORT through (socket) binary stream STREAM. After - this (blocking) function completes, the stream should behave mostly - as if a direct connection had been made to the desination. - -DESTINATION-ADDRESS is either a Fully Qualified Domain Name (including -the dot at the end and less than 255 characters) string, a vector of 4 -bytes (ipv4 address), or a vector of 6 bytes (ipv6 address). - -Returns (BOUND-ADDRESS-TYPE BOUND-ADDRESS BOUND-PORT) of the -connection on the proxy server. - -See http://www.faqs.org/rfcs/rfc1928.html"; - (socks-client-connect (wrap-stream 'socks-client stream) - destination-address destination-port)) - -(defun destructure-user-address (address) - "Takes as input a string or byte array and determines the type of -desination address specified. Returns 2 values: its type (one -of :ipv4 :ipv6 or :domainname) and the processed address that is valid -to pass into SOCKS-REQUEST." - (typecase address - (string (values :domainname address)) - (sequence (case (length address) - (4 (values :ipv4 address)) - (6 (values :ipv6 address)) - (t (error "Invalid Address ~A" address)))) - (t (error "Invalid Address ~A" address)))) - -(defun socks-client-connect (client destination-address destination-port) - (socks-authenticate client) - (multiple-value-bind (bound-address-type bound-address port) - (socks-request client :connect :domainname destination-address destination-port) - #+nil - (format t "Successfully connected to socks server bound to ~A ~A ~A!~%" - bound-address-type bound-address port) - (values bound-address-type bound-address port))) - - -(defmacro with-syntax-sugar ((socks-stream-var) &body body) - `(labels ((expect-byte (expected &optional (error-format "Read unexpected SOCKS stream byte value ~A")) - (let ((value (read-byte ,socks-stream-var))) - (unless (eql expected value) - (error error-format value)) - expected)) - - (read-n-bytes (n) - (let ((array (make-array n :element-type '(unsigned-byte 8)))) - (unless (eql n (read-sequence array ,socks-stream-var)) - (error "Failed to read ~A bytes from SOCKS stream" n)) - array)) - - (expect-version-byte () - (expect-byte +socks5-version-byte+ "Invalid SOCKS connection/version ~A"))) - ,@body)) - -(defun socks-authenticate (client) - "Performs handshake using the underlying stream." - (let ((socks-stream (client-underlying-stream client))) - (with-syntax-sugar (socks-stream) - ;; http://www.faqs.org/rfcs/rfc1928.html - - ;; Send acceptable authentication methods. only support no - ;; authorization for now - (write-sequence (vector +socks5-version-byte+ 1 +socks5-no-authorization+) socks-stream) - (finish-output socks-stream) - - (expect-version-byte) - (expect-byte +socks5-no-authorization+) - - client))) - -(defun socks-request (client command address-type address port) - (declare (type (member :connect) command) - (type (member :ipv4 :ipv6 :domainname) address-type) - (type integer port) - (type socks-client client)) - (let ((socks-stream (client-underlying-stream client))) - (with-syntax-sugar (socks-stream) - ;; write version, cmd, rsv - (write-sequence (vector +socks5-version-byte+ - (case command - (:connect 1) - (:bind 2) - (:udp-associate 3)) - 0) - socks-stream) - - ;; write the address type - (case address-type - (:ipv4 (write-sequence (concatenate 'vector - (list +socks5-address-type-ipv4+) - address) - socks-stream)) - (:ipv6 (write-sequence (concatenate 'vector - (list +socks5-address-type-ipv6+) - address) - socks-stream)) - (:domainname (let ((octets (flexi-streams:string-to-octets address))) - (unless (<= (length octets) 255) - (error "Fully qualified domain name too long")) - (when (not (eql #\. (elt address (- (length octets) 1)))) - (error "Fully qualified domain name must end in '.'")) - (write-sequence (concatenate 'vector - (list +socks5-address-type-domainname+ - (length octets)) - octets) - socks-stream)))) - - ;; write the port number - (unless (> (expt 2 16) port -1) - (error "Invalid port number ~A" port)) - - (write-sequence (vector (ldb (byte 8 8) port) - (ldb (byte 8 0) port)) - socks-stream) - - (finish-output socks-stream) - - ;;; Receive the response - (expect-version-byte) - (expect-byte 0 "SOCKS5 error during connect. Code: ~A") - (read-byte socks-stream) - - (multiple-value-bind (server-bound-address-type server-bound-address) - (let ((type-byte (read-byte socks-stream))) - (cond - ((eql type-byte +socks5-address-type-ipv4+) - (values :ipv4 - (read-n-bytes 4))) - ((eql type-byte +socks5-address-type-ipv6+) - (values :ipv6 - (read-n-bytes 6))) - - ((eql type-byte +socks5-address-type-domainname+) - (values :domainname - (let ((addr-len (read-byte socks-stream))) - (flexi-streams:octets-to-string (read-n-bytes addr-len))))) - - (t (error "Invalid address type byte received ~A" type-byte)))) - - (let* ((port-bytes (read-n-bytes 2)) - (port (+ (ash (elt port-bytes 0) 8) - (elt port-bytes 1)))) - #+nil - (format t "Connected ~A ~A ~A~%" server-bound-address-type server-bound-address port) - (values server-bound-address-type server-bound-address port)))))) diff --git a/request.lisp b/request.lisp index a720da9..777922a 100644 --- a/request.lisp +++ b/request.lisp @@ -188,40 +188,6 @@ second value." result))) (chunked-input-stream-trailers (flexi-stream-stream stream))))) -(defun drakma-open-tcp-stream (host port &key socks-host socks-port - #+:lispworks connection-timeout - #+:lispworks read-timeout - #+(and :lispworks (not :lw-does-not-have-write-timeout)) write-timeout) - "Creates a TCP stream and returns it." - (declare (optimize (debug 3))) - (flet ((create-stream (host port) - "This is a raw socket stream creation function that we wrap - with various other functionality like SOCKS negotiation." -#+:lispworks - (comm:open-tcp-stream host port - :element-type 'octet - :timeout connection-timeout - :read-timeout read-timeout - #-:lw-does-not-have-write-timeout - :write-timeout - #-:lw-does-not-have-write-timeout - write-timeout - :errorp t) - #-:lispworks - (usocket:socket-stream - (usocket:socket-connect host port - :element-type 'octet - #+:openmcl :deadline - #+:openmcl deadline - :nodelay t)))) - (if socks-host - (let* ((socks-stream (create-stream socks-host socks-port))) - (socks:socks-connect socks-stream - (concatenate 'string host ".") - port) - socks-stream) - (create-stream host port)))) - (defun http-request (uri &rest args &key (protocol :http/1.1) (method :get) @@ -239,7 +205,6 @@ second value." (decompress t) proxy proxy-basic-authorization - socks-proxy additional-headers (redirect 5) (redirect-methods '(:get :head)) @@ -373,19 +338,13 @@ decompressed body sequence or string; if WANT-STREAM is T, then BODY-OR-STREAM is a flexi-stream backed by a gzip-input-stream, which in turn wraps the socket stream. -If PROXY is not NIL, it should be a string denoting an HTTP proxy -server through which the request should be sent. Or it can be a list -of two values -- a string denoting the proxy server and an integer -denoting the port to use \(which will default to 80 otherwise). -PROXY-BASIC-AUTHORIZATION is used like BASIC-AUTHORIZATION, but for -the proxy, and only if PROXY is true. - -If SOCKS-PROXY is not NIL, it should be a string denoting a SOCKSu5 -proxy server through which the request should be sent. Or it can be a -list of two values -- a string denoting the proxy server and an -integer denoting the port to use \(which will default to 1080 -otherwise). If both PROXY and SOCKS-PROXY are specified, then the -request goes through the SOCKS5 proxy and then through the HTTP proxy. +If PROXY is not NIL, it should be a string denoting a proxy +server through which the request should be sent. Or it can be a +list of two values - a string denoting the proxy server and an +integer denoting the port to use \(which will default to 80 +otherwise). PROXY-BASIC-AUTHORIZATION is used like +BASIC-AUTHORIZATION, but for the proxy, and only if PROXY is +true. ADDITIONAL-HEADERS is a name/value alist of additional HTTP headers which should be sent with the request. Unlike in PARAMETERS, the cdrs @@ -471,10 +430,6 @@ only available on CCL 1.2 and later." (when proxy (when (atom proxy) (setq proxy (list proxy 80)))) - ;; convert SOCKS-PROXY argument to canonical form - (when socks-proxy - (when (atom socks-proxy) - (setq socks-proxy (list socks-proxy 1080)))) ;; make sure we don't get :CRLF on Windows (let ((*default-eol-style* :lf) (file-parameters-p (find-if-not #'stringp parameters :key #'cdr)) @@ -515,19 +470,22 @@ only available on CCL 1.2 and later." (setq write-timeout nil)) (setq http-stream (or stream #+:lispworks - (drakma-open-tcp-stream host port - :socks-host (first socks-proxy) - :socks-port (second socks-proxy) - :timeout connection-timeout - :read-timeout read-timeout - #-:lw-does-not-have-write-timeout - :write-timeout - #-:lw-does-not-have-write-timeout - write-timeout) + (comm:open-tcp-stream host port + :element-type 'octet + :timeout connection-timeout + :read-timeout read-timeout + #-:lw-does-not-have-write-timeout + :write-timeout + #-:lw-does-not-have-write-timeout + write-timeout + :errorp t) #-:lispworks - (drakma-open-tcp-stream host port - :socks-host (first socks-proxy) - :socks-port (second socks-proxy)))) + (usocket:socket-stream + (usocket:socket-connect host port + :element-type 'octet + #+:openmcl :deadline + #+:openmcl deadline + :nodelay t)))) #+:openmcl (when deadline ;; it is correct to set the deadline here even though
_______________________________________________ drakma-devel mailing list drakma-devel@common-lisp.net http://common-lisp.net/cgi-bin/mailman/listinfo/drakma-devel
