Replace version 24.2 with 24.3 where appropriate (hopefully)
[bpt/emacs.git] / lisp / url / url-parse.el
CommitLineData
8c8b8430 1;;; url-parse.el --- Uniform Resource Locator parser
ffc00a35 2
acaf905b 3;; Copyright (C) 1996-1999, 2004-2012 Free Software Foundation, Inc.
ffc00a35 4
8c8b8430
SM
5;; Keywords: comm, data, processes
6
ffc00a35
SM
7;; This file is part of GNU Emacs.
8;;
4936186e 9;; GNU Emacs is free software: you can redistribute it and/or modify
ffc00a35 10;; it under the terms of the GNU General Public License as published by
4936186e
GM
11;; the Free Software Foundation, either version 3 of the License, or
12;; (at your option) any later version.
13
ffc00a35
SM
14;; GNU Emacs is distributed in the hope that it will be useful,
15;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17;; GNU General Public License for more details.
4936186e 18
ffc00a35 19;; You should have received a copy of the GNU General Public License
4936186e 20;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
ffc00a35
SM
21
22;;; Commentary:
23
24;;; Code:
25
8c8b8430 26(require 'url-vars)
04c23739 27(require 'auth-source)
a464a6c7 28(eval-when-compile (require 'cl-lib))
8c8b8430
SM
29
30(autoload 'url-scheme-get-property "url-methods")
31
a464a6c7 32(cl-defstruct (url
d18ec89f
SM
33 (:constructor nil)
34 (:constructor url-parse-make-urlobj
35 (&optional type user password host portspec filename
36 target attributes fullness))
37 (:copier nil))
aacaa419
LI
38 type user password host portspec filename target attributes fullness
39 silent (use-cookies t))
8c8b8430 40
d18ec89f 41(defsubst url-port (urlobj)
9f9aa044 42 "Return the port number for the URL specified by URLOBJ."
a464a6c7 43 (declare (gv-setter (lambda (port) `(setf (url-portspec ,urlobj) ,port))))
d18ec89f 44 (or (url-portspec urlobj)
9f9aa044 45 (if (url-type urlobj)
d18ec89f 46 (url-scheme-get-property (url-type urlobj) 'default-port))))
8c8b8430 47
71ddfde5 48
9f9aa044
CY
49(defun url-path-and-query (urlobj)
50 "Return the path and query components of URLOBJ.
51These two components are store together in the FILENAME slot of
52the object. The return value of this function is (PATH . QUERY),
53where each of PATH and QUERY are strings or nil."
54 (let ((name (url-filename urlobj))
55 path query)
56 (when name
57 (if (string-match "\\?" name)
58 (setq path (substring name 0 (match-beginning 0))
59 query (substring name (match-end 0)))
60 (setq path name)))
61 (if (equal path "") (setq path nil))
62 (if (equal query "") (setq query nil))
63 (cons path query)))
64
65(defun url-port-if-non-default (urlobj)
66 "Return the port number specified by URLOBJ, if it is not the default.
67If the specified port number is the default, return nil."
68 (let ((port (url-portspec urlobj))
69 type)
70 (and port
71 (or (null (setq type (url-type urlobj)))
72 (not (equal port (url-scheme-get-property type 'default-port))))
73 port)))
74
8c8b8430
SM
75;;;###autoload
76(defun url-recreate-url (urlobj)
61bbdf64 77 "Recreate a URL string from the parsed URLOBJ."
9f9aa044
CY
78 (let* ((type (url-type urlobj))
79 (user (url-user urlobj))
80 (pass (url-password urlobj))
81 (host (url-host urlobj))
82 ;; RFC 3986: "omit the port component and its : delimiter if
83 ;; port is empty or if its value would be the same as that of
84 ;; the scheme's default."
85 (port (url-port-if-non-default urlobj))
86 (file (url-filename urlobj))
87 (frag (url-target urlobj)))
ce7b18ec
CY
88 (concat (if type (concat type ":"))
89 (if (url-fullness urlobj) "//")
90 (if (or user pass)
91 (concat user
92 (if pass (concat ":" pass))
93 "@"))
94 host
9f9aa044 95 (if port (format ":%d" (url-port urlobj)))
ce7b18ec
CY
96 (or file "/")
97 (if frag (concat "#" frag)))))
fb7dc310
SM
98
99(defun url-recreate-url-attributes (urlobj)
100 "Recreate the attributes of an URL string from the parsed URLOBJ."
101 (when (url-attributes urlobj)
0539db75 102 (concat ";"
fb7dc310
SM
103 (mapconcat (lambda (x)
104 (if (cdr x)
105 (concat (car x) "=" (cdr x))
106 (car x)))
107 (url-attributes urlobj) ";"))))
2a1e2476 108(make-obsolete 'url-recreate-url-attributes nil "24.3")
8c8b8430
SM
109
110;;;###autoload
111(defun url-generic-parse-url (url)
66991ff0
SM
112 "Return an URL-struct of the parts of URL.
113The CL-style struct contains the following fields:
ce7b18ec
CY
114
115TYPE is the URI scheme (string or nil).
116USER is the user name (string or nil).
117PASSWORD is the password (string [deprecated] or nil).
118HOST is the host (a registered name, IP literal in square
119 brackets, or IPv4 address in dotted-decimal form).
120PORTSPEC is the specified port (a number), or nil.
121FILENAME is the path AND the query component of the URI.
122TARGET is the fragment identifier component (used to refer to a
123 subordinate resource, e.g. a part of a webpage).
124ATTRIBUTES is nil; this slot originally stored the attribute and
125 value alists for IMAP URIs, but this feature was removed
126 since it conflicts with RFC 3986.
9f9aa044
CY
127FULLNESS is non-nil iff the hierarchical sequence component of
128 the URL starts with two slashes, \"//\".
ce7b18ec
CY
129
130The parser follows RFC 3986, except that it also tries to handle
131URIs that are not fully specified (e.g. lacking TYPE), and it
132does not check for or perform %-encoding.
133
134Here is an example. The URL
135
136 foo://bob:pass@example.com:42/a/b/c.dtb?type=animal&name=narwhal#nose
137
138parses to
139
140 TYPE = \"foo\"
141 USER = \"bob\"
142 PASSWORD = \"pass\"
143 HOST = \"example.com\"
144 PORTSPEC = 42
145 FILENAME = \"/a/b/c.dtb?type=animal&name=narwhal\"
146 TARGET = \"nose\"
147 ATTRIBUTES = nil
148 FULLNESS = t"
149 (if (null url)
150 (url-parse-make-urlobj)
d58fae84 151 (with-temp-buffer
c074ba4a
SM
152 ;; Don't let those temp-buffer modifications accidentally
153 ;; deactivate the mark of the current-buffer.
154 (let ((deactivate-mark nil))
155 (set-syntax-table url-parse-syntax-table)
ce7b18ec
CY
156 (erase-buffer)
157 (insert url)
158 (goto-char (point-min))
159 (let ((save-pos (point))
160 scheme user pass host port file fragment full
c074ba4a 161 (inhibit-read-only t))
c074ba4a
SM
162
163 ;; 3.1. Scheme
ce7b18ec
CY
164 ;; This is nil for a URI that is not fully specified.
165 (when (looking-at "\\([a-zA-Z][-a-zA-Z0-9+.]*\\):")
166 (goto-char (match-end 0))
167 (setq save-pos (point))
168 (setq scheme (downcase (match-string 1))))
c074ba4a
SM
169
170 ;; 3.2. Authority
171 (when (looking-at "//")
172 (setq full t)
173 (forward-char 2)
174 (setq save-pos (point))
ce7b18ec 175 (skip-chars-forward "^/?#")
c074ba4a 176 (setq host (buffer-substring save-pos (point)))
ce7b18ec 177 ;; 3.2.1 User Information
c074ba4a
SM
178 (if (string-match "^\\([^@]+\\)@" host)
179 (setq user (match-string 1 host)
ce7b18ec
CY
180 host (substring host (match-end 0))))
181 (if (and user (string-match "\\`\\([^:]*\\):\\(.*\\)" user))
c074ba4a
SM
182 (setq pass (match-string 2 user)
183 user (match-string 1 user)))
ce7b18ec
CY
184 (cond
185 ;; IPv6 literal address.
186 ((string-match "^\\(\\[[^]]+\\]\\)\\(?::\\([0-9]*\\)\\)?$" host)
187 (setq port (match-string 2 host)
188 host (match-string 1 host)))
189 ;; Registered name or IPv4 address.
190 ((string-match ":\\([0-9]*\\)$" host)
191 (setq port (match-string 1 host)
192 host (substring host 0 (match-beginning 0)))))
193 (cond ((equal port "")
194 (setq port nil))
195 (port
196 (setq port (string-to-number port))))
197 (setq host (downcase host)))
198
ce7b18ec
CY
199 ;; Now point is on the / ? or # which terminates the
200 ;; authority, or at the end of the URI, or (if there is no
201 ;; authority) at the beginning of the absolute path.
202
c074ba4a 203 (setq save-pos (point))
ce7b18ec
CY
204 (if (string= "data" scheme)
205 ;; For the "data" URI scheme, all the rest is the FILE.
206 (setq file (buffer-substring save-pos (point-max)))
207 ;; For hysterical raisins, our data structure returns the
208 ;; path and query components together in one slot.
209 ;; 3.3. Path
210 (skip-chars-forward "^?#")
211 ;; 3.4. Query
212 (when (looking-at "?")
213 (skip-chars-forward "^#"))
214 (setq file (buffer-substring save-pos (point)))
215 ;; 3.5 Fragment
216 (when (looking-at "#")
217 (let ((opoint (point)))
218 (forward-char 1)
219 (unless (eobp)
220 (setq fragment (buffer-substring (point) (point-max))))
221 (delete-region opoint (point-max)))))
c074ba4a 222
c074ba4a
SM
223 (if (and host (string-match "%[0-9][0-9]" host))
224 (setq host (url-unhex-string host)))
ce7b18ec
CY
225 (url-parse-make-urlobj scheme user pass host port file
226 fragment nil full))))))
8c8b8430 227
04c23739
MH
228(defmacro url-bit-for-url (method lookfor url)
229 `(let* ((urlobj (url-generic-parse-url url))
230 (bit (funcall ,method urlobj))
231 (methods (list 'url-recreate-url
563790b6
TZ
232 'url-host))
233 auth-info)
04c23739 234 (while (and (not bit) (> (length methods) 0))
563790b6
TZ
235 (setq auth-info (auth-source-search
236 :max 1
237 :host (funcall (pop methods) urlobj)
238 :port (url-type urlobj)))
239 (setq bit (plist-get (nth 0 auth-info) ,lookfor))
240 (when (functionp bit)
241 (setq bit (funcall bit))))
04c23739
MH
242 bit))
243
244(defun url-user-for-url (url)
245 "Attempt to use .authinfo to find a user for this URL."
563790b6 246 (url-bit-for-url 'url-user :user url))
04c23739
MH
247
248(defun url-password-for-url (url)
249 "Attempt to use .authinfo to find a password for this URL."
563790b6 250 (url-bit-for-url 'url-password :secret url))
04c23739 251
8c8b8430 252(provide 'url-parse)
e5566bd5 253
ffc00a35 254;;; url-parse.el ends here