lisp/url/url-util.el

   1 ;;; url-util.el --- Miscellaneous helper routines for URL library
   2
   3 ;; Copyright (C) 1996-1999, 2001, 2004-2012  Free Software Foundation, Inc.
   4
   5 ;; Author: Bill Perry <wmperry@gnu.org>
   6 ;; Keywords: comm, data, processes
   7
   8 ;; This file is part of GNU Emacs.
   9 ;;
  10 ;; GNU Emacs 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 ;; GNU Emacs 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 GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24
  25 ;;; Code:
  26
  27 (require 'url-parse)
  28 (require 'url-vars)
  29 (autoload 'timezone-parse-date "timezone")
  30 (autoload 'timezone-make-date-arpa-standard "timezone")
  31 (autoload 'mail-header-extract "mailheader")
  32
  33 (defvar url-parse-args-syntax-table
  34   (copy-syntax-table emacs-lisp-mode-syntax-table)
  35   "A syntax table for parsing sgml attributes.")
  36
  37 (modify-syntax-entry ?' "\"" url-parse-args-syntax-table)
  38 (modify-syntax-entry ?` "\"" url-parse-args-syntax-table)
  39 (modify-syntax-entry ?{ "(" url-parse-args-syntax-table)
  40 (modify-syntax-entry ?} ")" url-parse-args-syntax-table)
  41
  42 ;;;###autoload
  43 (defcustom url-debug nil
  44   "What types of debug messages from the URL library to show.
  45 Debug messages are logged to the *URL-DEBUG* buffer.
  46
  47 If t, all messages will be logged.
  48 If a number, all messages will be logged, as well shown via `message'.
  49 If a list, it is a list of the types of messages to be logged."
  50   :type '(choice (const :tag "none" nil)
  51                  (const :tag "all" t)
  52                  (checklist :tag "custom"
  53                             (const :tag "HTTP" :value http)
  54                             (const :tag "DAV" :value dav)
  55                             (const :tag "General" :value retrieval)
  56                             (const :tag "Filename handlers" :value handlers)
  57                             (symbol :tag "Other")))
  58   :group 'url-hairy)
  59
  60 ;;;###autoload
  61 (defun url-debug (tag &rest args)
  62   (if quit-flag
  63       (error "Interrupted!"))
  64   (if (or (eq url-debug t)
  65           (numberp url-debug)
  66           (and (listp url-debug) (memq tag url-debug)))
  67       (with-current-buffer (get-buffer-create "*URL-DEBUG*")
  68         (goto-char (point-max))
  69         (insert (symbol-name tag) " -> " (apply 'format args) "\n")
  70         (if (numberp url-debug)
  71             (apply 'message args)))))
  72
  73 ;;;###autoload
  74 (defun url-parse-args (str &optional nodowncase)
  75   ;; Return an assoc list of attribute/value pairs from an RFC822-type string
  76   (let (
  77         name                            ; From name=
  78         value                           ; its value
  79         results                         ; Assoc list of results
  80         name-pos                        ; Start of XXXX= position
  81         val-pos                         ; Start of value position
  82         st
  83         nd
  84         )
  85     (save-excursion
  86       (save-restriction
  87         (set-buffer (get-buffer-create " *urlparse-temp*"))
  88         (set-syntax-table url-parse-args-syntax-table)
  89         (erase-buffer)
  90         (insert str)
  91         (setq st (point-min)
  92               nd (point-max))
  93         (set-syntax-table url-parse-args-syntax-table)
  94         (narrow-to-region st nd)
  95         (goto-char (point-min))
  96         (while (not (eobp))
  97           (skip-chars-forward "; \n\t")
  98           (setq name-pos (point))
  99           (skip-chars-forward "^ \n\t=;")
 100           (if (not nodowncase)
 101               (downcase-region name-pos (point)))
 102           (setq name (buffer-substring name-pos (point)))
 103           (skip-chars-forward " \t\n")
 104           (if (/= (or (char-after (point)) 0)  ?=) ; There is no value
 105               (setq value nil)
 106             (skip-chars-forward " \t\n=")
 107             (setq val-pos (point)
 108                   value
 109                   (cond
 110                    ((or (= (or (char-after val-pos) 0) ?\")
 111                         (= (or (char-after val-pos) 0) ?'))
 112                     (buffer-substring (1+ val-pos)
 113                                       (condition-case ()
 114                                           (prog2
 115                                               (forward-sexp 1)
 116                                               (1- (point))
 117                                             (skip-chars-forward "\""))
 118                                         (error
 119                                          (skip-chars-forward "^ \t\n")
 120                                          (point)))))
 121                    (t
 122                     (buffer-substring val-pos
 123                                       (progn
 124                                         (skip-chars-forward "^;")
 125                                         (skip-chars-backward " \t")
 126                                         (point)))))))
 127           (setq results (cons (cons name value) results))
 128           (skip-chars-forward "; \n\t"))
 129         results))))
 130
 131 ;;;###autoload
 132 (defun url-insert-entities-in-string (string)
 133   "Convert HTML markup-start characters to entity references in STRING.
 134 Also replaces the \" character, so that the result may be safely used as
 135   an attribute value in a tag.  Returns a new string with the result of the
 136   conversion.  Replaces these characters as follows:
 137     &  ==>  &amp;
 138     <  ==>  &lt;
 139     >  ==>  &gt;
 140     \"  ==>  &quot;"
 141   (if (string-match "[&<>\"]" string)
 142       (with-current-buffer (get-buffer-create " *entity*")
 143         (erase-buffer)
 144         (buffer-disable-undo (current-buffer))
 145         (insert string)
 146         (goto-char (point-min))
 147         (while (progn
 148                  (skip-chars-forward "^&<>\"")
 149                  (not (eobp)))
 150           (insert (cdr (assq (char-after (point))
 151                              '((?\" . "&quot;")
 152                                (?& . "&amp;")
 153                                (?< . "&lt;")
 154                                (?> . "&gt;")))))
 155           (delete-char 1))
 156         (buffer-string))
 157     string))
 158
 159 ;;;###autoload
 160 (defun url-normalize-url (url)
 161   "Return a 'normalized' version of URL.
 162 Strips out default port numbers, etc."
 163   (let (type data retval)
 164     (setq data (url-generic-parse-url url)
 165           type (url-type data))
 166     (if (member type '("www" "about" "mailto" "info"))
 167         (setq retval url)
 168       ;; FIXME all this does, and all this function seems to do in
 169       ;; most cases, is remove any trailing "#anchor" part of a url.
 170       (setf (url-target data) nil)
 171       (setq retval (url-recreate-url data)))
 172     retval))
 173
 174 ;;;###autoload
 175 (defun url-lazy-message (&rest args)
 176   "Just like `message', but is a no-op if called more than once a second.
 177 Will not do anything if `url-show-status' is nil."
 178   (if (or (and url-current-object
 179                (url-silent url-current-object))
 180           (null url-show-status)
 181           (active-minibuffer-window)
 182           (= url-lazy-message-time
 183              (setq url-lazy-message-time (nth 1 (current-time)))))
 184       nil
 185     (apply 'message args)))
 186
 187 ;;;###autoload
 188 (defun url-get-normalized-date (&optional specified-time)
 189  "Return a 'real' date string that most HTTP servers can understand."
 190  (let ((system-time-locale "C"))
 191   (format-time-string "%a, %d %b %Y %T GMT"
 192    (or specified-time (current-time)) t)))
 193
 194 ;;;###autoload
 195 (defun url-eat-trailing-space (x)
 196   "Remove spaces/tabs at the end of a string."
 197   (let ((y (1- (length x)))
 198         (skip-chars (list ?  ?\t ?\n)))
 199     (while (and (>= y 0) (memq (aref x y) skip-chars))
 200       (setq y (1- y)))
 201     (substring x 0 (1+ y))))
 202
 203 ;;;###autoload
 204 (defun url-strip-leading-spaces (x)
 205   "Remove spaces at the front of a string."
 206   (let ((y (1- (length x)))
 207         (z 0)
 208         (skip-chars (list ?  ?\t ?\n)))
 209     (while (and (<= z y) (memq (aref x z) skip-chars))
 210       (setq z (1+ z)))
 211     (substring x z nil)))
 212
 213 ;;;###autoload
 214 (defun url-pretty-length (n)
 215   (cond
 216    ((< n 1024)
 217     (format "%d bytes" n))
 218    ((< n (* 1024 1024))
 219     (format "%dk" (/ n 1024.0)))
 220    (t
 221     (format "%2.2fM" (/ n (* 1024 1024.0))))))
 222
 223 ;;;###autoload
 224 (defun url-display-percentage (fmt perc &rest args)
 225   (when (and url-show-status
 226              (or (null url-current-object)
 227                  (not (url-silent url-current-object))))
 228     (if (null fmt)
 229         (if (fboundp 'clear-progress-display)
 230             (clear-progress-display))
 231       (if (and (fboundp 'progress-display) perc)
 232           (apply 'progress-display fmt perc args)
 233         (apply 'message fmt args)))))
 234
 235 ;;;###autoload
 236 (defun url-percentage (x y)
 237   (if (fboundp 'float)
 238       (round (* 100 (/ x (float y))))
 239     (/ (* x 100) y)))
 240
 241 ;;;###autoload
 242 (defalias 'url-basepath 'url-file-directory)
 243
 244 ;;;###autoload
 245 (defun url-file-directory (file)
 246   "Return the directory part of FILE, for a URL."
 247   (cond
 248    ((null file) "")
 249    ((string-match "\\?" file)
 250     (url-file-directory (substring file 0 (match-beginning 0))))
 251    ((string-match "\\(.*\\(/\\|%2[fF]\\)\\)" file)
 252     (match-string 1 file))))
 253
 254 ;;;###autoload
 255 (defun url-file-nondirectory (file)
 256   "Return the nondirectory part of FILE, for a URL."
 257   (cond
 258    ((null file) "")
 259    ((string-match "\\?" file)
 260     (url-file-nondirectory (substring file 0 (match-beginning 0))))
 261    ((string-match ".*\\(?:/\\|%2[fF]\\)\\(.*\\)" file)
 262     (match-string 1 file))
 263    (t file)))
 264
 265 ;;;###autoload
 266 (defun url-parse-query-string (query &optional downcase allow-newlines)
 267   (let (retval pairs cur key val)
 268     (setq pairs (split-string query "[;&]"))
 269     (while pairs
 270       (setq cur (car pairs)
 271             pairs (cdr pairs))
 272       (unless (string-match "=" cur)
 273         (setq cur (concat cur "=")))
 274
 275       (when (string-match "=" cur)
 276         (setq key (url-unhex-string (substring cur 0 (match-beginning 0))
 277                                     allow-newlines))
 278         (setq val (url-unhex-string (substring cur (match-end 0) nil)
 279                                     allow-newlines))
 280         (if downcase
 281             (setq key (downcase key)))
 282         (setq cur (assoc key retval))
 283         (if cur
 284             (setcdr cur (cons val (cdr cur)))
 285           (setq retval (cons (list key val) retval)))))
 286     retval))
 287
 288 ;;;###autoload
 289 (defun url-build-query-string (query &optional semicolons keep-empty)
 290   "Build a query-string.
 291
 292 Given a QUERY in the form:
 293 '((key1 val1)
 294   (key2 val2)
 295   (key3 val1 val2)
 296   (key4)
 297   (key5 ""))
 298
 299 \(This is the same format as produced by `url-parse-query-string')
 300
 301 This will return a string
 302 \"key1=val1&key2=val2&key3=val1&key3=val2&key4&key5\". Keys may
 303 be strings or symbols; if they are symbols, the symbol name will
 304 be used.
 305
 306 When SEMICOLONS is given, the separator will be \";\".
 307
 308 When KEEP-EMPTY is given, empty values will show as \"key=\"
 309 instead of just \"key\" as in the example above."
 310   (mapconcat
 311    (lambda (key-vals)
 312      (let ((escaped
 313             (mapcar (lambda (sym)
 314                       (url-hexify-string (format "%s" sym))) key-vals)))
 315        (mapconcat (lambda (val)
 316                     (let ((vprint (format "%s" val))
 317                           (eprint (format "%s" (car escaped))))
 318                       (concat eprint
 319                               (if (or keep-empty
 320                                       (and val (not (zerop (length vprint)))))
 321                                   "="
 322                                 "")
 323                               vprint)))
 324                   (or (cdr escaped) '("")) (if semicolons ";" "&"))))
 325    query (if semicolons ";" "&")))
 326
 327 (defun url-unhex (x)
 328   (if (> x ?9)
 329       (if (>= x ?a)
 330           (+ 10 (- x ?a))
 331         (+ 10 (- x ?A)))
 332     (- x ?0)))
 333
 334 ;; Fixme: Is this definition better, and does it ever matter?
 335
 336 ;; (defun url-unhex-string (str &optional allow-newlines)
 337 ;;   "Remove %XX, embedded spaces, etc in a url.
 338 ;; If optional second argument ALLOW-NEWLINES is non-nil, then allow the
 339 ;; decoding of carriage returns and line feeds in the string, which is normally
 340 ;; forbidden in URL encoding."
 341 ;;   (setq str (or str ""))
 342 ;;   (setq str (replace-regexp-in-string "%[[:xdigit:]]\\{2\\}"
 343 ;;                                    (lambda (match)
 344 ;;                                      (string (string-to-number
 345 ;;                                               (substring match 1) 16)))
 346 ;;                                    str t t))
 347 ;;   (if allow-newlines
 348 ;;       (replace-regexp-in-string "[\n\r]" (lambda (match)
 349 ;;                                         (format "%%%.2X" (aref match 0)))
 350 ;;                              str t t)
 351 ;;     str))
 352
 353 ;;;###autoload
 354 (defun url-unhex-string (str &optional allow-newlines)
 355   "Remove %XX embedded spaces, etc in a URL.
 356 If optional second argument ALLOW-NEWLINES is non-nil, then allow the
 357 decoding of carriage returns and line feeds in the string, which is normally
 358 forbidden in URL encoding."
 359   (setq str (or str ""))
 360   (let ((tmp "")
 361         (case-fold-search t))
 362     (while (string-match "%[0-9a-f][0-9a-f]" str)
 363       (let* ((start (match-beginning 0))
 364              (ch1 (url-unhex (elt str (+ start 1))))
 365              (code (+ (* 16 ch1)
 366                       (url-unhex (elt str (+ start 2))))))
 367         (setq tmp (concat
 368                    tmp (substring str 0 start)
 369                    (cond
 370                     (allow-newlines
 371                      (byte-to-string code))
 372                     ((or (= code ?\n) (= code ?\r))
 373                      " ")
 374                     (t (byte-to-string code))))
 375               str (substring str (match-end 0)))))
 376     (concat tmp str)))
 377
 378 (defconst url-unreserved-chars
 379   '(?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z
 380     ?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z
 381     ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9
 382     ?- ?_ ?. ?~)
 383   "List of characters that are unreserved in the URL spec.
 384 This is taken from RFC 3986 (section 2.3).")
 385
 386 (defconst url-encoding-table
 387   (let ((vec (make-vector 256 nil)))
 388     (dotimes (byte 256)
 389       ;; RFC 3986 (Section 2.1): For consistency, URI producers and
 390       ;; normalizers should use uppercase hexadecimal digits for all
 391       ;; percent-encodings.
 392       (aset vec byte (format "%%%02X" byte)))
 393     vec)
 394   "Vector translating bytes to URI-encoded %-sequences.")
 395
 396 (defun url--allowed-chars (char-list)
 397   "Return an \"allowed character\" mask (a 256-slot vector).
 398 The Nth element is non-nil if character N is in CHAR-LIST.  The
 399 result can be passed as the second arg to `url-hexify-string'."
 400   (let ((vec (make-vector 256 nil)))
 401     (dolist (byte char-list)
 402       (ignore-errors (aset vec byte t)))
 403     vec))
 404
 405 ;;;###autoload
 406 (defun url-hexify-string (string &optional allowed-chars)
 407   "URI-encode STRING and return the result.
 408 If STRING is multibyte, it is first converted to a utf-8 byte
 409 string.  Each byte corresponding to an allowed character is left
 410 as-is, while all other bytes are converted to a three-character
 411 string: \"%\" followed by two upper-case hex digits.
 412
 413 The allowed characters are specified by ALLOWED-CHARS.  If this
 414 argument is nil, the list `url-unreserved-chars' determines the
 415 allowed characters.  Otherwise, ALLOWED-CHARS should be a vector
 416 whose Nth element is non-nil if character N is allowed."
 417   (unless allowed-chars
 418     (setq allowed-chars (url--allowed-chars url-unreserved-chars)))
 419   (mapconcat (lambda (byte)
 420                (if (aref allowed-chars byte)
 421                    (char-to-string byte)
 422                  (aref url-encoding-table byte)))
 423              (if (multibyte-string-p string)
 424                  (encode-coding-string string 'utf-8)
 425                string)
 426              ""))
 427
 428 (defconst url-host-allowed-chars
 429   ;; Allow % to avoid re-encoding %-encoded sequences.
 430   (url--allowed-chars (append '(?% ?! ?$ ?& ?' ?\( ?\) ?* ?+ ?, ?\; ?=)
 431                               url-unreserved-chars))
 432   "Allowed-character byte mask for the host segment of a URI.
 433 These characters are specified in RFC 3986, Appendix A.")
 434
 435 (defconst url-path-allowed-chars
 436   (let ((vec (copy-sequence url-host-allowed-chars)))
 437     (aset vec ?/ t)
 438     (aset vec ?: t)
 439     (aset vec ?@ t)
 440     vec)
 441   "Allowed-character byte mask for the path segment of a URI.
 442 These characters are specified in RFC 3986, Appendix A.")
 443
 444 (defconst url-query-allowed-chars
 445   (let ((vec (copy-sequence url-path-allowed-chars)))
 446     (aset vec ?? t)
 447     vec)
 448   "Allowed-character byte mask for the query segment of a URI.
 449 These characters are specified in RFC 3986, Appendix A.")
 450
 451 ;;;###autoload
 452 (defun url-encode-url (url)
 453   "Return a properly URI-encoded version of URL.
 454 This function also performs URI normalization, e.g. converting
 455 the scheme to lowercase if it is uppercase.  Apart from
 456 normalization, if URL is already URI-encoded, this function
 457 should return it unchanged."
 458   (if (multibyte-string-p url)
 459       (setq url (encode-coding-string url 'utf-8)))
 460   (let* ((obj  (url-generic-parse-url url))
 461          (user (url-user obj))
 462          (pass (url-password obj))
 463          (host (url-host obj))
 464          (path-and-query (url-path-and-query obj))
 465          (path  (car path-and-query))
 466          (query (cdr path-and-query))
 467          (frag (url-target obj)))
 468     (if user
 469         (setf (url-user obj) (url-hexify-string user)))
 470     (if pass
 471         (setf (url-password obj) (url-hexify-string pass)))
 472     ;; No special encoding for IPv6 literals.
 473     (and host
 474          (not (string-match "\\`\\[.*\\]\\'" host))
 475          (setf (url-host obj)
 476                (url-hexify-string host url-host-allowed-chars)))
 477
 478     (if path
 479         (setq path (url-hexify-string path url-path-allowed-chars)))
 480     (if query
 481         (setq query (url-hexify-string query url-query-allowed-chars)))
 482     (setf (url-filename obj) (if query (concat path "?" query) path))
 483
 484     (if frag
 485         (setf (url-target obj)
 486               (url-hexify-string frag url-query-allowed-chars)))
 487     (url-recreate-url obj)))
 488
 489 ;;;###autoload
 490 (defun url-file-extension (fname &optional x)
 491   "Return the filename extension of FNAME.
 492 If optional argument X is t, then return the basename
 493 of the file with the extension stripped off."
 494   (if (and fname
 495            (setq fname (url-file-nondirectory fname))
 496            (string-match "\\.[^./]+$" fname))
 497       (if x (substring fname 0 (match-beginning 0))
 498         (substring fname (match-beginning 0) nil))
 499     ;;
 500     ;; If fname has no extension, and x then return fname itself instead of
 501     ;; nothing. When caching it allows the correct .hdr file to be produced
 502     ;; for filenames without extension.
 503     ;;
 504     (if x
 505         fname
 506       "")))
 507
 508 ;;;###autoload
 509 (defun url-truncate-url-for-viewing (url &optional width)
 510   "Return a shortened version of URL that is WIDTH characters wide or less.
 511 WIDTH defaults to the current frame width."
 512   (let* ((fr-width (or width (frame-width)))
 513          (str-width (length url))
 514          (fname nil)
 515          (modified 0)
 516          (urlobj nil))
 517     ;; The first thing that can go are the search strings
 518     (if (and (>= str-width fr-width)
 519              (string-match "?" url))
 520         (setq url (concat (substring url 0 (match-beginning 0)) "?...")
 521               str-width (length url)))
 522     (if (< str-width fr-width)
 523         nil                             ; Hey, we are done!
 524       (setq urlobj (url-generic-parse-url url)
 525             fname (url-filename urlobj)
 526             fr-width (- fr-width 4))
 527       (while (and (>= str-width fr-width)
 528                   (string-match "/" fname))
 529         (setq fname (substring fname (match-end 0) nil)
 530               modified (1+ modified))
 531         (setf (url-filename urlobj) fname)
 532         (setq url (url-recreate-url urlobj)
 533               str-width (length url)))
 534       (if (> modified 1)
 535           (setq fname (concat "/.../" fname))
 536         (setq fname (concat "/" fname)))
 537       (setf (url-filename urlobj) fname)
 538       (setq url (url-recreate-url urlobj)))
 539     url))
 540
 541 ;;;###autoload
 542 (defun url-view-url (&optional no-show)
 543   "View the current document's URL.
 544 Optional argument NO-SHOW means just return the URL, don't show it in
 545 the minibuffer.
 546
 547 This uses `url-current-object', set locally to the buffer."
 548   (interactive)
 549   (if (not url-current-object)
 550       nil
 551     (if no-show
 552         (url-recreate-url url-current-object)
 553       (message "%s" (url-recreate-url url-current-object)))))
 554
 555 (defvar url-get-url-filename-chars "-%.?@a-zA-Z0-9()_/:~=&"
 556   "Valid characters in a URL.")
 557
 558 (defun url-get-url-at-point (&optional pt)
 559   "Get the URL closest to point, but don't change position.
 560 Has a preference for looking backward when not directly on a symbol."
 561   ;; Not at all perfect - point must be right in the name.
 562   (save-excursion
 563     (if pt (goto-char pt))
 564     (let (start url)
 565       (save-excursion
 566         ;; first see if you're just past a filename
 567         (if (not (eobp))
 568             (if (looking-at "[] \t\n[{}()]") ; whitespace or some parens
 569                 (progn
 570                   (skip-chars-backward " \n\t\r({[]})")
 571                   (if (not (bobp))
 572                       (backward-char 1)))))
 573         (if (and (char-after (point))
 574                  (string-match (concat "[" url-get-url-filename-chars "]")
 575                                (char-to-string (char-after (point)))))
 576             (progn
 577               (skip-chars-backward url-get-url-filename-chars)
 578               (setq start (point))
 579               (skip-chars-forward url-get-url-filename-chars))
 580           (setq start (point)))
 581         (setq url (buffer-substring-no-properties start (point))))
 582       (if (and url (string-match "^(.*)\\.?$" url))
 583           (setq url (match-string 1 url)))
 584       (if (and url (string-match "^URL:" url))
 585           (setq url (substring url 4 nil)))
 586       (if (and url (string-match "\\.$" url))
 587           (setq url (substring url 0 -1)))
 588       (if (and url (string-match "^www\\." url))
 589           (setq url (concat "http://" url)))
 590       (if (and url (not (string-match url-nonrelative-link url)))
 591           (setq url nil))
 592       url)))
 593
 594 (defun url-generate-unique-filename (&optional fmt)
 595   "Generate a unique filename in `url-temporary-directory'."
 596   (declare (obsolete make-temp-file "23.1"))
 597   ;; This variable is obsolete, but so is this function.
 598   (let ((tempdir (with-no-warnings url-temporary-directory)))
 599     (if (not fmt)
 600         (let ((base (format "url-tmp.%d" (user-real-uid)))
 601               (fname "")
 602               (x 0))
 603           (setq fname (format "%s%d" base x))
 604           (while (file-exists-p
 605                   (expand-file-name fname tempdir))
 606             (setq x (1+ x)
 607                   fname (concat base (int-to-string x))))
 608           (expand-file-name fname tempdir))
 609       (let ((base (concat "url" (int-to-string (user-real-uid))))
 610             (fname "")
 611             (x 0))
 612         (setq fname (format fmt (concat base (int-to-string x))))
 613         (while (file-exists-p
 614                 (expand-file-name fname tempdir))
 615           (setq x (1+ x)
 616                 fname (format fmt (concat base (int-to-string x)))))
 617         (expand-file-name fname tempdir)))))
 618
 619 (defun url-extract-mime-headers ()
 620   "Set `url-current-mime-headers' in current buffer."
 621   (save-excursion
 622     (goto-char (point-min))
 623     (unless url-current-mime-headers
 624       (set (make-local-variable 'url-current-mime-headers)
 625            (mail-header-extract)))))
 626
 627 (defun url-make-private-file (file)
 628   "Make FILE only readable and writable by the current user.
 629 Creates FILE and its parent directories if they do not exist."
 630   (let ((dir (file-name-directory file)))
 631     (when dir
 632       ;; For historical reasons.
 633       (make-directory dir t)))
 634   ;; Based on doc-view-make-safe-dir.
 635   (condition-case nil
 636       (let ((umask (default-file-modes)))
 637         (unwind-protect
 638             (progn
 639               (set-default-file-modes #o0600)
 640               (with-temp-buffer
 641                 (write-region (point-min) (point-max)
 642                               file nil 'silent nil 'excl)))
 643           (set-default-file-modes umask)))
 644     (file-already-exists
 645      (if (file-symlink-p file)
 646          (error "Danger: `%s' is a symbolic link" file))
 647      (set-file-modes file #o0600))))
 648
 649 (provide 'url-util)
 650
 651 ;;; url-util.el ends here