lisp/net/tramp-gw.el

   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: 277e3a81-fdee-40cf-9e6b-59626292a5e0
 324 ;;; tramp-gw.el ends here