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

@@ -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)))
-

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)))
 

gnu/gnunet/identity.scm

@@ -0,0 +1,161 @@
+;;;; -*- mode: Scheme; indent-tabs-mode: nil; fill-column: 80; -*-
+;;;; 
+;;;; Copyright © 2015 Rémi Delrue <asgeir@free.fr>
+;;;; 
+;;;; 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))