-;;; url-http.el --- HTTP retrieval routines
+;;; url-http.el --- HTTP retrieval routines -*- lexical-binding:t -*-
;; Copyright (C) 1999, 2001, 2004-2016 Free Software Foundation, Inc.
(require 'cl-lib)
(require 'puny)
+(require 'nsm)
(eval-when-compile
(require 'subr-x))
(507 insufficient-storage "Insufficient storage"))
"The HTTP return codes and their text.")
+(defconst url-https-default-port 443 "Default HTTPS port.")
+
;(eval-when-compile
;; These are all macros so that they are hidden from external sight
;; when the file is byte-compiled.
;; `url-open-stream' needs a buffer in which to do things
;; like authentication. But we use another buffer afterwards.
(unwind-protect
- (let ((proc (url-open-stream host buf host port gateway-method)))
+ (let ((proc (url-open-stream host buf
+ (if url-using-proxy
+ (url-host url-using-proxy)
+ host)
+ (if url-using-proxy
+ (url-port url-using-proxy)
+ port)
+ gateway-method)))
;; url-open-stream might return nil.
(when (processp proc)
;; Drop the temp buffer link before killing the buffer.
(if connection
(url-http-mark-connection-as-busy host port connection))))
+(defun url-http--user-agent-default-string ()
+ "Compute a default User-Agent string based on `url-privacy-level'."
+ (let ((package-info (when url-package-name
+ (format "%s/%s" url-package-name url-package-version)))
+ (emacs-info (unless (and (listp url-privacy-level)
+ (memq 'emacs url-privacy-level))
+ (format "Emacs/%s" emacs-version)))
+ (os-info (unless (and (listp url-privacy-level)
+ (memq 'os url-privacy-level))
+ (format "(%s; %s)" url-system-type url-os-type)))
+ (url-info (format "URL/%s" url-version)))
+ (string-join (delq nil (list package-info url-info
+ emacs-info os-info))
+ " ")))
+
;; Building an HTTP request
(defun url-http-user-agent-string ()
- (if (or (eq url-privacy-level 'paranoid)
- (and (listp url-privacy-level)
- (memq 'agent url-privacy-level)))
- ""
- (if (functionp url-user-agent)
- (funcall url-user-agent)
- url-user-agent)))
+ "Compute a User-Agent string.
+The string is based on `url-privacy-level' and `url-user-agent'."
+ (let* ((hide-ua
+ (or (eq url-privacy-level 'paranoid)
+ (and (listp url-privacy-level)
+ (memq 'agent url-privacy-level))))
+ (ua-string
+ (and (not hide-ua)
+ (cond
+ ((functionp url-user-agent) (funcall url-user-agent))
+ ((stringp url-user-agent) url-user-agent)
+ ((eq url-user-agent 'default) (url-http--user-agent-default-string))))))
+ (if ua-string (format "User-Agent: %s\r\n" (string-trim ua-string)) "")))
(defun url-http-create-request (&optional ref-url)
"Create an HTTP request for `url-http-target-url', referred to by REF-URL."
;; allows us to elide null lines directly, at the cost of making
;; the layout less clear.
(setq request
- ;; We used to concat directly, but if one of the strings happens
- ;; to being multibyte (even if it only contains pure ASCII) then
- ;; every string gets converted with `string-MAKE-multibyte' which
- ;; turns the 127-255 codes into things like latin-1 accented chars
- ;; (it would work right if it used `string-TO-multibyte' instead).
- ;; So to avoid the problem we force every string to be unibyte.
- (mapconcat
- ;; FIXME: Instead of `string-AS-unibyte' we'd want
- ;; `string-to-unibyte', so as to properly signal an error if one
- ;; of the strings contains a multibyte char.
- 'string-as-unibyte
- (delq nil
- (list
+ (concat
;; The request
(or url-http-method "GET") " "
(if using-proxy (url-recreate-url url-http-target-url) real-fname)
"\r\n"
;; Any data
url-http-data))
- ""))
+ ;; Bug#23750
+ (unless (= (string-bytes request)
+ (length request))
+ (error "Multibyte text in HTTP request: %s" request))
(url-http-debug "Request is: \n%s" request)
request))
)
(declare-function gnutls-peer-status "gnutls.c" (proc))
+(declare-function gnutls-negotiate "gnutls.el" t t)
(defun url-http-parse-headers ()
"Parse and handle HTTP specific headers.
;; )
;; These unfortunately cannot be macros... please ignore them!
-(defun url-http-idle-sentinel (proc why)
+(defun url-http-idle-sentinel (proc _why)
"Remove (now defunct) process PROC from the list of open connections."
(maphash (lambda (key val)
(if (memq proc val)
(erase-buffer)
(let ((url-request-method url-http-method)
(url-request-extra-headers url-http-extra-headers)
- (url-request-data url-http-data))
+ (url-request-data url-http-data)
+ (url-using-proxy (url-find-proxy-for-url
+ url-current-object
+ (url-host url-current-object))))
+ (when url-using-proxy
+ (setq url-using-proxy
+ (url-generic-parse-url url-using-proxy)))
(url-http url-current-object url-callback-function
url-callback-arguments (current-buffer)))))
((url-http-parse-headers)
(url-http-activate-callback))))))
-(defun url-http-simple-after-change-function (st nd length)
+(defun url-http-simple-after-change-function (_st _nd _length)
;; Function used when we do NOT know how long the document is going to be
;; Just _very_ simple 'downloaded %d' type of info.
- (url-lazy-message "Reading %s..." (file-size-human-readable nd)))
+ (url-lazy-message "Reading %s..." (file-size-human-readable (buffer-size))))
-(defun url-http-content-length-after-change-function (st nd length)
+(defun url-http-content-length-after-change-function (_st nd _length)
"Function used when we DO know how long the document is going to be.
More sophisticated percentage downloaded, etc.
Also does minimal parsing of HTTP headers and will actually cause
(if (url-http-parse-headers)
(url-http-activate-callback))))))))))
-(defun url-http-wait-for-headers-change-function (st nd length)
+(defun url-http-wait-for-headers-change-function (_st nd _length)
;; This will wait for the headers to arrive and then splice in the
;; next appropriate after-change-function, etc.
(url-http-debug "url-http-wait-for-headers-change-function (%s)"
(let ((end-of-headers nil)
(old-http nil)
(process-buffer (current-buffer))
- (content-length nil))
+ ;; (content-length nil)
+ )
(when (not (bobp))
(goto-char (point-min))
(if (and (looking-at ".*\n") ; have one line at least
The return value of this function is the retrieval buffer."
(cl-check-type url vector "Need a pre-parsed URL.")
- (let* ((host (url-host (or url-using-proxy url)))
- (port (url-port (or url-using-proxy url)))
+ (let* (;; (host (url-host (or url-using-proxy url)))
+ ;; (port (url-port (or url-using-proxy url)))
(nsm-noninteractive (or url-request-noninteractive
(and (boundp 'url-http-noninteractive)
url-http-noninteractive)))
- (connection (url-http-find-free-connection host port gateway-method))
+ (connection (url-http-find-free-connection (url-host url)
+ (url-port url)
+ gateway-method))
(mime-accept-string url-mime-accept-string)
(buffer (or retry-buffer
(generate-new-buffer
- (format " *http %s:%d*" host port)))))
+ (format " *http %s:%d*" (url-host url) (url-port url))))))
(if (not connection)
;; Failed to open the connection for some reason
(progn
(kill-buffer buffer)
(setq buffer nil)
- (error "Could not create connection to %s:%d" host port))
+ (error "Could not create connection to %s:%d" (url-host url)
+ (url-port url)))
(with-current-buffer buffer
(mm-disable-multibyte)
(setq url-current-object url
(set-process-sentinel connection 'url-http-async-sentinel))
(`failed
;; Asynchronous connection failed
- (error "Could not create connection to %s:%d" host port))
+ (error "Could not create connection to %s:%d" (url-host url)
+ (url-port url)))
(_
- (set-process-sentinel connection
- 'url-http-end-of-document-sentinel)
- (process-send-string connection (url-http-create-request))))))
+ (if (and url-http-proxy (string= "https"
+ (url-type url-current-object)))
+ (url-https-proxy-connect connection)
+ (set-process-sentinel connection
+ 'url-http-end-of-document-sentinel)
+ (process-send-string connection (url-http-create-request)))))))
buffer))
+(defun url-https-proxy-connect (connection)
+ (setq url-http-after-change-function 'url-https-proxy-after-change-function)
+ (process-send-string connection (format (concat "CONNECT %s:%d HTTP/1.1\r\n"
+ "Host: %s\r\n"
+ "\r\n")
+ (url-host url-current-object)
+ (or (url-port url-current-object)
+ url-https-default-port)
+ (url-host url-current-object))))
+
+(defun url-https-proxy-after-change-function (_st _nd _length)
+ (let* ((process-buffer (current-buffer))
+ (proc (get-buffer-process process-buffer)))
+ (goto-char (point-min))
+ (when (re-search-forward "^\r?\n" nil t)
+ (backward-char 1)
+ ;; Saw the end of the headers
+ (setq url-http-end-of-headers (set-marker (make-marker) (point)))
+ (url-http-parse-response)
+ (cond
+ ((null url-http-response-status)
+ ;; We got back a headerless malformed response from the
+ ;; server.
+ (url-http-activate-callback)
+ (error "Malformed response from proxy, fail!"))
+ ((= url-http-response-status 200)
+ (if (gnutls-available-p)
+ (condition-case e
+ (let ((tls-connection (gnutls-negotiate
+ :process proc
+ :hostname (url-host url-current-object)
+ :verify-error nil)))
+ ;; check certificate validity
+ (setq tls-connection
+ (nsm-verify-connection tls-connection
+ (url-host url-current-object)
+ (url-port url-current-object)))
+ (with-current-buffer process-buffer (erase-buffer))
+ (set-process-buffer tls-connection process-buffer)
+ (setq url-http-after-change-function
+ 'url-http-wait-for-headers-change-function)
+ (set-process-filter tls-connection 'url-http-generic-filter)
+ (process-send-string tls-connection
+ (url-http-create-request)))
+ (gnutls-error
+ (url-http-activate-callback)
+ (error "gnutls-error: %s" e))
+ (error
+ (url-http-activate-callback)
+ (error "error: %s" e)))
+ (error "error: gnutls support needed!")))
+ (t
+ (message "error response: %d" url-http-response-status)
+ (url-http-activate-callback))))))
+
(defun url-http-async-sentinel (proc why)
;; We are performing an asynchronous connection, and a status change
;; has occurred.
(url-http-end-of-document-sentinel proc why))
((string= (substring why 0 4) "open")
(setq url-http-connection-opened t)
- (condition-case error
- (process-send-string proc (url-http-create-request))
- (file-error
- (setq url-http-connection-opened nil)
- (message "HTTP error: %s" error))))
+ (if (and url-http-proxy (string= "https" (url-type url-current-object)))
+ (url-https-proxy-connect proc)
+ (condition-case error
+ (process-send-string proc (url-http-create-request))
+ (file-error
+ (setq url-http-connection-opened nil)
+ (message "HTTP error: %s" error)))))
(t
(setf (car url-callback-arguments)
(nconc (list :error (list 'error 'connection-failed why
(defalias 'url-http-file-readable-p 'url-http-file-exists-p)
-(defun url-http-head-file-attributes (url &optional id-format)
+(defun url-http-head-file-attributes (url &optional _id-format)
(let ((buffer (url-http-head url)))
(when buffer
(prog1
nil nil nil) ;whether gid would change ; inode ; device.
(kill-buffer buffer)))))
-(declare-function url-dav-file-attributes "url-dav" (url &optional id-format))
+(declare-function url-dav-file-attributes "url-dav" (url &optional _id-format))
(defun url-http-file-attributes (url &optional id-format)
(if (url-dav-supported-p url)
;; with url-http.el on systems with 8-character file names.
(require 'tls)
-(defconst url-https-default-port 443 "Default HTTPS port.")
(defconst url-https-asynchronous-p t "HTTPS retrievals are asynchronous.")
;; FIXME what is the point of this alias being an autoload?