Add mtime check for hashes.

[doldaconnect.git] / lib / guile / autodl

diff --git a/lib/guile/autodl b/lib/guile/autodl
index 11a5a90..6b72550 100755 (executable)
--- a/lib/guile/autodl
+++ b/lib/guile/autodl
@@ -122,6 +122,10 @@
        (if tag (set! args (append args (list "tag" (cdr tag))))))
       (let ((uarg (assoc 'uarg session)))
        (if uarg (set! args (append args (list "user" (cdr uarg))))))
        (if tag (set! args (append args (list "tag" (cdr tag))))))
       (let ((uarg (assoc 'uarg session)))
        (if uarg (set! args (append args (list "user" (cdr uarg))))))

+      (let ((xargs (assoc 'xargs session)))
+       (if xargs (for-each (lambda (o)
+                             (set! args (append args (list (car o) (cdr o)))))
+                          (cdr xargs))))

       (set! resp (apply dc-ecmd-assert 200 args)))
     (let ((id (car (dc-intresp resp))))
       (set! trans
       (set! resp (apply dc-ecmd-assert 200 args)))
     (let ((id (car (dc-intresp resp))))
       (set! trans


@@ -380,8 +384,8 @@
   )
 
 (define (autodl-main args)
   )
 
 (define (autodl-main args)

-  (let ((dc-server #f) (done #f) (retval 0))
-    (let ((getopt (make-getopt (cdr args) "whs:S:e:p:t:a:I:")) (arg #f))
+  (let ((dc-server #f) (done #f) (retval 0) (filterexit ""))
+    (let ((getopt (make-getopt (cdr args) "whs:S:e:p:t:a:I:E:x:")) (arg #f))

       (do ((arg (getopt) (getopt))) ((not (and (pair? arg) (char? (car arg)))) (set! args arg))
        (cond ((eq? (car arg) #\h)
               (begin (display "usage: autodl [-s server] -S sessfile\n" (current-error-port))
       (do ((arg (getopt) (getopt))) ((not (and (pair? arg) (char? (car arg)))) (set! args arg))
        (cond ((eq? (car arg) #\h)
               (begin (display "usage: autodl [-s server] -S sessfile\n" (current-error-port))


@@ -409,10 +413,19 @@
               (let ((c (assoc 'info-file session)))
                 (if c (set-cdr! c (cdr arg))
                     (set! session (cons (cons 'info-file (cdr arg)) session)))))
               (let ((c (assoc 'info-file session)))
                 (if c (set-cdr! c (cdr arg))
                     (set! session (cons (cons 'info-file (cdr arg)) session)))))

+             ((eq? (car arg) #\E)
+              (let ((c (assoc 'estat-file session)))
+                (if c (set-cdr! c (cdr arg))
+                    (set! session (cons (cons 'estat-file (cdr arg)) session)))))

              ((eq? (car arg) #\e)
               (set! session (cons (cons 'sexpr (dc-lexsexpr (cdr arg))) session)))
              ((eq? (car arg) #\w)
               (set! session (cons '(search-mode . wait) session)))
              ((eq? (car arg) #\e)
               (set! session (cons (cons 'sexpr (dc-lexsexpr (cdr arg))) session)))
              ((eq? (car arg) #\w)
               (set! session (cons '(search-mode . wait) session)))

+             ((eq? (car arg) #\x)
+              (let* ((c (assoc 'xargs session)) (p (string-index (cdr arg) #\=))
+                     (recons (cons (substring (cdr arg) 0 p) (substring (cdr arg) (1+ p)))))
+                (if c (set-cdr! c (cons recons (cdr c)))
+                    (set! session (cons (cons 'xargs (list recons)) session)))))

              )
        )
       )
              )
        )
       )


@@ -422,7 +435,7 @@
     (if (not (assoc 'maxtrans session))
        (set! session (cons '(maxtrans . 1) session)))
     (if (not (assoc 'search-mode session))
     (if (not (assoc 'maxtrans session))
        (set! session (cons '(maxtrans . 1) session)))
     (if (not (assoc 'search-mode session))

-       (set! session (cons '(search-mode . wait) session)))
+       (set! session (cons '(search-mode . normal) session)))

     (if (not (validate-session session)) (begin (display "Invalid session!\n" (current-error-port)) (exit 1)))
     (if (not dc-server) (set! dc-server (getenv "DCSERVER")))
     (if (not dc-server) (set! dc-server "localhost"))
     (if (not (validate-session session)) (begin (display "Invalid session!\n" (current-error-port)) (exit 1)))
     (if (not dc-server) (set! dc-server (getenv "DCSERVER")))
     (if (not dc-server) (set! dc-server "localhost"))


@@ -432,7 +445,7 @@
           (lambda (key . args)
             (logf (string-append "could not connect to server: " (apply format #f (cadr args) (caddr args))))
             (exit 2)))
           (lambda (key . args)
             (logf (string-append "could not connect to server: " (apply format #f (cadr args) (caddr args))))
             (exit 2)))

-    (dc-ecmd-assert 200 "notify" "all" "on")
+    (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))
     (catch 'sig
           (lambda ()
     (for-each (lambda (sig) (sigaction sig (lambda (sig) (throw 'sig sig)))) (list SIGINT SIGTERM SIGHUP))
     (catch 'sig
           (lambda ()


@@ -497,9 +510,10 @@
                                           (let* ((ires (dc-intresp resp)) (tr (and ires (assoc (car ires) trans))))
                                             (if tr
                                                 (begin (if (eq? (cdr (assoc 'state (cdr tr))) 'done)
                                           (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"))
+                                                           (begin (logf (string-append "transfer " (number->string (car ires)) " done (" (cadr ires) ")"))

                                                                   (set! trans (assq-remove! trans (car ires)))
                                                                   (set! done #t)
                                                                   (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"))
                                                                   (set! trans (assq-remove! trans (car ires)))))))))
                                                                   (throw 'sig 0))
                                                            (begin (logf (string-append "transfer " (number->string (car ires)) " disappeared"))
                                                                   (set! trans (assq-remove! trans (car ires)))))))))


@@ -558,6 +572,11 @@
                        )))
           (lambda (key sig)
             (logf "forcing quit")))
                        )))
           (lambda (key sig)
             (logf "forcing quit")))

+    (if (assoc 'estat-file session)
+       (let ((op (open-output-file (cdr (assoc 'estat-file session)))))
+         (display filterexit op)
+         (newline op)
+         (close-port op)))

     (exit retval)
     )
   )
     (exit retval)
     )
   )