Sparse out write-info-file.

git-svn-id: svn+ssh://svn.dolda2000.com/srv/svn/repos/src/doldaconnect@421 959494ce-11ee-0310-bf91-de5d638817bd

diff --git a/lib/guile/autodl b/lib/guile/autodl
index fef6b70..3d2a340 100755 (executable)
--- a/lib/guile/autodl
+++ b/lib/guile/autodl
@@ -181,19 +181,22 @@
                    (begin (logf (string-append "transfer " (number->string (car o)) " timing out"))
                           (dc-ecmd-assert 200 "cancel" (car o))
                           (disablepeer (cdr (assoc 'peer (cdr o))))
-                          (set! trans (assq-remove! trans (car o)))))
+                          (set! trans (assq-remove! trans (car o)))
+                          (write-info-file)))
                (if (and (eq? (cdr (assoc 'state (cdr o))) 'main)
                         (> (- time (cdr (assoc 'lastprog (cdr o)))) 60))
                    (begin (logf (string-append "transfer " (number->string (car o)) " seems to have stalled"))
                           (dc-ecmd-assert 200 "cancel" (car o))
-                          (set! trans (assq-remove! trans (car o)))))
+                          (set! trans (assq-remove! trans (car o)))
+                          (write-info-file)))
                (if (and (eq? (cdr (assoc 'state (cdr o))) 'main)
                         (> (- (cdr (assoc 'lastprog (cdr o))) (cdr (assoc 'lasttime (cdr o)))) 20))
                    (begin (set-cdr! (assoc 'curspeed (cdr o))
                                     (/ (- (cdr (assoc 'curpos (cdr o))) (cdr (assoc 'lastpos (cdr o))))
                                        (- (cdr (assoc 'lastprog (cdr o))) (cdr (assoc 'lasttime (cdr o))))))
                           (set-cdr! (assoc 'lastpos (cdr o)) (cdr (assoc 'curpos (cdr o))))
-                          (set-cdr! (assoc 'lasttime (cdr o)) (cdr (assoc 'lastprog (cdr o)))))))
+                          (set-cdr! (assoc 'lasttime (cdr o)) (cdr (assoc 'lastprog (cdr o))))
+                          (write-info-file))))
                trans))
   )
 
@@ -315,6 +318,7 @@
     (set! info-numavail numavail)
     (set! info-numreal numreal)
     (set! info-numtotal numtotal)
+    (write-info-file)
     retval)
   )
 
@@ -435,7 +439,8 @@
                               (begin (set! srchid (car ires))
                                      (logf (string-append "search scheduled in " (number->string (cadr ires)) " seconds (id " (number->string srchid) ")"))
                                      (set! info-searcheta (+ (current-time) (cadr ires)))
-                                     (set! lastsearch -1)))
+                                     (set! lastsearch -1)
+                                     (write-info-file)))
                              ((501)
                               (begin (set! srchid -1)
                                      (logf (string-append "no fnetnodes available to search on"))
@@ -449,7 +454,6 @@
                    (if (> (- (current-time) lastparse) 20)
                        (begin (parseresults)
                               (set! lastparse (current-time))))
-                   (write-info-file)
                    (dc-select 10000)
                    (while (let ((resp (dc-getresp)))
                             (if resp