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