gnunet/gnu/gnunet/fs.scm

;;;; -*- mode: Scheme; indent-tabs-mode: nil; fill-column: 80; -*-
;;;; 
;;;; 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 (gnu gnunet fs)
  #:use-module (system foreign)
  #:use-module (gnu gnunet binding-utils)
  #:use-module (gnu gnunet common)
  #:use-module (gnu gnunet configuration)
  #:use-module (gnu gnunet container metadata)
  #:use-module (gnu gnunet fs uri)
  #:use-module (gnu gnunet fs progress-info)
  #:export (search-service-open
            start-ksk-search
            stop-search
            is-directory?))

(define struct-fs-handle
  (list '* '* '* '* '* '* '* '* '* '* '* '* '* '* time-relative
	unsigned-int unsigned-int unsigned-int unsigned-int unsigned-int))

(define struct-search-context
  (list '* '* '* '* '* '* '* '* '* '* time-absolute time-relative '*
	unsigned-int unsigned-int uint32 uint32 unsigned-int))

(define struct-download-context
  (list '* '* '* '* '* '* '* '* '* '* '* '* '* '* '* '* '* '* '* '* '* '* '* '*
	eddsa-public-key '* uint64 uint64 uint64 uint64 time-absolute
	time-relative uint32 unsigned-int unsigned-int int int int))

(define default-max-parallel-downloads 16)
(define default-max-parallel-requests (* 1024 10))

(define-gnunet-fs %search-start
  "GNUNET_FS_search_start" : (list '* '* uint32 unsigned-int '*) -> '*)

(define-gnunet-fs %search-stop
  "GNUNET_FS_search_stop"  : (list '*) -> void)

(define-gnunet-fs %test-for-directory
  "GNUNET_FS_meta_data_test_for_directory" : (list '*) -> int)

(define (progress-callback->pointer thunk)
    (procedure->pointer '* (lambda (cls info)
			     (thunk info)
			     %null-pointer)
			(list '* '*)))

;; This is a temporary replacement for the actual GNUNET_FS_start function that
;; is variadic and, hence, not currently handlable by Guile’s Dynamic FFI.
;; 
;;+TODO: replace value for avg_block_latency with a call to a function
;;       akin `(time-relative #:minutes 1)`
(define (%gnunet-fs-start config client-name progress-callback)
  (make-c-struct struct-fs-handle
		 (list (unwrap-configuration config)
		       (string->pointer client-name)
		       (progress-callback->pointer progress-callback)
		       %null-pointer	        ; progress-cb closure
		       %null-pointer	        ; top_head
		       %null-pointer	        ; top_tail
		       %null-pointer	        ; running_head
		       %null-pointer	        ; running_tail
		       %null-pointer	        ; pending_head
		       %null-pointer	        ; pending_tail
		       %null-pointer	        ; probes_head
		       %null-pointer	        ; probes_tail
		       %null-pointer	        ; queue_job
		       %null-pointer	        ; probe_ping_task
		       (* 60 1000 1000)         ; avg_block_latency (1 minute)
		       0		        ; active_downloads
		       0		        ; active_blocks
		       0		        ; flags
		       default-max-parallel-downloads
		       default-max-parallel-requests)))

(define* (search-service-open config
                              #:key resume resume-result suspend result
                                    result-namespace update error
                                    paused continued result-stopped
                                    result-suspend stopped
                              #:rest callbacks)
  (define (progress-cb %progress-info)
    (let* ((status   (cadr (progress-info-status %progress-info)))
           (callback (getf callbacks status)))
      (when callback (callback %progress-info))))
  (%gnunet-fs-start config "gnunet-search" progress-cb))

(define (start-ksk-search handle keywords)
  (let ((uri (apply make-ksk-uri keywords)))
    (%search-start handle (unwrap-uri uri) 0 0 %null-pointer)))

(define (stop-search handle)
  (%search-stop handle))

;;+TODO: should be (is-directory? search-result) or
;;       (result-is-directory? result)
(define (is-directory? metadata)
  "Checks some search result’s METADATA if its mime-type matches
GNUNET_FS_DIRECTORY_MIME."
  (= gnunet-yes (%test-for-directory (unwrap-metadata metadata))))