[gnunet] 08/17: Add `examples/identity.scm`, `examples/identity-bis.scm`, `examples/search-ns.scm`, and a few minor modifications. * examples/search-ns.scm: a basic tool to search namespaces. * examples/identity.scm: a basic tool to list egos. * examples/identity-bis.scm: idem, but using `start-identity-lookup`. * fs/uri.scm: `wrap-uri` throws an `invalid-arg` exception when given a null pointer. * tests/uri.scm: c.f. ↑ * configuration.scm: add `configuration-value-set?`. * identity.scm: add `ecdsa-public-key->string`.

[Rémi Birot-Delrue]

remibd pushed a commit to branch master
in repository gnunet.

commit 8fce653b323ee4794336ed305d91d1ad4f1cab5f
Author: Rémi Birot-Delrue <address@hidden>
Date:   Fri Jul 31 12:10:34 2015 +0200

    Add `examples/identity.scm`, `examples/identity-bis.scm`, 
`examples/search-ns.scm`, and a few minor modifications.
    * examples/search-ns.scm: a basic tool to search namespaces.
    * examples/identity.scm: a basic tool to list egos.
    * examples/identity-bis.scm: idem, but using `start-identity-lookup`.
    * fs/uri.scm: `wrap-uri` throws an `invalid-arg` exception when given a
                  null pointer.
    * tests/uri.scm: c.f. ↑
    * configuration.scm: add `configuration-value-set?`.
    * identity.scm: add `ecdsa-public-key->string`.
---
 examples/identity-bis.scm    |   49 ++++++++++++++++++++
 examples/identity.scm        |   49 ++++++++++++++++++++
 examples/search-ns.scm       |  103 ++++++++++++++++++++++++++++++++++++++++++
 gnu/gnunet/configuration.scm |   11 ++++-
 gnu/gnunet/fs/uri.scm        |    5 +-
 gnu/gnunet/identity.scm      |   19 +++++---
 tests/identity.scm           |   51 +++++++++++++++++++++
 tests/uri.scm                |    7 +++-
 8 files changed, 282 insertions(+), 12 deletions(-)

