Re: Ftp freezes on w32

[Lennart Borgman]

Eli Zaretskii wrote:
> > Date: Wed, 08 Nov 2006 08:20:45 +0100
> > From: Lennart Borgman <address@hidden>
> > CC:  address@hidden,  address@hidden,  address@hidden
> >     
> > > I think it's not a good idea to have changes in your version that are
> > > not in the official code base.
> > >   
> > >       
> > So what is your suggestion?
> >     
>
> Either convince us to install your changes in the CVS, or wait with
> the change until after the release and get it into CVS then.
>   

Ok. My main argument is that I can find no way to get ange-ftp to work 
on w2k (at least on my pc) without something like this patch. The patch 
is also quite general in its structure so it can perhaps be used for 
other problems with the ftp process.

And it is quite small. In the attached patch I did not remove my trace 
functions. They should of course not be there in the final version.
Index: ange-ftp.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/net/ange-ftp.el,v
retrieving revision 1.80
diff -u -r1.80 ange-ftp.el
--- ange-ftp.el 6 Feb 2006 11:33:04 -0000       1.80
+++ ange-ftp.el 11 Nov 2006 14:22:59 -0000
@@ -1641,10 +1641,43 @@
 ;; Build up a complete line of output from the ftp PROCESS and pass it
 ;; on to ange-ftp-process-handle-line to deal with.
 
+(defvar ange-ftp-proc-trace nil)
+(defvar ange-ftp-proc-trace-on nil)
+;;(setq ange-ftp-proc-trace-on t) <-
+(defun ange-ftp-add-to-proc-trace(str)
+  (when ange-ftp-proc-trace-on
+    (setq ange-ftp-proc-trace (cons str ange-ftp-proc-trace))))
+(defun ange-ftp-show-proc-trace()
+  (interactive)
+  (let ((buf (get-buffer-create "ange-ftp-proc-trace")))
+    (with-current-buffer buf
+      (erase-buffer)
+      (insert (format "%s" (apply 'concat ange-ftp-proc-trace))))
+    (switch-to-buffer-other-window buf)))
+
 (defun ange-ftp-process-filter (proc str)
   ;; Eliminate nulls.
-  (while (string-match "\000+" str)
-    (setq str (replace-match "" nil nil str)))
+  ;;
+  ;; Also check if the ftp process seems ok.  If it is not ok throw
+  ;; `ange-ftp-proc-defunct' which will be caught by
+  ;; `ange-ftp-raw-send' that will then restart the ftp process.
+  ;;
+  ;; On w32 when the ftp program from gnu
+  ;; (ftp://ftp.gnu.org/old-gnu/emacs/windows/contrib/ftp-for-win32.zip)
+  ;; is used Emacs will read a string consisting of only nulls after
+  ;; the ftp program has timed out.  The only way I have found to cure
+  ;; this is to delete the ftp process.
+  (ange-ftp-add-to-proc-trace (format "str=%s\n" str))
+  (let ((str-len (length str)))
+    (while (string-match "\000+" str)
+      (setq str (replace-match "" nil nil str)))
+    (when (and (boundp 'ange-ftp-check-proc-ok)
+               ange-ftp-check-proc-ok
+               (cond ((eq system-type 'windows-nt)
+                      (and
+                       (= 0 (length str))
+                       (< 20 str-len)))))
+      (throw 'ange-ftp-proc-defunct t)))
 
   ;; see if the buffer is still around... it could have been deleted.
   (when (buffer-live-p (process-buffer proc))
@@ -2277,7 +2310,9 @@
        (ange-ftp-this-user user)
        (ange-ftp-this-host host)
        (ange-ftp-this-msg msg)
-       cmd2 cmd3 host-type fix-name-func result)
+       cmd2 cmd3 host-type fix-name-func result
+        (sent-sts nil)
+        (sent-res nil))
 
     (cond
 
@@ -2365,37 +2400,55 @@
                      (and cmd2 (concat " " cmd2))))
 
     ;; Actually send the resulting command.
-    (if (and (consp result) (null (car result)))
-       ;; `ange-ftp-cd' has failed, so there's no point sending `cmd'.
-       result
-      (let (afsc-result
-           afsc-line)
-       (ange-ftp-raw-send-cmd
-        (ange-ftp-get-process host user)
-        cmd
-        msg
-        (list (lambda (result line host user cmd msg cont nowait)
-                (or cont (setq afsc-result result
-                               afsc-line line))
-                (if result (ange-ftp-call-cont cont result line)
-                   (ange-ftp-raw-send-cmd
-                    (ange-ftp-get-process host user)
-                    cmd
-                    msg
-                    (list (lambda (result line cont)
-                            (or cont (setq afsc-result result
-                                           afsc-line line))
-                            (ange-ftp-call-cont cont result line))
-                          cont)
-                   nowait)))
-              host user cmd msg cont nowait)
-        nowait)
-
-       (if nowait
-           nil
-         (if cont
-             nil
-           (cons afsc-result afsc-line)))))))
+    (while (memq sent-sts '(nil tried))
+      (when (eq sent-sts 'tried)
+        ;; Delete ftp process if send failed before, it will be
+        ;; restarted by `ange-ftp-get-process'.
+        (message "Ftp process possibly defunct, deleting it ...")
+        (ange-ftp-add-to-proc-trace "\n********* DEFUNCT killing ftp 
process\\n")
+        (let* ((proc (ange-ftp-get-process host user))
+               (delete-exited-processes t))
+          (delete-process proc)))
+      (if (and (consp result) (null (car result)))
+          ;; `ange-ftp-cd' has failed, so there's no point sending `cmd'.
+          (progn
+            (setq sent-res result)
+            (setq sent-sts 'failed))
+        (let (afsc-result
+              afsc-line
+              (ange-ftp-check-proc-ok (not nowait)))
+          (catch 'ange-ftp-proc-defunct
+            (setq sent-sts 'tried)
+            ;; May throw 'ange-ftp-proc-defunct:
+            (ange-ftp-add-to-proc-trace (format "cmd=%s\n" cmd))
+            (ange-ftp-raw-send-cmd
+             (ange-ftp-get-process host user)
+             cmd
+             msg
+             (list (lambda (result line host user cmd msg cont nowait)
+                     (or cont (setq afsc-result result
+                                    afsc-line line))
+                     (if result (ange-ftp-call-cont cont result line)
+                       (ange-ftp-raw-send-cmd
+                        (ange-ftp-get-process host user)
+                        cmd
+                        msg
+                        (list (lambda (result line cont)
+                                (or cont (setq afsc-result result
+                                               afsc-line line))
+                                (ange-ftp-call-cont cont result line))
+                              cont)
+                        nowait)))
+                   host user cmd msg cont nowait)
+             nowait)
+
+            (setq sent-sts 'ok)
+            (if nowait
+                (setq sent-res nil)
+              (if cont
+                  (setq sent-res nil)
+                (setq sent-res (cons afsc-result afsc-line))))))))
+    sent-res))
 
 ;; It might be nice to message users about the host type identified,
 ;; but there is so much other messaging going on, it would not be