(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))
(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))
)
(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))
(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)))
(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 ()
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)
(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 '()))
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)))
(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)
(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)
(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)))))))))
(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))
(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")
((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))))
(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)))
)
)
(lambda (key sig)
- (logf (string-append "interrupted by signal " (number->string sig)))
+ (logf "interrupted by signal ~a" sig)
(if (not done)
(set! retval 1)))
)
Dolda2000 GitWeb / doldaconnect.git / commitdiff