#!@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: