X-Git-Url: http://git.dolda2000.com/gitweb/?a=blobdiff_plain;f=lib%2Fguile%2Fautodl;h=d752f1588edb2ad8412500b2ea567b5fe5337160;hb=c6cc011bad4e662c651a5ca9c30944b042ae240a;hp=fe454e8db6fe00be18156df616b0bc8dcf072ae6;hpb=d9d1283ed0a42621e9cb76ee63e2dbd3a8227cca;p=doldaconnect.git diff --git a/lib/guile/autodl b/lib/guile/autodl index fe454e8..d752f15 100755 --- a/lib/guile/autodl +++ b/lib/guile/autodl @@ -17,8 +17,8 @@ (define dpeers '()) (define lastdl 0) -(define (logf msg) - (write-line msg (current-output-port)) +(define (logf fmt . msg) + (apply format (cons* (current-output-port) (string-append fmt "\n") msg)) (catch 'system-error (lambda () (fsync (current-output-port))) (lambda (key . err) #f)) @@ -122,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 @@ -137,19 +141,13 @@ (cons 'lasttime (current-time)) (cons 'lastprog (current-time)))) trans)) - (logf (string-append "downloading " - (cdr (assoc 'filename sr)) - " from " - (cadr (cdr (assoc 'peer sr))) - ", " - (number->string (cdr (assoc 'size sr))) - " bytes (id " - (number->string id) - ", " - (number->string (cdr (assoc 'slots sr))) - " slots), timing out in " - (number->string (max 10 (* (cdr (assoc 'resptime sr)) 2))) - " seconds")))) + (logf "downloading ~a from ~a, ~a bytes (id ~a, ~a slots), timing out in ~a seconds" + (cdr (assoc 'filename sr)) + (cadr (cdr (assoc 'peer sr))) + (number->string (cdr (assoc 'size sr))) + (number->string id) + (number->string (cdr (assoc 'slots sr))) + (number->string (max 10 (* (cdr (assoc 'resptime sr)) 2)))))) (set! lastdl (current-time)) ) @@ -166,7 +164,7 @@ (set! newglist (cons (cons (car g) (sort newlist sr-less?)) newglist))))) sr) (set! sr (sort newglist srg-less?)) - (logf (string-append "disabled " (cadr peer) " and removed " (number->string numrem) " search results"))) + (logf "disabled ~a and removed ~a search results" (cadr peer) numrem)) (let* ((dpa (assoc peer dpeers)) (dp (and (pair? dpa) (cdr dpa)))) (if dp (set-cdr! (assoc 'time dp) (current-time)) @@ -180,14 +178,14 @@ (for-each (lambda (o) (if (and (memq (cdr (assoc 'state (cdr o))) '(wait hs)) (> (- time (cdr (assoc 'lastprog (cdr o)))) (max 10 (* (cdr (assoc 'resptime (cdr o))) 2)))) - (begin (logf (string-append "transfer " (number->string (car o)) " timing out")) + (begin (logf "transfer ~a timing out" (car o)) (dc-ecmd-assert 200 "cancel" (car o)) (disablepeer (cdr (assoc 'peer (cdr 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")) + (begin (logf "transfer ~a seems to have stalled" (car o)) (dc-ecmd-assert 200 "cancel" (car o)) (set! trans (assq-remove! trans (car o))) (write-info-file))) @@ -205,25 +203,21 @@ (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) - (cons 'srchmode (cdr (assoc 'search-mode session)))) - 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) - (logf (string-append "entering parseresults with " - (number->string - (apply + (map (lambda (o) (length (cdr o))) sr))) - " results in " - (number->string (length sr)) - " sizes")) + (logf "entering parseresults with ~a results in ~a sizes" + (apply + (map (lambda (o) (length (cdr o))) sr)) + (number->string (length sr))) (let ((retval #t) (numreal 0) (numtotal 0) (numavail 0)) (catch 'ret (lambda () @@ -242,7 +236,7 @@ sr) (set! sr (sort newglist srg-less?)) (if (> countrem 0) - (logf (string-append "removed " (number->string countrem) " time-outed results and " (number->string numrem) " entire sizes")))) + (logf "removed ~a time-outed results and ~a entire sizes" countrem numrem))) (let ((numrem 0) (newlist '())) (for-each (lambda (o) (if (> (- (current-time) (cdr (assoc 'time o))) 1800) @@ -250,7 +244,7 @@ (set! newlist (cons o newlist)))) dpeers) (set! dpeers newlist) - (logf (string-append "re-enabled " (number->string numrem) " disabled users"))) + (logf "re-enabled ~a disabled users" numrem)) (let ((numrem 0) (countrem 0) (newglist '())) (for-each (lambda (g) (let ((newlist '())) @@ -265,7 +259,7 @@ sr) (set! sr (sort newglist srg-less?)) (if (> countrem 0) - (logf (string-append "removed " (number->string countrem) " results with disabled peers and " (number->string numrem) " entire sizes")))) + (logf "removed ~a results with disabled peers and ~a entire sizes" countrem numrem))) (and (eq? sr '()) (throw 'ret #f)) (set! numtotal (apply + (map (lambda (o) (length (cdr o))) sr))) (let* ((maxsize (apply max (map (lambda (o) (length (cdr o))) sr))) @@ -276,7 +270,7 @@ (set! numrem (+ numrem 1))))) sr) (if (> countrem 0) - (logf (string-append "will disregard " (number->string countrem) " results from " (number->string numrem) " sizes due to popularity lack"))) + (logf "will disregard ~a results from ~a sizes due to popularity lack" countrem numrem)) (set! numreal (- numtotal countrem))) (let ((numrem 0) (numrrem 0)) (for-each (lambda (g) @@ -288,7 +282,7 @@ (cdr g))) sr) (if (> numrem 0) - (logf (string-append (number->string numrem) " results had no slots"))) + (logf "~a results had no slots" numrem)) (set! numavail (- numreal numrrem))) (for-each (lambda (g) (if (>= (length (cdr g)) minsize) @@ -306,9 +300,8 @@ (if (and (cdr (assoc 'curspeed tr)) (not (equal? (cdr (assoc 'peer sr)) (cdr (assoc 'peer tr)))) (> (- (or (cdr (assoc 'speed sr)) (defspeed sr)) (cdr (assoc 'curspeed tr))) 10000)) - (begin (logf (string-append "abandoning transfer " - (number->string (cdr (assoc 'id tr))) - " for possible faster sender")) + (begin (logf "abandoning transfer ~a for possible faster sender" + (cdr (assoc 'id tr))) (dc-ecmd-assert 200 "cancel" (cdr (assoc 'id tr))) (set! trans (assq-remove! trans (cdr (assoc 'id tr)))) (download sr))))))))) @@ -326,6 +319,9 @@ ) (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 @@ -377,8 +373,8 @@ ) (define (autodl-main args) - (let ((dc-server #f) (done #f) (retval 0)) - (let ((getopt (make-getopt (cdr args) "whs: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)) @@ -406,10 +402,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))))) ) ) ) @@ -419,7 +424,7 @@ (if (not (assoc 'maxtrans session)) (set! session (cons '(maxtrans . 1) session))) (if (not (assoc 'search-mode session)) - (set! session (cons '(search-mode . wait) 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")) @@ -427,9 +432,9 @@ (lambda () (dc-c&l #t dc-server #t)) (lambda (key . args) - (logf (string-append "could not connect to server: " (apply format #f (cadr args) (caddr args)))) + (logf "could not connect to server: ~a" (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 () @@ -444,13 +449,15 @@ (case (cdr (assoc 'code eres)) ((200) (begin (set! srchid (car ires)) - (logf (string-append "search scheduled in " (number->string (cadr ires)) " seconds (id " (number->string srchid) ")")) + (logf "search scheduled in ~a seconds (id ~a)" + (number->string (cadr ires)) + (number->string srchid)) (set! info-searcheta (+ (current-time) (cadr ires))) (set! lastsearch -1) (write-info-file))) ((501) (begin (set! srchid -1) - (logf (string-append "no fnetnodes available to search on")) + (logf "no fnetnodes available to search on") (set! lastsearch (current-time)))) ((509) (begin (logf "illegal search expression") @@ -479,7 +486,7 @@ ((614) ; Transfer error (let ((ires (dc-intresp resp))) (if (and ires (assoc (car ires) trans)) - (begin (logf (string-append "transfer " (number->string (car ires)) " encountered error " (number->string (cadr ires)))) + (begin (logf "transfer ~a encountered error ~a" (car ires) (cadr ires)) (dc-ecmd-assert 200 "cancel" (car ires)) (let ((tr (cdr (assoc (car ires) trans)))) (disablepeer (cdr (assoc 'peer tr)))) @@ -494,17 +501,18 @@ (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 "transfer ~a done (~a)" (car ires) (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")) + (begin (logf "transfer ~a disappeared" (car ires)) (set! trans (assq-remove! trans (car ires))))))))) ((620) ; Search rescheduled (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 "search rescheduled to T+~a" (cadr ires)) (write-info-file))))) ((621) ; Search committed (let ((ires (dc-intresp resp))) @@ -515,9 +523,6 @@ (write-info-file))))) ((622) ; Search result (let ((ires (list->vector (dc-intresp resp)))) - (if (eq? (cdr (assoc 'search-mode session)) 'wait) - (begin (set-cdr! (assoc 'search-mode session) 'normal) - (logf "reverting to normal mode"))) (if (and ires (= (vector-ref ires 0) srchid)) (apply handlesr (map (lambda (n) (vector-ref ires n)) '(1 2 3 4 5 7 8)))))) ) @@ -533,7 +538,7 @@ ) ) (lambda (key sig) - (logf (string-append "interrupted by signal " (number->string sig))) + (logf "interrupted by signal ~a" sig) (if (not done) (set! retval 1))) ) @@ -558,6 +563,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) ) )