176 lines
6.1 KiB
Scheme
176 lines
6.1 KiB
Scheme
;;;; -*- 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!
|
||
ecdsa-public-key->string))
|
||
|
||
|
||
(define-record-type <ego>
|
||
(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))
|