diff --git a/examples/identity-bis.scm b/examples/identity-bis.scm
new file mode 100755
index 0000000..9e506a0
--- /dev/null
+++ b/examples/identity-bis.scm
@@ -0,0 +1,49 @@
+#!/usr/bin/guile \
+-e (@\ (gnunet-identity)\ main) -L . -s
+!#
+;;;; Copyright © 2015 Rémi Delrue <address@hidden>
+;;;; 
+;;;; 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 3 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, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnunet-identity)
+  #: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)
+  #:export     (main))
+
+(define *config* #f) ; configuration handle
+(define *handle* #f) ; operation handle
+(define *kill-task* #f)
+
+(define (shutdown-task _)
+  (when *handle* (stop-ego-lookup! *handle*)))
+
+(define (print-ego ego)
+  (cancel-task! *kill-task*)
+  (cond (ego (let ((key (ego-public-key ego)))
+              (simple-format #t "~a - ~a\n" "testremi"
+                             (ecdsa-public-key->string key))))
+       ((not ego)
+        (simple-format #t "Undefined error in the identity service\n"))))
+
+(define (first-task _)
+  (set! *handle* (start-ego-lookup *config* "testremi" print-ego))
+  (set! *kill-task* (add-task! shutdown-task #:delay (* 5 1000 1000))))
+
+(define (main args)
+  (set! *config* (load-configuration "~/.gnunet/gnunet.conf"))
+  (call-with-scheduler *config* first-task))
diff --git a/examples/identity.scm b/examples/identity.scm
new file mode 100755
index 0000000..bb11ada
--- /dev/null
+++ b/examples/identity.scm
@@ -0,0 +1,49 @@
+#!/usr/bin/guile \
+-e (@\ (gnunet-identity)\ main) -L . -s
+!#
+;;;; Copyright © 2015 Rémi Delrue <address@hidden>
+;;;; 
+;;;; 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 3 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, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnunet-identity)
+  #: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)
+  #:export     (main))
+
+(define *config* #f) ; configuration handle
+(define *handle* #f) ; identity handle
+(define *kill-task* #f)
+
+(define (shutdown-task _)
+  (when *handle* (close-identity-service *handle*)))
+
+(define (print-ego ego name)
+  (cond ((and ego name)
+        (let ((key (ego-public-key ego)))
+          (simple-format #t "~a - ~a\n" name (ecdsa-public-key->string key))))
+       ((not ego)
+        (cancel-task! *kill-task*)
+        (set-next-task! shutdown-task))))
+
+(define (first-task _)
+  (set! *handle* (open-identity-service *config* print-ego))
+  (set! *kill-task* (add-task! shutdown-task #:delay (* 5 1000 1000))))
+
+(define (main args)
+  (set! *config* (load-configuration "~/.gnunet/gnunet.conf"))
+  (call-with-scheduler *config* first-task))
diff --git a/examples/search-ns.scm b/examples/search-ns.scm
new file mode 100755
index 0000000..9d2ac13
--- /dev/null
+++ b/examples/search-ns.scm
@@ -0,0 +1,103 @@
+#!/usr/bin/guile \
+-e (@\ (gnunet-search)\ main) -L . -s
+!#
+;;;; Copyright © 2015 Rémi Delrue <address@hidden>
+;;;; 
+;;;; 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 3 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, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnunet-search)
+  #:use-module (ice-9 match)
+  #:use-module (system foreign)
+  #:use-module (gnu gnunet configuration)
+  #:use-module (gnu gnunet scheduler)
+  #:use-module (gnu gnunet identity)
+  #:use-module (gnu gnunet container metadata)
+  #:use-module (gnu gnunet fs)
+  #:use-module (gnu gnunet fs uri)
+  #:use-module (gnu gnunet fs progress-info)
+  #:export     (main))
+
+(define *config-file*   "~/.gnunet/gnunet.conf")
+(define *config*        #f)
+(define *kill-task*     #f)
+
+(define *fs-handle*     #f)
+(define *search-handle* #f)
+(define *lookup-op*     #f)
+
+(define *binary-name*   #f)
+(define *identifier*    #f)
+(define *ns-name*       #f)
+(define *ns-ego*        #f)
+(define *uri*           #f)
+
+(define (main args)
+  (set! *config* (load-configuration *config-file*))
+  (set! *binary-name* (car args))
+  (cond ((not (= (length args) 3))
+        (simple-format #t "Usage: ~a <namespace> <identifier>\n" (car args)))
+       (else
+        (set! *ns-name* (cadr args))
+        (set! *identifier*  (caddr args))
+        (call-with-scheduler *config* first-task))))
+
+(define (first-task _)
+  (set! *lookup-op*
+    (start-ego-lookup *config* *ns-name* ego-callback))
+  (set! *kill-task*
+    (add-task! (lambda (_) (stop-ego-lookup! *lookup-op*))
+              #:delay (* 5 1000 1000))))
+
+(define (ego-callback ego)
+  (cancel-task! *kill-task*)
+  (set! *ns-ego* ego)
+  (ego-continuation))
+
+(define (ego-continuation)
+  (cond
+   ((not *ns-ego*) (simple-format #t "Error: ego ~a not found\n" *ns-name*))
+   (else
+    (set! *fs-handle*     (open-filesharing-service *config* *binary-name*
+                                                   progress-callback))
+    (set! *uri*           (make-sks-uri (ego-public-key *ns-ego*) 
*identifier*))
+    (set! *search-handle* (start-search *fs-handle* *uri*))
+    (set! *kill-task*     (add-task! (lambda (_)
+                                      (stop-search *search-handle*))
+                                    #:delay (* 5 1000 1000)))
+    (simple-format #t "Searching ~a\n" (uri->string *uri*)))))
+
+(define (progress-callback %info)
+  (let ((status (progress-info-status %info)))
+    (when (equal? '(#:search #:result) status)
+      (match (parse-c-progress-info %info)
+       (((context cctx pctx %query duration anonymity
+                  (%metadata %uri %result applicability-rank)) _ _)
+        (let* ((result-uri        (uri->string (wrap-uri %uri)))
+               (metadata          (wrap-metadata %metadata))
+               (result-directory? (is-directory? metadata))
+               (result-filename   (metadata-ref metadata #:original-filename)))
+          (cond ((and result-directory?
+                      (string-null? result-filename))
+                 (simple-format
+                  #t "gnunet-download -o \"collection.gnd\" -R ~a\n"
+                  result-uri))
+                (result-directory?
+                 (simple-format #t
+                                "gnunet-download -o \"~a.gnd\" -R ~a\n"
+                                result-filename result-uri))
+                ((string-null? result-filename)
+                 (simple-format #t "gnunet-download ~a\n" result-uri))
+                (else
+                 (simple-format #t "gnunet-download -o \"~a\" ~a\n"
+                                result-filename result-uri)))))))))
diff --git a/gnu/gnunet/configuration.scm b/gnu/gnunet/configuration.scm
index 263c237..dfe2c48 100644
--- a/gnu/gnunet/configuration.scm
+++ b/gnu/gnunet/configuration.scm
@@ -25,7 +25,8 @@
             load-configuration
             configuration?
             unwrap-configuration
-            configuration-ref))
+            configuration-ref
+            configuration-value-set?))
 
 (define-record-type <configuration>
   (wrap-configuration pointer)
@@ -40,6 +41,8 @@
   "GNUNET_CONFIGURATION_get_value_number" : '(* * * *) -> int)
 (define-gnunet %get-value-string
   "GNUNET_CONFIGURATION_get_value_string" : '(* * * *) -> int)
+(define-gnunet %configuration-have-value?
+  "GNUNET_CONFIGURATION_have_value"       : '(* * *) -> int)
 
 (define (load-configuration filename)
   "Load GnuNet default configuration (a set of files sometimes placed
@@ -76,3 +79,9 @@ denoted by FILENAME. Returns a configuration handle."
            (pointer->string
             (dereference-pointer (bytevector->pointer result)))))
         #f)))
+
+(define (configuration-value-set? config section option)
+  (= gnunet-ok
+     (%configuration-have-value? (unwrap-configuration config)
+                                 (string->pointer* section)
+                                 (string->pointer* option))))
diff --git a/gnu/gnunet/fs/uri.scm b/gnu/gnunet/fs/uri.scm
index 9e43841..485f450 100644
--- a/gnu/gnunet/fs/uri.scm
+++ b/gnu/gnunet/fs/uri.scm
@@ -91,6 +91,8 @@
   (string-concatenate/shared (interleave " " keywords)))
 
 (define* (wrap-uri pointer #:key (finalize #f))
+  (when (eq? %null-pointer pointer)
+    (throw 'invalid-arg "wrap-uri" pointer))
   (when finalize
     (set-pointer-finalizer! pointer %uri-destroy))
   (%wrap-uri pointer (%uri-get-type pointer)))
@@ -138,8 +140,7 @@
     (throw 'invalid-arg "make-sks-uri-pointer" identifier))
   ;; GNUNET_FS_uri_sks_create cannot return a NULL pointer; on memory shortage,
   ;; it aborts.
-  (%uri-sks-create (string->data-pointer namespace (/ 256 8))
-                   (string->pointer identifier)))
+  (%uri-sks-create namespace (string->pointer identifier)))
 
 ;;+TODO: divide <uri> into four types (ksk, sks, chk, loc) and ship valuable
 ;;       information, such as namespace & identifier (for the sks URIs).
diff --git a/gnu/gnunet/identity.scm b/gnu/gnunet/identity.scm
index d05dd01..d453e2a 100644
--- a/gnu/gnunet/identity.scm
+++ b/gnu/gnunet/identity.scm
@@ -17,7 +17,6 @@
 
 (define-module (gnu gnunet identity)
   #:use-module (srfi srfi-9)
-  #:use-module (srfi srfi-9 gnu)
   #:use-module (system foreign)
   #:use-module (rnrs bytevectors)
   #:use-module (gnu gnunet common)
@@ -36,7 +35,8 @@
            set-default-ego
            cancel-operation!
            start-ego-lookup
-           stop-ego-lookup!))
+           stop-ego-lookup!
+            ecdsa-public-key->string))
 
 
 (define-record-type <ego>
@@ -44,12 +44,6 @@
   ego?
   (pointer unwrap-ego))
 
-(set-record-type-printer! <ego>
-  (lambda (ego port)
-    (write-char #\< port)
-    (display "ego")
-    (display (unwrap-ego ego) port)
-    (write-char #\> port)))
 
 (define-gnunet-id %get-private-key
   "GNUNET_IDENTITY_ego_get_private_key" : '(*)   -> '*)
@@ -72,6 +66,9 @@
   "GNUNET_IDENTITY_ego_lookup"        : '(* * * *) -> '*)
 (define-gnunet-id %ego-lookup-cancel!
   "GNUNET_IDENTITY_ego_lookup_cancel" : '(*)       -> void)
+
+(define-gnunet %ecdsa-public-key->string
+  "GNUNET_CRYPTO_ecdsa_public_key_to_string" : '(*) -> '*)
 
 (define (ego-private-key ego)
   (%get-private-key (unwrap-ego ego)))
@@ -167,3 +164,9 @@ Return a handle to the lookup that can be cancelled with 
CANCEL-EGO-LOOKUP!"
 (define (stop-ego-lookup! lookup)
   "Abort an ego lookup attempt."
   (%ego-lookup-cancel! lookup))
+
+(define (ecdsa-public-key->string key)
+  (let* ((%s (%ecdsa-public-key->string key))
+        (res (pointer->string %s)))
+    (%free %s)
+    res))
diff --git a/tests/identity.scm b/tests/identity.scm
new file mode 100644
index 0000000..d41f851
--- /dev/null
+++ b/tests/identity.scm
@@ -0,0 +1,51 @@
+;;;; -*- mode: Scheme; indent-tabs-mode: nil; fill-column: 80; -*-
+;;;; 
+;;;; Copyright © 2015 Rémi Delrue <address@hidden>
+;;;; 
+;;;; 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 3 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, see <http://www.gnu.org/licenses/>.
+
+(define-module (test-identity)
+  #:use-module (srfi srfi-64)
+  #:use-module (system foreign)
+  #:use-module (rnrs bytevectors)
+  #:use-module (gnu gnunet identity))
+
+;; struct GNUNET_IDENTITY_ego {
+;;     struct GNUNET_CRYPTO_EcdsaPrivateKey *pk;
+;;     char *name;
+;;     void *ctx;
+;;     struct GNUNET_HashCode id;
+;; }
+
+(define *test-ego*
+  (let* ((len  (+ (* 3 (sizeof ptrdiff_t))
+                 (* 16 (sizeof uint32)))) ; sizeof struct GNUNET_HashCode
+        (size (sizeof ptrdiff_t))
+        (endi (native-endianness))
+        (bv   (make-bytevector len 0))
+        (priv (string->pointer "sonic"))
+        (name (string->pointer "screwdriver"))
+        (hash (string->utf8 "oods are odd")))
+    (bytevector-sint-set! bv 0 (pointer-address priv) endi size)
+    (bytevector-sint-set! bv size (pointer-address name) endi size)
+    ;; hash will start with "oods are odd" end continue with zeroes
+    (bytevector-copy! hash 0 bv (* 3 size) (bytevector-length hash))
+    (wrap-ego (bytevector->pointer bv))))
+
+(test-begin "test-identity")
+
+(test-assert (ego? *test-ego*))
+(test-equal "sonic" (pointer->string (ego-private-key *test-ego*)))
+
+(test-end)
diff --git a/tests/uri.scm b/tests/uri.scm
index 4453a95..cefc7d0 100644
--- a/tests/uri.scm
+++ b/tests/uri.scm
@@ -18,10 +18,14 @@
 (define-module (test-fs-uri)
   #:use-module (system foreign)
   #:use-module (srfi srfi-64)
+  #:use-module (gnu gnunet common)
   #:use-module (gnu gnunet fs uri))
 
 (test-begin "test-fs-uri")
 
+;; wrap-uri
+(test-error 'invalid-arg (wrap-uri %null-pointer))
+
 ;; keyword-list->string
 (test-equal "" (keyword-list->string '()))
 (test-equal "foo bar baz" (keyword-list->string '("foo" "bar" "baz")))
@@ -38,7 +42,8 @@
 
 ;; make-sks-uri
 
-(define test-ns "M2OC987U9LFJHQ8LC9SLCV4Q0ONHJV7FMTFQ2VRPE0M9R9MK5860")
+(define test-pk "M2OC987U9LFJHQ8LC9SLCV4Q0ONHJV7FMTFQ2VRPE0M9R9MK5860")
+(define test-ns (string->data-pointer test-pk (/ 256 8)))
 
 (test-error 'invalid-arg (make-sks-uri-pointer test-ns ""))