1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
| | ;;; url-methods.el --- Load URL schemes as needed -*- lexical-binding: t; -*-
;; Copyright (C) 1996-1999, 2004-2024 Free Software Foundation, Inc.
;; Keywords: comm, data, processes, hypermedia
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
;; This loads up some of the small, silly URLs that I really don't
;; want to bother putting in their own separate files.
(require 'url-parse)
(defvar url-scheme-registry (make-hash-table :size 7 :test 'equal))
(defconst url-scheme-methods
'((default-port . variable)
(asynchronous-p . variable)
(expand-file-name . function)
(file-exists-p . function)
(file-attributes . function)
(parse-url . function)
(file-symlink-p . function)
(file-writable-p . function)
(file-directory-p . function)
(file-executable-p . function)
(directory-files . function)
(file-truename . function))
"Assoc-list of methods that each URL loader can provide.")
(defconst url-scheme-default-properties
(list 'name "unknown"
'loader 'url-scheme-default-loader
'default-port 0
'expand-file-name 'url-identity-expander
'parse-url 'url-generic-parse-url
'asynchronous-p nil
'file-directory-p 'ignore
'file-truename (lambda (&rest args)
(url-recreate-url (car args)))
'file-exists-p 'ignore
'file-attributes 'ignore))
(defun url-scheme-default-loader (url &optional _callback _cbargs)
"Signal an error for an unknown URL scheme."
(error "Unknown URL scheme: %s" (url-type url)))
(defvar url-scheme--registering-proxy nil)
(defun url-scheme-register-proxy (scheme)
"Automatically find a proxy for SCHEME and put it in `url-proxy-services'."
(let* ((env-var (concat scheme "_proxy"))
(env-proxy (or (getenv (upcase env-var))
(getenv (downcase env-var))))
(cur-proxy (assoc scheme url-proxy-services))
(urlobj nil)
(url-scheme--registering-proxy t))
;; If env-proxy is an empty string, treat it as if it were nil
(when (and (stringp env-proxy)
(string= env-proxy ""))
(setq env-proxy nil))
;; Store any proxying information - this will not overwrite an old
;; entry, so that people can still set this information in their
;; init file
(cond
(cur-proxy nil) ; Keep their old settings
((null env-proxy) nil) ; No proxy setup
;; First check if its something like hostname:port
((string-match "^\\([^:]+\\):\\([0-9]+\\)$" env-proxy)
(setq urlobj (url-generic-parse-url nil)) ; Get a blank object
(setf (url-type urlobj) "http")
(setf (url-host urlobj) (match-string 1 env-proxy))
(setf (url-port urlobj) (string-to-number (match-string 2 env-proxy))))
;; Then check if its a fully specified URL
((string-match url-nonrelative-link env-proxy)
(setq urlobj (url-generic-parse-url env-proxy))
(setf (url-target urlobj) nil))
;; Finally, fall back on the assumption that its just a hostname
(t
(setq urlobj (url-generic-parse-url nil)) ; Get a blank object
(setf (url-type urlobj) "http")
(setf (url-host urlobj) env-proxy)))
(if (and (not cur-proxy) urlobj)
(progn
(setq url-proxy-services
(cons (cons scheme (if (member (url-type urlobj)
url-proxy-full-address-types)
(url-recreate-url urlobj)
(format "%s:%d" (url-host urlobj)
(url-port urlobj))))
url-proxy-services))
(message "Using a proxy for %s..." scheme)))))
(defun url-scheme-get-property (scheme property)
"Get PROPERTY of a URL SCHEME.
Will automatically try to load a backend from url-SCHEME.el if
it has not already been loaded."
(setq scheme (downcase scheme))
(let ((desc (gethash scheme url-scheme-registry)))
(if (not desc)
(let* ((stub (concat "url-" scheme))
(loader (intern stub)))
(condition-case ()
;; url-https.el was merged into url-http because of 8+3
;; filename limitations, so we have to do this dance.
(require (if (equal "https" scheme) 'url-http loader))
(error nil))
(if (fboundp loader)
(progn
;; Found the module to handle <scheme> URLs
(unless url-scheme--registering-proxy
(url-scheme-register-proxy scheme))
(setq desc (list 'name scheme
'loader loader))
(dolist (cell url-scheme-methods)
(let ((symbol (intern-soft (format "%s-%s" stub (car cell))))
(type (cdr cell)))
(if symbol
(pcase type
('function
;; Store the symbol name of a function
(if (fboundp symbol)
(setq desc (plist-put desc (car cell) symbol))))
('variable
;; Store the VALUE of a variable
(if (boundp symbol)
(setq desc (plist-put desc (car cell)
(symbol-value symbol)))))
(_
(error "Malformed url-scheme-methods entry: %S"
cell))))))
(puthash scheme desc url-scheme-registry)))))
(or (plist-get desc property)
(plist-get url-scheme-default-properties property))))
(provide 'url-methods)
;;; url-methods.el ends here
|