Commit | Line | Data |
---|---|---|
1a06eabd ER |
1 | ;;; ftp.el --- file input and output over Internet using FTP |
2 | ||
d76c2808 | 3 | ;; Copyright (C) 1987 Free Software Foundation, Inc. |
d76c2808 | 4 | |
9750e079 ER |
5 | ;; Author: Richard Mlynarik <mly@prep.ai.mit.edu> |
6 | ||
d76c2808 JA |
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 | |
e5167999 | 11 | ;; the Free Software Foundation; either version 2, or (at your option) |
d76c2808 JA |
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 | ||
e5167999 ER |
23 | ;;; Code: |
24 | ||
d76c2808 JA |
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 | ||
c888bcc3 | 81 | ;;;###autoload |
d76c2808 JA |
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 | ||
c888bcc3 | 95 | ;;;###autoload |
d76c2808 JA |
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 | \f | |
c888bcc3 | 152 | ;;;###autoload |
d76c2808 JA |
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 | |
c888bcc3 | 158 | last ftping from HOST (unless `password-remembering' is disabled). |
d76c2808 JA |
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) | |
c888bcc3 | 186 | "\\(150\\|125\\).*\n" |
d76c2808 JA |
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 | \f | |
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))) | |
c888bcc3 JB |
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)) | |
d76c2808 JA |
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) | |
c888bcc3 | 257 | ;; Ignore status messages whose codes indicate no problem. |
d76c2808 | 258 | (forward-line 1)) |
bc98c79c RS |
259 | ((looking-at "^[^0-9]") |
260 | ;; Ignore any lines that don't have status codes. | |
261 | (forward-line 1)) | |
d76c2808 | 262 | ((not (search-forward "\n" nil t)) |
5859cd33 | 263 | ;; the way asynchronous process-output works with (point) |
d76c2808 JA |
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.*$"))) | |
c888bcc3 JB |
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)))) | |
d76c2808 JA |
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"))) | |
1a06eabd ER |
391 | |
392 | ;;; ftp.el ends here |