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