Quicklisp with HTTPS downloads via Drakma

Quicklisp's lack of authentication is a recurring topic that has bothered me for years. A recent decent blog post summarizes the problem and suggests to configure QL to make all connections through mitmproxy, which then makes HTTPS requests on QL's behalf. Since this comes with some minor problems itself, the author then suggests the following:

A good compromise would be to first install Quicklisp the way I have outlined, then install a TLS patch for Quicklisp that pulls in all its dependencies. We would still need to bootstrap Quicklisp securely the hard way, but once we have an initial secure connection we can safely pull in any dependencies we need.

Such a patch is actually extremely simple. If you have Drakma already installed through some secure method, you can simply register the following function in ql-http:*fetch-scheme-functions* (for HTTP, not HTTPS!) to download over HTTPS without any proxies. It uses two internal functions, but they are easy to reimplement with external ones if you want to do so.

(defun quicklisp-https-fetch (url file &key (follow-redirects t) quietly
					 (if-exists :rename-and-delete)
					 (maximum-redirects ql-http:*maximum-redirects*))
  "Like Quicklisp's built-in `http-fetch', but rewrites URLs to HTTPS and
fetches them with Drakma instead."
  (setf url (ql-http::merge-urls url ql-http:*default-url-defaults*)
	file (merge-pathnames file)
	(ql-http:scheme url) "https")
  (multiple-value-bind (response code)
      (handler-bind ((drakma:drakma-error
		      (lambda (c) ; This is as fine-grained as Drakma gets, sadly.
			(when (search "but redirection limit has been exceeded."
				      (princ-to-string c))
			  (error 'ql-http:too-many-redirects
				 :url url :redirect-count maximum-redirects)))))
	(drakma:http-request (ql-http::urlstring url)
			     :force-binary t
			     :redirect (if follow-redirects maximum-redirects nil)
			     :proxy (if ql-http:*proxy-url*
					(let ((p (ql-http:url ql-http:*proxy-url*)))
					  (list (ql-http:hostname p)
						(or (ql-http:port p) 80)))
			     :user-agent nil))
    (when (/= code 200)
      (error 'ql-http:unexpected-http-status :url url :status-code code))
    (unless quietly
      (format *trace-output* "~&; Fetched (via HTTPS) ~A~%" url))
    (alexandria:write-byte-vector-into-file response file :if-exists if-exists)
    ;; The first return value is unused, which makes sense because it's a header
    ;; object that's specific to this fetch method. The very first version from
    ;; 2010 wasn't scheme-generic yet but doesn't use it either. A mystery.
    (values nil (and file (probe-file file)))))

Date: 2022-03-20 11:53:11