Commit | Line | Data |
---|---|---|
00d6fd04 MA |
1 | ;;; tramp-gw.el --- Tramp utility functions for HTTP tunnels and SOCKS gateways |
2 | ||
73b0cd50 | 3 | ;; Copyright (C) 2007-2011 Free Software Foundation, Inc. |
00d6fd04 MA |
4 | |
5 | ;; Author: Michael Albinus <michael.albinus@gmx.de> | |
6 | ;; Keywords: comm, processes | |
bd78fa1d | 7 | ;; Package: tramp |
00d6fd04 MA |
8 | |
9 | ;; This file is part of GNU Emacs. | |
10 | ||
874a927a | 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
00d6fd04 | 12 | ;; it under the terms of the GNU General Public License as published by |
874a927a GM |
13 | ;; the Free Software Foundation, either version 3 of the License, or |
14 | ;; (at your option) any later version. | |
00d6fd04 MA |
15 | |
16 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 | ;; GNU General Public License for more details. | |
20 | ||
21 | ;; You should have received a copy of the GNU General Public License | |
874a927a | 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
00d6fd04 MA |
23 | |
24 | ;;; Commentary: | |
25 | ||
26 | ;; Access functions for HTTP tunnels and SOCKS gateways from Tramp. | |
27 | ;; SOCKS functionality is implemented by socks.el from the w3 package. | |
28 | ;; HTTP tunnels are partly implemented in socks.el and url-http.el; | |
29 | ;; both implementations are not complete. Therefore, it is | |
30 | ;; implemented in this package. | |
31 | ||
32 | ;;; Code: | |
33 | ||
34 | (require 'tramp) | |
35 | ||
36 | ;; Pacify byte-compiler | |
37 | (eval-when-compile | |
38 | (require 'cl) | |
39 | (require 'custom)) | |
40 | ||
00d6fd04 MA |
41 | ;; Avoid byte-compiler warnings if the byte-compiler supports this. |
42 | ;; Currently, XEmacs supports this. | |
43 | (eval-when-compile | |
44 | (when (featurep 'xemacs) | |
45 | (byte-compiler-options (warnings (- unused-vars))))) | |
46 | ||
66feec8b MA |
47 | ;; We don't add the following methods to `tramp-methods', in order to |
48 | ;; exclude them from file name completion. | |
49 | ||
00d6fd04 | 50 | ;; Define HTTP tunnel method ... |
0f34aa77 MA |
51 | ;;;###tramp-autoload |
52 | (defconst tramp-gw-tunnel-method "tunnel" | |
00d6fd04 MA |
53 | "*Method to connect HTTP gateways.") |
54 | ||
55 | ;; ... and port. | |
0f34aa77 | 56 | (defconst tramp-gw-default-tunnel-port 8080 |
00d6fd04 MA |
57 | "*Default port for HTTP gateways.") |
58 | ||
59 | ;; Define SOCKS method ... | |
0f34aa77 MA |
60 | ;;;###tramp-autoload |
61 | (defconst tramp-gw-socks-method "socks" | |
00d6fd04 MA |
62 | "*Method to connect SOCKS servers.") |
63 | ||
64 | ;; ... and port. | |
0f34aa77 | 65 | (defconst tramp-gw-default-socks-port 1080 |
00d6fd04 MA |
66 | "*Default port for SOCKS servers.") |
67 | ||
0f34aa77 MA |
68 | ;; Autoload the socks library. It is used only when we access a SOCKS server. |
69 | (autoload 'socks-open-network-stream "socks") | |
70 | (defvar socks-username (user-login-name)) | |
71 | (defvar socks-server | |
72 | (list "Default server" "socks" tramp-gw-default-socks-port 5)) | |
73 | ||
00d6fd04 | 74 | ;; Add a default for `tramp-default-user-alist'. Default is the local user. |
b191c9d9 | 75 | ;;;###tramp-autoload |
66feec8b MA |
76 | (add-to-list |
77 | 'tramp-default-user-alist | |
78 | (list (concat "\\`" | |
79 | (regexp-opt (list tramp-gw-tunnel-method tramp-gw-socks-method)) | |
80 | "\\'") | |
81 | nil (user-login-name))) | |
00d6fd04 MA |
82 | |
83 | ;; Internal file name functions and variables. | |
84 | ||
85 | (defvar tramp-gw-vector nil | |
86 | "Keeps the remote host identification. Needed for Tramp messages.") | |
87 | ||
88 | (defvar tramp-gw-gw-vector nil | |
89 | "Current gateway identification vector.") | |
90 | ||
91 | (defvar tramp-gw-gw-proc nil | |
92 | "Current gateway process.") | |
93 | ||
94 | ;; This variable keeps the listening process, in order to reuse it for | |
95 | ;; new processes. | |
96 | (defvar tramp-gw-aux-proc nil | |
97 | "Process listening on local port, as mediation between SSH and the gateway.") | |
98 | ||
99 | (defun tramp-gw-gw-proc-sentinel (proc event) | |
100 | "Delete auxiliary process when we are deleted." | |
101 | (unless (memq (process-status proc) '(run open)) | |
102 | (tramp-message | |
103 | tramp-gw-vector 4 "Deleting auxiliary process `%s'" tramp-gw-gw-proc) | |
104 | (let* (tramp-verbose | |
105 | (p (tramp-get-connection-property proc "process" nil))) | |
106 | (when (processp p) (delete-process p))))) | |
107 | ||
108 | (defun tramp-gw-aux-proc-sentinel (proc event) | |
109 | "Activate the different filters for involved gateway and auxiliary processes." | |
110 | (when (memq (process-status proc) '(run open)) | |
111 | ;; A new process has been spawned from `tramp-gw-aux-proc'. | |
112 | (tramp-message | |
113 | tramp-gw-vector 4 | |
114 | "Opening auxiliary process `%s', speaking with process `%s'" | |
115 | proc tramp-gw-gw-proc) | |
bd8fadca | 116 | (tramp-compat-set-process-query-on-exit-flag proc nil) |
00d6fd04 MA |
117 | ;; We don't want debug messages, because the corresponding debug |
118 | ;; buffer might be undecided. | |
119 | (let (tramp-verbose) | |
120 | (tramp-set-connection-property tramp-gw-gw-proc "process" proc) | |
121 | (tramp-set-connection-property proc "process" tramp-gw-gw-proc)) | |
122 | ;; Set the process-filter functions for both processes. | |
123 | (set-process-filter proc 'tramp-gw-process-filter) | |
124 | (set-process-filter tramp-gw-gw-proc 'tramp-gw-process-filter) | |
125 | ;; There might be already some output from the gateway process. | |
126 | (with-current-buffer (process-buffer tramp-gw-gw-proc) | |
127 | (unless (= (point-min) (point-max)) | |
128 | (let ((s (buffer-string))) | |
129 | (delete-region (point) (point-max)) | |
130 | (tramp-gw-process-filter tramp-gw-gw-proc s)))))) | |
131 | ||
132 | (defun tramp-gw-process-filter (proc string) | |
133 | (let (tramp-verbose) | |
134 | (process-send-string | |
135 | (tramp-get-connection-property proc "process" nil) string))) | |
136 | ||
0f34aa77 | 137 | ;;;###tramp-autoload |
00d6fd04 MA |
138 | (defun tramp-gw-open-connection (vec gw-vec target-vec) |
139 | "Open a remote connection to VEC (see `tramp-file-name' structure). | |
140 | Take GW-VEC as SOCKS or HTTP gateway, i.e. its method must be a | |
141 | gateway method. TARGET-VEC identifies where to connect to via | |
142 | the gateway, it can be different from VEC when there are more | |
143 | hops to be applied. | |
144 | ||
145 | It returns a string like \"localhost#port\", which must be used | |
146 | instead of the host name declared in TARGET-VEC." | |
147 | ||
148 | ;; Remember vectors for property retrieval. | |
149 | (setq tramp-gw-vector vec | |
150 | tramp-gw-gw-vector gw-vec) | |
151 | ||
152 | ;; Start listening auxiliary process. | |
153 | (unless (and (processp tramp-gw-aux-proc) | |
154 | (memq (process-status tramp-gw-aux-proc) '(listen))) | |
155 | (let ((aux-vec | |
156 | (vector "aux" (tramp-file-name-user gw-vec) | |
157 | (tramp-file-name-host gw-vec) nil))) | |
158 | (setq tramp-gw-aux-proc | |
159 | (make-network-process | |
160 | :name (tramp-buffer-name aux-vec) :buffer nil :host 'local | |
161 | :server t :noquery t :service t :coding 'binary)) | |
162 | (set-process-sentinel tramp-gw-aux-proc 'tramp-gw-aux-proc-sentinel) | |
bd8fadca | 163 | (tramp-compat-set-process-query-on-exit-flag tramp-gw-aux-proc nil) |
00d6fd04 MA |
164 | (tramp-message |
165 | vec 4 "Opening auxiliary process `%s', listening on port %d" | |
166 | tramp-gw-aux-proc (process-contact tramp-gw-aux-proc :service)))) | |
167 | ||
168 | (let* ((gw-method | |
169 | (intern | |
170 | (tramp-find-method | |
171 | (tramp-file-name-method gw-vec) | |
172 | (tramp-file-name-user gw-vec) | |
173 | (tramp-file-name-host gw-vec)))) | |
174 | (socks-username | |
175 | (tramp-find-user | |
176 | (tramp-file-name-method gw-vec) | |
177 | (tramp-file-name-user gw-vec) | |
178 | (tramp-file-name-host gw-vec))) | |
179 | ;; Declare the SOCKS server to be used. | |
180 | (socks-server | |
40ba43b4 | 181 | (list "Tramp temporary socks server list" |
00d6fd04 MA |
182 | ;; Host name. |
183 | (tramp-file-name-real-host gw-vec) | |
184 | ;; Port number. | |
185 | (or (tramp-file-name-port gw-vec) | |
186 | (case gw-method | |
187 | (tunnel tramp-gw-default-tunnel-port) | |
188 | (socks tramp-gw-default-socks-port))) | |
189 | ;; Type. We support only http and socks5, NO socks4. | |
190 | ;; 'http could be used when HTTP tunnel works in socks.el. | |
191 | 5)) | |
192 | ;; The function to be called. | |
193 | (socks-function | |
194 | (case gw-method | |
195 | (tunnel 'tramp-gw-open-network-stream) | |
196 | (socks 'socks-open-network-stream))) | |
197 | socks-noproxy) | |
198 | ||
199 | ;; Open SOCKS process. | |
200 | (setq tramp-gw-gw-proc | |
201 | (funcall | |
202 | socks-function | |
66feec8b MA |
203 | (tramp-get-connection-name gw-vec) |
204 | (tramp-get-connection-buffer gw-vec) | |
00d6fd04 MA |
205 | (tramp-file-name-real-host target-vec) |
206 | (tramp-file-name-port target-vec))) | |
207 | (set-process-sentinel tramp-gw-gw-proc 'tramp-gw-gw-proc-sentinel) | |
bd8fadca | 208 | (tramp-compat-set-process-query-on-exit-flag tramp-gw-gw-proc nil) |
00d6fd04 MA |
209 | (tramp-message |
210 | vec 4 "Opened %s process `%s'" | |
211 | (case gw-method ('tunnel "HTTP tunnel") ('socks "SOCKS")) | |
212 | tramp-gw-gw-proc) | |
213 | ||
214 | ;; Return the new host for gateway access. | |
215 | (format "localhost#%d" (process-contact tramp-gw-aux-proc :service)))) | |
216 | ||
217 | (defun tramp-gw-open-network-stream (name buffer host service) | |
218 | "Open stream to proxy server HOST:SERVICE. | |
219 | Resulting process has name NAME and buffer BUFFER. If | |
220 | authentication is requested from proxy server, provide it." | |
221 | (let ((command (format (concat | |
222 | "CONNECT %s:%d HTTP/1.1\r\n" | |
223 | "Host: %s:%d\r\n" | |
224 | "Connection: keep-alive\r\n" | |
225 | "User-Agent: Tramp/%s\r\n") | |
226 | host service host service tramp-version)) | |
227 | (authentication "") | |
228 | (first t) | |
229 | found proc) | |
230 | ||
231 | (while (not found) | |
232 | ;; Clean up. | |
233 | (when (processp proc) (delete-process proc)) | |
234 | (with-current-buffer buffer (erase-buffer)) | |
235 | ;; Open network stream. | |
236 | (setq proc (open-network-stream | |
237 | name buffer (nth 1 socks-server) (nth 2 socks-server))) | |
238 | (set-process-coding-system proc 'binary 'binary) | |
bd8fadca | 239 | (tramp-compat-set-process-query-on-exit-flag proc nil) |
00d6fd04 MA |
240 | ;; Send CONNECT command. |
241 | (process-send-string proc (format "%s%s\r\n" command authentication)) | |
242 | (tramp-message | |
243 | tramp-gw-vector 6 "\n%s" | |
244 | (format | |
245 | "%s%s\r\n" command | |
246 | (replace-regexp-in-string ;; no password in trace! | |
247 | "Basic [^\r\n]+" "Basic xxxxx" authentication t))) | |
248 | (with-current-buffer buffer | |
249 | ;; Trap errors to be traced in the right trace buffer. Often, | |
250 | ;; proxies have a timeout of 60". We wait 65" in order to | |
251 | ;; receive an answer this case. | |
03c1ad43 MA |
252 | (ignore-errors |
253 | (let (tramp-verbose) | |
254 | (tramp-wait-for-regexp proc 65 "\r?\n\r?\n"))) | |
00d6fd04 MA |
255 | ;; Check return code. |
256 | (goto-char (point-min)) | |
257 | (narrow-to-region | |
258 | (point-min) | |
259 | (or (search-forward-regexp "\r?\n\r?\n" nil t) (point-max))) | |
260 | (tramp-message tramp-gw-vector 6 "\n%s" (buffer-string)) | |
261 | (goto-char (point-min)) | |
262 | (search-forward-regexp "^HTTP/[1-9]\\.[0-9]" nil t) | |
263 | (case (condition-case nil (read (current-buffer)) (error)) | |
264 | ;; Connected. | |
265 | (200 (setq found t)) | |
266 | ;; We need basic authentication. | |
267 | (401 (setq authentication (tramp-gw-basic-authentication nil first))) | |
268 | ;; Target host not found. | |
269 | (404 (tramp-error-with-buffer | |
270 | (current-buffer) tramp-gw-vector 'file-error | |
271 | "Host %s not found." host)) | |
272 | ;; We need basic proxy authentication. | |
273 | (407 (setq authentication (tramp-gw-basic-authentication t first))) | |
274 | ;; Connection failed. | |
275 | (503 (tramp-error-with-buffer | |
276 | (current-buffer) tramp-gw-vector 'file-error | |
277 | "Connection to %s:%d failed." host service)) | |
278 | ;; That doesn't work at all. | |
279 | (t (tramp-error-with-buffer | |
280 | (current-buffer) tramp-gw-vector 'file-error | |
281 | "Access to HTTP server %s:%d failed." | |
282 | (nth 1 socks-server) (nth 2 socks-server)))) | |
283 | ;; Remove HTTP headers. | |
284 | (delete-region (point-min) (point-max)) | |
285 | (widen) | |
286 | (setq first nil))) | |
287 | ;; Return the process. | |
288 | proc)) | |
289 | ||
290 | (defun tramp-gw-basic-authentication (proxy pw-cache) | |
291 | "Return authentication header for CONNECT, based on server request. | |
292 | PROXY is an indication whether we need a Proxy-Authorization header | |
293 | or an Authorization header. If PW-CACHE is non-nil, check for | |
294 | password in password cache. This is done for the first try only." | |
295 | ||
9c13938d | 296 | ;; `tramp-current-*' must be set for `tramp-read-passwd'. |
00d6fd04 MA |
297 | (let ((tramp-current-method (tramp-file-name-method tramp-gw-gw-vector)) |
298 | (tramp-current-user (tramp-file-name-user tramp-gw-gw-vector)) | |
299 | (tramp-current-host (tramp-file-name-host tramp-gw-gw-vector))) | |
9c13938d | 300 | (unless pw-cache (tramp-clear-passwd tramp-gw-gw-vector)) |
00d6fd04 MA |
301 | ;; We are already in the right buffer. |
302 | (tramp-message | |
303 | tramp-gw-vector 5 "%s required" | |
304 | (if proxy "Proxy authentication" "Authentication")) | |
305 | ;; Search for request header. We accept only basic authentication. | |
306 | (goto-char (point-min)) | |
307 | (search-forward-regexp | |
308 | "^\\(Proxy\\|WWW\\)-Authenticate:\\s-*Basic\\s-+realm=") | |
309 | ;; Return authentication string. | |
310 | (format | |
311 | "%s: Basic %s\r\n" | |
312 | (if proxy "Proxy-Authorization" "Authorization") | |
313 | (base64-encode-string | |
314 | (format | |
315 | "%s:%s" | |
316 | socks-username | |
317 | (tramp-read-passwd | |
9ce8462a | 318 | nil |
00d6fd04 MA |
319 | (format |
320 | "Password for %s@[%s]: " socks-username (read (current-buffer))))))))) | |
321 | ||
0f34aa77 MA |
322 | (add-hook 'tramp-unload-hook |
323 | (lambda () | |
324 | (unload-feature 'tramp-gw 'force))) | |
00d6fd04 MA |
325 | |
326 | (provide 'tramp-gw) | |
327 | ||
328 | ;;; TODO: | |
329 | ||
330 | ;; * Provide descriptive Commentary. | |
331 | ;; * Enable it for several gateway processes in parallel. | |
332 | ||
00d6fd04 | 333 | ;;; tramp-gw.el ends here |