[gnunet] 06/17: Bind GNUNET_FS_IDENTITY_* functions and add support for publishing in namespaces. * identity.scm: complete bindings of GNUNET_FS_IDENTITY * fs.scm: add support for egos/namespaces to `start-publish` * binding-utils: remove the useless import of `assert`

[R�mi Birot-Delrue]

remibd pushed a commit to branch master
in repository gnunet.

commit 96048086c654898673eef5a1946fdaec6a4d008a
Author: Rémi Birot-Delrue <address@hidden>
Date:   Tue Jul 21 19:25:04 2015 +0200

    Bind GNUNET_FS_IDENTITY_* functions and add support for publishing in 
namespaces.
    * identity.scm: complete bindings of GNUNET_FS_IDENTITY
    * fs.scm: add support for egos/namespaces to `start-publish`
    * binding-utils: remove the useless import of `assert`
---
 gnu/gnunet/binding-utils.scm |    3 +-
 gnu/gnunet/fs.scm            |   26 +++++--
 gnu/gnunet/identity.scm      |  161 ++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 182 insertions(+), 8 deletions(-)

diff --git a/gnu/gnunet/binding-utils.scm b/gnu/gnunet/binding-utils.scm
index cabbcf7..f82b328 100644
--- a/gnu/gnunet/binding-utils.scm
+++ b/gnu/gnunet/binding-utils.scm
@@ -18,7 +18,6 @@
 (define-module (gnu gnunet binding-utils)
   #:use-module (ice-9 match)
   #:use-module ((srfi srfi-1) #:select (find))
-  #:use-module ((rnrs base) #:select (assert))
   #:use-module (rnrs bytevectors)
   #:use-module (system foreign)
   #:export (getf
@@ -67,6 +66,7 @@
   (if (or (null? lst) (null? (cdr lst)))
       lst
       (cons (car lst) (%interleave (cdr lst)))))
+
 
 ;;; FFI utilities
 
