;;;; -*- mode: Scheme; indent-tabs-mode: nil; fill-column: 80; -*- ;;;; ;;;; Copyright © 2015 Rémi Delrue ;;;; ;;;; 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 . (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? 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! ecdsa-public-key->string)) (define-record-type (wrap-ego pointer) ego? (pointer unwrap-ego)) (define-gnunet-id %get-private-key "GNUNET_IDENTITY_ego_get_private_key" : '(*) -> '*) (define-gnunet-id %get-public-key "GNUNET_IDENTITY_ego_get_public_key" : '(* *) -> void) (define-gnunet-id %identity-connect "GNUNET_IDENTITY_connect" : '(* * *) -> '*) (define-gnunet-id %identity-disconnect "GNUNET_IDENTITY_disconnect" : '(*) -> void) (define-gnunet-id %identity-get "GNUNET_IDENTITY_get" : '(* * * *) -> '*) (define-gnunet-id %identity-set! "GNUNET_IDENTITY_set" : '(* * * * *) -> '*) (define-gnunet-id %cancel! "GNUNET_IDENTITY_cancel" : '(*) -> void) (define-gnunet-id %ego-lookup "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))) (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." (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." (%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 "get-default-ego" 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 (or (not (string? name)) (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)) (define (ecdsa-public-key->string key) (let* ((%s (%ecdsa-public-key->string key)) (res (pointer->string %s))) (%free %s) res))