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:
Rémi Birot-Delrue 2015-07-31 12:10:34 +02:00
parent ac1479fa17
commit 8fce653b32
8 changed files with 282 additions and 12 deletions

49
examples/identity-bis.scm Executable file
View File

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

49
examples/identity.scm Executable file
View File

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

103
examples/search-ns.scm Executable file
View File

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

View File

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

View File

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

View File

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

51
tests/identity.scm Normal file
View File

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

View File

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