Add autopackage Makefile.

[doldaconnect.git] / lib / guile / autodl

diff --git a/lib/guile/autodl b/lib/guile/autodl
index fef6b70..11a5a90 100755 (executable)
--- a/lib/guile/autodl
+++ b/lib/guile/autodl
@@ -62,7 +62,9 @@
 
 (define (wanttosearch)
   (> (- (current-time) lastsearch)
 
 (define (wanttosearch)
   (> (- (current-time) lastsearch)

-     (if (> (length trans) 0) 300 60))
+     (if (eq? (cdr (assoc 'search-mode session)) 'wait)
+        7200
+        (if (> (length trans) 0) 300 60)))

   )
 
 (define defspeed '())
   )
 
 (define defspeed '())


@@ -181,19 +183,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))))
                    (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))
                (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))))
                (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))
   )
 
                trans))
   )
 


@@ -206,7 +211,8 @@
                     (cons 'realsr info-numreal)
                     (cons 'totalsr info-numtotal)
                     (cons 'lastsrch lastsearch)
                     (cons 'realsr info-numreal)
                     (cons 'totalsr info-numtotal)
                     (cons 'lastsrch lastsearch)

-                    (cons 'srcheta info-searcheta))
+                    (cons 'srcheta info-searcheta)
+                    (cons 'srchmode (cdr (assoc 'search-mode session))))

               op)
        (newline op)
        (close-port op))))
               op)
        (newline op)
        (close-port op))))


@@ -315,10 +321,14 @@
     (set! info-numavail numavail)
     (set! info-numreal numreal)
     (set! info-numtotal numtotal)
     (set! info-numavail numavail)
     (set! info-numreal numreal)
     (set! info-numtotal numtotal)

