179 lines
6.7 KiB
Scheme
Executable File
179 lines
6.7 KiB
Scheme
Executable File
#!/usr/bin/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 (system foreign)
|
||
#:use-module (gnu gnunet common)
|
||
#:use-module (gnu gnunet fs)
|
||
#:use-module (gnu gnunet fs uri)
|
||
#:use-module (gnu gnunet fs progress-info)
|
||
#:use-module (gnu gnunet configuration)
|
||
#:use-module (gnu gnunet scheduler)
|
||
#:use-module (gnu gnunet identity)
|
||
#:export (main))
|
||
|
||
(define *index?* #t)
|
||
(define *simulate?* #f)
|
||
|
||
(define *config-file* "~/.gnunet/gnunet.conf")
|
||
(define *config* #f)
|
||
|
||
(define *binary-name* #f)
|
||
(define *filename* #f)
|
||
|
||
;;+TODO: add kill tasks everywhere!
|
||
;;+TODO: each continuation shalt check its indirect arguments.
|
||
;; The kill task is the task that will end the program, either because it has
|
||
;; reached a timeout or because it has come to a normal or abnormal ending.
|
||
(define *kill-task* #f)
|
||
|
||
(define *namespace-name* #f)
|
||
(define *namespace-ego* #f)
|
||
|
||
(define *file-identifier* #f)
|
||
|
||
(define *fs-handle* #f)
|
||
(define *identity-handle* #f)
|
||
(define *publish-handle* #f)
|
||
(define *dir-scanner* #f)
|
||
|
||
|
||
(define (main args)
|
||
"Entry point of the program."
|
||
(set! *config* (load-configuration *config-file*))
|
||
(call-with-scheduler *config* (first-task args)))
|
||
|
||
(define (first-task args)
|
||
"The initial task: parse the command line and either find the
|
||
demanded ego or call IDENTITY-CONTINUATION."
|
||
(lambda (_)
|
||
(match args
|
||
((binary filename namespace identifier)
|
||
(set! *binary-name* binary)
|
||
(set! *filename* filename)
|
||
(set! *namespace-name* namespace)
|
||
(set! *file-identifier* identifier)
|
||
(set! *identity-handle*
|
||
(open-identity-service *config* identity-callback))
|
||
(set! *kill-task*
|
||
(add-task! (lambda (_)
|
||
(close-identity-service *identity-handle*))
|
||
#:delay (time-rel #:seconds 5))))
|
||
((binary file-name)
|
||
(set! *binary-name* binary)
|
||
(set! *filename* file-name)
|
||
(identity-continuation))
|
||
((binary . _)
|
||
(simple-format #t "Usage: ~a filename [namespace identifier]\n"
|
||
binary)
|
||
(schedule-shutdown!)))))
|
||
|
||
(define (identity-callback ego name)
|
||
"The first callback, called repeatedly by the identity service. Set
|
||
NAMESPACE-EGO to the right ego, then continue with
|
||
IDENTITY-CONTINUATION."
|
||
(display "IDENTITY-CALLBACK\n")
|
||
(cond ((and ego name (string= *namespace-name* name))
|
||
(set! *namespace-ego* ego))
|
||
((and (not ego) (not name)) ; last call
|
||
(cancel-task! *kill-task*)
|
||
(identity-continuation))))
|
||
|
||
(define (identity-continuation)
|
||
"The second task: open the filesharing service and start a directory
|
||
scan on *FILENAME*."
|
||
(display "IDENTITY-CONTINUATION\n")
|
||
(cond
|
||
((or (and *namespace-name* *namespace-ego*)
|
||
(and (not *namespace-name*) (not *namespace-ego*)))
|
||
(if *namespace-name*
|
||
(simple-format #t " -> FILENAME ~a\tNAMESPACE ~a\n" *filename* *namespace-name*)
|
||
(display " -> FILENAME ~a\n"))
|
||
(set! *fs-handle* (open-filesharing-service *config* *binary-name*
|
||
progress-callback))
|
||
(set! *dir-scanner* (start-directory-scan *filename* dirscan-callback))
|
||
(set! *kill-task* (add-task! (lambda (_)
|
||
(display "Stopping directory scan (unexpected)\n")
|
||
(stop-directory-scan *dir-scanner*))
|
||
#:delay (time-rel #:seconds 5))))
|
||
(else
|
||
(simple-format #t "Error: no ego named ~a has been found!\n"
|
||
*namespace-name*)
|
||
;; there’s an error, we must execute the killing task right now
|
||
(schedule-shutdown!))))
|
||
|
||
(define (dirscan-callback filename directory? reason)
|
||
"The second callback, called repeatedly by the directory scanning
|
||
tasks: wait until the scan is finished, interpret its results and
|
||
start the publication by calling DIRSCAN-CONTINUATION."
|
||
(simple-format #t "DIRSCAN-CALLBACK(~a ~a ~a)\n" filename directory? reason)
|
||
(case reason
|
||
((#:finished)
|
||
(cancel-task! *kill-task*)
|
||
(let* ((%share-tree (directory-scanner-result *fs-handle* *dir-scanner*))
|
||
(file-info (share-tree->file-information *fs-handle* %share-tree
|
||
*index?*)))
|
||
(dirscan-continuation file-info)))
|
||
((#:internal-error)
|
||
(display "dirscan-callback: internal error.\n")
|
||
(schedule-shutdown!))))
|
||
|
||
(define (dirscan-continuation file-info)
|
||
"Start the publication of FILE-INFO."
|
||
(display "DIRSCAN-CONTINUATION\n")
|
||
(set! *publish-handle*
|
||
(start-publish *fs-handle* file-info
|
||
#:namespace *namespace-ego*
|
||
#:identifier *file-identifier*
|
||
#:simulate? *simulate?*))
|
||
(set! *kill-task* (add-task! (lambda (_)
|
||
(display "Stopping publication (unexpected)\n")
|
||
(stop-publish *publish-handle*))
|
||
#:delay (time-rel #:seconds 5))))
|
||
|
||
(define (progress-callback %info)
|
||
"The third callback, called repeteadly by the publishing tasks once the
|
||
publication is engaged: when the publication starts, print a little something,
|
||
and when it’s complete print the published file’s URI and stop the publication."
|
||
(display "PROGRESS-CALLBACK\n")
|
||
(let ((status (progress-info-status %info)))
|
||
(case (cadr status) ; status is of the form (#:publish <something>)
|
||
((#:start)
|
||
(match (parse-c-progress-info %info)
|
||
(((%context %file-info cctx pctx %filename . _) _ _)
|
||
(simple-format #t "Publishing `~a'.\n" (pointer->string %filename)))))
|
||
((#:completed)
|
||
(display "3\n")
|
||
(cancel-task! *kill-task*)
|
||
(match (parse-c-progress-info %info)
|
||
(((%context %file-info cctx pctx %filename _ _ _ _ _ (%chk-uri)) _ _)
|
||
(simple-format #t "Published `~a'.\n~a\n" (pointer->string %filename)
|
||
(uri->string (wrap-uri %chk-uri)))))
|
||
;; We must avoid calling `stop-publish` inside the progress-callback, as
|
||
;; it frees the publish-handle that might still be used just after this
|
||
;; call to progress-callback ends. Therefore, we continue with a new kill
|
||
;; task.
|
||
(set! *kill-task*
|
||
(set-next-task! (lambda (_)
|
||
(display "Stopping publication\n")
|
||
(stop-publish *publish-handle*)))))
|
||
((#:stopped)
|
||
(display "Publication stopped\n")
|
||
(schedule-shutdown!)))))
|