lisp/url/url-vars.el

   1 ;;; url-vars.el --- Variables for Uniform Resource Locator tool
   2
   3 ;; Copyright (C) 1996-1999, 2001, 2004-2017 Free Software Foundation,
   4 ;; Inc.
   5
   6 ;; Keywords: comm, data, processes, hypermedia
   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 ;;; Code:
  24
  25 (defconst url-version "Emacs"
  26   "Version number of URL package.")
  27
  28 (defgroup url nil
  29   "Uniform Resource Locator tool."
  30   :version "22.1"
  31   :link '(custom-manual "(url) Top")
  32   :link '(info-link "(url) Customization")
  33   :group 'comm)
  34
  35 (defgroup url-file nil
  36   "URL storage."
  37   :prefix "url-"
  38   :group 'url)
  39
  40 (defgroup url-cache nil
  41   "URL cache."
  42   :prefix "url-"
  43   :prefix "url-cache-"
  44   :group 'url)
  45
  46 (defgroup url-mime nil
  47   "MIME options of URL."
  48   :prefix "url-"
  49   :group 'url)
  50
  51 (defgroup url-hairy nil
  52   "Hairy options of URL."
  53   :prefix "url-"
  54   :group 'url)
  55
  56
  57 (defvar url-current-object nil
  58   "A parsed representation of the current URL.")
  59
  60 (defvar url-current-mime-headers nil
  61   "A parsed representation of the MIME headers for the current URL.")
  62
  63 (mapc 'make-variable-buffer-local
  64       '(
  65         url-current-object
  66         url-current-mime-headers
  67         ))
  68
  69 (defcustom url-honor-refresh-requests t
  70   "Whether to do automatic page reloads.
  71 These are done at the request of the document author or the server via
  72 the `Refresh' header in an HTTP response.  If nil, no refresh
  73 requests will be honored.  If t, all refresh requests will be honored.
  74 If non-nil and not t, the user will be asked for each refresh request."
  75   :type '(choice (const :tag "off" nil)
  76                  (const :tag "on" t)
  77                  (other :tag "ask" ask))
  78   :group 'url-hairy)
  79
  80 (defcustom url-automatic-caching nil
  81   "If non-nil, all documents will be automatically cached to the local disk."
  82   :type 'boolean
  83   :group 'url-cache)
  84
  85 (define-obsolete-variable-alias 'url-bug-address
  86   'report-emacs-bug-address "24.5")
  87
  88 (defcustom url-personal-mail-address nil
  89   "Your full email address.
  90 This is what is sent to HTTP servers as the FROM field in an HTTP
  91 request."
  92   :type '(choice (const :tag "Unspecified" nil) string)
  93   :group 'url)
  94
  95 (defcustom url-directory-index-file "index.html"
  96   "The filename to look for when indexing a directory.
  97 If this file exists, and is readable, then it will be viewed instead of
  98 using `dired' to view the directory."
  99   :type 'string
 100   :group 'url-file)
 101
 102 (defcustom url-privacy-level '(email)
 103   "How private you want your requests to be.
 104 HTTP has header fields for various information about the user, including
 105 operating system information, email addresses, the last page you visited, etc.
 106 This variable controls how much of this information is sent.
 107
 108 This should a symbol or a list.
 109 Valid values if a symbol are:
 110 none     -- send all information
 111 low      -- don't send the last location
 112 high     -- don't send the email address or last location
 113 paranoid -- don't send anything
 114
 115 If a list, this should be a list of symbols of what NOT to send.
 116 Valid symbols are:
 117 email    -- the email address
 118 os       -- the operating system info
 119 emacs    -- the version of Emacs
 120 lastloc  -- the last location
 121 agent    -- do not send the User-Agent string
 122 cookies  -- never accept HTTP cookies
 123
 124 Samples:
 125
 126  (setq url-privacy-level \\='high)
 127  (setq url-privacy-level \\='(email lastloc))    ;; equivalent to \\='high
 128  (setq url-privacy-level \\='(os))
 129
 130 ::NOTE::
 131 This variable controls several other variables and is _NOT_ automatically
 132 updated.  Call the function `url-setup-privacy-info' after modifying this
 133 variable."
 134   :initialize 'custom-initialize-default
 135   :set (lambda (sym val) (set-default sym val) (url-setup-privacy-info))
 136   :type '(radio (const :tag "None (you believe in the basic goodness of humanity)"
 137                        :value none)
 138                 (const :tag "Low (do not reveal last location)"
 139                        :value low)
 140                 (const :tag "High (no email address or last location)"
 141                        :value high)
 142                 (const :tag "Paranoid (reveal nothing!)"
 143                        :value paranoid)
 144                 (checklist :tag "Custom"
 145                            (const :tag "Email address" :value email)
 146                            (const :tag "Operating system" :value os)
 147                            (const :tag "Emacs version" :value emacs)
 148                            (const :tag "Last location" :value lastloc)
 149                            (const :tag "Browser identification" :value agent)
 150                            (const :tag "No cookies" :value cookie)))
 151   :group 'url)
 152
 153 (defvar url-inhibit-uncompression nil "Do not do decompression if non-nil.")
 154
 155 (defcustom url-uncompressor-alist '((".z"  . "x-gzip")
 156                                     (".gz" . "x-gzip")
 157                                     (".uue" . "x-uuencoded")
 158                                     (".hqx" . "x-hqx")
 159                                     (".Z"  . "x-compress")
 160                                     (".bz2" . "x-bzip2")
 161                                     (".xz" . "x-xz"))
 162   "An alist of file extensions and appropriate content-transfer-encodings."
 163   :type '(repeat (cons :format "%v"
 164                        (string :tag "Extension")
 165                        (string :tag "Encoding")))
 166   :group 'url-mime)
 167
 168 (defcustom url-mail-command 'compose-mail
 169   "This function will be called whenever URL needs to send mail.
 170 It should enter a mail-mode-like buffer in the current window.
 171 The commands `mail-to' and `mail-subject' should still work in this
 172 buffer, and it should use `mail-header-separator' if possible."
 173   :type 'function
 174   :group 'url)
 175
 176 (defcustom url-proxy-services nil
 177   "An alist of schemes and proxy servers that gateway them.
 178 Looks like ((\"http\" . \"hostname:portnumber\") ...).  This is set up
 179 from the ACCESS_proxy environment variables."
 180   :type '(repeat (cons :format "%v"
 181                        (string :tag "Protocol")
 182                        (string :tag "Proxy")))
 183   :group 'url)
 184
 185 (defcustom url-standalone-mode nil
 186   "Rely solely on the cache?"
 187   :type 'boolean
 188   :group 'url-cache)
 189
 190 (defvar url-mime-separator-chars (mapcar 'identity
 191                                         (concat "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
 192                                                 "abcdefghijklmnopqrstuvwxyz"
 193                                                 "0123456789'()+_,-./=?"))
 194   "Characters allowable in a MIME multipart separator.")
 195
 196 (defcustom url-bad-port-list
 197   '("25" "119" "19")
 198   "List of ports to warn the user about connecting to.
 199 Defaults to just the mail, chargen, and NNTP ports so you cannot be
 200 tricked into sending fake mail or forging messages by a malicious HTML
 201 document."
 202   :type '(repeat (string :tag "Port"))
 203   :group 'url-hairy)
 204
 205 (defvar url-mime-content-type-charset-regexp
 206   ";[ \t]*charset=\"?\\([^\"]+\\)\"?"
 207   "Regexp used in parsing `Content-Type' for a charset indication.")
 208
 209 (defvar url-request-data nil "Any data to send with the next request.")
 210
 211 (defvar url-request-extra-headers nil
 212   "A list of extra headers to send with the next request.
 213 Should be an assoc list of headers/contents.")
 214
 215 (defvar url-request-noninteractive nil
 216   "If non-nil, the request is done in a noninteractive context.")
 217
 218 (defvar url-request-method nil "The method to use for the next request.")
 219
 220 (defvar url-mime-encoding-string (and (fboundp 'zlib-available-p)
 221                                       (zlib-available-p)
 222                                       "gzip")
 223   "String to send in the Accept-encoding: field in HTTP requests.")
 224
 225 (defvar mm-mime-mule-charset-alist)
 226 (declare-function mm-coding-system-p "mm-util" (cs))
 227
 228 ;; Perhaps the first few should actually be given decreasing `q's and
 229 ;; the list should be trimmed significantly.
 230 ;; Fixme: do something sane if we don't have `sort-coding-systems'
 231 ;; (Emacs 20, XEmacs).
 232 (defun url-mime-charset-string ()
 233   "Generate a list of preferred MIME charsets for HTTP requests.
 234 Generated according to current coding system priorities."
 235   (require 'mm-util)
 236   (if (fboundp 'sort-coding-systems)
 237       (let ((ordered (sort-coding-systems
 238                       (let (accum)
 239                         (dolist (elt mm-mime-mule-charset-alist)
 240                           (if (mm-coding-system-p (car elt))
 241                               (push (car elt) accum)))
 242                         (nreverse accum)))))
 243         (concat (format "%s;q=1, " (pop ordered))
 244                 (mapconcat 'symbol-name ordered ";q=0.5, ")
 245                 ";q=0.5"))))
 246
 247 (defvar url-mime-charset-string nil
 248   "String to send in the Accept-charset: field in HTTP requests.
 249 The MIME charset corresponding to the most preferred coding system is
 250 given priority 1 and the rest are given priority 0.5.")
 251
 252 (defun url-set-mime-charset-string ()
 253   (setq url-mime-charset-string (url-mime-charset-string)))
 254 ;; Regenerate if the language environment changes.
 255 (add-hook 'set-language-environment-hook 'url-set-mime-charset-string)
 256
 257 ;; Fixme: set from the locale.
 258 (defcustom url-mime-language-string nil
 259   "String to send in the Accept-language: field in HTTP requests.
 260
 261 Specifies the preferred language when servers can serve documents in
 262 several languages.  Use RFC 1766 abbreviations, e.g.: `en' for
 263 English, `de' for German.  A comma-separated specifies descending
 264 order of preference.  The ordering can be made explicit using `q'
 265 factors defined by HTTP, e.g. `de,en-gb;q=0.8,en;q=0.7'.  `*' means
 266 get the first available language (as opposed to the default)."
 267   :type '(radio
 268           (const :tag "None (get default language version)" :value nil)
 269           (const :tag "Any (get first available language version)" :value "*")
 270           (string :tag "Other"))
 271   :group 'url-mime
 272   :group 'i18n)
 273
 274 (defvar url-mime-accept-string nil
 275   "String to send to the server in the Accept: field in HTTP requests.")
 276
 277 (defvar url-package-version nil
 278   "Version number of package using URL.")
 279
 280 (defvar url-package-name nil "Name of package using URL.")
 281
 282 (defvar url-system-type nil
 283   "What type of system we are on.")
 284 (defvar url-os-type nil
 285   "What OS we are on.")
 286
 287 (defcustom url-max-password-attempts 5
 288   "Maximum number of times a password will be prompted for.
 289 Applies when a protected document is denied by the server."
 290   :type 'integer
 291   :group 'url)
 292
 293 (defcustom url-temporary-directory (or (getenv "TMPDIR") "/tmp")
 294   "Where temporary files go."
 295   :type 'directory
 296   :group 'url-file)
 297 (make-obsolete-variable 'url-temporary-directory
 298                         'temporary-file-directory "23.1")
 299
 300 (defcustom url-show-status t
 301   "Whether to show a running total of bytes transferred.
 302 Can cause a large hit if using a remote X display over a slow link, or
 303 a terminal with a slow modem."
 304   :type 'boolean
 305   :group 'url)
 306
 307 (defvar url-using-proxy nil
 308   "Either nil or the fully qualified proxy URL in use, e.g.
 309 http://www.example.com/")
 310
 311 (defcustom url-news-server nil
 312   "The default news server from which to get newsgroups/articles.
 313 Applies if no server is specified in the URL.  Defaults to the
 314 environment variable NNTPSERVER or \"news\" if NNTPSERVER is
 315 undefined."
 316   :type '(choice (const :tag "None" :value nil) string)
 317   :group 'url)
 318
 319 ;; From RFC3986: Scheme names consist of a sequence of characters
 320 ;; beginning with a letter and followed by any combination of letters,
 321 ;; digits, plus ("+"), period ("."), or hyphen ("-").
 322
 323 (defvar url-nonrelative-link
 324   "\\`\\([a-zA-Z][-a-zA-Z0-9+.]*:\\)"
 325   "A regular expression that will match an absolute URL.")
 326
 327 (defcustom url-max-redirections 30
 328   "The maximum number of redirection requests to honor in a HTTP connection.
 329 A negative number means to honor an unlimited number of redirection requests."
 330   :type 'integer
 331   :group 'url)
 332
 333 (defcustom url-confirmation-func 'y-or-n-p
 334   "What function to use for asking yes or no functions.
 335 Possible values are `yes-or-no-p' or `y-or-n-p', or any function that
 336 takes a single argument (the prompt), and returns t only if a positive
 337 answer is given."
 338   :type '(choice (const :tag "Short (y or n)" :value y-or-n-p)
 339                  (const :tag "Long (yes or no)" :value yes-or-no-p)
 340                  (function :tag "Other"))
 341   :group 'url-hairy)
 342
 343 (defcustom url-gateway-method 'native
 344   "The type of gateway support to use.
 345 Should be a symbol specifying how to get a connection from the local machine.
 346
 347 Currently supported methods:
 348 `telnet': Run telnet in a subprocess to connect;
 349 `rlogin': Rlogin to another machine to connect;
 350 `socks': Connect through a socks server;
 351 `tls': Connect with TLS;
 352 `ssl': Connect with SSL (deprecated, use `tls' instead);
 353 `native': Connect directly."
 354   :type '(radio (const :tag "Telnet to gateway host" :value telnet)
 355                 (const :tag "Rlogin to gateway host" :value rlogin)
 356                 (const :tag "Use SOCKS proxy" :value socks)
 357                 (const :tag "Use SSL/TLS for all connections" :value tls)
 358                 (const :tag "Use SSL for all connections (obsolete)" :value ssl)
 359                 (const :tag "Direct connection" :value native))
 360   :group 'url-hairy)
 361
 362 (defcustom url-user-agent 'default
 363   "User Agent used by the URL package for HTTP/HTTPS requests.
 364 Should be one of:
 365 * A string (not including the \"User-Agent:\" prefix)
 366 * A function of no arguments, returning a string
 367 * `default' (to compute a value according to `url-privacy-level')
 368 * nil (to omit the User-Agent header entirely)"
 369   :type
 370   '(choice
 371     (string :tag "A static User-Agent string")
 372     (function :tag "Call a function to get the User-Agent string")
 373     (const :tag "No User-Agent at all" :value nil)
 374     (const :tag "An string auto-generated according to `url-privacy-level'"
 375            :value default))
 376   :version "26.1"
 377   :group 'url)
 378
 379 (defvar url-setup-done nil "Has setup configuration been done?")
 380
 381 (defconst url-weekday-alist
 382   '(("Sunday" . 0) ("Monday" . 1) ("Tuesday" . 2) ("Wednesday" . 3)
 383     ("Thursday" . 4) ("Friday" . 5) ("Saturday" . 6)
 384     ("Tues" . 2) ("Thurs" . 4)
 385     ("Sun" . 0) ("Mon" . 1) ("Tue" . 2) ("Wed" . 3)
 386     ("Thu" . 4) ("Fri" . 5) ("Sat" . 6)))
 387
 388 (defconst url-monthabbrev-alist
 389   '(("Jan" . 1) ("Feb" . 2) ("Mar" . 3) ("Apr" . 4) ("May" . 5) ("Jun" . 6)
 390     ("Jul" . 7) ("Aug" . 8) ("Sep" . 9) ("Oct" . 10) ("Nov" . 11)
 391     ("Dec" . 12)))
 392
 393 (defvar url-lazy-message-time 0)
 394
 395 ;; Fixme: We may not be able to run SSL.
 396 (defvar url-extensions-header "Security/Digest Security/SSL")
 397
 398 (defvar url-parse-syntax-table
 399   (copy-syntax-table emacs-lisp-mode-syntax-table)
 400   "A syntax table for parsing URLs.")
 401
 402 (modify-syntax-entry ?' "\"" url-parse-syntax-table)
 403 (modify-syntax-entry ?` "\"" url-parse-syntax-table)
 404 (modify-syntax-entry ?< "(>" url-parse-syntax-table)
 405 (modify-syntax-entry ?> ")<" url-parse-syntax-table)
 406 (modify-syntax-entry ?/ " " url-parse-syntax-table)
 407
 408 (defcustom url-load-hook nil
 409   "Hook run after initializing the URL library."
 410   :group 'url
 411   :type 'hook)
 412
 413 ;;; Make OS/2 happy - yeeks
 414 ;; (defvar      tcp-binary-process-input-services nil
 415 ;;   "*Make OS/2 happy with our CRLF pairs...")
 416
 417 (defconst url-working-buffer " *url-work")
 418
 419 (defvar url-gateway-unplugged nil
 420   "Non-nil means don't open new network connections.
 421 This should be set, e.g. by mail user agents rendering HTML to avoid
 422 `bugs' which call home.")
 423
 424 (provide 'url-vars)
 425
 426 ;;; url-vars.el ends here