lisp/url/url-vars.el

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