660
|
1 ;;; ftp.el --- file input and output over Internet using FTP
|
|
2
|
845
|
3 ;; Copyright (C) 1987 Free Software Foundation, Inc.
|
|
4
|
793
|
5 ;; Author: Richard Mlynarik <mly@prep.ai.mit.edu>
|
64
|
6
|
|
7 ;; This file is part of GNU Emacs.
|
|
8
|
|
9 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
10 ;; it under the terms of the GNU General Public License as published by
|
807
|
11 ;; the Free Software Foundation; either version 2, or (at your option)
|
64
|
12 ;; any later version.
|
|
13
|
|
14 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
17 ;; GNU General Public License for more details.
|
|
18
|
|
19 ;; You should have received a copy of the GNU General Public License
|
|
20 ;; along with GNU Emacs; see the file COPYING. If not, write to
|
|
21 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
22
|
807
|
23 ;;; Code:
|
|
24
|
64
|
25 ;; Prevent changes in major modes from altering these variables.
|
|
26 (put 'ftp-temp-file-name 'permanent-local t)
|
|
27 (put 'ftp-file 'permanent-local t)
|
|
28 (put 'ftp-host 'permanent-local t)
|
|
29
|
|
30 ;; you can turn this off by doing
|
|
31 ;; (setq ftp-password-alist 'compulsory-urinalysis)
|
|
32 (defvar ftp-password-alist () "Security sucks")
|
|
33
|
|
34 (defun read-ftp-user-password (host user new)
|
|
35 (let (tem)
|
|
36 (if (and (not new)
|
|
37 (listp ftp-password-alist)
|
|
38 (setq tem (cdr (assoc host ftp-password-alist)))
|
|
39 (or (null user)
|
|
40 (string= user (car tem))))
|
|
41 tem
|
|
42 (or user
|
|
43 (progn
|
|
44 (setq tem (or (and (listp ftp-password-alist)
|
|
45 (car (cdr (assoc host ftp-password-alist))))
|
|
46 (user-login-name)))
|
|
47 (setq user (read-string (format
|
|
48 "User-name for %s (default \"%s\"): "
|
|
49 host tem)))
|
|
50 (if (equal user "") (setq user tem))))
|
|
51 (setq tem (cons user
|
|
52 ;; If you want to use some non-echoing string-reader,
|
|
53 ;; feel free to write it yourself. I don't care enough.
|
|
54 (read-string (format "Password for %s@%s: " user host)
|
|
55 (if (not (listp ftp-password-alist))
|
|
56 ""
|
|
57 (or (cdr (cdr (assoc host ftp-password-alist)))
|
|
58 (let ((l ftp-password-alist))
|
|
59 (catch 'foo
|
|
60 (while l
|
|
61 (if (string= (car (cdr (car l))) user)
|
|
62 (throw 'foo (cdr (cdr (car l))))
|
|
63 (setq l (cdr l))))
|
|
64 nil))
|
|
65 "")))))
|
|
66 (message "")
|
|
67 (if (and (listp ftp-password-alist)
|
|
68 (not (string= (cdr tem) "")))
|
|
69 (setq ftp-password-alist (cons (cons host tem)
|
|
70 ftp-password-alist)))
|
|
71 tem)))
|
|
72
|
|
73 (defun ftp-read-file-name (prompt)
|
|
74 (let ((s ""))
|
|
75 (while (not (string-match "\\`[ \t]*\\([^ \t:]+\\)[ \t]*:\\(.+\\)\\'" s))
|
|
76 (setq s (read-string prompt s)))
|
|
77 (list (substring s (match-beginning 1) (match-end 1))
|
|
78 (substring s (match-beginning 2) (match-end 2)))))
|
|
79
|
|
80
|
318
|
81 ;;;###autoload
|
64
|
82 (defun ftp-find-file (host file &optional user password)
|
|
83 "FTP to HOST to get FILE, logging in as USER with password PASSWORD.
|
|
84 Interactively, HOST and FILE are specified by reading a string with
|
|
85 a colon character separating the host from the filename.
|
|
86 USER and PASSWORD are defaulted from the values used when
|
|
87 last ftping from HOST (unless password-remembering is disabled).
|
|
88 Supply a password of the symbol `t' to override this default
|
|
89 (interactively, this is done by giving a prefix arg)"
|
|
90 (interactive
|
|
91 (append (ftp-read-file-name "FTP get host:file: ")
|
|
92 (list nil (not (null current-prefix-arg)))))
|
|
93 (ftp-find-file-or-directory host file t user password))
|
|
94
|
318
|
95 ;;;###autoload
|
64
|
96 (defun ftp-list-directory (host file &optional user password)
|
|
97 "FTP to HOST to list DIRECTORY, logging in as USER with password PASSWORD.
|
|
98 Interactively, HOST and FILE are specified by reading a string with
|
|
99 a colon character separating the host from the filename.
|
|
100 USER and PASSWORD are defaulted from the values used when
|
|
101 last ftping from HOST (unless password-remembering is disabled).
|
|
102 Supply a password of the symbol `t' to override this default
|
|
103 (interactively, this is done by giving a prefix arg)"
|
|
104 (interactive
|
|
105 (append (ftp-read-file-name "FTP get host:directory: ")
|
|
106 (list nil (not (null current-prefix-arg)))))
|
|
107 (ftp-find-file-or-directory host file nil user password))
|
|
108
|
|
109 (defun ftp-find-file-or-directory (host file filep &optional user password)
|
|
110 "FTP to HOST to get FILE. Third arg is t for file, nil for directory.
|
|
111 Log in as USER with PASSWORD. If USER is nil or PASSWORD is nil or t,
|
|
112 we prompt for the user name and password."
|
|
113 (or (and user password (not (eq password t)))
|
|
114 (progn (setq user (read-ftp-user-password host user (eq password t))
|
|
115 password (cdr user)
|
|
116 user (car user))))
|
|
117 (let ((buffer (get-buffer-create (format "*ftp%s %s:%s*"
|
|
118 (if filep "" "-directory")
|
|
119 host file))))
|
|
120 (set-buffer buffer)
|
|
121 (let ((process nil)
|
|
122 (case-fold-search nil))
|
|
123 (let ((win nil))
|
|
124 (unwind-protect
|
|
125 (progn
|
|
126 (setq process (ftp-setup-buffer host file))
|
|
127 (if (setq win (ftp-login process host user password))
|
|
128 (message "Logged in")
|
|
129 (error "Ftp login failed")))
|
|
130 (or win (and process (delete-process process)))))
|
|
131 (message "Opening %s %s:%s..." (if filep "file" "directory")
|
|
132 host file)
|
|
133 (if (ftp-command process
|
|
134 (format "%s \"%s\" -\nquit\n" (if filep "get" "dir")
|
|
135 file)
|
|
136 "\\(150\\|125\\).*\n"
|
|
137 "200.*\n")
|
|
138 (progn (forward-line 1)
|
|
139 (let ((buffer-read-only nil))
|
|
140 (delete-region (point-min) (point)))
|
|
141 (message "Retrieving %s:%s in background. Bye!" host file)
|
|
142 (set-process-sentinel process
|
|
143 'ftp-asynchronous-input-sentinel)
|
|
144 process)
|
|
145 (switch-to-buffer buffer)
|
|
146 (let ((buffer-read-only nil))
|
|
147 (insert-before-markers "<<<Ftp lost>>>"))
|
|
148 (delete-process process)
|
|
149 (error "Ftp %s:%s lost" host file)))))
|
|
150
|
|
151
|
318
|
152 ;;;###autoload
|
64
|
153 (defun ftp-write-file (host file &optional user password)
|
|
154 "FTP to HOST to write FILE, logging in as USER with password PASSWORD.
|
|
155 Interactively, HOST and FILE are specified by reading a string with colon
|
|
156 separating the host from the filename.
|
|
157 USER and PASSWORD are defaulted from the values used when
|
318
|
158 last ftping from HOST (unless `password-remembering' is disabled).
|
64
|
159 Supply a password of the symbol `t' to override this default
|
|
160 (interactively, this is done by giving a prefix arg)"
|
|
161 (interactive
|
|
162 (append (ftp-read-file-name "FTP write host:file: ")
|
|
163 (list nil (not (null current-prefix-arg)))))
|
|
164 (or (and user password (not (eq password t)))
|
|
165 (progn (setq user (read-ftp-user-password host user (eq password t))
|
|
166 password (cdr user)
|
|
167 user (car user))))
|
|
168 (let ((buffer (get-buffer-create (format "*ftp %s:%s*" host file)))
|
|
169 (tmp (make-temp-name "/tmp/emacsftp")))
|
|
170 (write-region (point-min) (point-max) tmp)
|
|
171 (save-excursion
|
|
172 (set-buffer buffer)
|
|
173 (make-local-variable 'ftp-temp-file-name)
|
|
174 (setq ftp-temp-file-name tmp)
|
|
175 (let ((process (ftp-setup-buffer host file))
|
|
176 (case-fold-search nil))
|
|
177 (let ((win nil))
|
|
178 (unwind-protect
|
|
179 (if (setq win (ftp-login process host user password))
|
|
180 (message "Logged in")
|
|
181 (error "Ftp login lost"))
|
|
182 (or win (delete-process process))))
|
|
183 (message "Opening file %s:%s..." host file)
|
|
184 (if (ftp-command process
|
|
185 (format "send \"%s\" \"%s\"\nquit\n" tmp file)
|
318
|
186 "\\(150\\|125\\).*\n"
|
64
|
187 "200.*\n")
|
|
188 (progn (forward-line 1)
|
|
189 (setq foo1 (current-buffer))
|
|
190 (let ((buffer-read-only nil))
|
|
191 (delete-region (point-min) (point)))
|
|
192 (message "Saving %s:%s in background. Bye!" host file)
|
|
193 (set-process-sentinel process
|
|
194 'ftp-asynchronous-output-sentinel)
|
|
195 process)
|
|
196 (switch-to-buffer buffer)
|
|
197 (setq foo2 (current-buffer))
|
|
198 (let ((buffer-read-only nil))
|
|
199 (insert-before-markers "<<<Ftp lost>>>"))
|
|
200 (delete-process process)
|
|
201 (error "Ftp write %s:%s lost" host file))))))
|
|
202
|
|
203
|
|
204 (defun ftp-setup-buffer (host file)
|
|
205 (fundamental-mode)
|
|
206 (and (get-buffer-process (current-buffer))
|
|
207 (progn (discard-input)
|
|
208 (if (y-or-n-p (format "Kill process \"%s\" in %s? "
|
|
209 (process-name (get-buffer-process
|
|
210 (current-buffer)))
|
|
211 (buffer-name (current-buffer))))
|
|
212 (while (get-buffer-process (current-buffer))
|
|
213 (kill-process (get-buffer-process (current-buffer))))
|
|
214 (error "Foo"))))
|
|
215 ;(buffer-disable-undo (current-buffer))
|
|
216 (setq buffer-read-only nil)
|
|
217 (erase-buffer)
|
|
218 (make-local-variable 'ftp-host)
|
|
219 (setq ftp-host host)
|
|
220 (make-local-variable 'ftp-file)
|
|
221 (setq ftp-file file)
|
|
222 (setq foo3 (current-buffer))
|
|
223 (setq buffer-read-only t)
|
|
224 (start-process "ftp" (current-buffer) "ftp" "-i" "-n" "-g"))
|
|
225
|
|
226
|
|
227 (defun ftp-login (process host user password)
|
|
228 (message "FTP logging in as %s@%s..." user host)
|
|
229 (if (ftp-command process
|
|
230 (format "open %s\nuser %s %s\n" host user password)
|
|
231 "230.*\n"
|
|
232 "\\(Connected to \\|220\\|331\\|Remote system type\\|Using.*mode\\|Remember to set\\).*\n")
|
|
233 t
|
|
234 (switch-to-buffer (process-buffer process))
|
|
235 (delete-process process)
|
|
236 (if (listp ftp-password-alist)
|
|
237 (setq ftp-password-alist (delq (assoc host ftp-password-alist)
|
|
238 ftp-password-alist)))
|
|
239 nil))
|
|
240
|
|
241 (defun ftp-command (process command win ignore)
|
|
242 (process-send-string process command)
|
|
243 (let ((p 1))
|
|
244 (while (numberp p)
|
|
245 (cond ;((not (bolp)))
|
318
|
246 ((looking-at "^[0-9]+-")
|
|
247 (while (not (re-search-forward "^[0-9]+ " nil t))
|
|
248 (save-excursion
|
|
249 (accept-process-output process)))
|
|
250 (beginning-of-line))
|
64
|
251 ((looking-at win)
|
|
252 (goto-char (point-max))
|
|
253 (setq p t))
|
|
254 ((looking-at "^ftp> \\|^\n")
|
|
255 (goto-char (match-end 0)))
|
|
256 ((looking-at ignore)
|
318
|
257 ;; Ignore status messages whose codes indicate no problem.
|
64
|
258 (forward-line 1))
|
633
|
259 ((looking-at "^[^0-9]")
|
|
260 ;; Ignore any lines that don't have status codes.
|
|
261 (forward-line 1))
|
64
|
262 ((not (search-forward "\n" nil t))
|
81
|
263 ;; the way asynchronous process-output works with (point)
|
64
|
264 ;; is really really disgusting.
|
|
265 (setq p (point))
|
|
266 (condition-case ()
|
|
267 (accept-process-output process)
|
|
268 (error nil))
|
|
269 (goto-char p))
|
|
270 (t
|
|
271 (setq p nil))))
|
|
272 p))
|
|
273
|
|
274
|
|
275 (defun ftp-asynchronous-input-sentinel (process msg)
|
|
276 (ftp-sentinel process msg t t))
|
|
277 (defun ftp-synchronous-input-sentinel (process msg)
|
|
278 (ftp-sentinel process msg nil t))
|
|
279 (defun ftp-asynchronous-output-sentinel (process msg)
|
|
280 (ftp-sentinel process msg t nil))
|
|
281 (defun ftp-synchronous-output-sentinel (process msg)
|
|
282 (ftp-sentinel process msg nil nil))
|
|
283
|
|
284 (defun ftp-sentinel (process msg asynchronous input)
|
|
285 (cond ((null (buffer-name (process-buffer process)))
|
|
286 ;; deleted buffer
|
|
287 (set-process-buffer process nil))
|
|
288 ((and (eq (process-status process) 'exit)
|
|
289 (= (process-exit-status process) 0))
|
|
290 (save-excursion
|
|
291 (set-buffer (process-buffer process))
|
|
292 (let (msg
|
|
293 (r (if input "[0-9]+ bytes received in [0-9]+\\.[0-9]+ seconds.*$" "[0-9]+ bytes sent in [0-9]+\\.[0-9]+ seconds.*$")))
|
318
|
294 (goto-char (point-max))
|
|
295 (search-backward "226 ")
|
|
296 (if (looking-at r)
|
|
297 (search-backward "226 "))
|
|
298 (let ((p (point)))
|
|
299 (setq msg (concat (format "ftp %s %s:%s done"
|
|
300 (if input "read" "write")
|
|
301 ftp-host ftp-file)
|
|
302 (if (re-search-forward r nil t)
|
|
303 (concat ": " (buffer-substring
|
|
304 (match-beginning 0)
|
|
305 (match-end 0)))
|
|
306 "")))
|
|
307 (delete-region p (point-max))
|
|
308 (save-excursion
|
|
309 (set-buffer (get-buffer-create "*ftp log*"))
|
|
310 (let ((buffer-read-only nil))
|
|
311 (insert msg ?\n))))
|
64
|
312 ;; Note the preceding let must end here
|
|
313 ;; so it doesn't cross the (kill-buffer (current-buffer)).
|
|
314 (if (not input)
|
|
315 (progn
|
|
316 (condition-case ()
|
|
317 (and (boundp 'ftp-temp-file-name)
|
|
318 ftp-temp-file-name
|
|
319 (delete-file ftp-temp-file-name))
|
|
320 (error nil))
|
|
321 ;; Kill the temporary buffer which the ftp process
|
|
322 ;; puts its output in.
|
|
323 (kill-buffer (current-buffer)))
|
|
324 ;; You don't want to look at this.
|
|
325 (let ((kludge (generate-new-buffer (format "%s:%s (ftp)"
|
|
326 ftp-host ftp-file))))
|
|
327 (setq kludge (prog1 (buffer-name kludge) (kill-buffer kludge)))
|
|
328 (rename-buffer kludge)
|
|
329 ;; ok, you can look again now.
|
|
330 (set-buffer-modified-p nil)
|
|
331 (ftp-setup-write-file-hooks)))
|
|
332 (if (and asynchronous
|
|
333 ;(waiting-for-user-input-p)
|
|
334 )
|
|
335 (progn (message "%s" msg)
|
|
336 (sleep-for 2))))))
|
|
337 ((memq (process-status process) '(exit signal))
|
|
338 (save-excursion
|
|
339 (set-buffer (process-buffer process))
|
|
340 (setq msg (format "Ftp died (buffer %s): %s"
|
|
341 (buffer-name (current-buffer))
|
|
342 msg))
|
|
343 (let ((buffer-read-only nil))
|
|
344 (goto-char (point-max))
|
|
345 (insert ?\n ?\n msg))
|
|
346 (delete-process proc)
|
|
347 (set-buffer (get-buffer-create "*ftp log*"))
|
|
348 (let ((buffer-read-only nil))
|
|
349 (goto-char (point-max))
|
|
350 (insert msg))
|
|
351 (if (waiting-for-user-input-p)
|
|
352 (error "%s" msg))))))
|
|
353
|
|
354 (defun ftp-setup-write-file-hooks ()
|
|
355 (let ((hooks write-file-hooks))
|
|
356 (make-local-variable 'write-file-hooks)
|
|
357 (setq write-file-hooks (append write-file-hooks
|
|
358 '(ftp-write-file-hook))))
|
|
359 (make-local-variable 'revert-buffer-function)
|
|
360 (setq revert-buffer-function 'ftp-revert-buffer)
|
|
361 (setq default-directory "/tmp/")
|
|
362 (setq buffer-file-name (concat default-directory
|
|
363 (make-temp-name
|
|
364 (buffer-name (current-buffer)))))
|
|
365 (setq buffer-read-only nil))
|
|
366
|
|
367 (defun ftp-write-file-hook ()
|
|
368 (let ((process (ftp-write-file ftp-host ftp-file)))
|
|
369 (set-process-sentinel process 'ftp-synchronous-output-sentinel)
|
|
370 (message "FTP writing %s:%s..." ftp-host ftp-file)
|
|
371 (while (eq (process-status process) 'run)
|
|
372 (condition-case ()
|
|
373 (accept-process-output process)
|
|
374 (error nil)))
|
|
375 (set-buffer-modified-p nil)
|
|
376 (message "FTP writing %s:%s...done" ftp-host ftp-file))
|
|
377 t)
|
|
378
|
|
379 (defun ftp-revert-buffer (&rest ignore)
|
|
380 (let ((process (ftp-find-file ftp-host ftp-file)))
|
|
381 (set-process-sentinel process 'ftp-synchronous-input-sentinel)
|
|
382 (message "FTP reverting %s:%s" ftp-host ftp-file)
|
|
383 (while (eq (process-status process) 'run)
|
|
384 (condition-case ()
|
|
385 (accept-process-output process)
|
|
386 (error nil)))
|
|
387 (and (eq (process-status process) 'exit)
|
|
388 (= (process-exit-status process) 0)
|
|
389 (set-buffer-modified-p nil))
|
|
390 (message "Reverted")))
|
660
|
391
|
|
392 ;;; ftp.el ends here
|