Added GPL notices to the Guile code.

[doldaconnect.git] / lib / guile / autodl

diff --git a/lib/guile/autodl b/lib/guile/autodl
index 32eb92d..ff21b84 100755 (executable)
--- a/lib/guile/autodl
+++ b/lib/guile/autodl
@@ -1,6 +1,23 @@
 #!/usr/bin/guile -s
 !#
 
 #!/usr/bin/guile -s
 !#
 

+;  Dolda Connect - Modular multiuser Direct Connect-style client
+;  Copyright (C) 2007 Fredrik Tolf <fredrik@dolda2000.com>
+;  
+;  This program is free software; you can redistribute it and/or modify
+;  it under the terms of the GNU General Public License as published by
+;  the Free Software Foundation; either version 2 of the License, or
+;  (at your option) any later version.
+;  
+;  This program is distributed in the hope that it will be useful,
+;  but WITHOUT ANY WARRANTY; without even the implied warranty of
+;  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;  GNU General Public License for more details.
+;  
+;  You should have received a copy of the GNU General Public License
+;  along with this program; if not, write to the Free Software
+;  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+

 (use-modules (dolcon ui))
 (use-modules (ice-9 pretty-print))
 
 (use-modules (dolcon ui))
 (use-modules (ice-9 pretty-print))
 


