112 lines
3.9 KiB
Scheme
Executable File
112 lines
3.9 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)
|
||
#:export (main))
|
||
|
||
(define config-file "~/.gnunet/gnunet.conf")
|
||
|
||
(define *fs-handle* #f)
|
||
(define *publish-handle* #f)
|
||
(define *dir-scanner* #f)
|
||
(define *kill-task* #f)
|
||
|
||
|
||
(define (progress-cb %info)
|
||
(let ((status (progress-info-status %info)))
|
||
(cond ((equal? status '(#:publish #:start))
|
||
(match (parse-c-progress-info %info)
|
||
(((%context %file-info cctx pctx %filename . _) _ _)
|
||
(simple-format #t "Indexing `~a'.\n"
|
||
(pointer->string %filename)))))
|
||
((equal? status '(#:publish #:completed))
|
||
(match (parse-c-progress-info %info)
|
||
(((%context %file-info cctx pctx %filename _ _ _ _ _
|
||
(chk-uri)) _ _)
|
||
(simple-format #t "Indexed `~a'.\n~a"
|
||
(pointer->string %filename)
|
||
(uri->string (wrap-uri chk-uri)))))
|
||
(when *kill-task* (cancel-task! *kill-task*))
|
||
(set! *kill-task*
|
||
(set-next-task! (lambda (_)
|
||
(stop-publish *publish-handle*)))))
|
||
(else
|
||
(simple-format #t "Got status ~a\n" status)))))
|
||
|
||
(define* (start-publish-file filesharing-handle filename
|
||
#:key simulate? (index? #t))
|
||
(define (scan-progress-cb filename directory? reason)
|
||
(case reason
|
||
((#:finished)
|
||
(let* ((%share-tree #f)
|
||
(file-info #f))
|
||
(set! %share-tree (directory-scanner-result filesharing-handle
|
||
*dir-scanner*))
|
||
(set! *dir-scanner* #f)
|
||
(set! file-info (share-tree->file-information filesharing-handle
|
||
%share-tree index?))
|
||
(set! %share-tree #f)
|
||
(set! *publish-handle*
|
||
(start-publish filesharing-handle (unwrap-file-information file-info)
|
||
#:simulate? simulate?))
|
||
(when *kill-task* (cancel-task! *kill-task*))
|
||
(set! *kill-task*
|
||
(add-task! (lambda (_)
|
||
(stop-publish *publish-handle*)
|
||
(simple-format #t
|
||
"Stopped publication.\n"))
|
||
#:delay (* 5 1000 1000)))))
|
||
|
||
((#:internal-error)
|
||
(simple-format #t "scan-progress-cb: internal error.\n")
|
||
(when *kill-task* (cancel-task! *kill-task*))
|
||
(set! *kill-task*
|
||
(set-next-task! (lambda (_)
|
||
(stop-directory-scan *dir-scanner*)
|
||
(simple-format #t
|
||
"Stopped directory scanner.\n")))))))
|
||
(set! *dir-scanner* (start-directory-scan filename scan-progress-cb))
|
||
(when *kill-task* (cancel-task! *kill-task*))
|
||
(set! *kill-task*
|
||
(add-task! (lambda (_)
|
||
(simple-format #t "stopping directory scanner (2) ~a\n"
|
||
*dir-scanner*)
|
||
(stop-directory-scan *dir-scanner*)
|
||
(simple-format #t
|
||
"Stopped directory scanner.\n"))
|
||
#:delay (* 5 1000 1000))))
|
||
|
||
|
||
(define (main args)
|
||
(let ((config (load-configuration config-file)))
|
||
(define (first-task _)
|
||
(match args
|
||
((binary-name filename)
|
||
(set! *fs-handle* (open-filesharing-service config binary-name
|
||
progress-cb))
|
||
(start-publish-file *fs-handle* filename))))
|
||
(call-with-scheduler config first-task)))
|