202 lines
7.0 KiB
Plaintext
202 lines
7.0 KiB
Plaintext
#!@GUILE@ \
|
|
-e (@\ (gnunet-publish)\ 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-publish)
|
|
#:use-module (ice-9 match)
|
|
#:use-module (ice-9 getopt-long)
|
|
#:use-module (rnrs bytevectors)
|
|
#:use-module (system foreign)
|
|
#:use-module (gnu gnunet binding-utils)
|
|
#: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))
|
|
|
|
;;; foreign utilities
|
|
|
|
(define-gnunet %relative-time-to-string
|
|
"GNUNET_STRINGS_relative_time_to_string" : (list time-relative int) -> '*)
|
|
|
|
(define* (time-relative->string t #:optional (round? #t))
|
|
(let ((s (%relative-time-to-string t (bool->int round?))))
|
|
(when (eq? %null-pointer s)
|
|
(throw 'invalid-result "time-relative->string" "%relative-time-to-string"
|
|
s (list t (bool->int round?))))
|
|
(pointer->string s)))
|
|
|
|
;;; parameters
|
|
|
|
(define %options
|
|
'((simulate (single-char #\s) (value #f))
|
|
(pseudonym (single-char #\P) (value #t))
|
|
(this-id (single-char #\t) (value #t))
|
|
(update-id (single-char #\N) (value #t))))
|
|
|
|
(define %block-options
|
|
(make-block-options (time-relative->absolute (time-rel #:days 365)) 0))
|
|
|
|
(define *config-file* "~/.gnunet/gnunet.conf")
|
|
(define *simulate?* #f)
|
|
(define *index?* #t)
|
|
(define *pseudonym* #f) ; a string
|
|
(define *ego* #f) ; an instance of <ego>
|
|
(define *path* #f)
|
|
(define *id* #f) ; file identifier
|
|
(define *update-id* #f) ; update file identifier
|
|
(define *args* #f) ; ordinary arguments to the command line
|
|
|
|
;;; handles
|
|
|
|
(define *config* #f)
|
|
(define *identity* #f)
|
|
(define *fs* #f)
|
|
(define *publish* #f)
|
|
|
|
;;; cleaning
|
|
|
|
(define (do-stop-task _)
|
|
"We are finished with the publishing operation, clean up all FS state."
|
|
(when *identity*
|
|
(close-identity-service *identity*)
|
|
(set! *identity* #f))
|
|
(cond (*publish*
|
|
(stop-publish *publish*)
|
|
(set! *publish* #f))
|
|
(*fs*
|
|
(close-filesharing-service! *fs*)
|
|
(set! *fs* #f))))
|
|
|
|
;;; callbacks
|
|
|
|
(define (progress-cb info status)
|
|
"Called by FS client to give information about the progress of an operation."
|
|
(match status
|
|
((#:publish #:start) *unspecified*)
|
|
((#:publish (or #:progress #:progress-directory))
|
|
(simple-format #t "Publishing `~a' at ~a/~a (~a remaining)\n"
|
|
(pinfo-publish-filename info)
|
|
(pinfo-publish-completed info)
|
|
(pinfo-publish-size info)
|
|
(time-relative->string (pinfo-publish-eta info))))
|
|
((#:publish #:error)
|
|
(simple-format #t "Error publishing: ~a\n" (pinfo-publish-message info))
|
|
(schedule-shutdown!))
|
|
((#:publish #:completed)
|
|
(simple-format #t "Publishing `~a' done.\nURI is `~a'.\n"
|
|
(pinfo-publish-filename info)
|
|
(uri->string (pinfo-publish-chk-uri info)))
|
|
(when (pinfo-publish-sks-uri info)
|
|
(simple-format #t "Namespace URI is `~a'.\n"
|
|
(uri->string (pinfo-publish-sks-uri info))))
|
|
(schedule-shutdown!))
|
|
((#:publish #:stopped)
|
|
(add-task! do-stop-task))))
|
|
|
|
(define (meta-printer name type format mime-type data)
|
|
"Print metadata entries (except binary metadata and the filename).
|
|
|
|
NAME: name of the plugin that generated the meta data;
|
|
TYPE: type of the meta data;
|
|
FORMAT: format of data;
|
|
MIME-TYPE: mime type of data;
|
|
DATA: bytevector containing the value of the metadata."
|
|
(define (textual? fmt) (or (eq? #:utf8 fmt)
|
|
(eq? #:c-string fmt)))
|
|
(when (and (textual? format)
|
|
(not (eq? #:original-filename type)))
|
|
(simple-format #t "\t~a - ~a\n" type (utf8->string data))))
|
|
|
|
(define (identity-continuation)
|
|
"Continuation proceeding with initialization after identity
|
|
subsystem has been initialized."
|
|
(cond ((and *pseudonym* (not *ego*))
|
|
(simple-format (current-error-port)
|
|
"Selected pseudonym `~a' unknown.\n" *pseudonym*)
|
|
(schedule-shutdown!))
|
|
(else
|
|
(let ((info (make-file-information *fs* *path* %block-options
|
|
#:index? *index?*)))
|
|
(cond ((not info)
|
|
(simple-format (current-error-port)
|
|
"Failed to access `~a'.\n" *path*)
|
|
(schedule-shutdown!))
|
|
(else
|
|
(catch 'invalid-result
|
|
(lambda ()
|
|
(set! *publish*
|
|
(start-publish *fs* info #:namespace *ego*
|
|
#:identifier *id*
|
|
#:update-identifier *update-id*
|
|
#:simulate? *simulate?*)))
|
|
(lambda ()
|
|
(display "Could not start publishing.\n"
|
|
(current-error-port))
|
|
(schedule-shutdown!)))))))))
|
|
|
|
(define (identity-cb ego name)
|
|
"Function called by identity service with known pseudonyms."
|
|
(cond ((not ego) (identity-continuation))
|
|
((and name (string=? *pseudonym* name))
|
|
(set! *ego* ego))))
|
|
|
|
(define (first-task _)
|
|
"Main function that will be run by the scheduler."
|
|
(let ((err (current-error-port)))
|
|
(cond
|
|
((or (not *args*) (null? *args*) (> (length *args*) 1))
|
|
(display "Usage: examples/publish.scm [options] filename\n" err))
|
|
((and *pseudonym* (not *id*))
|
|
(display "Option `-t' is required when using option `-P'.\n" err))
|
|
((and (not *pseudonym*) *id*)
|
|
(display "Option `-t' makes no sense without option `-P'.\n" err))
|
|
((and (not *id*) *update-id*)
|
|
(display "Option `-N' makes no sense without option `-P'.\n" err))
|
|
(else
|
|
(set! *path* (car *args*))
|
|
(set! *fs* (open-filesharing-service *config* "gnunet-publish"
|
|
progress-cb))
|
|
(add-task! do-stop-task #:delay (time-rel #:seconds 5))
|
|
(if *pseudonym*
|
|
(catch 'invalid-result
|
|
(lambda ()
|
|
(set! *identity* (open-identity-service *config* identity-cb)))
|
|
(lambda ()
|
|
(display "Could not connect to the identity service.\n"
|
|
(current-error-port))))
|
|
(identity-continuation))))))
|
|
|
|
(define (main args)
|
|
"The main function to publish content to GNUnet."
|
|
(set! *config* (load-configuration "~/.gnunet/gnunet.conf"))
|
|
(let* ((options (getopt-long args %options)))
|
|
(set! *simulate?* (option-ref options 'simulate #f))
|
|
(set! *pseudonym* (option-ref options 'pseudonym #f))
|
|
(set! *id* (option-ref options 'this-id #f))
|
|
(set! *update-id* (option-ref options 'update-id #f))
|
|
(set! *args* (option-ref options '() #f)))
|
|
(call-with-scheduler *config* first-task))
|
|
|
|
;; Local Variables:
|
|
;; mode: scheme
|
|
;; End:
|