X-Git-Url: http://dolda2000.com/gitweb/?a=blobdiff_plain;f=lib%2Fguile%2Fautodl;h=62ccbf778ce9b5d2eae2af09871f80bb14417773;hb=c5de778c48b3e88bf710e58bf575ab719ab2b21b;hp=fef6b70e4ab1990df49b62c225c35a99ebd69d71;hpb=3b0de0fd382823328dd3bbd7439b72b7a7758b01;p=doldaconnect.git diff --git a/lib/guile/autodl b/lib/guile/autodl index fef6b70..62ccbf7 100755 --- a/lib/guile/autodl +++ b/lib/guile/autodl @@ -62,7 +62,9 @@ (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 '()) @@ -120,6 +122,10 @@ (if tag (set! args (append args (list "tag" (cdr tag)))))) (let ((uarg (assoc 'uarg session))) (if uarg (set! args (append args (list "user" (cdr uarg)))))) + (let ((xargs (assoc 'xargs session))) + (if xargs (for-each (lambda (o) + (set! args (append args (list (car o) (cdr o))))) + (cdr xargs)))) (set! resp (apply dc-ecmd-assert 200 args))) (let ((id (car (dc-intresp resp)))) (set! trans @@ -181,34 +187,37 @@ (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)) ) (define (write-info-file) (if (assoc 'info-file session) (let ((op (open-output-file (cdr (assoc 'info-file session))))) - (write (list (cons 'numdl (length trans)) - (cons 'lastdl lastdl) - (cons 'availsr info-numavail) - (cons 'realsr info-numreal) - (cons 'totalsr info-numtotal) - (cons 'lastsrch lastsearch) - (cons 'srcheta info-searcheta)) - op) - (newline op) + (pretty-print (list (cons 'numdl (length trans)) + (cons 'lastdl lastdl) + (cons 'availsr info-numavail) + (cons 'realsr info-numreal) + (cons 'totalsr info-numtotal) + (cons 'lastsrch lastsearch) + (cons 'srcheta info-searcheta) + (cons 'srchmode (cdr (assoc 'search-mode session)))) + op) (close-port op)))) (define (parseresults) @@ -315,10 +324,14 @@ (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) + (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 @@ -370,12 +383,12 @@ ) (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 ((dc-server #f) (done #f) (retval 0) (filterexit "")) + (let ((getopt (make-getopt (cdr args) "whs:S:e:p:t:a:I:E:x:")) (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)) - (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))) @@ -399,8 +412,19 @@ (let ((c (assoc 'info-file session))) (if c (set-cdr! c (cdr arg)) (set! session (cons (cons 'info-file (cdr arg)) session))))) + ((eq? (car arg) #\E) + (let ((c (assoc 'estat-file session))) + (if c (set-cdr! c (cdr arg)) + (set! session (cons (cons 'estat-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))) + ((eq? (car arg) #\x) + (let* ((c (assoc 'xargs session)) (p (string-index (cdr arg) #\=)) + (recons (cons (substring (cdr arg) 0 p) (substring (cdr arg) (1+ p))))) + (if c (set-cdr! c (cons recons (cdr c))) + (set! session (cons (cons 'xargs (list recons)) session))))) ) ) ) @@ -409,6 +433,8 @@ (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 . normal) 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")) @@ -418,7 +444,7 @@ (lambda (key . args) (logf (string-append "could not connect to server: " (apply format #f (cadr args) (caddr args)))) (exit 2))) - (dc-ecmd-assert 200 "notify" "all" "on") + (dc-ecmd-assert 200 "notify" "trans:act" "on" "trans:prog" "on" "srch:act" "on") (for-each (lambda (sig) (sigaction sig (lambda (sig) (throw 'sig sig)))) (list SIGINT SIGTERM SIGHUP)) (catch 'sig (lambda () @@ -435,7 +461,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 +476,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 @@ -483,9 +509,10 @@ (let* ((ires (dc-intresp resp)) (tr (and ires (assoc (car ires) trans)))) (if tr (begin (if (eq? (cdr (assoc 'state (cdr tr))) 'done) - (begin (logf (string-append "transfer " (number->string (car ires)) " done")) + (begin (logf (string-append "transfer " (number->string (car ires)) " done (" (cadr ires) ")")) (set! trans (assq-remove! trans (car ires))) (set! done #t) + (set! filterexit (cadr ires)) (throw 'sig 0)) (begin (logf (string-append "transfer " (number->string (car ires)) " disappeared")) (set! trans (assq-remove! trans (car ires))))))))) @@ -493,13 +520,15 @@ (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) - (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)))))) @@ -542,6 +571,11 @@ ))) (lambda (key sig) (logf "forcing quit"))) + (if (assoc 'estat-file session) + (let ((op (open-output-file (cdr (assoc 'estat-file session))))) + (display filterexit op) + (newline op) + (close-port op))) (exit retval) ) )