1;;; url-gw.el --- Gateway munging for URL loading 2 3;; Copyright (C) 1997, 1998, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. 4 5;; Author: Bill Perry <wmperry@gnu.org> 6;; Keywords: comm, data, 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 12;; the Free Software Foundation; either version 2, or (at your option) 13;; any later version. 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, write to the 22;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 23;; Boston, MA 02110-1301, USA. 24 25;;; Code: 26 27(eval-when-compile (require 'cl)) 28(require 'url-vars) 29 30;; Fixme: support SSH explicitly or via a url-gateway-rlogin-program? 31 32(autoload 'socks-open-network-stream "socks") 33(autoload 'open-ssl-stream "ssl") 34(autoload 'open-tls-stream "tls") 35 36(defgroup url-gateway nil 37 "URL gateway variables." 38 :group 'url) 39 40(defcustom url-gateway-local-host-regexp nil 41 "*A regular expression specifying local hostnames/machines." 42 :type '(choice (const nil) regexp) 43 :group 'url-gateway) 44 45(defcustom url-gateway-prompt-pattern 46 "^[^#$%>;]*[#$%>;] *" ;; "bash\\|\$ *\r?$\\|> *\r?" 47 "*A regular expression matching a shell prompt." 48 :type 'regexp 49 :group 'url-gateway) 50 51(defcustom url-gateway-rlogin-host nil 52 "*What hostname to actually rlog into before doing a telnet." 53 :type '(choice (const nil) string) 54 :group 'url-gateway) 55 56(defcustom url-gateway-rlogin-user-name nil 57 "*Username to log into the remote machine with when using rlogin." 58 :type '(choice (const nil) string) 59 :group 'url-gateway) 60 61(defcustom url-gateway-rlogin-parameters '("telnet" "-8") 62 "*Parameters to `url-open-rlogin'. 63This list will be used as the parameter list given to rsh." 64 :type '(repeat string) 65 :group 'url-gateway) 66 67(defcustom url-gateway-telnet-host nil 68 "*What hostname to actually login to before doing a telnet." 69 :type '(choice (const nil) string) 70 :group 'url-gateway) 71 72(defcustom url-gateway-telnet-parameters '("exec" "telnet" "-8") 73 "*Parameters to `url-open-telnet'. 74This list will be executed as a command after logging in via telnet." 75 :type '(repeat string) 76 :group 'url-gateway) 77 78(defcustom url-gateway-telnet-login-prompt "^\r*.?login:" 79 "*Prompt that tells us we should send our username when loggin in w/telnet." 80 :type 'regexp 81 :group 'url-gateway) 82 83(defcustom url-gateway-telnet-password-prompt "^\r*.?password:" 84 "*Prompt that tells us we should send our password when loggin in w/telnet." 85 :type 'regexp 86 :group 'url-gateway) 87 88(defcustom url-gateway-telnet-user-name nil 89 "User name to log in via telnet with." 90 :type '(choice (const nil) string) 91 :group 'url-gateway) 92 93(defcustom url-gateway-telnet-password nil 94 "Password to use to log in via telnet with." 95 :type '(choice (const nil) string) 96 :group 'url-gateway) 97 98(defcustom url-gateway-broken-resolution nil 99 "*Whether to use nslookup to resolve hostnames. 100This should be used when your version of Emacs cannot correctly use DNS, 101but your machine can. This usually happens if you are running a statically 102linked Emacs under SunOS 4.x" 103 :type 'boolean 104 :group 'url-gateway) 105 106(defcustom url-gateway-nslookup-program "nslookup" 107 "*If non-nil then a string naming nslookup program." 108 :type '(choice (const :tag "None" :value nil) string) 109 :group 'url-gateway) 110 111;; Stolen from ange-ftp 112;;;###autoload 113(defun url-gateway-nslookup-host (host) 114 "Attempt to resolve the given HOST using nslookup if possible." 115 (interactive "sHost: ") 116 (if url-gateway-nslookup-program 117 (let ((proc (start-process " *nslookup*" " *nslookup*" 118 url-gateway-nslookup-program host)) 119 (res host)) 120 (set-process-query-on-exit-flag proc nil) 121 (with-current-buffer (process-buffer proc) 122 (while (memq (process-status proc) '(run open)) 123 (accept-process-output proc)) 124 (goto-char (point-min)) 125 (if (re-search-forward "Name:.*\nAddress: *\\(.*\\)$" nil t) 126 (setq res (buffer-substring (match-beginning 1) 127 (match-end 1)))) 128 (kill-buffer (current-buffer))) 129 res) 130 host)) 131 132;; Stolen from red gnus nntp.el 133(defun url-wait-for-string (regexp proc) 134 "Wait until string matching REGEXP arrives in process PROC's buffer." 135 (let ((buf (current-buffer))) 136 (goto-char (point-min)) 137 (while (not (re-search-forward regexp nil t)) 138 (accept-process-output proc) 139 (set-buffer buf) 140 (goto-char (point-min))))) 141 142;; Stolen from red gnus nntp.el 143(defun url-open-rlogin (name buffer host service) 144 "Open a connection using rsh." 145 (if (not (stringp service)) 146 (setq service (int-to-string service))) 147 (let ((proc (if url-gateway-rlogin-user-name 148 (start-process 149 name buffer "rsh" 150 url-gateway-rlogin-host "-l" url-gateway-rlogin-user-name 151 (mapconcat 'identity 152 (append url-gateway-rlogin-parameters 153 (list host service)) " ")) 154 (start-process 155 name buffer "rsh" url-gateway-rlogin-host 156 (mapconcat 'identity 157 (append url-gateway-rlogin-parameters 158 (list host service)) 159 " "))))) 160 (set-buffer buffer) 161 (url-wait-for-string "^\r*200" proc) 162 (beginning-of-line) 163 (delete-region (point-min) (point)) 164 proc)) 165 166;; Stolen from red gnus nntp.el 167(defun url-open-telnet (name buffer host service) 168 (if (not (stringp service)) 169 (setq service (int-to-string service))) 170 (with-current-buffer (get-buffer-create buffer) 171 (erase-buffer) 172 (let ((proc (start-process name buffer "telnet" "-8")) 173 (case-fold-search t)) 174 (when (memq (process-status proc) '(open run)) 175 (process-send-string proc "set escape \^X\n") 176 (process-send-string proc (concat 177 "open " url-gateway-telnet-host "\n")) 178 (url-wait-for-string url-gateway-telnet-login-prompt proc) 179 (process-send-string 180 proc (concat 181 (or url-gateway-telnet-user-name 182 (setq url-gateway-telnet-user-name (read-string "login: "))) 183 "\n")) 184 (url-wait-for-string url-gateway-telnet-password-prompt proc) 185 (process-send-string 186 proc (concat 187 (or url-gateway-telnet-password 188 (setq url-gateway-telnet-password 189 (read-passwd "Password: "))) 190 "\n")) 191 (erase-buffer) 192 (url-wait-for-string url-gateway-prompt-pattern proc) 193 (process-send-string 194 proc (concat (mapconcat 'identity 195 (append url-gateway-telnet-parameters 196 (list host service)) " ") "\n")) 197 (url-wait-for-string "^\r*Escape character.*\r*\n+" proc) 198 (delete-region (point-min) (match-end 0)) 199 (process-send-string proc "\^]\n") 200 (url-wait-for-string "^telnet" proc) 201 (process-send-string proc "mode character\n") 202 (accept-process-output proc 1) 203 (sit-for 1) 204 (goto-char (point-min)) 205 (forward-line 1) 206 (delete-region (point) (point-max))) 207 proc))) 208 209;;;###autoload 210(defun url-open-stream (name buffer host service) 211 "Open a stream to HOST, possibly via a gateway. 212Args per `open-network-stream'. 213Will not make a connection if `url-gateway-unplugged' is non-nil. 214Might do a non-blocking connection; use `process-status' to check." 215 (unless url-gateway-unplugged 216 (let ((gw-method (if (and url-gateway-local-host-regexp 217 (not (eq 'tls url-gateway-method)) 218 (not (eq 'ssl url-gateway-method)) 219 (string-match 220 url-gateway-local-host-regexp 221 host)) 222 'native 223 url-gateway-method)) 224;;; ;; This hack is for OS/2 Emacs so that it will not do bogus CRLF 225;;; ;; conversions while trying to be 'helpful' 226;;; (tcp-binary-process-output-services (if (stringp service) 227;;; (list service) 228;;; (list service 229;;; (int-to-string service)))) 230 231 ;; An attempt to deal with denied connections, and attempt 232 ;; to reconnect 233 (cur-retries 0) 234 (retry t) 235 (errobj nil) 236 (conn nil)) 237 238 ;; If the user told us to do DNS for them, do it. 239 (if url-gateway-broken-resolution 240 (setq host (url-gateway-nslookup-host host))) 241 242 (condition-case errobj 243 ;; This is a clean way to ensure the new process inherits the 244 ;; right coding systems in both Emacs and XEmacs. 245 (let ((coding-system-for-read 'binary) 246 (coding-system-for-write 'binary)) 247 (setq conn (case gw-method 248 (tls 249 (open-tls-stream name buffer host service)) 250 (ssl 251 (open-ssl-stream name buffer host service)) 252 ((native) 253 ;; Use non-blocking socket if we can. 254 (make-network-process :name name :buffer buffer 255 :host host :service service 256 :nowait 257 (featurep 'make-network-process '(:nowait t)))) 258 (socks 259 (socks-open-network-stream name buffer host service)) 260 (telnet 261 (url-open-telnet name buffer host service)) 262 (rlogin 263 (url-open-rlogin name buffer host service)) 264 (otherwise 265 (error "Bad setting of url-gateway-method: %s" 266 url-gateway-method))))) 267 ;; Ignoring errors here seems wrong. E.g. it'll throw away the 268 ;; error signalled two lines above. It was also found inconvenient 269 ;; during debugging. 270 ;; (error 271 ;; (setq conn nil)) 272 ) 273 conn))) 274 275(provide 'url-gw) 276 277;; arch-tag: 1c4c0317-6d03-45b8-b3f3-838bd8f9d838 278;;; url-gw.el ends here 279