Function: ange-ftp-fix-name-for-cms

ange-ftp-fix-name-for-cms is a byte-compiled function defined in ange-ftp.el.gz.

Signature

(ange-ftp-fix-name-for-cms NAME &optional REVERSE)

Source Code

;; Defined in /usr/src/emacs/lisp/net/ange-ftp.el.gz
;;;; ------------------------------------------------------------
;;;; CMS support
;;;; ------------------------------------------------------------

;; Since CMS doesn't have any full file name syntax, we have to fudge
;; things with cd's. We actually send too many cd's, but it's dangerous
;; to try to remember the current minidisk, because if the connection
;; is closed and needs to be reopened, we will find ourselves back in
;; the default minidisk. This is fairly likely since CMS ftp servers
;; usually close the connection after 5 minutes of inactivity.

;; Have I got the filename character set right?

(defun ange-ftp-fix-name-for-cms (name &optional reverse)
  (save-match-data
    (if reverse
	;; Since we only convert output from a pwd in this direction,
	;; we'll assume that it's a minidisk, and make it into a
	;; directory file name. Note that the expand-dir-hashtable
	;; stores directories without the trailing /. Is this
	;; consistent?
	(concat "/" name)
      (if (string-match "\\`/\\([-A-Z0-9$*._]+\\)/\\([-A-Z0-9$._]+\\)?\\'"
			name)
	  (let ((minidisk (match-string 1 name)))
	    (if (match-beginning 2)
		(let ((file (match-string 2 name))
		      (cmd (concat "cd " minidisk))

		      ;; Note that host and user are bound in the call
		      ;; to ange-ftp-send-cmd
		      (proc (ange-ftp-get-process ange-ftp-this-host
						  ange-ftp-this-user)))

		  ;; Must use ange-ftp-raw-send-cmd here to avoid
		  ;; an infinite loop.
		  (if (car (ange-ftp-raw-send-cmd proc cmd ange-ftp-this-msg))
		      file
		    ;; failed... try ONCE more.
		    (setq proc (ange-ftp-get-process ange-ftp-this-host
						     ange-ftp-this-user))
		    (let ((result (ange-ftp-raw-send-cmd proc cmd
							 ange-ftp-this-msg)))
		      (if (car result)
			  file
			;; failed.  give up.
			(ange-ftp-error ange-ftp-this-host ange-ftp-this-user
					(format "cd to minidisk %s failed: %s"
						minidisk (cdr result)))))))
	      ;; return the minidisk
	      minidisk))
	(error "Invalid CMS filename")))))