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