[bpt/emacs.git] / lisp / net / tramp-gw.el

;;; -*- coding: iso-8859-1; -*-
;;; tramp-gw.el --- Tramp utility functions for HTTP tunnels and SOCKS gateways

;; Copyright (C) 2007 Free Software Foundation, Inc.

;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes

;; 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; see the file COPYING.  If not, see
;; <http://www.gnu.org/licenses/>.

;;; Commentary:

;; Access functions for HTTP tunnels and SOCKS gateways from Tramp.
;; SOCKS functionality is implemented by socks.el from the w3 package.
;; HTTP tunnels are partly implemented in socks.el and url-http.el;
;; both implementations are not complete.  Therefore, it is
;; implemented in this package.

;;; Code:

(require 'tramp)

;; Pacify byte-compiler
(eval-when-compile
  (require 'cl)
  (require 'custom))

;; Autoload the socks library.  It is used only when we access a SOCKS server.
(autoload 'socks-open-network-stream "socks")
(defvar socks-username (user-login-name))
(defvar socks-server (list "Default server" "socks" 1080 5))

;; Avoid byte-compiler warnings if the byte-compiler supports this.
;; Currently, XEmacs supports this.
(eval-when-compile
  (when (featurep 'xemacs)
      (byte-compiler-options (warnings (- unused-vars)))))

;; Define HTTP tunnel method ...
(defvar tramp-gw-tunnel-method "tunnel"
  "*Method to connect HTTP gateways.")

;; ... and port.
(defvar tramp-gw-default-tunnel-port 8080
  "*Default port for HTTP gateways.")

;; Define SOCKS method ...
(defvar tramp-gw-socks-method "socks"
  "*Method to connect SOCKS servers.")

;; ... and port.
(defvar tramp-gw-default-socks-port 1080
  "*Default port for SOCKS servers.")

;; Add a default for `tramp-default-user-alist'.  Default is the local user.
(add-to-list 'tramp-default-user-alist
	     `(,tramp-gw-tunnel-method nil ,(user-login-name)))
(add-to-list 'tramp-default-user-alist
	     `(,tramp-gw-socks-method nil ,(user-login-name)))

;; Internal file name functions and variables.

(defvar tramp-gw-vector nil
  "Keeps the remote host identification.  Needed for Tramp messages.")

(defvar tramp-gw-gw-vector nil
  "Current gateway identification vector.")

(defvar tramp-gw-gw-proc nil
  "Current gateway process.")

;; This variable keeps the listening process, in order to reuse it for
;; new processes.
(defvar tramp-gw-aux-proc nil
  "Process listening on local port, as mediation between SSH and the gateway.")

(defun tramp-gw-gw-proc-sentinel (proc event)
  "Delete auxiliary process when we are deleted."
  (unless (memq (process-status proc) '(run open))
    (tramp-message
     tramp-gw-vector 4 "Deleting auxiliary process `%s'" tramp-gw-gw-proc)
    (let* (tramp-verbose
	   (p (tramp-get-connection-property proc "process" nil)))
      (when (processp p) (delete-process p)))))

(defun tramp-gw-aux-proc-sentinel (proc event)
  "Activate the different filters for involved gateway and auxiliary processes."
  (when (memq (process-status proc) '(run open))
    ;; A new process has been spawned from `tramp-gw-aux-proc'.
    (tramp-message
     tramp-gw-vector 4
     "Opening auxiliary process `%s', speaking with process `%s'"
     proc tramp-gw-gw-proc)
    (tramp-set-process-query-on-exit-flag proc nil)
    ;; We don't want debug messages, because the corresponding debug
    ;; buffer might be undecided.
    (let (tramp-verbose)
      (tramp-set-connection-property tramp-gw-gw-proc "process" proc)
      (tramp-set-connection-property proc "process" tramp-gw-gw-proc))
    ;; Set the process-filter functions for both processes.
    (set-process-filter proc 'tramp-gw-process-filter)
    (set-process-filter tramp-gw-gw-proc 'tramp-gw-process-filter)
    ;; There might be already some output from the gateway process.
    (with-current-buffer (process-buffer tramp-gw-gw-proc)
      (unless (= (point-min) (point-max))
	(let ((s (buffer-string)))
	  (delete-region (point) (point-max))
	  (tramp-gw-process-filter tramp-gw-gw-proc s))))))

(defun tramp-gw-process-filter (proc string)
  (let (tramp-verbose)
    (process-send-string
     (tramp-get-connection-property proc "process" nil) string)))

(defun tramp-gw-open-connection (vec gw-vec target-vec)
  "Open a remote connection to VEC (see `tramp-file-name' structure).
Take GW-VEC as SOCKS or HTTP gateway, i.e. its method must be a
gateway method.  TARGET-VEC identifies where to connect to via
the gateway, it can be different from VEC when there are more
hops to be applied.

It returns a string like \"localhost#port\", which must be used
instead of the host name declared in TARGET-VEC."

  ;; Remember vectors for property retrieval.
  (setq tramp-gw-vector vec
	tramp-gw-gw-vector gw-vec)

  ;; Start listening auxiliary process.
  (unless (and (processp tramp-gw-aux-proc)
	       (memq (process-status tramp-gw-aux-proc) '(listen)))
    (let ((aux-vec
	   (vector "aux" (tramp-file-name-user gw-vec)
		   (tramp-file-name-host gw-vec) nil)))
      (setq tramp-gw-aux-proc
	    (make-network-process
	     :name (tramp-buffer-name aux-vec) :buffer nil :host 'local
	     :server t :noquery t :service t :coding 'binary))
      (set-process-sentinel tramp-gw-aux-proc 'tramp-gw-aux-proc-sentinel)
      (tramp-set-process-query-on-exit-flag tramp-gw-aux-proc nil)
      (tramp-message
       vec 4 "Opening auxiliary process `%s', listening on port %d"
       tramp-gw-aux-proc (process-contact tramp-gw-aux-proc :service))))

  (let* ((gw-method
	  (intern
	   (tramp-find-method
	    (tramp-file-name-method gw-vec)
	    (tramp-file-name-user gw-vec)
	    (tramp-file-name-host gw-vec))))
	 (socks-username
	  (tramp-find-user
	   (tramp-file-name-method gw-vec)
	   (tramp-file-name-user gw-vec)
	   (tramp-file-name-host gw-vec)))
	 ;; Declare the SOCKS server to be used.
	 (socks-server
	  (list "Tramp tempory socks server list"
		;; Host name.
		(tramp-file-name-real-host gw-vec)
		;; Port number.
		(or (tramp-file-name-port gw-vec)
		    (case gw-method
		      (tunnel tramp-gw-default-tunnel-port)
		      (socks tramp-gw-default-socks-port)))
		;; Type.  We support only http and socks5, NO socks4.
		;; 'http could be used when HTTP tunnel works in socks.el.
		5))
	 ;; The function to be called.
	 (socks-function
	  (case gw-method
	    (tunnel 'tramp-gw-open-network-stream)
	    (socks 'socks-open-network-stream)))
	 socks-noproxy)

    ;; Open SOCKS process.
    (setq tramp-gw-gw-proc
	  (funcall
	   socks-function
	   (tramp-buffer-name gw-vec)
	   (tramp-get-buffer gw-vec)
	   (tramp-file-name-real-host target-vec)
	   (tramp-file-name-port target-vec)))
    (set-process-sentinel tramp-gw-gw-proc 'tramp-gw-gw-proc-sentinel)
    (tramp-set-process-query-on-exit-flag tramp-gw-gw-proc nil)
    (tramp-message
     vec 4 "Opened %s process `%s'"
     (case gw-method ('tunnel "HTTP tunnel") ('socks "SOCKS"))
     tramp-gw-gw-proc)

    ;; Return the new host for gateway access.
    (format "localhost#%d" (process-contact tramp-gw-aux-proc :service))))

(defun tramp-gw-open-network-stream (name buffer host service)
  "Open stream to proxy server HOST:SERVICE.
Resulting process has name NAME and buffer BUFFER.  If
authentication is requested from proxy server, provide it."
  (let ((command (format (concat
			  "CONNECT %s:%d HTTP/1.1\r\n"
			  "Host: %s:%d\r\n"
			  "Connection: keep-alive\r\n"
			  "User-Agent: Tramp/%s\r\n")
			 host service host service tramp-version))
	(authentication "")
	(first t)
	found proc)

    (while (not found)
      ;; Clean up.
      (when (processp proc) (delete-process proc))
      (with-current-buffer buffer (erase-buffer))
      ;; Open network stream.
      (setq proc (open-network-stream
		  name buffer (nth 1 socks-server) (nth 2 socks-server)))
      (set-process-coding-system proc 'binary 'binary)
      (tramp-set-process-query-on-exit-flag proc nil)
      ;; Send CONNECT command.
      (process-send-string proc (format "%s%s\r\n" command authentication))
      (tramp-message
       tramp-gw-vector 6 "\n%s"
       (format
	"%s%s\r\n" command
	(replace-regexp-in-string ;; no password in trace!
	 "Basic [^\r\n]+" "Basic xxxxx" authentication t)))
      (with-current-buffer buffer
	;; Trap errors to be traced in the right trace buffer.  Often,
	;; proxies have a timeout of 60".  We wait 65" in order to
	;; receive an answer this case.
	(condition-case nil
	    (let (tramp-verbose)
	      (tramp-wait-for-regexp proc 65 "\r?\n\r?\n"))
	  (error nil))
	;; Check return code.
	(goto-char (point-min))
	(narrow-to-region
	 (point-min)
	 (or (search-forward-regexp "\r?\n\r?\n" nil t) (point-max)))
	(tramp-message tramp-gw-vector 6 "\n%s" (buffer-string))
	(goto-char (point-min))
	(search-forward-regexp "^HTTP/[1-9]\\.[0-9]" nil t)
	(case (condition-case nil (read (current-buffer)) (error))
	  ;; Connected.
	  (200 (setq found t))
	  ;; We need basic authentication.
	  (401 (setq authentication (tramp-gw-basic-authentication nil first)))
	  ;; Target host not found.
	  (404 (tramp-error-with-buffer
		(current-buffer) tramp-gw-vector 'file-error
		"Host %s not found." host))
	  ;; We need basic proxy authentication.
	  (407 (setq authentication (tramp-gw-basic-authentication t first)))
	  ;; Connection failed.
	  (503 (tramp-error-with-buffer
		(current-buffer) tramp-gw-vector 'file-error
		"Connection to %s:%d failed." host service))
	  ;; That doesn't work at all.
	  (t (tramp-error-with-buffer
	      (current-buffer) tramp-gw-vector 'file-error
	      "Access to HTTP server %s:%d failed."
	      (nth 1 socks-server) (nth 2 socks-server))))
	;; Remove HTTP headers.
	(delete-region (point-min) (point-max))
	(widen)
	(setq first nil)))
    ;; Return the process.
    proc))

(defun tramp-gw-basic-authentication (proxy pw-cache)
  "Return authentication header for CONNECT, based on server request.
PROXY is an indication whether we need a Proxy-Authorization header
or an Authorization header.  If PW-CACHE is non-nil, check for
password in password cache.  This is done for the first try only."

  ;; `tramp-current-*' must be set for `tramp-read-passwd' and
  ;; `tramp-clear-passwd'.
  (let ((tramp-current-method (tramp-file-name-method tramp-gw-gw-vector))
	(tramp-current-user (tramp-file-name-user tramp-gw-gw-vector))
	(tramp-current-host (tramp-file-name-host tramp-gw-gw-vector)))
    (unless pw-cache (tramp-clear-passwd))
    ;; We are already in the right buffer.
    (tramp-message
     tramp-gw-vector 5 "%s required"
     (if proxy "Proxy authentication" "Authentication"))
    ;; Search for request header.  We accept only basic authentication.
    (goto-char (point-min))
    (search-forward-regexp
     "^\\(Proxy\\|WWW\\)-Authenticate:\\s-*Basic\\s-+realm=")
    ;; Return authentication string.
    (format
     "%s: Basic %s\r\n"
     (if proxy "Proxy-Authorization" "Authorization")
     (base64-encode-string
      (format
       "%s:%s"
       socks-username
       (tramp-read-passwd
	proc
	(format
	 "Password for %s@[%s]: " socks-username (read (current-buffer)))))))))


(provide 'tramp-gw)

;;; TODO:

;; * Provide descriptive Commentary.
;; * Enable it for several gateway processes in parallel.

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