Skip to content

Instantly share code, notes, and snippets.

@kurohuku
Created November 19, 2010 00:37
Show Gist options
  • Save kurohuku/705955 to your computer and use it in GitHub Desktop.
Save kurohuku/705955 to your computer and use it in GitHub Desktop.
(asdf:oos 'asdf:load-op :cl+ssl)
(in-package :asdf-install)
(setf (symbol-function 'make-stream-from-url-old)
#'make-stream-from-url)
(setf (symbol-function 'url-host-old)
#'url-host)
(setf (symbol-function 'url-port-old)
#'url-port)
(setf (symbol-function 'request-uri-old)
#'request-uri)
(defun make-stream-from-url (connect-to-url)
(let ((sock (make-stream-from-url-old connect-to-url)))
(if *proxy*
sock
(cl+ssl:make-ssl-client-stream sock))))
(defun url-host (url)
(if (string= url "https://" :end1 8)
(let* ((port-start (position #\: url :start 8))
(host-end (min (or (position #\/ url :start 8) (length url))
(or port-start (length url)))))
(subseq url 8 host-end))
(url-host-old url)))
(defun url-port (url)
(if (string= url "https://" :end1 8)
(let ((port-start (position #\: url :start 8)))
(if port-start
(parse-integer url :start (1+ port-start) :junk-allowed t)
443))
(url-port-old url)))
(defun request-uri (url)
(if (string-equal url "https://" :end1 8)
(if *proxy*
url
(let ((path-start (position #\/ url :start 8)))
(assert (and path-start) nil "url does not specify a file.")
(subseq url path-start)))
(request-uri-old url)))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment