└── curl-for-url.el /curl-for-url.el: -------------------------------------------------------------------------------- 1 | ;;; curl-for-url.el --- use url-retrieve with curl doing the work 2 | 3 | ;; Copyright (C) 2015 Nic Ferrier 4 | 5 | ;; Author: Nic Ferrier 6 | ;; Keywords: hypermedia 7 | ;; Version: 0.0.2 8 | ;; Package-requires: ((noflet "0.0.15")) 9 | 10 | ;; This program is free software; you can redistribute it and/or modify 11 | ;; it under the terms of the GNU General Public License as published by 12 | ;; the Free Software Foundation, either version 3 of the License, or 13 | ;; (at your option) any later version. 14 | 15 | ;; This program is distributed in the hope that it will be useful, 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 | ;; GNU General Public License for more details. 19 | 20 | ;; You should have received a copy of the GNU General Public License 21 | ;; along with this program. If not, see . 22 | 23 | 24 | ;;; Commentary: 25 | 26 | ;; Sometimes curl is more reliable than Emacs internal url stuff. 27 | 28 | ;; This provides the `url-retrieve' function but with curl. This is 29 | ;; useful in weird environments where curl does better than 30 | ;; `url-retrieve'. 31 | 32 | ;;; Code: 33 | 34 | (require 'noflet) 35 | (require 'url-http) 36 | 37 | (defmacro comment (&rest code)) 38 | 39 | ;; this is how url-retrieve works. 40 | (comment 41 | (url-retrieve 42 | "http://localhost:8081" 43 | (lambda (status &rest cbargs) 44 | (message 45 | "url retrieve done: [%s] %s" 46 | url-http-response-status 47 | (buffer-substring-no-properties 48 | url-http-end-of-headers (+ url-http-end-of-headers 50))))) 49 | ;; This is how the curl works 50 | (noflet ((url-http (url callback cbargs &optional retry-buffer) 51 | (curl-call url nil callback cbargs))) 52 | ;; Setup an elnode with a redirector, for example: 53 | ;; 54 | ;; (elnode-start 55 | ;; (lambda (httpcon) 56 | ;; (elnode-send-redirect 57 | ;; httpcon 58 | ;; "http://nic.ferrier.me.uk/stuff/css/site.css")) 59 | ;; :port 8081) 60 | (url-retrieve 61 | "http://localhost:8081" 62 | (lambda (status &rest cbargs) 63 | (message 64 | "url retrieve done: [%s] %s" 65 | url-http-response-status 66 | (buffer-substring-no-properties 67 | url-http-end-of-headers (+ url-http-end-of-headers 50))))))) 68 | 69 | (defun curl/sentinel (proc evt) 70 | "Sentinel for `curl-call'." 71 | (cl-case (intern (car (split-string evt "\n"))) 72 | ('finished 73 | (with-current-buffer (process-buffer proc) 74 | (noflet ((url-http-mark-connection-as-free (&rest params) nil)) 75 | (let ((url-http-end-of-headers 76 | (save-excursion 77 | (goto-char (point-min)) 78 | (re-search-forward "\r\n\r\n" nil t)))) 79 | (save-excursion 80 | (goto-char (point-min)) 81 | (while (re-search-forward "\r\n" url-http-end-of-headers t) 82 | (replace-match "\n"))) 83 | (url-http-end-of-document-sentinel proc evt))))))) 84 | 85 | (defun curl-call (url data callback cbargs) 86 | "Do curl for url-retrieval." 87 | (let* (connection ; dummy var for url-retrieve interop 88 | (url-string (format "%s://%s:%s%s" 89 | (url-type url) 90 | (url-host url) 91 | (url-port url) 92 | (url-filename url))) 93 | (curl-name (format "*curl-%s-%s*" url-string (or url-request-method "GET"))) 94 | (retry-buffer (generate-new-buffer curl-name)) 95 | (args (list "curl" "-s" "-i" url-string)) 96 | (proc (apply 'start-process 97 | (append (list curl-name (generate-new-buffer curl-name)) args)))) 98 | (with-current-buffer (process-buffer proc) ; stuff ripped out of url-http 99 | (mm-disable-multibyte) 100 | (setq url-current-object url mode-line-format "%b [%s]") 101 | (dolist (var '(url-http-end-of-headers 102 | url-http-content-type 103 | url-http-content-length 104 | url-http-transfer-encoding 105 | url-http-after-change-function 106 | url-http-response-version 107 | url-http-response-status 108 | url-http-chunked-length 109 | url-http-chunked-counter 110 | url-http-chunked-start 111 | url-callback-function 112 | url-callback-arguments 113 | url-show-status 114 | url-http-process 115 | url-http-method 116 | url-http-extra-headers 117 | url-http-data 118 | url-http-target-url 119 | url-http-no-retry 120 | url-http-connection-opened 121 | url-http-proxy)) 122 | (set (make-local-variable var) nil)) 123 | (setq url-http-method (or url-request-method "GET") 124 | url-http-extra-headers url-request-extra-headers 125 | url-http-data url-request-data 126 | url-http-process connection 127 | url-http-chunked-length nil 128 | url-http-chunked-start nil 129 | url-http-chunked-counter 0 130 | url-callback-function callback 131 | url-callback-arguments cbargs 132 | url-http-after-change-function 'url-http-wait-for-headers-change-function 133 | url-http-target-url url-current-object 134 | url-http-no-retry retry-buffer 135 | url-http-connection-opened nil 136 | url-http-proxy url-using-proxy)) 137 | (set-process-sentinel proc 'curl/sentinel))) 138 | 139 | (defun url-http-with-curl (url callback cbargs &optional retry-buffer) 140 | (curl-call url callback cbargs)) 141 | 142 | (defvar curl-url-retrieve-original nil) 143 | 144 | ;;;###autoload 145 | (defun curl-for-url-install () 146 | "Replaces the url-retrieve function with a curl one." 147 | (unless curl-url-retrieve-original 148 | (fset 'curl-url-retrieve-original (symbol-function 'url-http)) 149 | (fset 'url-http (symbol-function 'url-http-with-curl)))) 150 | 151 | ;;;###autoload 152 | (defun curl-for-url-uninstall () 153 | "Restores `url-http' after a `curl-for-url-install'." 154 | (when curl-url-retrieve-original 155 | (fset 'url-http (symbol-function 'curl-url-retrieve-orginal)) 156 | (fset 'curl-url-retrieve-original nil))) 157 | 158 | (provide 'curl-for-url) 159 | 160 | ;;; curl-for-url.el ends here 161 | --------------------------------------------------------------------------------