From 8fce653b323ee4794336ed305d91d1ad4f1cab5f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?R=C3=A9mi=20Birot-Delrue?= Date: Fri, 31 Jul 2015 12:10:34 +0200 Subject: [PATCH] =?UTF-8?q?Add=20`examples/identity.scm`,=20`examples/iden?= =?UTF-8?q?tity-bis.scm`,=20`examples/search-ns.scm`,=20and=20a=20few=20mi?= =?UTF-8?q?nor=20modifications.=20*=20examples/search-ns.scm:=20a=20basic?= =?UTF-8?q?=20tool=20to=20search=20namespaces.=20*=20examples/identity.scm?= =?UTF-8?q?:=20a=20basic=20tool=20to=20list=20egos.=20*=20examples/identit?= =?UTF-8?q?y-bis.scm:=20idem,=20but=20using=20`start-identity-lookup`.=20*?= =?UTF-8?q?=20fs/uri.scm:=20`wrap-uri`=20throws=20an=20`invalid-arg`=20exc?= =?UTF-8?q?eption=20when=20given=20a=20=20=20=20=20=20=20=20=20=20=20=20?= =?UTF-8?q?=20=20=20null=20pointer.=20*=20tests/uri.scm:=20c.f.=20?= =?UTF-8?q?=E2=86=91=20*=20configuration.scm:=20add=20`configuration-value?= =?UTF-8?q?-set=3F`.=20*=20identity.scm:=20add=20`ecdsa-public-key->string?= =?UTF-8?q?`.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- examples/identity-bis.scm | 49 +++++++++++++++++ examples/identity.scm | 49 +++++++++++++++++ examples/search-ns.scm | 103 +++++++++++++++++++++++++++++++++++ gnu/gnunet/configuration.scm | 11 +++- gnu/gnunet/fs/uri.scm | 5 +- gnu/gnunet/identity.scm | 19 ++++--- tests/identity.scm | 51 +++++++++++++++++ tests/uri.scm | 7 ++- 8 files changed, 282 insertions(+), 12 deletions(-) create mode 100755 examples/identity-bis.scm create mode 100755 examples/identity.scm create mode 100755 examples/search-ns.scm create mode 100644 tests/identity.scm diff --git a/examples/identity-bis.scm b/examples/identity-bis.scm new file mode 100755 index 0000000..9e506a0 --- /dev/null +++ b/examples/identity-bis.scm @@ -0,0 +1,49 @@ +#!/usr/bin/guile \ +-e (@\ (gnunet-identity)\ main) -L . -s +!# +;;;; 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 (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)) diff --git a/examples/identity.scm b/examples/identity.scm new file mode 100755 index 0000000..bb11ada --- /dev/null +++ b/examples/identity.scm @@ -0,0 +1,49 @@ +#!/usr/bin/guile \ +-e (@\ (gnunet-identity)\ main) -L . -s +!# +;;;; 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 (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)) diff --git a/examples/search-ns.scm b/examples/search-ns.scm new file mode 100755 index 0000000..9d2ac13 --- /dev/null +++ b/examples/search-ns.scm @@ -0,0 +1,103 @@ +#!/usr/bin/guile \ +-e (@\ (gnunet-search)\ main) -L . -s +!# +;;;; 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 (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 \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))))))))) diff --git a/gnu/gnunet/configuration.scm b/gnu/gnunet/configuration.scm index 263c237..dfe2c48 100644 --- a/gnu/gnunet/configuration.scm +++ b/gnu/gnunet/configuration.scm @@ -25,7 +25,8 @@ load-configuration configuration? unwrap-configuration - configuration-ref)) + configuration-ref + configuration-value-set?)) (define-record-type (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)))) diff --git a/gnu/gnunet/fs/uri.scm b/gnu/gnunet/fs/uri.scm index 9e43841..485f450 100644 --- a/gnu/gnunet/fs/uri.scm +++ b/gnu/gnunet/fs/uri.scm @@ -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 into four types (ksk, sks, chk, loc) and ship valuable ;; information, such as namespace & identifier (for the sks URIs). diff --git a/gnu/gnunet/identity.scm b/gnu/gnunet/identity.scm index d05dd01..d453e2a 100644 --- a/gnu/gnunet/identity.scm +++ b/gnu/gnunet/identity.scm @@ -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 @@ -44,12 +44,6 @@ ego? (pointer unwrap-ego)) -(set-record-type-printer! - (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)) diff --git a/tests/identity.scm b/tests/identity.scm new file mode 100644 index 0000000..d41f851 --- /dev/null +++ b/tests/identity.scm @@ -0,0 +1,51 @@ +;;;; -*- 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 (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) diff --git a/tests/uri.scm b/tests/uri.scm index 4453a95..cefc7d0 100644 --- a/tests/uri.scm +++ b/tests/uri.scm @@ -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 ""))