efs-mac.el and diffs to efs package 1.14
Jeff Morgenthaler (jpmorgen@wisp4.physics.wisc.edu)
Tue, 02 May 95 11:12:30 -0500
Well, here is some code that gets efs-1.14 up and running smoothly for
Peter's FTP 2.4.0 on a mac running system 7.5. I had to hack into the
UNIX listing functions pretty deep to get it to auto-recognize, since
the mac listing resembles UNIX so much. You might not like where I
ended up putting it, though it has not broken standard UNIX efs for
me. I also had to define a stand-alone function "efs-macbinary" that
sends a "quote site h (e|d)" to the ftpd which gets it to add or not
add .hqx to the filenames in directory listings. The .hqx extension
and a binary transfer type is a hint to the ftpd to BinHex the entire
file as it sends it, rather than just send the data fork of the file
in the current file transfer mode. This is a nice way of doing
things, since you don't have to define all kinds of new transfer
types. I put in hashtable entries and defined extensions in
efs-binary-file-name-regexp for all the possible file forks so people
can get parts of files at least one file at a time. I also put in
(hopefully helpful) doc strings and messages.
Enjoy your new teaching position. I hope to end up doing the same
thing some day myself.
jpm
Jeff Morgenthaler Research assistant
Wisconsin Space Physics Department of Physics
jpmorgen@wisp4.physics.wisc.edu University of Wisconsin--Madison
;; -*-Emacs-Lisp-*-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; File: efs-mac.el
;; Release:
;; Version: 1.0
;; RCS:
;; Description: Macintosh support for efs
;; Author: Jeff Morgenthaler <jpmorgen@wisp4.physics.wisc.edu>
;; Created: Fri Apr 28 09:27:38 1995
;; Modified:
;; Language: Emacs-Lisp
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; This file is part of efs. See efs.el for copyright
;;; (it's copylefted) and warrranty (there isn't one) information.
(provide 'efs-mac)
(require 'efs)
(defconst efs-mac-version
(concat (substring "$efs release: 1.14 $" 14 -2)
"/"
(substring "$Revision: 1.0 $" 11 -2)))
;;;-----------------------------------------------------------------
;;; Mac support for efs
;;;-----------------------------------------------------------------
;;; Efs support for Peter's ftp deamon version 2.4.0 System 7.5.
;;; Apple has announced that this ftp server will be bundled with it's
;;; TCP/IP software.
(efs-defun efs-parse-listing mac
(host user dir path &optional switches)
;; Parse the current buffer which is assumed to be a macintosh listing
;; HOST = remote host name
;; USER = remote user name
;; DIR = directory as a full remote path
;; PATH = directory in full efs-path syntax
(let ((tbl (efs-make-hashtable))
file ressize datasize totalsize dir-p modes)
(efs-save-match-data
;; Can we check somehow if the listing is really for something
;; that doesn't exist?
(goto-char (point-min))
(while (looking-at efs-mac-listing-regexp)
(let ((eol (save-excursion (end-of-line) (point)))
(size 0))
(setq modes (buffer-substring (match-beginning 1)
(match-end 1))
dir-p (eq (string-to-char modes) ?d))
(efs-save-match-data
(re-search-forward efs-month-and-time-regexp eol t)
(setq file (buffer-substring (point) eol)
totalsize (string-to-int (buffer-substring
(match-beginning 1)
(match-end 1)))))
(if dir-p
(efs-put-hash-entry file (list dir-p totalsize modes) tbl)
;; Plain mac files have 2 "forks," resource and data
;; Binary transfers specified with no extension get the
;; data fork with .rsrc get the resource fork and with .bin
;; get both forks concatinated in the special macbinary
;; format.
(setq ressize (string-to-int (buffer-substring
(match-beginning 2)
(match-end 2)))
datasize (string-to-int (buffer-substring
(match-beginning 3)
(match-end 3))))
;; Put all possible file names in so the user can chose easily
(efs-put-hash-entry file
(list dir-p datasize modes) tbl) ; data fork
(efs-put-hash-entry (concat file ".bin") ;macbinary whole file
(list dir-p totalsize modes) tbl)
(efs-put-hash-entry (concat file ".hqx") ;binhex whole file
(list dir-p totalsize modes) tbl)
(efs-put-hash-entry (concat file ".info")
(list dir-p ressize modes) tbl)
(efs-put-hash-entry (concat file ".rsrc") ; macbinary resource fork
(list dir-p ressize modes) tbl)
(efs-put-hash-entry (concat file ".data") ; macbinary data fork
(list dir-p ressize modes) tbl))
(forward-line 1)))
(efs-put-hash-entry "." '(t) tbl)
(efs-put-hash-entry ".." '(t) tbl)
tbl)))
(defvar efs-macbinary-flag nil
"Flag to indicate whether or not the mac ftpd has been told to add .hqx
to all the files in directory listings.")
(defun efs-macbinary (arg host user)
"Send the command \"quote site h e\" to the macintosh ftp deamon so
that it appends a .hqx to all filenames \(you might have to use \"g\"
in the dired buffer to refresh the directory listing\). This causes
the files marked in dired to be transfered in BinHex format. When
called again interactively, issues \"quote site h d,\" disabling the
addition of .hqx to file names. The data fork of marked files will
then be transfered in the current transfer mode. This means that by
default, you can easily grab README files when you first log on. To
explicitly transfer the info header, data fork, resource fork, or raw
binary image \(unBinHexed\) of any file, just append .info, .data,
.rsrc, or .bin to the filename in the minibuffer. Filename completion
has been enabled for all these extensions. This command must be
issued for each host."
(interactive
(let ((name (or (buffer-file-name)
(and (eq major-mode 'dired-mode)
dired-directory))))
(list
(if current-prefix-arg
;; If an argument is specified, then turn on if non-negative else
;; turn off if negative.
(>= (prefix-numeric-value current-prefix-arg) 0)
;; If no argument is specified, then toggle.
'toggle)
(read-string "Host: "
(and name (car (efs-ftp-path name))))
(read-string "User: "
(and name (nth 1 (efs-ftp-path name)))))))
(setq host (downcase host))
(setq efs-macbinary-flag
(if (eq arg 'toggle)
(not efs-macbinary-flag)
arg))
(if efs-macbinary-flag
(efs-send-cmd host user (list 'quote 'site 'h "e")
"Telling mac ftpd to append .hqx to filenames.")
(efs-send-cmd host user (list 'quote 'site 'h "d")
"Telling mac ftpd not to append .hqx to filenames."))
(sit-for 2)
(message "Remember to relist directories.")
(sit-for 2))
;; Give user a pointer to the documentation for macbinary transfers
;; when the file loads.
(message "Type C-h f efs-macbinary for information about macbinary mode.")
(sit-for 2)
************************************
Jeff's diffs from efs 1.14
*** Makefile.orig Sun Nov 27 15:19:43 1994
--- Makefile Fri Apr 28 13:30:31 1995
***************
*** 95,101 ****
dired-cmpr.elc dired-diff.elc dired-help.elc dired-sex.elc
EFSOBJS = $(COREOBJS) efs-auto.elc \
efs-cms.elc efs-cms-knet.elc efs-dos-distinct.elc efs-nos-ve.elc \
! efs-gwp.elc efs-hell.elc efs-ka9q.elc \
efs-mpe.elc efs-mts.elc efs-mvs.elc efs-netware.elc \
efs-pc.elc efs-ti-explorer.elc efs-ti-twenex.elc \
efs-tops-20.elc efs-dl.elc efs-guardian.elc efs-coke.elc \
--- 95,101 ----
dired-cmpr.elc dired-diff.elc dired-help.elc dired-sex.elc
EFSOBJS = $(COREOBJS) efs-auto.elc \
efs-cms.elc efs-cms-knet.elc efs-dos-distinct.elc efs-nos-ve.elc \
! efs-gwp.elc efs-hell.elc efs-ka9q.elc efs-mac.elc\
efs-mpe.elc efs-mts.elc efs-mvs.elc efs-netware.elc \
efs-pc.elc efs-ti-explorer.elc efs-ti-twenex.elc \
efs-tops-20.elc efs-dl.elc efs-guardian.elc efs-coke.elc \
***************
*** 171,176 ****
--- 171,177 ----
efs-gwp.elc: efs-gwp.el
efs-hell.elc: efs-hell.el
efs-ka9q.elc: efs-ka9q.el
+ efs-mac.elc: efs-mac.el
efs-mpe.elc: efs-mpe.el
efs-mts.elc: efs-mts.el
efs-mvs.elc: efs-mvs.el
***************
*** 217,222 ****
--- 218,224 ----
gwp: core efs-gwp.elc
hell: core efs-hell.elc
ka9q: core efs-ka9q.elc
+ mac: core efs-mac.elc
mpe: core efs-mpe.elc
mts: core efs-mts.elc
mvs: core efs-mvs.elc
*** efs-cu.el.orig Wed Nov 16 13:07:33 1994
--- efs-cu.el Fri Apr 28 14:03:50 1995
***************
*** 145,151 ****
(defvar efs-mvs-host-regexp nil
"Regexp to match names of hosts running MVS.")
(defvar efs-tops-20-host-regexp nil
! "Regexp to match names of hosts runninf TOPS-20.")
(defvar efs-mpe-host-regexp nil
"Regexp to match hosts running the MPE operating system.")
(defvar efs-ka9q-host-regexp nil
--- 145,153 ----
(defvar efs-mvs-host-regexp nil
"Regexp to match names of hosts running MVS.")
(defvar efs-tops-20-host-regexp nil
! "Regexp to match names of hosts running TOPS-20.")
! (defvar efs-mac-host-regexp nil
! "Regexp to match names of hosts that are macintoshes.")
(defvar efs-mpe-host-regexp nil
"Regexp to match hosts running the MPE operating system.")
(defvar efs-ka9q-host-regexp nil
***************
*** 198,203 ****
--- 200,206 ----
(apollo-unix . efs-apollo-unix-host-regexp)
(unix . efs-unix-host-regexp)
(vms . efs-vms-host-regexp)
+ (mac . efs-mac-host-regexp)
(mts . efs-mts-host-regexp)
(cms . efs-cms-host-regexp)
(ti-explorer . efs-ti-explorer-host-regexp)
*** efs.el.orig Wed Nov 16 13:07:34 1994
--- efs.el Tue May 2 09:46:39 1995
***************
*** 1059,1064 ****
--- 1059,1065 ----
(defconst efs-listing-types
'(unix:dl unix:unknown
dos:novell dos:ftp dos:ncsa dos:microsoft dos:stcp dos:winsock
+ mac
mvs:nih mvs:tcp mvs:tcp
vms:full)
"List of supported listing types")
***************
*** 1234,1240 ****
(concat "\\." ; the dot
;; extensions
"\\([zZ]\\|t?gz\\|lzh\\|arc\\|zip\\|zoo\\|ta[rz]\\|dvi\\|sit\\|"
! "ps\\|elc\\|gif\\|Z-part-..\\|tpz\\|exe\\|[jm]pg\\|TZ[a-z]?\\|lib\\)"
"\\(~\\|~[0-9]+~\\)?$" ; backups
"\\|"
;; UPPER CASE LAND
--- 1235,1242 ----
(concat "\\." ; the dot
;; extensions
"\\([zZ]\\|t?gz\\|lzh\\|arc\\|zip\\|zoo\\|ta[rz]\\|dvi\\|sit\\|"
! "ps\\|elc\\|gif\\|Z-part-..\\|tpz\\|exe\\|[jm]pg\\|TZ[a-z]?\\|lib"
! "\\|data\\|rsrc\\|bin\\|hqx\\|info\\)" ; macbinary land
"\\(~\\|~[0-9]+~\\)?$" ; backups
"\\|"
;; UPPER CASE LAND
***************
*** 3870,3880 ****
((eq cmd1 'site)
;; SITE commands
(cond
! ((memq cmd2 '(umask idle dos exec nfs group gpass))
;; For UMASK cmd3 = value of umask
;; For IDLE cmd3 = idle setting, or nil if we're querying.
;; For DOS and NFS cmd3 is nil.
;; For EXEC cmd3 is the command to be exec'ed -- a string.
(if cmd3 (setq cmd3 (concat " " cmd3)))
(setq cmd-string (concat "quote site " (symbol-name cmd2)
cmd3)))
--- 3872,3883 ----
((eq cmd1 'site)
;; SITE commands
(cond
! ((memq cmd2 '(umask idle dos exec nfs group gpass h))
;; For UMASK cmd3 = value of umask
;; For IDLE cmd3 = idle setting, or nil if we're querying.
;; For DOS and NFS cmd3 is nil.
;; For EXEC cmd3 is the command to be exec'ed -- a string.
+ ;; For H (macbinary add .hqx) cmd3 is e or d (enable/disable)
(if cmd3 (setq cmd3 (concat " " cmd3)))
(setq cmd-string (concat "quote site " (symbol-name cmd2)
cmd3)))
***************
*** 6019,6024 ****
--- 6022,6035 ----
(used-F (and switches (string-match "F" switches)))
(old-tbl (efs-get-files-hashtable-entry path))
file-type symlink directory file size modes nlinks owner)
+ ;; Check for Macintosh, since it's listing is only subtly different from
+ ;; unix
+ (if (re-search-forward efs-mac-listing-regexp nil t)
+ (progn
+ (efs-add-host 'mac host)
+ (efs-add-listing-type 'mac host user)
+ (beginning-of-line)
+ (efs-parse-listing 'mac host user dir path))
(while (setq file (efs-ls-parse-file-line))
(setq size (nth 1 file)
modes (nth 2 file)
***************
*** 6115,6121 ****
(forward-line 1))
(efs-put-hash-entry "." '(t) tbl)
(efs-put-hash-entry ".." '(t) tbl)
! tbl))
(efs-defun efs-parse-listing nil (host user dir path &optional switches)
;; Parse the a listing which is assumed to be from some type of unix host.
--- 6126,6132 ----
(forward-line 1))
(efs-put-hash-entry "." '(t) tbl)
(efs-put-hash-entry ".." '(t) tbl)
! tbl))) ;extra paraen
(efs-defun efs-parse-listing nil (host user dir path &optional switches)
;; Parse the a listing which is assumed to be from some type of unix host.
***************
*** 6287,6292 ****
--- 6298,6319 ----
;;; Regexps for host and listing type guessing from the listing syntax.
+ (defconst efs-mac-listing-regexp
+ (concat
+ "\\([^ ][-r][-w][^ ][-r][-w][^ ][-r][-w][^ ] +\\)"
+ "\\(folder +\\|\\([0-9]+ +\\)\\([0-9]+ +\\)\\)"
+ efs-month-and-time-regexp))
+
+ ; What I want to say is drwxr-x---regexp + ((3 numbers) or "folder" +
+ ; number)) + date + time + filename
+
+ ;----r----- 5091 9542 14633 Apr 27 10:46 Geometric Factor
+ ;---r----- 0 7330 7330 Apr 27 15:39 Preliminary Calibration
+ ;----r----- 0 17059 17059 Apr 24 13:07 Window Transmission
+ ;drwxr-x--- folder 3 Apr 24 12:21 B3R
+ ;drwxr-x--- folder 2 Apr 24 12:21 Cold Plate
+ ;drwxr-x--- folder 2 Apr 24 12:21 Correspondence
+
(defconst efs-ka9q-listing-regexp
(concat
"^\\([0-9,.]+\\|No\\) files\\. [0-9,.]+ bytes free\\. "
***************
*** 10507,10512 ****
--- 10534,10540 ----
(efs-autoload 'efs-send-pwd coke "efs-coke")
;; A few packages are loaded by the listing parser.
+ (efs-autoload 'efs-parse-listing mac "efs-mac")
(efs-autoload 'efs-parse-listing ka9q "efs-ka9q")
(efs-autoload 'efs-parse-listing unix:dl "efs-dl")
(efs-autoload 'efs-parse-listing dos-distinct "efs-dos-distinct")
***************
*** 10521,10526 ****
--- 10549,10558 ----
(efs-autoload 'efs-internal-file-exists-p guardian "efs-guardian")
(efs-autoload 'efs-internal-file-directory-p guardian "efs-guardian")
+ ;; Autoloads for special functions
+ (autoload 'efs-macbinary "efs-mac"
+ "Flag to indicate whether or not the mac ftpd has been told to add .hqx
+ to all the files in directory listings." t)