gnunet/gnu/gnunet/common.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 common)
  #:use-module (system foreign)
  #:use-module (rnrs base)
  #:use-module (rnrs bytevectors)
  #:use-module (gnu gnunet binding-utils)
  #:export (gnunet-ok
            gnunet-system-error
            gnunet-yes
            gnunet-no
            bool->int
            int->bool

            time-relative
            time-absolute
            time-rel
            
            ecdsa-public-key
            ecdsa-public-key?
            eddsa-public-key
            eddsa-signature
            hashcode

            define-foreign-definer
            
            gnunet-util-ffi
            gnunet-fs-ffi
            define-gnunet
            define-gnunet-fs
            define-gnunet-id

            %make-blob-pointer
            %malloc
            %free

            string->data-pointer))


(define (generate n x)
  "Generates a list of length N which elements are X."
  (if (zero? n)
      '()
      (cons x (generate (1- n) x))))


(define time-relative uint64)
(define time-absolute uint64)

(define* (time-rel #:key (hours 0) (minutes 0) (seconds 0) (milli 0) (micro 0))
  (let* ((minutes* (+ (* hours    60)   minutes))
         (seconds* (+ (* minutes* 60)   seconds))
         (milli*   (+ (* seconds* 1000) milli))
         (micro*   (+ (* milli*   1000) micro)))
    micro*))

(define ecdsa-public-key (generate (/ 256 8 4) uint32))
(define eddsa-public-key ecdsa-public-key)
(define eddsa-signature (list eddsa-public-key
                              eddsa-public-key))
(define hashcode (list (generate 16 uint32)))

(define (ecdsa-public-key? key)
  (and (string? key)
       (= (/ 258 8) (string-length key))))

(define gnunet-ok            1)
(define gnunet-system-error -1)
(define gnunet-yes           1)
(define gnunet-no            0)

(define gnunet-util-ffi     (dynamic-link "libgnunetutil"))
(define gnunet-fs-ffi       (dynamic-link "libgnunetfs"))
(define gnunet-identity-ffi (dynamic-link "libgnunetidentity"))


(define-syntax define-foreign-definer
  (syntax-rules ()
    ((_ definer-name ffi-var)
     (define-syntax definer-name
       (syntax-rules (: ->)
         ((_ func name : in -> out)
          (define func
            (pointer->procedure out (dynamic-func name ffi-var) in))))))))

(define-foreign-definer define-gnunet    gnunet-util-ffi)
(define-foreign-definer define-gnunet-fs gnunet-fs-ffi)
(define-foreign-definer define-gnunet-id gnunet-identity-ffi)

(define-gnunet %xfree   "GNUNET_xfree_"   : (list '* '* int)     -> void)
(define-gnunet %xmalloc "GNUNET_xmalloc_" : (list size_t '* int) -> '*)

;; this function is needed to convert ASCII public keys to a format GNUnet can
;; understand.
(define-gnunet %string-to-data
  "GNUNET_STRINGS_string_to_data" : (list '* size_t '* size_t) -> int)


(define (bool->int x) (if x gnunet-yes gnunet-no))
(define (int->bool x)
  (cond ((= gnunet-yes x)          #t)
        ((= gnunet-no x)           #f)
        ((= gnunet-system-error x) #:system-error)
        (else                      #:unknown)))

(define %xfilename (string->pointer "guile"))

(define (%free pointer)
  (assert (not (eq? %null-pointer pointer)))
  (%xfree pointer %xfilename 0))

(define (%malloc size)
  "Allocates SIZE bytes on the C heap."
  ;; note: if %xmalloc couldn’t do the allocation (out of memory), it calls
  ;; abort(), and the whole guile process core dumps; at least, we’re assured
  ;; %xmalloc will never return a null pointer…
  (%xmalloc size %xfilename 0))

(define (%make-blob-pointer)
  (bytevector->pointer (make-bytevector (sizeof ptrdiff_t) 0)))

;;+TODO: what about (getenv "GNUNET_ARGS") ?
;;+TODO: skew-offset and skew-variance:
;;       GNUNET_TIME_set_offset(offset - variance)
;;+TODO: what about defining the configuration entry ("arm" "CONFIG")?
;; (define-syntax with-gnunet
;;   (syntax-rules ()
;;     ((_ (config-file-name) thunk)
;;      (let ((cfg-handle (load-configuration config-file-name)))

(define (string->data-pointer str data-len)
  (let* ((%data (bytevector->pointer (make-bytevector data-len 0)))
         (ret   (%string-to-data (string->pointer str) (string-length str)
                                 %data data-len)))
    (when (not (= gnunet-ok ret))
      (throw 'invalid-result "string->data-pointer" "%string-to-data"
             (list str data-len)))
    %data))