+    (write-info-file)

     retval)
   )
 
 (define (handlesr filename fnet peer size slots resptime hash)
     retval)
   )
 
 (define (handlesr filename fnet peer size slots resptime hash)

+  (if (eq? (cdr (assoc 'search-mode session)) 'wait)
+      (begin (set-cdr! (assoc 'search-mode session) 'normal)
+            (logf "reverting to normal mode")))

   (let ((cl (or (assoc size sr)
                (let ((newp (cons size '()))) (set! sr (append sr (list newp))) newp)))
        (newsr (list
   (let ((cl (or (assoc size sr)
                (let ((newp (cons size '()))) (set! sr (append sr (list newp))) newp)))
        (newsr (list


@@ -371,11 +381,11 @@
 
 (define (autodl-main args)
   (let ((dc-server #f) (done #f) (retval 0))
 
 (define (autodl-main args)
   (let ((dc-server #f) (done #f) (retval 0))

-    (let ((getopt (make-getopt (cdr args) "hs:S:e:p:t:a:I:")) (arg #f))
+    (let ((getopt (make-getopt (cdr args) "whs:S:e:p:t:a:I:")) (arg #f))

       (do ((arg (getopt) (getopt))) ((not (and (pair? arg) (char? (car arg)))) (set! args arg))
        (cond ((eq? (car arg) #\h)
               (begin (display "usage: autodl [-s server] -S sessfile\n" (current-error-port))
       (do ((arg (getopt) (getopt))) ((not (and (pair? arg) (char? (car arg)))) (set! args arg))
        (cond ((eq? (car arg) #\h)
               (begin (display "usage: autodl [-s server] -S sessfile\n" (current-error-port))

-                     (display "       autodl [-s server] -e search-expression [-p prio] [-t tag] [-a userarg]\n" (current-error-port))
+                     (display "       autodl [-w] [-s server] -e search-expression [-p prio] [-t tag] [-a userarg]\n" (current-error-port))

                      (display "       autodl [-s server]\n" (current-error-port))
                      (display "       autodl -h\n" (current-error-port))
                      (exit 0)))
                      (display "       autodl [-s server]\n" (current-error-port))
                      (display "       autodl -h\n" (current-error-port))
                      (exit 0)))


@@ -401,6 +411,8 @@
                     (set! session (cons (cons 'info-file (cdr arg)) session)))))
              ((eq? (car arg) #\e)
               (set! session (cons (cons 'sexpr (dc-lexsexpr (cdr arg))) session)))
                     (set! session (cons (cons 'info-file (cdr arg)) session)))))
              ((eq? (car arg) #\e)
               (set! session (cons (cons 'sexpr (dc-lexsexpr (cdr arg))) session)))

+             ((eq? (car arg) #\w)
+              (set! session (cons '(search-mode . wait) session)))

              )
        )
       )
              )
        )
       )


@@ -409,6 +421,8 @@
        (set! session (cons '(prio . 10) session)))
     (if (not (assoc 'maxtrans session))
        (set! session (cons '(maxtrans . 1) session)))
        (set! session (cons '(prio . 10) session)))
     (if (not (assoc 'maxtrans session))
        (set! session (cons '(maxtrans . 1) session)))

+    (if (not (assoc 'search-mode session))
+       (set! session (cons '(search-mode . wait) session)))

     (if (not (validate-session session)) (begin (display "Invalid session!\n" (current-error-port)) (exit 1)))
     (if (not dc-server) (set! dc-server (getenv "DCSERVER")))
     (if (not dc-server) (set! dc-server "localhost"))
     (if (not (validate-session session)) (begin (display "Invalid session!\n" (current-error-port)) (exit 1)))
     (if (not dc-server) (set! dc-server (getenv "DCSERVER")))
     (if (not dc-server) (set! dc-server "localhost"))


@@ -435,7 +449,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)))
                               (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"))
                              ((501)
                               (begin (set! srchid -1)
                                      (logf (string-append "no fnetnodes available to search on"))


@@ -449,7 +464,6 @@
                    (if (> (- (current-time) lastparse) 20)
                        (begin (parseresults)
                               (set! lastparse (current-time))))
                    (if (> (- (current-time) lastparse) 20)
                        (begin (parseresults)
                               (set! lastparse (current-time))))

-                   (write-info-file)

                    (dc-select 10000)
                    (while (let ((resp (dc-getresp)))
                             (if resp
                    (dc-select 10000)
                    (while (let ((resp (dc-getresp)))
                             (if resp


@@ -493,13 +507,15 @@
                                           (let ((ires (dc-intresp resp)))
                                             (if (and ires (= (car ires) srchid))
                                                 (begin (set! info-searcheta (+ (current-time) (cadr ires)))
                                           (let ((ires (dc-intresp resp)))
                                             (if (and ires (= (car ires) srchid))
                                                 (begin (set! info-searcheta (+ (current-time) (cadr ires)))

-                                                       (logf (string-append "search rescheduled to T+" (number->string (cadr ires))))))))
+                                                       (logf (string-append "search rescheduled to T+" (number->string (cadr ires))))
+                                                       (write-info-file)))))

                                          ((621) ; Search committed
                                           (let ((ires (dc-intresp resp)))
                                             (if (and ires (= (car ires) srchid))
                                                 (begin (logf "search committed")
                                                        (set! info-searcheta 0)
                                          ((621) ; Search committed
                                           (let ((ires (dc-intresp resp)))
                                             (if (and ires (= (car ires) srchid))
                                                 (begin (logf "search committed")
                                                        (set! info-searcheta 0)

-                                                       (set! lastsearch (current-time))))))
+                                                       (set! lastsearch (current-time))
+                                                       (write-info-file)))))

                                          ((622) ; Search result
                                           (let ((ires (list->vector (dc-intresp resp))))
                                             (if (and ires (= (vector-ref ires 0) srchid)) (apply handlesr (map (lambda (n) (vector-ref ires n)) '(1 2 3 4 5 7 8))))))
                                          ((622) ; Search result
                                           (let ((ires (list->vector (dc-intresp resp))))
                                             (if (and ires (= (vector-ref ires 0) srchid)) (apply handlesr (map (lambda (n) (vector-ref ires n)) '(1 2 3 4 5 7 8))))))