@@ -16,12 +33,25 @@
 (define trans '())
 (define dpeers '())
 (define lastdl 0)
 (define trans '())
 (define dpeers '())
 (define lastdl 0)

+(define logport (current-output-port))
+(define infoport #f)
+
+(define (logf fmt . msg)
+  (if logport
+      (begin
+       (apply format (cons* logport (string-append fmt "\n") msg))
+       (catch 'system-error (lambda ()
+                              (fsync logport))
+              (lambda (key . err) #f))))
+  )

 
 

-(define (logf msg)
-  (write-line msg (current-output-port))
-  (catch 'system-error (lambda ()
-                        (fsync (current-output-port)))
-        (lambda (key . err) #f))
+(define (infomsg fmt . msg)
+  (if infoport
+      (begin
+       (apply format (cons* infoport (string-append fmt "\n") msg))
+       (catch 'system-error (lambda ()
+                              (fsync infoport))
+              (lambda (key . err) #f))))

   )
 
 (define (make-getopt opts optdesc)
   )
 
 (define (make-getopt opts optdesc)


@@ -122,6 +152,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


@@ -137,19 +171,14 @@
                                 (cons 'lasttime (current-time))
                                 (cons 'lastprog (current-time))))
                  trans))
                                 (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)))
+           (cdr (assoc 'size sr))
+           id
+           (cdr (assoc 'slots sr))
+           (max 10 (* (cdr (assoc 'resptime sr)) 2)))
+      (infomsg "dl ~a ~a" (cdr (assoc 'size sr)) id)))

   (set! lastdl (current-time))
   )
 
   (set! lastdl (current-time))
   )
 


@@ -166,7 +195,7 @@
                      (set! newglist (cons (cons (car g) (sort newlist sr-less?)) newglist)))))
              sr)
     (set! sr (sort newglist srg-less?))
                      (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))
   (let* ((dpa (assoc peer dpeers)) (dp (and (pair? dpa) (cdr dpa))))
     (if dp
        (set-cdr! (assoc 'time dp) (current-time))


@@ -180,14 +209,16 @@
     (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))))
     (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))
+                          (infomsg "dlstop ~a timeout" (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))
                           (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))
+                          (infomsg "dlstop ~a stall" (car o))

                           (dc-ecmd-assert 200 "cancel" (car o))
                           (set! trans (assq-remove! trans (car o)))
                           (write-info-file)))
                           (dc-ecmd-assert 200 "cancel" (car o))
                           (set! trans (assq-remove! trans (car o)))
                           (write-info-file)))


@@ -205,25 +236,21 @@
 (define (write-info-file)
   (if (assoc 'info-file session)
       (let ((op (open-output-file (cdr (assoc 'info-file session)))))
 (define (write-info-file)
   (if (assoc 'info-file session)
       (let ((op (open-output-file (cdr (assoc 'info-file session)))))

-       (write (list (cons 'numdl (length trans))
-                    (cons 'lastdl lastdl)
-                    (cons 'availsr info-numavail)
-                    (cons 'realsr info-numreal)
-                    (cons 'totalsr info-numtotal)
-                    (cons 'lastsrch lastsearch)
-                    (cons 'srcheta info-searcheta)
-                    (cons 'srchmode (cdr (assoc 'search-mode session))))
-              op)
-       (newline op)
+       (pretty-print (list (cons 'numdl (length trans))
+                           (cons 'lastdl lastdl)
+                           (cons 'availsr info-numavail)
+                           (cons 'realsr info-numreal)
+                           (cons 'totalsr info-numtotal)
+                           (cons 'lastsrch lastsearch)
+                           (cons 'srcheta info-searcheta)
+                           (cons 'srchmode (cdr (assoc 'search-mode session))))
+                     op)

        (close-port op))))
 
 (define (parseresults)
        (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 ()
   (let ((retval #t) (numreal 0) (numtotal 0) (numavail 0))
     (catch 'ret
           (lambda ()


@@ -242,7 +269,7 @@
                         sr)
               (set! sr (sort newglist srg-less?))
               (if (> countrem 0)
                         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)
             (let ((numrem 0) (newlist '()))
               (for-each (lambda (o)
                           (if (> (- (current-time) (cdr (assoc 'time o))) 1800)


@@ -250,7 +277,7 @@
                               (set! newlist (cons o newlist))))
                         dpeers)
               (set! dpeers newlist)
                               (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 '()))
             (let ((numrem 0) (countrem 0) (newglist '()))
               (for-each (lambda (g)
                           (let ((newlist '()))


@@ -265,7 +292,7 @@
                         sr)
               (set! sr (sort newglist srg-less?))
               (if (> countrem 0)
                         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)))
             (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)))


@@ -276,7 +303,7 @@
                                                  (set! numrem (+ numrem 1)))))
                           sr)
                 (if (> countrem 0)
                                                  (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)
                 (set! numreal (- numtotal countrem)))
               (let ((numrem 0) (numrrem 0))
                 (for-each (lambda (g)


@@ -288,7 +315,7 @@
                                       (cdr g)))
                           sr)
                 (if (> numrem 0)
                                       (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)
                 (set! numavail (- numreal numrrem)))
               (for-each (lambda (g)
                           (if (>= (length (cdr g)) minsize)


@@ -306,9 +333,9 @@
                                              (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))
                                              (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)))
+                                                        (infomsg "dlstop ~a tryother" (cdr (assoc 'id tr)))

                                                         (dc-ecmd-assert 200 "cancel" (cdr (assoc 'id tr)))
                                                         (set! trans (assq-remove! trans (cdr (assoc 'id tr))))
                                                         (download sr)))))))))
                                                         (dc-ecmd-assert 200 "cancel" (cdr (assoc 'id tr)))
                                                         (set! trans (assq-remove! trans (cdr (assoc 'id tr))))
                                                         (download sr)))))))))


@@ -321,6 +348,7 @@
     (set! info-numavail numavail)
     (set! info-numreal numreal)
     (set! info-numtotal numtotal)
     (set! info-numavail numavail)
     (set! info-numreal numreal)
     (set! info-numtotal numtotal)

+    (infomsg "srs ~a ~a ~a" numtotal numreal numavail)

     (write-info-file)
     retval)
   )
     (write-info-file)
     retval)
   )


@@ -328,7 +356,8 @@
 (define (handlesr filename fnet peer size slots resptime hash)
   (if (eq? (cdr (assoc 'search-mode session)) 'wait)
       (begin (set-cdr! (assoc 'search-mode session) 'normal)
 (define (handlesr filename fnet peer size slots resptime hash)
   (if (eq? (cdr (assoc 'search-mode session)) 'wait)
       (begin (set-cdr! (assoc 'search-mode session) 'normal)

-            (logf "reverting to normal mode")))
+            (logf "reverting to normal mode")
+            (infomsg "searchmode normal")))

   (let ((cl (or (assoc size sr)
                (let ((newp (cons size '()))) (set! sr (append sr (list newp))) newp)))
        (newsr (list
   (let ((cl (or (assoc size sr)
                (let ((newp (cons size '()))) (set! sr (append sr (list newp))) newp)))
        (newsr (list


@@ -381,7 +410,7 @@
 
 (define (autodl-main args)
   (let ((dc-server #f) (done #f) (retval 0) (filterexit ""))
 
 (define (autodl-main args)
   (let ((dc-server #f) (done #f) (retval 0) (filterexit ""))

-    (let ((getopt (make-getopt (cdr args) "whs:S:e:p:t:a:I:")) (arg #f))
+    (let ((getopt (make-getopt (cdr args) "whis: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,6 +438,9 @@
               (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) #\i)
+              (set! infoport logport)
+              (set! logport #f))

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


@@ -417,6 +449,11 @@
               (set! session (cons (cons 'sexpr (dc-lexsexpr (cdr arg))) session)))
              ((eq? (car arg) #\w)
               (set! session (cons '(search-mode . wait) session)))
               (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)))))

              )
        )
       )
              )
        )
       )


@@ -428,13 +465,11 @@
     (if (not (assoc 'search-mode 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 (assoc 'search-mode 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"))

     (catch 'system-error
           (lambda ()
     (catch 'system-error
           (lambda ()

-            (dc-c&l #t dc-server #t))
+            (dc-c&l #f dc-server #t))

           (lambda (key . args)
           (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))
             (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))


@@ -451,13 +486,17 @@
                            (case (cdr (assoc 'code eres))
                              ((200)
                               (begin (set! srchid (car ires))
                            (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)"
+                                           (cadr ires)
+                                           srchid)
+                                     (infomsg "search pending ~a" (cadr ires))

                                      (set! info-searcheta (+ (current-time) (cadr ires)))
                                      (set! lastsearch -1)
                                      (write-info-file)))
                              ((501)
                               (begin (set! srchid -1)
                                      (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")
+                                     (infomsg "nofns")

                                      (set! lastsearch (current-time))))
                              ((509)
                               (begin (logf "illegal search expression")
                                      (set! lastsearch (current-time))))
                              ((509)
                               (begin (logf "illegal search expression")


@@ -486,7 +525,8 @@
                                          ((614) ; Transfer error
                                           (let ((ires (dc-intresp resp)))
                                             (if (and ires (assoc (car ires) trans))
                                          ((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))
+                                                       (infomsg "dlstop ~a 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))))
                                                        (dc-ecmd-assert 200 "cancel" (car ires))
                                                        (let ((tr (cdr (assoc (car ires) trans))))
                                                          (disablepeer (cdr (assoc 'peer tr))))


@@ -501,23 +541,28 @@
                                           (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 (" (cadr ires) ")"))
+                                                           (begin (logf "transfer ~a done (~a)" (car ires) (cadr ires))
+                                                                  (infomsg "dldone ~a" (car ires))
+                                                                  (infomsg "estat ~a" (cadr ires))

                                                                   (set! trans (assq-remove! trans (car ires)))
                                                                   (set! done #t)
                                                                   (set! filterexit (cadr ires))
                                                                   (throw 'sig 0))
                                                                   (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))
+                                                                  (infomsg "dlstop ~a gone" (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)))
                                                                   (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))
+                                                       (infomsg "search pending ~a" (cadr ires))

                                                        (write-info-file)))))
                                          ((621) ; Search committed
                                           (let ((ires (dc-intresp resp)))
                                             (if (and ires (= (car ires) srchid))
                                                 (begin (logf "search committed")
                                                        (write-info-file)))))
                                          ((621) ; Search committed
                                           (let ((ires (dc-intresp resp)))
                                             (if (and ires (= (car ires) srchid))
                                                 (begin (logf "search committed")

+                                                       (infomsg "search commit")

                                                        (set! info-searcheta 0)
                                                        (set! lastsearch (current-time))
                                                        (write-info-file)))))
                                                        (set! info-searcheta 0)
                                                        (set! lastsearch (current-time))
                                                        (write-info-file)))))


@@ -538,7 +583,7 @@
                    )
             )
           (lambda (key sig)
                    )
             )
           (lambda (key sig)

-            (logf (string-append "interrupted by signal " (number->string sig)))
+            (logf "interrupted by signal ~a" sig)

             (if (not done)
                 (set! retval 1)))
           )
             (if (not done)
                 (set! retval 1)))
           )


@@ -565,7 +610,7 @@
             (logf "forcing quit")))
     (if (assoc 'estat-file session)
        (let ((op (open-output-file (cdr (assoc 'estat-file session)))))
             (logf "forcing quit")))
     (if (assoc 'estat-file session)
        (let ((op (open-output-file (cdr (assoc 'estat-file session)))))

-         (write filterexit op)
+         (display filterexit op)

          (newline op)
          (close-port op)))
     (exit retval)
          (newline op)
          (close-port op)))
     (exit retval)