guix-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[gnunet] 10/17: Add `time-rel` to replace all ad-hoc time calculations.


From: Rémi Birot-Delrue
Subject: [gnunet] 10/17: Add `time-rel` to replace all ad-hoc time calculations.
Date: Wed, 12 Aug 2015 18:24:40 +0000

remibd pushed a commit to branch master
in repository gnunet.

commit 12e8a31b236494c1c1fea70f6f1f4cf3c7c9087e
Author: RĂ©mi Birot-Delrue <address@hidden>
Date:   Mon Aug 3 15:57:09 2015 +0200

    Add `time-rel` to replace all ad-hoc time calculations.
---
 examples/download.scm     |    2 +-
 examples/identity-bis.scm |    2 +-
 examples/identity.scm     |    2 +-
 examples/publish.scm      |    6 +++---
 examples/search-ns.scm    |    5 +++--
 examples/search.scm       |   45 ++++++++++++++++++++++-----------------------
 gnu/gnunet/common.scm     |   10 ++++++++++
 gnu/gnunet/fs.scm         |    5 +----
 8 files changed, 42 insertions(+), 35 deletions(-)

diff --git a/examples/download.scm b/examples/download.scm
index 02eee76..0928306 100755
--- a/examples/download.scm
+++ b/examples/download.scm
@@ -75,5 +75,5 @@
           ;; add a timeout in 5 seconds
           (simple-format *stderr* "scheduler add: timeout\n")
           (force-output *stderr*)
-          (add-task! shutdown-task #:delay (* 5 1000 1000))))))
+          (add-task! shutdown-task #:delay (time-rel #:seconds 5))))))
     (call-with-scheduler config first-task)))
