• Home
  • History
  • Annotate
  • Raw
  • Download
  • only in /macosx-10.10.1/emacs-93/emacs/lisp/url/

Lines Matching +defs:url +defs:target

0 ;;; url-http.el --- HTTP retrieval routines
30 (defvar url-http-extra-headers)
31 (defvar url-http-target-url)
32 (defvar url-http-proxy)
33 (defvar url-http-connection-opened)
34 (require 'url-gw)
35 (require 'url-util)
36 (require 'url-parse)
37 (require 'url-cookie)
39 (require 'url-auth)
40 (require 'url)
41 (autoload 'url-cache-create-filename "url-cache")
43 (defconst url-http-default-port 80 "Default HTTP port.")
44 (defconst url-http-asynchronous-p t "HTTP retrievals are asynchronous.")
45 (defalias 'url-http-expand-file-name 'url-default-expander)
47 (defvar url-http-real-basic-auth-storage nil)
48 (defvar url-http-proxy-basic-auth-storage nil)
50 (defvar url-http-open-connections (make-hash-table :test 'equal
54 (defvar url-http-version "1.1"
62 (defvar url-http-attempt-keepalives t
76 (defsubst url-http-debug (&rest args)
86 (apply 'url-debug 'http args))
88 (defun url-http-mark-connection-as-busy (host port proc)
89 (url-http-debug "Marking connection as busy: %s:%d %S" host port proc)
92 (delq proc (gethash (cons host port) url-http-open-connections))
93 url-http-open-connections)
96 (defun url-http-mark-connection-as-free (host port proc)
97 (url-http-debug "Marking connection as free: %s:%d %S" host port proc)
100 (set-process-sentinel proc 'url-http-idle-sentinel)
103 (cons proc (gethash (cons host port) url-http-open-connections))
104 url-http-open-connections))
107 (defun url-http-find-free-connection (host port)
108 (let ((conns (gethash (cons host port) url-http-open-connections))
113 (url-http-debug "Cleaning up dead process: %s:%d %S"
115 (url-http-idle-sentinel (car conns) nil))
117 (url-http-debug "Found existing connection: %s:%d %S" host port found))
120 (url-http-debug "Reusing existing connection: %s:%d" host port)
121 (url-http-debug "Contacting host: %s:%d" host port))
122 (url-lazy-message "Contacting host: %s:%d" host port)
123 (url-http-mark-connection-as-busy
126 (let ((buf (generate-new-buffer " *url-http-temp*")))
127 ;; `url-open-stream' needs a buffer in which to do things
130 (let ((proc (url-open-stream host buf host port)))
131 ;; url-open-stream might return nil.
139 (defun url-http-user-agent-string ()
140 (if (or (eq url-privacy-level 'paranoid)
141 (and (listp url-privacy-level)
142 (memq 'agent url-privacy-level)))
145 (if url-package-name
146 (concat url-package-name "/" url-package-version " ")
148 url-version
150 ((and url-os-type url-system-type)
151 (concat " (" url-os-type "; " url-system-type ")"))
152 ((or url-os-type url-system-type)
153 (concat " (" (or url-system-type url-os-type) ")"))
156 (defun url-http-create-request (&optional ref-url)
157 "Create an HTTP request for `url-http-target-url', referred to by REF-URL."
159 url-http-method url-http-data
160 url-http-extra-headers))
163 (no-cache (cdr-safe (assoc "Pragma" url-http-extra-headers)))
164 (using-proxy url-http-proxy)
166 url-http-extra-headers))
169 (let ((url-basic-auth-storage
170 'url-http-proxy-basic-auth-storage))
171 (url-get-authentication url-http-target-url nil 'any nil))))
172 (real-fname (concat (url-filename url-http-target-url)
173 (url-recreate-url-attributes url-http-target-url)))
174 (host (url-host url-http-target-url))
175 (auth (if (cdr-safe (assoc "Authorization" url-http-extra-headers))
177 (url-get-authentication (or
180 url-http-target-url) nil 'any nil))))
190 (if (and ref-url (stringp ref-url) (or (string= ref-url "file:nil")
191 (string= ref-url "")))
192 (setq ref-url nil))
195 (if (or (memq url-privacy-level '(low high paranoid))
196 (and (listp url-privacy-level)
197 (memq 'lastloc url-privacy-level)))
198 (setq ref-url nil))
200 ;; url-http-extra-headers contains an assoc-list of
205 url-http-extra-headers "\r\n"))
228 (or url-http-method "GET") " "
229 (if using-proxy (url-recreate-url url-http-target-url) real-fname)
230 " HTTP/" url-http-version "\r\n"
235 (not url-http-attempt-keepalives))
238 (if url-extensions-header
240 "Extension: %s\r\n" url-extensions-header))
242 (if (/= (url-port url-http-target-url)
243 (url-scheme-get-property
244 (url-type url-http-target-url) 'default-port))
246 "Host: %s:%d\r\n" host (url-port url-http-target-url))
249 (if url-personal-mail-address
251 "From: " url-personal-mail-address "\r\n"))
253 (if url-mime-encoding-string
255 "Accept-encoding: " url-mime-encoding-string "\r\n"))
256 (if url-mime-charset-string
258 "Accept-charset: " url-mime-charset-string "\r\n"))
260 (if url-mime-language-string
262 "Accept-language: " url-mime-language-string "\r\n"))
264 "Accept: " (or url-mime-accept-string "*/*") "\r\n"
266 (url-http-user-agent-string)
272 (url-cookie-generate-header-lines host real-fname
273 (equal "https" (url-type url-http-target-url)))
276 (member url-http-method '("GET" nil)))
277 (let ((tm (url-is-cached url-http-target-url)))
280 (url-get-normalized-date tm) "\r\n"))))
282 (if ref-url (concat
283 "Referer: " ref-url "\r\n"))
286 (if url-http-data
289 (length url-http-data))
294 url-http-data))
296 (url-http-debug "Request is: \n%s" request)
300 (defun url-http-clean-headers ()
303 (declare (special url-http-end-of-headers))
305 (while (re-search-forward "\r$" url-http-end-of-headers t)
308 (defun url-http-handle-authentication (proxy)
309 (declare (special status success url-http-method url-http-data
310 url-callback-function url-callback-arguments))
311 (url-http-debug "Handling %s authentication" (if proxy "proxy" "normal"))
318 (url (url-recreate-url url-current-object))
319 (url-basic-auth-storage 'url-http-real-basic-auth-storage)
324 (setq url-basic-auth-storage 'url-http-proxy-basic-auth-storage))
328 (setq this-auth (url-eat-trailing-space
329 (url-strip-leading-spaces
335 (registered (url-auth-registered this-type))
342 (if (not (url-auth-registered type))
348 " send it to " url-bug-address ".<hr>")
350 (let* ((args (url-parse-args (subst-char-in-string ?, ?\; auth)))
351 (auth (url-get-authentication url (cdr-safe (assoc "realm" args))
356 url-http-extra-headers)
357 (let ((url-request-method url-http-method)
358 (url-request-data url-http-data)
359 (url-request-extra-headers url-http-extra-headers))
360 (url-retrieve-internal url url-callback-function
361 url-callback-arguments)))))))
363 (defun url-http-parse-response ()
365 (declare (special url-http-end-of-headers url-http-response-status
366 url-http-response-version))
367 (if (not url-http-end-of-headers)
369 (url-http-debug "url-http-parse-response called in (%s)" (buffer-name))
373 (setq url-http-response-version
378 (setq url-http-response-status (read (current-buffer))))
380 (defun url-http-handle-cookies ()
386 (and cookies (url-http-debug "Found %d Set-Cookie headers" (length cookies)))
387 (and cookies2 (url-http-debug "Found %d Set-Cookie2 headers" (length cookies2)))
389 (url-cookie-handle-set-cookie (pop cookies)))
391 ;;; (url-cookie-handle-set-cookie2 (pop cookies)))
395 (defun url-http-parse-headers ()
401 (declare (special url-http-end-of-headers url-http-response-status
402 url-http-response-version
403 url-http-method url-http-data url-http-process
404 url-callback-function url-callback-arguments))
406 (url-http-mark-connection-as-free (url-host url-current-object)
407 (url-port url-current-object)
408 url-http-process)
410 (if (or (not (boundp 'url-http-end-of-headers))
411 (not url-http-end-of-headers))
414 (url-http-debug "url-http-parse-headers called in (%s)" (buffer-name))
415 (url-http-parse-response)
417 ;;(narrow-to-region (point-min) url-http-end-of-headers)
424 ((string= url-http-response-version "1.0")
427 (delete-process url-http-process)))
431 (delete-process url-http-process)))))
434 (setq class (/ url-http-response-status 100))
435 (url-http-debug "Parsed HTTP headers: class=%d status=%d" class url-http-response-status)
436 (url-http-handle-cookies)
450 (url-mark-buffer-as-dead (current-buffer))
451 (error "HTTP responses in class 1xx not supported (%d)" url-http-response-status))
461 (case url-http-response-status
464 (url-mark-buffer-as-dead (current-buffer))
470 (if (and url-automatic-caching (equal url-http-method "GET"))
471 (url-store-in-cache (current-buffer)))
483 (case url-http-response-status
507 (if (member url-http-method '("HEAD" "GET"))
513 (url-http-debug "Converting `%s' request to `GET' because of REDIRECT(%d)"
514 url-http-method url-http-response-status)
515 (setq url-http-method "GET"
516 url-http-data nil)))
521 (setq url-http-method "GET"
522 url-http-data nil))
525 (url-http-debug "Extracting document from cache... (%s)"
526 (url-cache-create-filename (url-view-url t)))
527 (url-cache-extract (url-cache-create-filename (url-view-url t)))
551 (if (not (string-match url-nonrelative-link redirect-uri))
552 ;; Be careful to use the real target URL, otherwise we may
555 (url-expand-file-name redirect-uri url-http-target-url)))
556 (let ((url-request-method url-http-method)
557 (url-request-data url-http-data)
558 (url-request-extra-headers url-http-extra-headers))
560 (if (or (< url-max-redirections 0)
561 (and (> url-max-redirections 0)
562 (let ((events (car url-callback-arguments))
569 (< old-redirects url-max-redirections))))
570 ;; url-max-redirections hasn't been reached, so go
574 (setf (car url-callback-arguments)
576 (car url-callback-arguments)))
579 ;; FIXME: This is a hack to fix url-retrieve-synchronously
580 ;; without changing the API. Instead url-retrieve should
583 (set (make-local-variable 'url-redirect-buffer)
584 (url-retrieve-internal
585 redirect-uri url-callback-function
586 url-callback-arguments))
587 (url-mark-buffer-as-dead (current-buffer)))
588 ;; We hit url-max-redirections, so issue an error and
590 (url-http-debug "Maximum redirections reached")
591 (setf (car url-callback-arguments)
594 (car url-callback-arguments)))
618 (case url-http-response-status
625 (url-http-handle-authentication nil))
628 (url-mark-buffer-as-dead (current-buffer))
656 (url-http-handle-authentication t))
682 ;; `url-http-create-request' automatically calculates the
721 (setf (car url-callback-arguments)
722 (nconc (list :error (list 'error 'http url-http-response-status))
723 (car url-callback-arguments)))))
733 (case url-http-response-status
776 (setf (car url-callback-arguments)
777 (nconc (list :error (list 'error 'http url-http-response-status))
778 (car url-callback-arguments)))))
781 class url-http-response-status)))
783 (url-mark-buffer-as-dead (current-buffer)))
784 (url-http-debug "Finished parsing HTTP headers: %S" success)
789 (defun url-http-activate-callback ()
791 (declare (special url-http-process
792 url-callback-function
793 url-callback-arguments))
794 (url-http-mark-connection-as-free (url-host url-current-object)
795 (url-port url-current-object)
796 url-http-process)
797 (url-http-debug "Activating callback in buffer (%s)" (buffer-name))
798 (apply url-callback-function url-callback-arguments))
803 (defun url-http-idle-sentinel (proc why)
807 (puthash key (delq proc val) url-http-open-connections)))
808 url-http-open-connections))
810 (defun url-http-end-of-document-sentinel (proc why)
813 (url-http-debug "url-http-end-of-document-sentinel in buffer (%s)"
815 (url-http-idle-sentinel proc why)
820 (url-http-activate-callback)
821 (if (url-http-parse-headers)
822 (url-http-activate-callback)))))
824 (defun url-http-simple-after-change-function (st nd length)
827 (declare (special url-http-end-of-headers))
828 (url-lazy-message "Reading %s..." (url-pretty-length nd)))
830 (defun url-http-content-length-after-change-function (st nd length)
835 (declare (special url-current-object
836 url-http-end-of-headers
837 url-http-content-length
838 url-http-content-type
839 url-http-process))
840 (if url-http-content-type
841 (url-display-percentage
843 (url-percentage (- nd url-http-end-of-headers)
844 url-http-content-length)
845 url-http-content-type
846 (url-pretty-length (- nd url-http-end-of-headers))
847 (url-pretty-length url-http-content-length)
848 (url-percentage (- nd url-http-end-of-headers)
849 url-http-content-length))
850 (url-display-percentage
852 (url-percentage (- nd url-http-end-of-headers)
853 url-http-content-length)
854 (url-pretty-length (- nd url-http-end-of-headers))
855 (url-pretty-length url-http-content-length)
856 (url-percentage (- nd url-http-end-of-headers)
857 url-http-content-length)))
859 (if (> (- nd url-http-end-of-headers) url-http-content-length)
862 (url-display-percentage nil nil)
863 (url-lazy-message "Reading... done.")
864 (if (url-http-parse-headers)
865 (url-http-activate-callback)))))
867 (defun url-http-chunked-encoding-after-change-function (st nd length)
872 (declare (special url-current-object
873 url-http-end-of-headers
874 url-http-content-type
875 url-http-chunked-length
876 url-http-chunked-counter
877 url-http-process url-http-chunked-start))
887 (setq no-initial-crlf (= 0 url-http-chunked-counter))
888 (if url-http-content-type
889 (url-display-percentage nil
891 url-http-content-type url-http-chunked-counter)
892 (url-display-percentage nil
894 url-http-chunked-counter))
895 (url-http-debug "Reading chunk %d (%d %d %d)"
896 url-http-chunked-counter st nd length)
901 (if url-http-chunked-start
904 (if (> nd (+ url-http-chunked-start url-http-chunked-length))
906 (url-http-debug "Got to the end of chunk #%d!"
907 url-http-chunked-counter)
908 (goto-char (+ url-http-chunked-start
909 url-http-chunked-length)))
910 (url-http-debug "Still need %d bytes to hit end of chunk"
911 (- (+ url-http-chunked-start
912 url-http-chunked-length)
916 (url-http-debug "Still spinning for next chunk...")
922 (url-http-debug "Did not see start of chunk @ %d!" (point))
930 (setq url-http-chunked-length (string-to-number (buffer-substring
934 url-http-chunked-counter (1+ url-http-chunked-counter)
935 url-http-chunked-start (set-marker
936 (or url-http-chunked-start
939 ; (if (not url-http-debug)
941 (url-http-debug "Saw start of chunk %d (length=%d, start=%d"
942 url-http-chunked-counter url-http-chunked-length
943 (marker-position url-http-chunked-start))
944 (if (= 0 url-http-chunked-length)
947 (url-http-debug "Saw end of stream chunk!")
949 (url-display-percentage nil nil)
952 (url-http-debug "Saw end of trailers..."))
953 (if (url-http-parse-headers)
954 (url-http-activate-callback))))))))))
956 (defun url-http-wait-for-headers-change-function (st nd length)
959 (declare (special url-current-object
960 url-http-end-of-headers
961 url-http-content-type
962 url-http-content-length
963 url-http-transfer-encoding
964 url-callback-function
965 url-callback-arguments
966 url-http-process
967 url-http-method
968 url-http-after-change-function
969 url-http-response-status))
970 (url-http-debug "url-http-wait-for-headers-change-function (%s)"
982 url-http-end-of-headers 0
986 (url-http-debug "Saw end of headers... (%s)" (buffer-name))
987 (setq url-http-end-of-headers (set-marker (make-marker)
990 (url-http-clean-headers)))
999 (url-http-parse-response)
1001 ;;(narrow-to-region (point-min) url-http-end-of-headers)
1002 (setq url-http-transfer-encoding (mail-fetch-field
1004 url-http-content-type (mail-fetch-field "content-type"))
1006 (setq url-http-content-length
1009 (when url-http-transfer-encoding
1010 (setq url-http-transfer-encoding
1011 (downcase url-http-transfer-encoding)))
1014 ((or (= url-http-response-status 204)
1015 (= url-http-response-status 205))
1016 (url-http-debug "%d response must have headers only (%s)."
1017 url-http-response-status (buffer-name))
1018 (when (url-http-parse-headers)
1019 (url-http-activate-callback)))
1020 ((string= "HEAD" url-http-method)
1024 (url-http-debug "HEAD request must have headers only (%s)."
1026 (when (url-http-parse-headers)
1027 (url-http-activate-callback)))
1028 ((string= "CONNECT" url-http-method)
1031 (url-http-debug "CONNECT request must have headers only.")
1032 (when (url-http-parse-headers)
1033 (url-http-activate-callback)))
1034 ((equal url-http-response-status 304)
1036 ;; this here instead of in url-http-parse-headers because if
1042 (when (url-http-parse-headers)
1043 (url-http-activate-callback)))
1047 (url-http-debug
1049 (setq url-http-after-change-function
1050 'url-http-simple-after-change-function))
1051 ((equal url-http-transfer-encoding "chunked")
1052 (url-http-debug "Saw chunked encoding.")
1053 (setq url-http-after-change-function
1054 'url-http-chunked-encoding-after-change-function)
1055 (when (> nd url-http-end-of-headers)
1056 (url-http-debug
1058 (url-http-chunked-encoding-after-change-function
1059 (marker-position url-http-end-of-headers) nd
1060 (- nd url-http-end-of-headers))))
1061 ((integerp url-http-content-length)
1062 (url-http-debug
1064 (setq url-http-after-change-function
1065 'url-http-content-length-after-change-function)
1067 ((= 0 url-http-content-length)
1070 (url-http-debug
1072 (when (url-http-parse-headers)
1073 (url-http-activate-callback)))
1074 ((> nd url-http-end-of-headers)
1076 (url-http-debug "Calling initial content-length for extra data at end of headers")
1077 (url-http-content-length-after-change-function
1078 (marker-position url-http-end-of-headers)
1080 (- nd url-http-end-of-headers)))
1084 (url-http-debug "No content-length, being dumb.")
1085 (setq url-http-after-change-function
1086 'url-http-simple-after-change-function)))))
1089 (url-http-debug "Spinning waiting for headers..."))
1093 (defun url-http (url callback cbargs)
1095 URL must be a parsed URL. See `url-generic-parse-url' for details.
1098 (check-type url vector "Need a pre-parsed URL.")
1099 (declare (special url-current-object
1100 url-http-end-of-headers
1101 url-http-content-type
1102 url-http-content-length
1103 url-http-transfer-encoding
1104 url-http-after-change-function
1105 url-callback-function
1106 url-callback-arguments
1107 url-http-method
1108 url-http-extra-headers
1109 url-http-data
1110 url-http-chunked-length
1111 url-http-chunked-start
1112 url-http-chunked-counter
1113 url-http-process))
1114 (let* ((host (url-host (or url-using-proxy url)))
1115 (port (url-port (or url-using-proxy url)))
1116 (connection (url-http-find-free-connection host port))
1126 (setq url-current-object url
1129 (dolist (var '(url-http-end-of-headers
1130 url-http-content-type
1131 url-http-content-length
1132 url-http-transfer-encoding
1133 url-http-after-change-function
1134 url-http-response-version
1135 url-http-response-status
1136 url-http-chunked-length
1137 url-http-chunked-counter
1138 url-http-chunked-start
1139 url-callback-function
1140 url-callback-arguments
1141 url-http-process
1142 url-http-method
1143 url-http-extra-headers
1144 url-http-data
1145 url-http-target-url
1146 url-http-connection-opened
1147 url-http-proxy))
1150 (setq url-http-method (or url-request-method "GET")
1151 url-http-extra-headers url-request-extra-headers
1152 url-http-data url-request-data
1153 url-http-process connection
1154 url-http-chunked-length nil
1155 url-http-chunked-start nil
1156 url-http-chunked-counter 0
1157 url-callback-function callback
1158 url-callback-arguments cbargs
1159 url-http-after-change-function 'url-http-wait-for-headers-change-function
1160 url-http-target-url url-current-object
1161 url-http-connection-opened nil
1162 url-http-proxy url-using-proxy)
1165 (set-process-filter connection 'url-http-generic-filter)
1170 (set-process-sentinel connection 'url-http-async-sentinel))
1175 (set-process-sentinel connection 'url-http-end-of-document-sentinel)
1176 (process-send-string connection (url-http-create-request)))))))
1179 (defun url-http-async-sentinel (proc why)
1180 (declare (special url-callback-arguments))
1185 (url-http-connection-opened
1186 (url-http-end-of-document-sentinel proc why))
1188 (setq url-http-connection-opened t)
1189 (process-send-string proc (url-http-create-request)))
1191 (setf (car url-callback-arguments)
1193 :host (url-host (or url-http-proxy url-current-object))
1194 :service (url-port (or url-http-proxy url-current-object))))
1195 (car url-callback-arguments)))
1196 (url-http-activate-callback)))))
1204 (defun url-http-generic-filter (proc data)
1208 (declare (special url-http-after-change-function))
1212 (url-http-debug "Calling after change function `%s' for `%S'" url-http-after-change-function proc)
1213 (funcall url-http-after-change-function
1224 (defalias 'url-http-symbol-value-in-buffer
1234 (defun url-http-head (url)
1235 (let ((url-request-method "HEAD")
1236 (url-request-data nil))
1237 (url-retrieve-synchronously url)))
1240 (defun url-http-file-exists-p (url)
1243 (buffer (url-http-head url)))
1246 (setq status (url-http-symbol-value-in-buffer 'url-http-response-status
1254 (defalias 'url-http-file-readable-p 'url-http-file-exists-p)
1256 (defun url-http-head-file-attributes (url &optional id-format)
1257 (let ((buffer (url-http-head url)))
1265 (url-http-symbol-value-in-buffer 'url-http-content-length
1272 (defun url-http-file-attributes (url &optional id-format)
1273 (if (url-dav-supported-p url)
1274 (url-dav-file-attributes url id-format)
1275 (url-http-head-file-attributes url id-format)))
1278 (defun url-http-options (url)
1303 (let* ((url-request-method "OPTIONS")
1304 (url-request-data nil)
1305 (buffer (url-retrieve-synchronously url))
1308 (when (and buffer (= 2 (/ (url-http-symbol-value-in-buffer
1309 'url-http-response-status buffer 0) 100)))
1351 ;; HTTPS. This used to be in url-https.el, but that file collides
1352 ;; with url-http.el on systems with 8-character file names.
1356 (defconst url-https-default-port 443 "Default HTTPS port.")
1358 (defconst url-https-asynchronous-p t "HTTPS retrievals are asynchronous.")
1360 (defalias 'url-https-expand-file-name 'url-http-expand-file-name)
1362 (defmacro url-https-create-secure-wrapper (method args)
1363 `(defun ,(intern (format (if method "url-https-%s" "url-https") method)) ,args
1364 ,(format "HTTPS wrapper around `%s' call." (or method "url-http"))
1365 (let ((url-gateway-method 'tls))
1366 (,(intern (format (if method "url-http-%s" "url-http") method))
1369 ;;;###autoload (autoload 'url-https "url-http")
1370 (url-https-create-secure-wrapper nil (url callback cbargs))
1371 ;;;###autoload (autoload 'url-https-file-exists-p "url-http")
1372 (url-https-create-secure-wrapper file-exists-p (url))
1373 ;;;###autoload (autoload 'url-https-file-readable-p "url-http")
1374 (url-https-create-secure-wrapper file-readable-p (url))
1375 ;;;###autoload (autoload 'url-https-file-attributes "url-http")
1376 (url-https-create-secure-wrapper file-attributes (url &optional id-format))
1378 (provide 'url-http)
1381 ;;; url-http.el ends here