Updated with hash related strings.
[doldaconnect.git] / lib / guile / autodl
index f57423f..3d2a340 100755 (executable)
                      (cadr (cdr (assoc 'peer sr)))
                      (cdr (assoc 'filename sr))
                      (cdr (assoc 'size sr)))))
+      (let ((hash (assoc 'hash sr)))
+       (if (and hash (not (equal? (cdr hash) ""))) (set! args (append args (list "hash" (cdr hash))))))
       (let ((tag (assoc 'tag session)))
        (if tag (set! args (append args (list "tag" (cdr tag))))))
       (let ((uarg (assoc 'uarg session)))
                    (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))
   )
 
     (set! info-numavail numavail)
     (set! info-numreal numreal)
     (set! info-numtotal numtotal)
+    (write-info-file)
     retval)
   )
 
-(define (handlesr filename fnet peer size slots resptime)
+(define (handlesr filename fnet peer size slots resptime hash)
   (let ((cl (or (assoc size sr)
                (let ((newp (cons size '()))) (set! sr (append sr (list newp))) newp)))
        (newsr (list
                (cons 'slots slots)
                (cons 'resptime resptime)
                (cons 'speed (getspeed peer))
+               (cons 'hash hash)
                (cons 'recvtime (current-time))
                (cons 'dis #f)))
        (newlist '()))
                               (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"))
                    (if (> (- (current-time) lastparse) 20)
                        (begin (parseresults)
                               (set! lastparse (current-time))))
-                   (write-info-file)
                    (dc-select 10000)
                    (while (let ((resp (dc-getresp)))
                             (if resp
                                                        (set! lastsearch (current-time))))))
                                          ((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))))))
+                                            (if (and ires (= (vector-ref ires 0) srchid)) (apply handlesr (map (lambda (n) (vector-ref ires n)) '(1 2 3 4 5 7 8))))))
                                          
                                          )
                                        )