Mercurial > hg > xemacs-beta

comparison lisp/w3/url-gw.el @ 98:0d2f883870bc r20-1b1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b1
author cvs
date Mon, 13 Aug 2007 09:13:56 +0200
parents 0293115a14e9
children 9f59509498e1
comparison
equal deleted inserted replaced
97:498bf5da1c90 98:0d2f883870bc
1 ;;; url-gw.el --- Gateway munging for URL loading 1 ;;; url-gw.el --- Gateway munging for URL loading
2 ;; Author: wmperry 2 ;; Author: wmperry
3 ;; Created: 1997/01/16 14:17:34 3 ;; Created: 1997/02/10 01:00:01
4 ;; Version: 1.3 4 ;; Version: 1.5
5 ;; Keywords: comm, data, processes 5 ;; Keywords: comm, data, processes
6 6
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8 ;;; Copyright (c) 1997 Free Software Foundation, Inc. 8 ;;; Copyright (c) 1997 Free Software Foundation, Inc.
9 ;;; 9 ;;;
186 (list service) 186 (list service)
187 (list service 187 (list service
188 (int-to-string service)))) 188 (int-to-string service))))
189 189
190 ;; An attempt to deal with denied connections, and attempt to reconnect 190 ;; An attempt to deal with denied connections, and attempt to reconnect
191 (max-retries url-connection-retries)
192 (cur-retries 0) 191 (cur-retries 0)
193 (retry t) 192 (retry t)
194 (errobj nil) 193 (errobj nil)
195 (conn nil)) 194 (conn nil))
196 195
197 ;; If the user told us to do DNS for them, do it. 196 ;; If the user told us to do DNS for them, do it.
198 (if url-gateway-broken-resolution 197 (if url-gateway-broken-resolution
199 (setq host (url-nslookup-host host))) 198 (setq host (url-gateway-nslookup-host host)))
200 199
201 (while (and (not conn) retry) 200 (condition-case errobj
202 (condition-case errobj 201 (setq conn (case gw-method
203 (setq conn (case gw-method 202 (ssl
204 (ssl 203 (open-ssl-stream name buffer host service))
205 (open-ssl-stream name buffer host service)) 204 ((tcp native)
206 ((tcp native) 205 (and (eq 'tcp gw-method) (require 'tcp))
207 (and (eq 'tcp gw-method) (require 'tcp)) 206 (open-network-stream name buffer host service))
208 (open-network-stream name buffer host service)) 207 (socks
209 (socks 208 (socks-open-network-stream name buffer host service))
210 (socks-open-network-stream name buffer host service)) 209 (telnet
211 (telnet 210 (url-open-telnet name buffer host service))
212 (url-open-telnet name buffer host service)) 211 (rlogin
213 (rlogin 212 (url-open-rlogin name buffer host service))
214 (url-open-rlogin name buffer host service)) 213 (otherwise
215 (otherwise 214 (error "Bad setting of url-gateway-method: %s"
216 (error "Bad setting of url-gateway-method: %s" 215 url-gateway-method))))
217 url-gateway-method)))) 216 (error
218 (error 217 (insert "Could not contact host: " host " / "
219 (url-save-error errobj) 218 (if (stringp service) service (int-to-string service))
220 (save-window-excursion 219 "\nAttempted using gateway method: "
221 (save-excursion 220 (symbol-name gw-method)
222 (switch-to-buffer-other-window " *url-error*") 221 "\n---- Error was: ----\n")
223 (shrink-window-if-larger-than-buffer) 222 (setq url-current-mime-headers '(("content-type" . "text/plain")))
224 (goto-char (point-min)) 223 (display-error errobj (current-buffer))))
225 (if (and (re-search-forward "in use" nil t) 224 (if conn
226 (< cur-retries max-retries)) 225 (mule-inhibit-code-conversion conn))
227 (progn 226 conn))
228 (setq retry t
229 cur-retries (1+ cur-retries))
230 (sleep-for 0.5))
231 (setq cur-retries 0
232 retry (funcall url-confirmation-func
233 (concat "Connection to " host
234 " failed, retry? "))))
235 (kill-buffer (current-buffer)))))))
236 (if (not conn)
237 (error "Unable to connect to %s:%s" host service)
238 (mule-inhibit-code-conversion conn)
239 conn)))
240 227
241 (provide 'url-gw) 228 (provide 'url-gw)