Code cleaning: various improvements and bug fixes.

* identity.scm: `open-identity-service` now throws an exception on failure.
* binding-utils.scm: just add `destructuring-bind`.
* common.scm: `time-rel` now throws an exception instead of returning a
              meaningless negative result; add `setup-log`.
* container/metadata.scm: `metadata-set!` now throws an exception on error.
* tests/container-metadata.scm: add tests for `metadata-copy`,
                                `metadata-clear`, `metadata-equal?`
                                and `add-publication-date!`

gnu/gnunet/binding-utils.scm

@@ -30,6 +30,8 @@
             rassoc
             rassoc-ref
 
+            destructuring-bind
+            
             string->pointer*
             pointer->string*
             make-c-struct*
@@ -93,3 +95,8 @@ if STRING is empty (\"\")."
                    (if (eq? %null-pointer x*)
                        (or% y ...)
                        x*)))))
+
+;;; Utilities
+
+(define-syntax-rule (destructuring-bind pattern value body body* ...)
+  (match value (pattern body body* ...)))

gnu/gnunet/common.scm

@@ -45,6 +45,8 @@
             define-gnunet-fs
             define-gnunet-id
 
+            setup-log
+
             %make-blob-pointer
             %malloc
             %free
@@ -67,7 +69,11 @@
          (seconds* (+ (* minutes* 60)   seconds))
          (milli*   (+ (* seconds* 1000) milli))
          (micro*   (+ (* milli*   1000) micro)))
-    micro*))
+    (when (negative? micro*)
+      (scm-error 'out-of-range "time-rel"
+                 "result (~a) is negative" (list micro*)
+                 (list hours minutes seconds milli micro)))
+    (inexact->exact micro*)))
 
 (define ecdsa-public-key (generate (/ 256 8 4) uint32))
 (define eddsa-public-key ecdsa-public-key)
@@ -102,6 +108,8 @@
 (define-foreign-definer define-gnunet-fs gnunet-fs-ffi)
 (define-foreign-definer define-gnunet-id gnunet-identity-ffi)
 
+(define-gnunet %log-setup "GNUNET_log_setup" : '(* * *) -> int)
+
 (define-gnunet %xfree   "GNUNET_xfree_"   : (list '* '* int)     -> void)
 (define-gnunet %xmalloc "GNUNET_xmalloc_" : (list size_t '* int) -> '*)
 
@@ -111,6 +119,27 @@
   "GNUNET_STRINGS_string_to_data" : (list '* size_t '* size_t) -> int)
 
 
+(define log-level-alist
+  (list (cons #:none        (string->pointer "NONE"))
+        (cons #:error       (string->pointer "ERROR"))
+        (cons #:warning     (string->pointer "WARNING"))
+        (cons #:info        (string->pointer "INFO"))
+        (cons #:debug       (string->pointer "DEBUG"))
+        (cons #:invalid     (string->pointer "INVALID"))
+        (cons #:bulk        (string->pointer "BULK"))
+        (cons #:unspecified (string->pointer "UNSPECIFIED"))))
+
+(define* (setup-log client-name log-level #:optional (log-file ""))
+  "Setup GNUnet’s logging. CLIENT-NAME is the name of the program you’re
+writing, LOG-LEVEL is a keyword from (#:none #:error #:warning #:info #:debug
+#:invalid #:bulk), LOG-FILE is either a filename or #f for `stderr'."
+  (define (log-level->pointer key)
+    (or (assq-ref log-level-alist key)
+        (assq-ref log-level-alist #:unspecified)))
+  (%log-setup (string->pointer client-name)
+              (log-level->pointer log-level)
+              (string->pointer* log-file)))
+
 (define (bool->int x) (if x gnunet-yes gnunet-no))
 (define (int->bool x)
   (cond ((= gnunet-yes x)          #t)

gnu/gnunet/container/metadata.scm

@@ -148,8 +148,10 @@
         (bytevector-length      (metadata-item-data item))))
 
 (define (metadata-set! metadata item)
-  (apply %metadata-insert (unwrap-metadata metadata)
-         (metadata-item->list item)))
+  (let ((res (apply %metadata-insert (unwrap-metadata metadata)
+                    (metadata-item->list item))))
+    (when (= res gnunet-system-error)
+      (throw 'entry-already-exist "metadata-set!" metadata item))))
   
 (define (metadata-ref metadata type)
   (pointer->string

gnu/gnunet/identity.scm

@@ -98,9 +98,12 @@ assigned by the user for this ego (or #f if the user just deleted this ego).
 
 Return a handle to the identity service that’s needed by every identity related
 function."
-  (%identity-connect (unwrap-configuration config)
-		     (identity-callback->pointer identity-callback)
-		     %null-pointer))
+  (or%
+   (%identity-connect (unwrap-configuration config)
+                      (identity-callback->pointer identity-callback)
+                      %null-pointer)
+   (throw 'invalid-result "open-identity-service" "%identity-connect"
+          %null-pointer)))
 
 (define (close-identity-service identity-handle)
   "Disconnect from the identity service."

tests/container-metadata.scm

@@ -45,4 +45,19 @@
 (test-equal '("foo" "bar")
 	    (metadata-map (lambda (name . _) name) test-meta))
 
+;; copy
+(define test-meta-copy (metadata-copy test-meta))
+(test-equal "foo.scm" (metadata-ref test-meta-copy #:original-filename))
+
+;; equal?
+(test-assert (metadata-equal? test-meta test-meta-copy))
+
+;; clear!
+(metadata-clear! test-meta-copy)
+(test-equal #f (metadata-ref test-meta-copy #:original-filename))
+
+;; add-publication-date!
+(metadata-add-publication-date! test-meta-copy)
+(test-assert (metadata-ref test-meta-copy #:publication-date))
+
 (test-end)