From: fredrik Date: Thu, 23 Nov 2006 01:15:52 +0000 (+0000) Subject: Upgrade logf to use format. X-Git-Tag: 0.3~154 X-Git-Url: http://dolda2000.com/gitweb/?p=doldaconnect.git;a=commitdiff_plain;h=c6cc011bad4e662c651a5ca9c30944b042ae240a Upgrade logf to use format. git-svn-id: svn+ssh://svn.dolda2000.com/srv/svn/repos/src/doldaconnect@769 959494ce-11ee-0310-bf91-de5d638817bd --- diff --git a/lib/guile/autodl b/lib/guile/autodl index 62ccbf7..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)) @@ -141,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)) ) @@ -170,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)) @@ -184,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))) @@ -221,12 +215,9 @@ (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 () @@ -245,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) @@ -253,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 '())) @@ -268,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))) @@ -279,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) @@ -291,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) @@ -309,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))))))))) @@ -442,7 +432,7 @@ (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" "trans:act" "on" "trans:prog" "on" "srch:act" "on") (for-each (lambda (sig) (sigaction sig (lambda (sig) (throw 'sig sig)))) (list SIGINT SIGTERM SIGHUP)) @@ -459,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") @@ -494,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)))) @@ -509,18 +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 (" (cadr ires) ")")) + (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))) @@ -546,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))) )