lisp/net/tramp-gw.el

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