Updated Gaim plugin info.
[doldaconnect.git] / lib / guile / autodl
CommitLineData
d3372da9 1#!/usr/bin/guile -s
2!#
3
4(use-modules (dolcon ui))
5(use-modules (ice-9 pretty-print))
6
7(define sr '())
8(define lastsearch 0)
9(define info-searcheta 0)
10(define info-numavail 0)
11(define info-numreal 0)
12(define info-numtotal 0)
13(define lastparse 0)
14(define srchid -1)
15(define session '())
16(define trans '())
17(define dpeers '())
18(define lastdl 0)
e6485bff 19(define logport (current-output-port))
20(define infoport #f)
d3372da9 21
c6cc011b 22(define (logf fmt . msg)
e6485bff 23 (if logport
24 (begin
25 (apply format (cons* logport (string-append fmt "\n") msg))
26 (catch 'system-error (lambda ()
27 (fsync logport))
28 (lambda (key . err) #f))))
29 )
30
30806d5e 31(define (infomsg fmt . msg)
e6485bff 32 (if infoport
33 (begin
34 (apply format (cons* infoport (string-append fmt "\n") msg))
35 (catch 'system-error (lambda ()
36 (fsync infoport))
37 (lambda (key . err) #f))))
d3372da9 38 )
39
40(define (make-getopt opts optdesc)
41 (let ((arg opts) (curpos 0) (rest '()))
42 (lambda ()
43 (if (eq? arg '()) rest
44 (let ((ret #f))
45 (while (not ret)
46 (if (= curpos 0)
47 (if (eq? (string-ref (car arg) 0) #\-)
48 (set! curpos 1)
49 (begin
50 (set! rest (append rest (list (car arg))))
51 (set! arg (cdr arg))
52 (if (eq? arg '())
53 (set! ret #t)))))
54 (if (> curpos 0)
55 (if (< curpos (string-length (car arg)))
56 (begin (set! ret (string-ref (car arg) curpos)) (set! curpos (+ curpos 1)))
57 (begin (set! curpos 0) (set! arg (cdr arg)) (if (eq? arg '()) (set! ret #t))))))
58 (if (eq? ret #t) rest
59 (let ((opt (string-index optdesc ret)))
60 (if (eq? opt #f) (throw 'illegal-option ret)
61 (if (and (< opt (- (string-length optdesc) 1)) (eq? (string-ref optdesc (+ opt 1)) #\:))
62 (let ((ret
63 (cons ret (let ((optarg
64 (if (< curpos (string-length (car arg)))
65 (substring (car arg) curpos)
66 (begin (set! arg (cdr arg)) (if (eq? arg '()) (throw 'requires-argument ret)) (car arg)))))
67 (set! arg (cdr arg)) optarg))))
68 (set! curpos 0)
69 ret)
70 (list ret))))))))))
71
72(define (ftime)
73 (let ((ctime (gettimeofday)))
74 (+ (car ctime) (/ (cdr ctime) 1000000))))
75
76(define (wanttosearch)
77 (> (- (current-time) lastsearch)
d30cc4bc 78 (if (eq? (cdr (assoc 'search-mode session)) 'wait)
79 7200
80 (if (> (length trans) 0) 300 60)))
d3372da9 81 )
82
83(define defspeed '())
84(let ((matchlist (list
85 (cons (make-regexp "^[][{}() ]*BBB" regexp/icase) 100000))))
86 (set! defspeed
87 (lambda (sr)
88 (catch 'ret
89 (lambda ()
90 (for-each (lambda (o)
91 (if (regexp-exec (car o) (cadr (cdr (assoc 'peer sr))))
92 (throw 'ret (cdr o))))
93 matchlist)
94 15000)
95 (lambda (sig ret)
96 ret))
97 )))
98
99(define (sr-less? sr1 sr2)
100 (let ((s1 (if (cdr (assoc 'speed sr1)) (cdr (assoc 'speed sr1)) (defspeed sr1)))
101 (s2 (if (cdr (assoc 'speed sr2)) (cdr (assoc 'speed sr2)) (defspeed sr2))))
102 (if (= s1 s2)
103 (< (cdr (assoc 'resptime sr1)) (cdr (assoc 'resptime sr2)))
104 (> s1 s2)))
105 )
106
107(define (srg-less? g1 g2)
108 (or (> (length (cdr g1)) (length (cdr g2)))
109 (and (= (length (cdr g1)) (length (cdr g2)))
110 (> (car g1) (car g2))))
111 )
112
113(define (gettrbysize size)
114 (catch 'ret
115 (lambda ()
116 (for-each (lambda (o)
117 (if (= (cdr (assoc 'size (cdr o))) size)
118 (throw 'ret (cdr o))))
119 trans)
120 #f)
121 (lambda (sig ret)
122 ret))
123 )
124
125(define (download sr)
126 (let ((resp #f))
127 (let ((args (list "download"
128 (car (cdr (assoc 'peer sr)))
129 (cadr (cdr (assoc 'peer sr)))
130 (cdr (assoc 'filename sr))
131 (cdr (assoc 'size sr)))))
3b0de0fd 132 (let ((hash (assoc 'hash sr)))
133 (if (and hash (not (equal? (cdr hash) ""))) (set! args (append args (list "hash" (cdr hash))))))
d3372da9 134 (let ((tag (assoc 'tag session)))
135 (if tag (set! args (append args (list "tag" (cdr tag))))))
136 (let ((uarg (assoc 'uarg session)))
137 (if uarg (set! args (append args (list "user" (cdr uarg))))))
e838f46b 138 (let ((xargs (assoc 'xargs session)))
139 (if xargs (for-each (lambda (o)
140 (set! args (append args (list (car o) (cdr o)))))
141 (cdr xargs))))
d3372da9 142 (set! resp (apply dc-ecmd-assert 200 args)))
143 (let ((id (car (dc-intresp resp))))
144 (set! trans
145 (cons (cons id (list (assoc 'size sr)
146 (assoc 'peer sr)
147 (assoc 'filename sr)
148 (assoc 'resptime sr)
149 '(curpos . 0)
150 '(state . wait)
151 '(curspeed . #f)
152 '(lastpos . 0)
153 (cons 'id id)
154 (cons 'lasttime (current-time))
155 (cons 'lastprog (current-time))))
156 trans))
c6cc011b 157 (logf "downloading ~a from ~a, ~a bytes (id ~a, ~a slots), timing out in ~a seconds"
158 (cdr (assoc 'filename sr))
159 (cadr (cdr (assoc 'peer sr)))
e6485bff 160 (cdr (assoc 'size sr))
161 id
162 (cdr (assoc 'slots sr))
163 (max 10 (* (cdr (assoc 'resptime sr)) 2)))
164 (infomsg "dl ~a ~a" (cdr (assoc 'size sr)) id)))
d3372da9 165 (set! lastdl (current-time))
166 )
167
168(define (disablepeer peer)
169 (let ((newglist '()) (numrem 0))
170 (for-each (lambda (g)
171 (let ((newlist '()))
172 (for-each (lambda (o)
173 (if (not (equal? (cdr (assoc 'peer o)) peer))
174 (set! newlist (cons o newlist))
175 (set! numrem (+ numrem 1))))
176 (cdr g))
177 (if (not (eq? newlist '()))
178 (set! newglist (cons (cons (car g) (sort newlist sr-less?)) newglist)))))
179 sr)
180 (set! sr (sort newglist srg-less?))
c6cc011b 181 (logf "disabled ~a and removed ~a search results" (cadr peer) numrem))
d3372da9 182 (let* ((dpa (assoc peer dpeers)) (dp (and (pair? dpa) (cdr dpa))))
183 (if dp
184 (set-cdr! (assoc 'time dp) (current-time))
185 (set! dpeers (cons (cons peer (list (cons 'time (current-time))
186 (cons 'peer peer)))
187 dpeers))))
188 )
189
190(define (checktrans)
191 (let ((time (current-time)))
192 (for-each (lambda (o)
193 (if (and (memq (cdr (assoc 'state (cdr o))) '(wait hs))
194 (> (- time (cdr (assoc 'lastprog (cdr o)))) (max 10 (* (cdr (assoc 'resptime (cdr o))) 2))))
c6cc011b 195 (begin (logf "transfer ~a timing out" (car o))
e6485bff 196 (infomsg "dlstop ~a timeout" (car o))
d3372da9 197 (dc-ecmd-assert 200 "cancel" (car o))
198 (disablepeer (cdr (assoc 'peer (cdr o))))
ecd6e23d 199 (set! trans (assq-remove! trans (car o)))
200 (write-info-file)))
d3372da9 201 (if (and (eq? (cdr (assoc 'state (cdr o))) 'main)
202 (> (- time (cdr (assoc 'lastprog (cdr o)))) 60))
c6cc011b 203 (begin (logf "transfer ~a seems to have stalled" (car o))
e6485bff 204 (infomsg "dlstop ~a stall" (car o))
d3372da9 205 (dc-ecmd-assert 200 "cancel" (car o))
ecd6e23d 206 (set! trans (assq-remove! trans (car o)))
207 (write-info-file)))
d3372da9 208 (if (and (eq? (cdr (assoc 'state (cdr o))) 'main)
209 (> (- (cdr (assoc 'lastprog (cdr o))) (cdr (assoc 'lasttime (cdr o)))) 20))
210 (begin (set-cdr! (assoc 'curspeed (cdr o))
211 (/ (- (cdr (assoc 'curpos (cdr o))) (cdr (assoc 'lastpos (cdr o))))
212 (- (cdr (assoc 'lastprog (cdr o))) (cdr (assoc 'lasttime (cdr o))))))
213 (set-cdr! (assoc 'lastpos (cdr o)) (cdr (assoc 'curpos (cdr o))))
ecd6e23d 214 (set-cdr! (assoc 'lasttime (cdr o)) (cdr (assoc 'lastprog (cdr o))))
215 (write-info-file))))
d3372da9 216 trans))
217 )
218
219(define (write-info-file)
220 (if (assoc 'info-file session)
221 (let ((op (open-output-file (cdr (assoc 'info-file session)))))
d576878b 222 (pretty-print (list (cons 'numdl (length trans))
223 (cons 'lastdl lastdl)
224 (cons 'availsr info-numavail)
225 (cons 'realsr info-numreal)
226 (cons 'totalsr info-numtotal)
227 (cons 'lastsrch lastsearch)
228 (cons 'srcheta info-searcheta)
229 (cons 'srchmode (cdr (assoc 'search-mode session))))
230 op)
d3372da9 231 (close-port op))))
232
233(define (parseresults)
c6cc011b 234 (logf "entering parseresults with ~a results in ~a sizes"
235 (apply + (map (lambda (o) (length (cdr o))) sr))
236 (number->string (length sr)))
d3372da9 237 (let ((retval #t) (numreal 0) (numtotal 0) (numavail 0))
238 (catch 'ret
239 (lambda ()
240 (and (eq? sr '()) (throw 'ret #f))
241 (let ((numrem 0) (countrem 0) (newglist '()))
242 (for-each (lambda (g)
243 (let ((newlist '()))
244 (for-each (lambda (o)
245 (if (< (- (current-time) (cdr (assoc 'recvtime o))) 300)
246 (set! newlist (cons o newlist))
247 (set! countrem (+ countrem 1))))
248 (cdr g))
249 (if (> (length newlist) 0)
250 (set! newglist (cons (cons (car g) (sort newlist sr-less?)) newglist))
251 (set! numrem (+ numrem 1)))))
252 sr)
253 (set! sr (sort newglist srg-less?))
254 (if (> countrem 0)
c6cc011b 255 (logf "removed ~a time-outed results and ~a entire sizes" countrem numrem)))
d3372da9 256 (let ((numrem 0) (newlist '()))
257 (for-each (lambda (o)
258 (if (> (- (current-time) (cdr (assoc 'time o))) 1800)
259 (set! numrem (+ numrem 1))
260 (set! newlist (cons o newlist))))
261 dpeers)
262 (set! dpeers newlist)
c6cc011b 263 (logf "re-enabled ~a disabled users" numrem))
d3372da9 264 (let ((numrem 0) (countrem 0) (newglist '()))
265 (for-each (lambda (g)
266 (let ((newlist '()))
267 (for-each (lambda (o)
268 (if (not (assoc (cdr (assoc 'peer o)) dpeers))
269 (set! newlist (cons o newlist))
270 (set! countrem (+ countrem 1))))
271 (cdr g))
272 (if (> (length newlist) 0)
273 (set! newglist (cons (cons (car g) (sort newlist sr-less?)) newglist))
274 (set! numrem (+ numrem 1)))))
275 sr)
276 (set! sr (sort newglist srg-less?))
277 (if (> countrem 0)
c6cc011b 278 (logf "removed ~a results with disabled peers and ~a entire sizes" countrem numrem)))
d3372da9 279 (and (eq? sr '()) (throw 'ret #f))
280 (set! numtotal (apply + (map (lambda (o) (length (cdr o))) sr)))
281 (let* ((maxsize (apply max (map (lambda (o) (length (cdr o))) sr)))
282 (minsize (/ maxsize 3)))
283 (let ((numrem 0) (countrem 0))
284 (for-each (lambda (o) (if (< (length (cdr o)) minsize)
285 (begin (set! countrem (+ countrem (length (cdr o))))
286 (set! numrem (+ numrem 1)))))
287 sr)
288 (if (> countrem 0)
c6cc011b 289 (logf "will disregard ~a results from ~a sizes due to popularity lack" countrem numrem))
d3372da9 290 (set! numreal (- numtotal countrem)))
291 (let ((numrem 0) (numrrem 0))
292 (for-each (lambda (g)
293 (for-each (lambda (o)
294 (if (< (cdr (assoc 'slots o)) 1)
295 (begin (set! numrem (+ numrem 1))
296 (if (>= (length (cdr g)) minsize)
297 (set! numrrem (+ numrrem 1))))))
298 (cdr g)))
299 sr)
300 (if (> numrem 0)
c6cc011b 301 (logf "~a results had no slots" numrem))
d3372da9 302 (set! numavail (- numreal numrrem)))
303 (for-each (lambda (g)
304 (if (>= (length (cdr g)) minsize)
305 (catch 'found
306 (lambda ()
307 (for-each (lambda (o)
308 (and (> (cdr (assoc 'slots o)) 0)
309 (throw 'found o)))
310 (cdr g)))
311 (lambda (sig sr)
312 (let ((tr (gettrbysize (cdr (assoc 'size sr)))))
313 (if (not tr)
314 (if (< (length trans) (cdr (assoc 'maxtrans session)))
315 (download sr))
316 (if (and (cdr (assoc 'curspeed tr))
317 (not (equal? (cdr (assoc 'peer sr)) (cdr (assoc 'peer tr))))
318 (> (- (or (cdr (assoc 'speed sr)) (defspeed sr)) (cdr (assoc 'curspeed tr))) 10000))
c6cc011b 319 (begin (logf "abandoning transfer ~a for possible faster sender"
320 (cdr (assoc 'id tr)))
e6485bff 321 (infomsg "dlstop ~a tryother" (cdr (assoc 'id tr)))
d3372da9 322 (dc-ecmd-assert 200 "cancel" (cdr (assoc 'id tr)))
323 (set! trans (assq-remove! trans (cdr (assoc 'id tr))))
324 (download sr)))))))))
325 sr)
326 )
327 )
328 (lambda (sig ret)
329 (set! retval ret)
330 ))
331 (set! info-numavail numavail)
332 (set! info-numreal numreal)
333 (set! info-numtotal numtotal)
34905adc 334 (infomsg "srs ~a ~a ~a" numtotal numreal numavail)
ecd6e23d 335 (write-info-file)
d3372da9 336 retval)
337 )
338
3b0de0fd 339(define (handlesr filename fnet peer size slots resptime hash)
2bb57f49 340 (if (eq? (cdr (assoc 'search-mode session)) 'wait)
341 (begin (set-cdr! (assoc 'search-mode session) 'normal)
e6485bff 342 (logf "reverting to normal mode")
343 (infomsg "searchmode normal")))
d3372da9 344 (let ((cl (or (assoc size sr)
345 (let ((newp (cons size '()))) (set! sr (append sr (list newp))) newp)))
346 (newsr (list
347 (cons 'filename filename)
348 (cons 'peer (list fnet peer))
349 (cons 'size size)
350 (cons 'slots slots)
351 (cons 'resptime resptime)
352 (cons 'speed (getspeed peer))
3b0de0fd 353 (cons 'hash hash)
d3372da9 354 (cons 'recvtime (current-time))
355 (cons 'dis #f)))
356 (newlist '()))
357 (for-each (lambda (o) (if (not (and (equal? (cdr (assoc 'filename o)) filename)
358 (equal? (cdr (assoc 'peer o)) (list fnet peer))))
359 (set! newlist (cons o newlist))))
360 (cdr cl))
361 (set-cdr! cl (sort (cons newsr newlist) sr-less?))
362 )
363 )
364
365; XXX: Redefine to go through the server, once that is implemented
366(define (getspeed username)
367 (catch 'system-error
368 (lambda ()
369 (let* ((port (open-input-file (string-append (getenv "HOME") "/dc/users/" username))) (avg 0) (numdls (string->number (read-line port))) (max (string->number (read-line port))) (numents (string->number (read-line port))))
370 (do ((i 0 (+ i 1))) ((= i numents) (close-port port) (/ avg numents)) (set! avg (+ avg (string->number (read-line port)))))
371 ))
372 (lambda args
373 #f
374 )
375 )
376 )
377
378(define (validate-session session)
379 (catch 'wrong-type-arg
380 (lambda ()
381 (and
382 (assoc 'sexpr session)
383 (assoc 'prio session)
384 (assoc 'maxtrans session)
385 #t
386 )
387 )
388 (lambda (key . args)
389 (display "Session data is not an a-list\n" (current-error-port))
390 #f)
391 )
392 )
393
394(define (autodl-main args)
aa82fda0 395 (let ((dc-server #f) (done #f) (retval 0) (filterexit ""))
e6485bff 396 (let ((getopt (make-getopt (cdr args) "whis:S:e:p:t:a:I:E:x:")) (arg #f))
d3372da9 397 (do ((arg (getopt) (getopt))) ((not (and (pair? arg) (char? (car arg)))) (set! args arg))
398 (cond ((eq? (car arg) #\h)
399 (begin (display "usage: autodl [-s server] -S sessfile\n" (current-error-port))
d30cc4bc 400 (display " autodl [-w] [-s server] -e search-expression [-p prio] [-t tag] [-a userarg]\n" (current-error-port))
d3372da9 401 (display " autodl [-s server]\n" (current-error-port))
402 (display " autodl -h\n" (current-error-port))
403 (exit 0)))
404 ((eq? (car arg) #\s)
405 (set! dc-server (cdr arg)))
406 ((eq? (car arg) #\S)
407 (let ((port (open-file (cdr arg)))) (set! session (read port)) (close-port port)))
408 ((eq? (car arg) #\p)
409 (let ((c (assoc 'prio session)))
410 (if c (set-cdr! c (cdr arg))
411 (set! session (cons (cons 'prio (cdr arg)) session)))))
412 ((eq? (car arg) #\t)
413 (let ((c (assoc 'tag session)))
414 (if c (set-cdr! c (cdr arg))
415 (set! session (cons (cons 'tag (cdr arg)) session)))))
416 ((eq? (car arg) #\a)
417 (let ((c (assoc 'uarg session)))
418 (if c (set-cdr! c (cdr arg))
419 (set! session (cons (cons 'uarg (cdr arg)) session)))))
420 ((eq? (car arg) #\I)
421 (let ((c (assoc 'info-file session)))
422 (if c (set-cdr! c (cdr arg))
423 (set! session (cons (cons 'info-file (cdr arg)) session)))))
e6485bff 424 ((eq? (car arg) #\i)
425 (set! infoport logport)
426 (set! logport #f))
aa82fda0 427 ((eq? (car arg) #\E)
428 (let ((c (assoc 'estat-file session)))
429 (if c (set-cdr! c (cdr arg))
430 (set! session (cons (cons 'estat-file (cdr arg)) session)))))
d3372da9 431 ((eq? (car arg) #\e)
432 (set! session (cons (cons 'sexpr (dc-lexsexpr (cdr arg))) session)))
d30cc4bc 433 ((eq? (car arg) #\w)
434 (set! session (cons '(search-mode . wait) session)))
e838f46b 435 ((eq? (car arg) #\x)
436 (let* ((c (assoc 'xargs session)) (p (string-index (cdr arg) #\=))
437 (recons (cons (substring (cdr arg) 0 p) (substring (cdr arg) (1+ p)))))
438 (if c (set-cdr! c (cons recons (cdr c)))
439 (set! session (cons (cons 'xargs (list recons)) session)))))
d3372da9 440 )
441 )
442 )
443 (if (eq? session '()) (begin (if (isatty? (current-input-port)) (display "Enter session data (s-expr):\n" (current-error-port))) (set! session (read))))
444 (if (not (assoc 'prio session))
445 (set! session (cons '(prio . 10) session)))
446 (if (not (assoc 'maxtrans session))
447 (set! session (cons '(maxtrans . 1) session)))
d30cc4bc 448 (if (not (assoc 'search-mode session))
53acfa81 449 (set! session (cons '(search-mode . normal) session)))
d3372da9 450 (if (not (validate-session session)) (begin (display "Invalid session!\n" (current-error-port)) (exit 1)))
451 (if (not dc-server) (set! dc-server (getenv "DCSERVER")))
452 (if (not dc-server) (set! dc-server "localhost"))
453 (catch 'system-error
454 (lambda ()
6d8a9842 455 (dc-c&l #f dc-server #t))
d3372da9 456 (lambda (key . args)
c6cc011b 457 (logf "could not connect to server: ~a" (apply format #f (cadr args) (caddr args)))
d3372da9 458 (exit 2)))
c6a77cc5 459 (dc-ecmd-assert 200 "notify" "trans:act" "on" "trans:prog" "on" "srch:act" "on")
d3372da9 460 (for-each (lambda (sig) (sigaction sig (lambda (sig) (throw 'sig sig)))) (list SIGINT SIGTERM SIGHUP))
461 (catch 'sig
462 (lambda ()
463 (while #t
464 (if (and (not (= lastsearch -1)) (wanttosearch))
465 (begin
466 (if (not (= srchid -1))
467 (dc-ecmd "cansrch" srchid))
468 (let* ((resp (apply dc-ecmd-assert (append (list '(200 501 509) "search" "prio" (number->string (cdr (assoc 'prio session))) "all") (cdr (assoc 'sexpr session)))))
469 (ires (dc-intresp resp))
470 (eres (dc-extract resp)))
471 (case (cdr (assoc 'code eres))
472 ((200)
473 (begin (set! srchid (car ires))
c6cc011b 474 (logf "search scheduled in ~a seconds (id ~a)"
e6485bff 475 (cadr ires)
476 srchid)
477 (infomsg "search pending ~a" (cadr ires))
d3372da9 478 (set! info-searcheta (+ (current-time) (cadr ires)))
ecd6e23d 479 (set! lastsearch -1)
480 (write-info-file)))
d3372da9 481 ((501)
482 (begin (set! srchid -1)
c6cc011b 483 (logf "no fnetnodes available to search on")
e6485bff 484 (infomsg "nofns")
d3372da9 485 (set! lastsearch (current-time))))
486 ((509)
487 (begin (logf "illegal search expression")
488 (set! done #t)
489 (set! retval 3)
490 (throw 'sig 0)))))))
491 (checktrans)
492 (if (> (- (current-time) lastparse) 20)
493 (begin (parseresults)
494 (set! lastparse (current-time))))
d3372da9 495 (dc-select 10000)
496 (while (let ((resp (dc-getresp)))
497 (if resp
498 (begin
499 (let* ((er (dc-extract resp)) (code (cdr (assoc 'code er))) (cmd (cdr (assoc 'cmd er))))
500 (cond
501 ((equal? cmd ".notify")
502 (case code
503 ((611) ; Transfer state change
504 (let ((ires (dc-intresp resp)) (tr #f))
505 (if (and ires (assoc (car ires) trans))
506 (begin (set! tr (cdr (assoc (car ires) trans)))
507 (set-cdr! (assoc 'state tr)
508 (cdr (assoc (cadr ires) '((0 . wait) (1 . hs) (2 . main) (3 . done)))))
509 (set-cdr! (assoc 'lastprog tr) (current-time))))))
510 ((614) ; Transfer error
511 (let ((ires (dc-intresp resp)))
512 (if (and ires (assoc (car ires) trans))
c6cc011b 513 (begin (logf "transfer ~a encountered error ~a" (car ires) (cadr ires))
e6485bff 514 (infomsg "dlstop ~a error ~a" (car ires) (cadr ires))
d3372da9 515 (dc-ecmd-assert 200 "cancel" (car ires))
516 (let ((tr (cdr (assoc (car ires) trans))))
517 (disablepeer (cdr (assoc 'peer tr))))
518 (set! trans (assq-remove! trans (car ires)))))))
519 ((615) ; Transfer progress
520 (let ((ires (dc-intresp resp)) (tr #f))
521 (if (and ires (assoc (car ires) trans))
522 (begin (set! tr (cdr (assoc (car ires) trans)))
523 (set-cdr! (assoc 'curpos tr) (cadr ires))
524 (set-cdr! (assoc 'lastprog tr) (current-time))))))
525 ((617) ; Transfer destroyed
526 (let* ((ires (dc-intresp resp)) (tr (and ires (assoc (car ires) trans))))
527 (if tr
528 (begin (if (eq? (cdr (assoc 'state (cdr tr))) 'done)
c6cc011b 529 (begin (logf "transfer ~a done (~a)" (car ires) (cadr ires))
42a9c63a 530 (infomsg "dldone ~a" (car ires))
531 (infomsg "estat ~a" (cadr ires))
d3372da9 532 (set! trans (assq-remove! trans (car ires)))
533 (set! done #t)
2fc2772d 534 (set! filterexit (cadr ires))
d3372da9 535 (throw 'sig 0))
c6cc011b 536 (begin (logf "transfer ~a disappeared" (car ires))
e6485bff 537 (infomsg "dlstop ~a gone" (car ires))
d3372da9 538 (set! trans (assq-remove! trans (car ires)))))))))
539 ((620) ; Search rescheduled
540 (let ((ires (dc-intresp resp)))
541 (if (and ires (= (car ires) srchid))
542 (begin (set! info-searcheta (+ (current-time) (cadr ires)))
c6cc011b 543 (logf "search rescheduled to T+~a" (cadr ires))
e6485bff 544 (infomsg "search pending ~a" (cadr ires))
d30cc4bc 545 (write-info-file)))))
d3372da9 546 ((621) ; Search committed
547 (let ((ires (dc-intresp resp)))
548 (if (and ires (= (car ires) srchid))
549 (begin (logf "search committed")
e6485bff 550 (infomsg "search commit")
d3372da9 551 (set! info-searcheta 0)
d30cc4bc 552 (set! lastsearch (current-time))
553 (write-info-file)))))
d3372da9 554 ((622) ; Search result
555 (let ((ires (list->vector (dc-intresp resp))))
3b0de0fd 556 (if (and ires (= (vector-ref ires 0) srchid)) (apply handlesr (map (lambda (n) (vector-ref ires n)) '(1 2 3 4 5 7 8))))))
d3372da9 557
558 )
559 )
560
561 )
562 )
563 #t)
564 #f)
565 )
566 #t
567 )
568 )
569 )
570 (lambda (key sig)
c6cc011b 571 (logf "interrupted by signal ~a" sig)
d3372da9 572 (if (not done)
573 (set! retval 1)))
574 )
575 (logf "quitting...")
576 (catch 'sig
577 (lambda ()
578 (if (dc-connected)
579 (begin (for-each (lambda (o)
580 (dc-qcmd (list "cancel" (car o))))
581 trans)
582 (if (assoc 'info-file session)
583 (catch 'system-error
584 (lambda ()
585 (delete-file (cdr (assoc 'info-file session))))
586 (lambda (key . args) #t)))
587 (if (and done (assoc 'tag session))
588 (dc-qcmd (list "filtercmd" "rmtag" (cdr (assoc 'tag session)))))
589 (if (not (= srchid -1))
590 (dc-qcmd (list "cansrch" srchid)))
591 (dc-qcmd '("quit"))
592 (while (dc-connected) (dc-select))
593 )))
594 (lambda (key sig)
595 (logf "forcing quit")))
aa82fda0 596 (if (assoc 'estat-file session)
597 (let ((op (open-output-file (cdr (assoc 'estat-file session)))))
fc068ee7 598 (display filterexit op)
aa82fda0 599 (newline op)
600 (close-port op)))
d3372da9 601 (exit retval)
602 )
603 )
604
605(setlocale LC_ALL "")
606(autodl-main (command-line))