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`.
This commit is contained in:
parent
ac1479fa17
commit
8fce653b32
|
@ -0,0 +1,49 @@
|
|||
#!/usr/bin/guile \
|
||||
-e (@\ (gnunet-identity)\ main) -L . -s
|
||||
!#
|
||||
;;;; 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 (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))
|
|
@ -0,0 +1,49 @@
|
|||
#!/usr/bin/guile \
|
||||
-e (@\ (gnunet-identity)\ main) -L . -s
|
||||
!#
|
||||
;;;; 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 (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))
|
|
@ -0,0 +1,103 @@
|
|||
#!/usr/bin/guile \
|
||||
-e (@\ (gnunet-search)\ main) -L . -s
|
||||
!#
|
||||
;;;; 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 (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)))))))))
|
|
@ -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))))
|
||||
|
|
|
@ -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).
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -0,0 +1,51 @@
|
|||
;;;; -*- 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 (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)
|
|
@ -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 ""))
|
||||
|
||||
|
|
Loading…
Reference in New Issue