diff --git a/examples/identity-bis.scm b/examples/identity-bis.scm
index 9e506a0..2ef8f59 100755
--- a/examples/identity-bis.scm
+++ b/examples/identity-bis.scm
@@ -42,7 +42,7 @@
 
 (define (first-task _)
   (set! *handle* (start-ego-lookup *config* "testremi" print-ego))
-  (set! *kill-task* (add-task! shutdown-task #:delay (* 5 1000 1000))))
+  (set! *kill-task* (add-task! shutdown-task #:delay (time-rel #:seconds 5))))
 
 (define (main args)
   (set! *config* (load-configuration "~/.gnunet/gnunet.conf"))
diff --git a/examples/identity.scm b/examples/identity.scm
index bb11ada..7b7298f 100755
--- a/examples/identity.scm
+++ b/examples/identity.scm
@@ -42,7 +42,7 @@
 
 (define (first-task _)
   (set! *handle* (open-identity-service *config* print-ego))
-  (set! *kill-task* (add-task! shutdown-task #:delay (* 5 1000 1000))))
+  (set! *kill-task* (add-task! shutdown-task #:delay (time-rel #:seconds 5))))
 
 (define (main args)
   (set! *config* (load-configuration "~/.gnunet/gnunet.conf"))
diff --git a/examples/publish.scm b/examples/publish.scm
index 7ff1e0a..73d0e00 100755
--- a/examples/publish.scm
+++ b/examples/publish.scm
@@ -74,7 +74,7 @@ demanded ego or call IDENTITY-CONTINUATION."
        (set! *kill-task*
         (add-task! (lambda (_)
                      (close-identity-service *identity-handle*))
-                   #:delay (* 5 1000 1000))))
+                   #:delay (time-rel #:seconds 5))))
       ((binary file-name)
        (set! *binary-name* binary)
        (set! *filename*    file-name)
@@ -111,7 +111,7 @@ scan on *FILENAME*."
     (set! *kill-task*   (add-task! (lambda (_)
                                     (display "Stopping directory scan 
(unexpected)\n")
                                     (stop-directory-scan *dir-scanner*))
-                                  #:delay (* 5 1000 1000))))
+                                  #:delay (time-rel #:seconds 5))))
    (else
     (simple-format #t "Error: no ego named ~a has been found!\n"
                   *namespace-name*)
@@ -145,7 +145,7 @@ start the publication by calling DIRSCAN-CONTINUATION."
   (set! *kill-task* (add-task! (lambda (_)
                                 (display "Stopping publication (unexpected)\n")
                                 (stop-publish *publish-handle*))
-                              #:delay (* 5 1000 1000))))
+                              #:delay (time-rel #:seconds 5))))
 
 (define (progress-callback %info)
   "The third callback, called repeteadly by the publishing tasks once the
diff --git a/examples/search-ns.scm b/examples/search-ns.scm
index 9d2ac13..713c908 100755
--- a/examples/search-ns.scm
+++ b/examples/search-ns.scm
@@ -19,6 +19,7 @@
 (define-module (gnunet-search)
   #:use-module (ice-9 match)
   #:use-module (system foreign)
+  #:use-module (gnu gnunet common)
   #:use-module (gnu gnunet configuration)
   #:use-module (gnu gnunet scheduler)
   #:use-module (gnu gnunet identity)
@@ -57,7 +58,7 @@
     (start-ego-lookup *config* *ns-name* ego-callback))
   (set! *kill-task*
     (add-task! (lambda (_) (stop-ego-lookup! *lookup-op*))
-              #:delay (* 5 1000 1000))))
+              #:delay (time-rel #:seconds 5))))
 
 (define (ego-callback ego)
   (cancel-task! *kill-task*)
@@ -74,7 +75,7 @@
     (set! *search-handle* (start-search *fs-handle* *uri*))
     (set! *kill-task*     (add-task! (lambda (_)
                                       (stop-search *search-handle*))
-                                    #:delay (* 5 1000 1000)))
+                                    #:delay (time-rel #:seconds 5)))
     (simple-format #t "Searching ~a\n" (uri->string *uri*)))))
 
 (define (progress-callback %info)
diff --git a/examples/search.scm b/examples/search.scm
index 0a5f140..3516939 100755
--- a/examples/search.scm
+++ b/examples/search.scm
@@ -19,6 +19,7 @@
 (define-module (gnunet-search)
   #:use-module (ice-9 match)
   #:use-module (system foreign)
+  #:use-module (gnu gnunet common)
   #:use-module (gnu gnunet container metadata)
   #:use-module (gnu gnunet fs)
   #:use-module (gnu gnunet fs uri)
@@ -33,28 +34,26 @@
 (define (progress-cb %info)
   (when (equal? '(#:search #:result) (progress-info-status %info))
     (match (parse-c-progress-info %info)
-      (((context cctx pctx query duration anonymity
-                (metadata uri result applicability-rank)) status handle)
-       (match (parse-c-struct result '(* * * *)) ; incomplete parse of result
-        ((_ _ %uri %metadata)
-         (let* ((uri  (uri->string (wrap-uri %uri)))
-                (meta (wrap-metadata %metadata))
-                (result-directory? (is-directory? meta))
-                (result-filename (metadata-ref meta #:original-filename)))
-           (cond ((and result-directory?
-                       (string-null? result-filename))
-                  (simple-format
-                   #t "gnunet-download -o \"collection.gnd\" -R ~a\n" uri))
-                 (result-directory?
-                  (simple-format #t
-                                 "gnunet-download -o \"~a.gnd\" -R ~a\n"
-                                 result-filename uri))
-                 ((string-null? result-filename)
-                  (simple-format #t "gnunet-download ~a\n"
-                                 uri))
-                 (else
-                  (simple-format #t "gnunet-download -o \"~a\" ~a\n"
-                                 result-filename uri))))))))))
+      (((context _ _ query duration anonymity
+                (%metadata %uri %result applicability-rank)) _ _)
+       (let* ((uri  (uri->string (wrap-uri %uri)))
+             (meta (wrap-metadata %metadata))
+             (result-directory? (is-directory? meta))
+             (result-filename (metadata-ref meta #:original-filename)))
+        (cond ((and result-directory?
+                    (string-null? result-filename))
+               (simple-format
+                #t "gnunet-download -o \"collection.gnd\" -R ~a\n" uri))
+              (result-directory?
+               (simple-format #t
+                              "gnunet-download -o \"~a.gnd\" -R ~a\n"
+                              result-filename uri))
+              ((string-null? result-filename)
+               (simple-format #t "gnunet-download ~a\n"
+                              uri))
+              (else
+               (simple-format #t "gnunet-download -o \"~a\" ~a\n"
+                              result-filename uri))))))))
 
 (define (main args)
   (let ((config (load-configuration config-file)))
@@ -65,5 +64,5 @@
             (search     (start-search fs-service uri)))
        ;; adds a timeout in 5 seconds
        (add-task! (lambda (_) (stop-search search))
-                  #:delay (* 5 1000 1000))))
+                  #:delay (time-rel #:seconds 5))))
     (call-with-scheduler config first-task)))
diff --git a/gnu/gnunet/common.scm b/gnu/gnunet/common.scm
index 7557d4a..0d1a6b4 100644
--- a/gnu/gnunet/common.scm
+++ b/gnu/gnunet/common.scm
@@ -29,6 +29,8 @@
 
             time-relative
             time-absolute
+            time-rel
+            
             ecdsa-public-key
             ecdsa-public-key?
             eddsa-public-key
@@ -59,6 +61,14 @@
 
 (define time-relative uint64)
 (define time-absolute uint64)
+
+(define* (time-rel #:key (hours 0) (minutes 0) (seconds 0) (milli 0) (micro 0))
+  (let* ((minutes* (+ (* hours    60)   minutes))
+         (seconds* (+ (* minutes* 60)   seconds))
+         (milli*   (+ (* seconds* 1000) milli))
+         (micro*   (+ (* milli*   1000) micro)))
+    micro*))
+
 (define ecdsa-public-key (generate (/ 256 8 4) uint32))
 (define eddsa-public-key ecdsa-public-key)
 (define eddsa-signature (list eddsa-public-key
diff --git a/gnu/gnunet/fs.scm b/gnu/gnunet/fs.scm
index d32ef09..8cd3169 100644
--- a/gnu/gnunet/fs.scm
+++ b/gnu/gnunet/fs.scm
@@ -241,9 +241,6 @@ callback."
 ;;
 ;;+TODO: dynamically allocate the entire structure & client-name, so that we 
can
 ;;       call GNUNET_FS_stop on the returned handle.
-;;
-;;+TODO: replace value for avg_block_latency with a call to a function
-;;       akin `(time-relative #:minutes 1)`
 (define (%fs-start %config %client-name %progress-callback)
   (make-c-struct struct-fs-handle
                 (list %config
@@ -260,7 +257,7 @@ callback."
                       %null-pointer            ; probes_tail
                       %null-pointer            ; queue_job
                       %null-pointer            ; probe_ping_task
-                      (* 60 1000 1000)         ; avg_block_latency (1 minute)
+                      (time-rel #:minutes 1)   ; avg_block_latency
                       0                        ; active_downloads
                       0                        ; active_blocks
                       0                        ; flags



reply via email to

[Prev in Thread] Current Thread [Next in Thread]