@@ -77,4 +77,3 @@ if STRING is empty (\"\")."
 
 (define (pointer->string* ptr)
   (if (eq? %null-pointer ptr) #f (pointer->string ptr)))
-
diff --git a/gnu/gnunet/fs.scm b/gnu/gnunet/fs.scm
index f297663..010d166 100644
--- a/gnu/gnunet/fs.scm
+++ b/gnu/gnunet/fs.scm
@@ -24,6 +24,7 @@
   #:use-module (gnu gnunet common)
   #:use-module (gnu gnunet configuration)
   #:use-module (gnu gnunet container metadata)
+  #:use-module (gnu gnunet identity)
   #:use-module (gnu gnunet fs uri)
   #:use-module (gnu gnunet fs progress-info)
   #:use-module (gnu gnunet scheduler)
@@ -293,14 +294,27 @@ filesharing service (a search is started, a download is 
completed, etc.)."
   (%download-stop download-handle (if delete-incomplete? gnunet-yes 
gnunet-no)))
 
 (define* (start-publish filesharing-handle file-information
-                        #:key namespace namespace-identifier
+                        #:key namespace identifier
                         update-identifier simulate?)
   "Publish a file or a directory. If SIMULATE? is #t, no data will be stored in
-the datastore."
-  (let ((%namespace    (or namespace %null-pointer))
-        (%namespace-id (or namespace-identifier %null-pointer))
-        (%update-id    (or update-identifier %null-pointer))
-        (%option       (if simulate? gnunet-yes gnunet-no)))
+the datastore.
+
+By default, publishing is made in the global namespace (keywords extracted from
+the file are used to identify it). If NAMESPACE is set (to an instance of
+<ego>), then IDENTIFIER should also be set (to a string that will be used to
+identify the publication in place of the extracted keywords)."
+  ;; if namespace is set, identifier must be, and conversely
+  (when (or (and namespace (not identifier))
+            (and identifier (not namespace)))
+    (throw 'invalid-arg "start-publish" namespace identifier))
+  ;; update-identifier has no sense if namespace is #f
+  (when (and update-identifier (not namespace))
+    (throw 'invalid-arg "start-publish" namespace update-identifier))
+  (let ((%namespace  (if namespace  (unwrap-ego namespace) %null-pointer))
+        (%identifier (if identifier (string->pointer identifier) 
%null-pointer))
+        (%update-id  (if update-identifier (string->pointer update-identifier)
+                         %null-pointer))
+        (%option     (if simulate?  gnunet-yes gnunet-no)))
     (%publish-start filesharing-handle file-information
                     %namespace %namespace-id %update-id %option)))
 
diff --git a/gnu/gnunet/identity.scm b/gnu/gnunet/identity.scm
new file mode 100644
index 0000000..aa80106
--- /dev/null
+++ b/gnu/gnunet/identity.scm
@@ -0,0 +1,161 @@
+;;;; -*- 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 (gnu gnunet identity)
+  #:use-module (srfi srfi-9)
+  #:use-module (system foreign)
+  #:use-module (rnrs bytevectors)
+  #:use-module (gnu gnunet common)
+  #:use-module (gnu gnunet binding-utils)
+  #:use-module (gnu gnunet configuration)
+  #:export (<ego>
+           ego?
+           wrap-ego
+           unwrap-ego
+           
+           ego-private-key
+           ego-public-key
+           open-identity-service
+           close-identity-service
+           get-default-ego
+           set-default-ego
+           cancel-operation!
+           start-ego-lookup
+           stop-ego-lookup!))
+
+
+(define-record-type <ego>
+  ego?
+  (wrap-ego pointer)
+  (pointer unwrap-ego))
+
+
+(define-gnunet %get-private-key
+  "GNUNET_IDENTITY_ego_get_private_key" : '(*)   -> '*)
+(define-gnunet %get-public-key
+  "GNUNET_IDENTITY_ego_get_public_key"  : '(* *) -> void)
+
+(define-gnunet %identity-connect
+  "GNUNET_IDENTITY_connect"    : '(* * *) -> '*)
+(define-gnunet %identity-disconnect
+  "GNUNET_IDENTITY_disconnect" : '(*)     -> void)
+
+(define-gnunet %identity-get
+  "GNUNET_IDENTITY_get"      : '(* * * *)   -> '*)
+(define-gnunet %identity-set!
+  "GNUNET_IDENTITY_set"      : '(* * * * *) -> '*)
+
+(define-gnunet %cancel! "GNUNET_IDENTITY_cancel" : '(*) -> void)
+
+(define-gnunet %ego-lookup
+  "GNUNET_IDENTITY_ego_lookup"        : '(* * * *) -> '*)
+(define-gnunet %ego-lookup-cancel!
+  "GNUNET_IDENTITY_ego_lookup_cancel" : '(*)       -> void)
+
+(define (ego-private-key ego)
+  (%get-private-key (unwrap-ego ego)))
+
+(define (ego-public-key ego)
+  (let ((key (bytevector->pointer
+             (make-bytevector (sizeof ecdsa-public-key)))))
+    (%get-public-key (unwrap-ego ego) key)
+    key))
+
+(define (identity-callback->pointer thunk)
+  (procedure->pointer void
+                     (lambda (closure ego context name)
+                       (thunk (if (eq? %null-pointer ego) #f (wrap-ego ego))
+                              (pointer->string* name)))
+                     '(* * * *)))
+
+(define (open-identity-service config identity-callback)
+  "Connect to the identity service. IDENTITY-CALLBACK is called on each ego
+known by the service, and once with arguments (#f #f) to mark the end of the
+initial pass. Please note IDENTITY-CALLBACK can still be called after that: on
+error (with arguments (#f #f)), and whenever an ego’s name changes or if it is
+deleted.
+
+IDENTITY-CALLBACK is a function of two arguments: an ego (or #f) and the name
+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))
+
+(define (close-identity-service identity-handle)
+  "Disconnect from the identity service."
+  (%identity-disconnect identity-handle))
+
+(define (get-default-ego identity-handle service identity-callback)
+  "Obtain the ego that is currently prefered/default for SERVICE.
+
+IDENTITY-CALLBACK is called once with arguments (#f #f) on error and with
+non-null arguments on success, in which case OPEN-IDENTITY-SERVICE’s own
+IDENTITY-CALLBACK will also be called.
+
+Returns a handle to the “ego retrieving operation” that can be used to
+cancel it (see CANCEL-OPERATION!)."
+  (when (string-null? service)
+    (throw 'invalid-arg "open-identity-service" service))
+  (%identity-get identity-handle (string->pointer service)
+                (identity-callback->pointer identity-callback) %null-pointer))
+
+(define (set-default-ego identity-handle service ego identity-callback)
+  "Set the preferred/default ego for SERVICE.
+
+IDENTITY-CALLBACK is called once with arguments (#f #f) on error and with
+non-null arguments on success, in which case OPEN-IDENTITY-SERVICE’s own
+IDENTITY-CALLBACK will also be called.
+
+Returns a handle to the “ego setting operation” that can be used to cancel
+it (see CANCEL-OPERATION!)."
+  (when (string-null? service)
+    (throw 'invalid-arg "set-current-ego" service))
+  (when (eq? %null-pointer ego)
+    (throw 'invalid-arg "set-current-ego" ego))
+  (%identity-set! identity-handle (string->pointer service) (unwrap-ego ego)
+                 (identity-callback->pointer identity-callback) %null-pointer))
+
+(define (cancel-operation! op)
+  "Cancel an identity operation.
+
+Note that the operation may still be executed, notably if the request was
+already transmitted to the service."
+  (when (eq? %null-pointer op)
+    (throw 'invalid-arg "cancel-operation!" op))
+  (%cancel! op))
+
+(define (ego-callback->pointer thunk)
+  (procedure->pointer void
+                     (lambda (closure ego)
+                       (thunk (if (eq? %null-pointer ego) #f (wrap-ego ego))))
+                     '(* *)))
+
+(define (start-ego-lookup config name ego-callback)
+  "Lookup an ego by NAME.
+
+Return a handle to the lookup that can be cancelled with CANCEL-EGO-LOOKUP!"
+  (when (string-null? name)
+    (throw 'invalid-arg "lookup-ego" name))
+  (%ego-lookup (unwrap-configuration config) (string->pointer name)
+              (ego-callback->pointer ego-callback) %null-pointer))
+
+(define (stop-ego-lookup! lookup)
+  "Abort an ego lookup attempt."
+  (%ego-lookup-cancel! lookup))