Function: ange-ftp-guess-host-type

ange-ftp-guess-host-type is a byte-compiled function defined in ange-ftp.el.gz.

Signature

(ange-ftp-guess-host-type HOST USER)

Documentation

Guess the host type of HOST.

Works by doing a pwd and examining the directory syntax.

Source Code

;; Defined in /usr/src/emacs/lisp/net/ange-ftp.el.gz
(defun ange-ftp-guess-host-type (host user)
  "Guess the host type of HOST.
Works by doing a pwd and examining the directory syntax."
  (let ((host-type (ange-ftp-host-type host))
	(key (concat host "/" user "/~")))
    (if (eq host-type 'unix)
	;; Note that ange-ftp-host-type returns unix as the default value.
	(save-match-data
	  (let* ((result (ange-ftp-get-pwd host user))
		 (dir (car result))
		 fix-name-func)
	    (cond ((null dir)
		   (message "Warning! Unable to get home directory")
		   (sit-for 1)
		   (if (string-match
			"^450 No current working directory defined$"
			(cdr result))

		       ;; We'll assume that if pwd bombs with this
		       ;; error message, then it's CMS.
		       (progn
			 (ange-ftp-add-cms-host host)
			 (setq ange-ftp-host-cache host
			       ange-ftp-host-type-cache 'cms))))

		  ;; try for VMS
		  ((string-match ange-ftp-vms-name-template dir)
		   (ange-ftp-add-vms-host host)
		   ;; The add-host functions clear the host type cache.
		   ;; Therefore, need to set the cache afterwards.
		   (setq ange-ftp-host-cache host
			 ange-ftp-host-type-cache 'vms))

		  ;; try for MTS
		  ((string-match ange-ftp-mts-name-template dir)
		   (ange-ftp-add-mts-host host)
		   (setq ange-ftp-host-cache host
			 ange-ftp-host-type-cache 'mts))

		  ;; try for CMS
		  ((string-match ange-ftp-cms-name-template dir)
		   (ange-ftp-add-cms-host host)
		   (setq ange-ftp-host-cache host
			 ange-ftp-host-type-cache 'cms))

		  ;; try for BS2000-POSIX
		  ((ange-ftp-bs2000-posix-host host)
		   (ange-ftp-add-bs2000-host host)
		   (setq ange-ftp-host-cache host
			 ange-ftp-host-type-cache 'text-unix))
		  ;; try for BS2000
		  ((and (string-match ange-ftp-bs2000-name-template dir)
			(not (ange-ftp-bs2000-posix-host host)))
		   (ange-ftp-add-bs2000-host host)
		   (setq ange-ftp-host-cache host
			 ange-ftp-host-type-cache 'bs2000))
		  ;; assume UN*X
		  (t
		   (setq ange-ftp-host-cache host
			 ange-ftp-host-type-cache 'unix)))

	    ;; Now that we have done a pwd, might as well put it in
	    ;; the expand-dir hashtable.
	    (let ((ange-ftp-this-user user)
		  (ange-ftp-this-host host))
	      (setq fix-name-func (cdr (assq ange-ftp-host-type-cache
					     ange-ftp-fix-name-func-alist)))
	      (if fix-name-func
		  (setq dir (funcall fix-name-func dir 'reverse))))
	    (puthash key dir ange-ftp-expand-dir-hashtable))))

    ;; In the special case of CMS make sure that know the
    ;; expansion of the home minidisk now, because we will
    ;; be doing a lot of cd's.
    (if (and (eq host-type 'cms)
	     (not (ange-ftp-hash-entry-exists-p
		   key ange-ftp-expand-dir-hashtable)))
	(let ((dir (car (ange-ftp-get-pwd host user))))
	  (if dir
	      (puthash key (concat "/" dir) ange-ftp-expand-dir-hashtable)
	    (message "Warning! Unable to get home directory")
	    (sit-for 1))))))