gnunet/examples/search-ns.scm

#!/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 common)
  #: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 (time-rel #:seconds 5))))

(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 (time-rel #:seconds 5)))
    (simple-format #t "Searching ~a\n" (uri->string *uri*)))))

(define (progress-callback info status)
  (when (equal? '(#:search #:result) status)
    (let* ((result-uri        (uri->string (pinfo-search-uri info)))
	   (metadata          (pinfo-search-metadata info))
	   (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)))))
  (when (equal? '(#:search #:stopped) status)
    (add-task!
     (lambda (_) (close-filesharing-service! *fs-handle*)))))