Function: ffap-machine-p

ffap-machine-p is a byte-compiled function defined in ffap.el.gz.

Signature

(ffap-machine-p HOST &optional SERVICE QUIET STRATEGY)

Documentation

Decide whether HOST is the name of a real, reachable machine.

Depending on the domain (none, known, or unknown), follow the strategy named by the variable ffap-machine-p-local, ffap-machine-p-known, or ffap-machine-p-unknown. Pinging uses open-network-stream. Optional SERVICE specifies the port used (default "discard"). Optional QUIET flag suppresses the "Pinging..." message. Optional STRATEGY overrides the three variables above. Returned values:
 t means that HOST answered.
accept means the relevant variable told us to accept.
"mesg" means HOST exists, but does not respond for some reason.

Source Code

;; Defined in /usr/src/emacs/lisp/ffap.el.gz
(defun ffap-machine-p (host &optional service quiet strategy)
  "Decide whether HOST is the name of a real, reachable machine.
Depending on the domain (none, known, or unknown), follow the strategy
named by the variable `ffap-machine-p-local', `ffap-machine-p-known',
or `ffap-machine-p-unknown'.  Pinging uses `open-network-stream'.
Optional SERVICE specifies the port used (default \"discard\").
Optional QUIET flag suppresses the \"Pinging...\" message.
Optional STRATEGY overrides the three variables above.
Returned values:
 t       means that HOST answered.
`accept' means the relevant variable told us to accept.
\"mesg\"   means HOST exists, but does not respond for some reason."
  ;; Try some (Emory local):
  ;; (ffap-machine-p "ftp" nil nil 'ping)
  ;; (ffap-machine-p "nonesuch" nil nil 'ping)
  ;; (ffap-machine-p "ftp.mathcs.emory.edu" nil nil 'ping)
  ;; (ffap-machine-p "mathcs" 5678 nil 'ping)
  ;; (ffap-machine-p "foo.bonk" nil nil 'ping)
  ;; (ffap-machine-p "foo.bonk.com" nil nil 'ping)
  (if (or (string-match "[^-[:alnum:].]" host) ; Invalid chars (?)
	  (not (string-match "[^0-9]" host))) ; 1: a number? 2: quick reject
      nil
    (let* ((domain
	    (and (string-match "\\.[^.]*$" host)
		 (downcase (substring host (1+ (match-beginning 0))))))
	   (what-domain (if domain (ffap-what-domain domain) "Local")))
      (or strategy
	  (setq strategy
		(cond ((not domain) ffap-machine-p-local)
		      ((not what-domain) ffap-machine-p-unknown)
		      (t ffap-machine-p-known))))
      (cond
       ((eq strategy 'accept) 'accept)
       ((eq strategy 'reject) nil)
       ((not (fboundp 'open-network-stream)) nil)
       ;; assume (eq strategy 'ping)
       (t
	(or quiet
	    (if (stringp what-domain)
		(message "Pinging %s (%s)..." host what-domain)
	      (message "Pinging %s ..." host)))
	(condition-case error
	    (progn
	      (delete-process
	       (open-network-stream
		"ffap-machine-p" nil host (or service "discard")))
	      t)
	  (error
	   (let ((mesg (car (cdr error))))
	     (cond
	      ;; v18:
	      ((string-match "\\(^Unknown host\\|Name or service not known$\\)"
			     mesg) nil)
	      ((string-match "not responding$" mesg) mesg)
	      ;; v19:
              ;; (file-error "Connection failed" "permission denied"
	      ;;             "nonesuch" "ffap-machine-p")
              ;; (file-error "Connection failed" "host is unreachable"
	      ;;	     "gopher.house.gov" "ffap-machine-p")
              ;; (file-error "Connection failed" "address already in use"
	      ;;	     "ftp.uu.net" "ffap-machine-p")
	      ((equal mesg "connection failed")
	       (if (string= (downcase (nth 2 error)) "permission denied")
		   nil			; host does not exist
		 ;; Other errors mean the host exists:
		 (nth 2 error)))
	      ;; Could be "Unknown service":
	      (t (signal (car error) (cdr error))))))))))))