[gnunet-scheme] 06/324: Begin defining (gnu gnunet metadata)

[gnunet]

This is an automated email from the git hooks/post-receive script.

maxime-devos pushed a commit to branch master
in repository gnunet-scheme.

commit baf2b08e57b19c393d0823283ba4b26e5e4abb5e
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Wed Nov 4 21:08:55 2020 +0100

    Begin defining (gnu gnunet metadata)
---
 gnu/gnunet/metadata.scm | 192 ++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 192 insertions(+)

diff --git a/gnu/gnunet/metadata.scm b/gnu/gnunet/metadata.scm
new file mode 100644
index 0000000..08f297d
--- /dev/null
+++ b/gnu/gnunet/metadata.scm
@@ -0,0 +1,192 @@
+;;   This file is part of scheme-GNUnet, a partial Scheme port of GNUnet.
+;;   Copyright (C) 2003, 2004, 2005, 2006, 2008, 2009, 2010 GNUnet e.V.
+;;   Copyright (C) 2020 Maxime Devos <maxime.devos@student.kuleuven.be>
+;;
+;;   GNUnet is free software: you can redistribute it and/or modify it
+;;   under the terms of the GNU Affero General Public License as published
+;;   by the Free Software Foundation, either version 3 of the License,
+;;   or (at your option) any later version.
+;;
+;;   GNUnet 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
+;;   Affero General Public License for more details.
+;;
+;;   You should have received a copy of the GNU Affero General Public License
+;;   along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;;
+;;   SPDX-License-Identifier: AGPL-3.0-or-later
+;;
+;;   As a special exception to the GNU Affero General Public License,
+;;   the file may be relicensed under any license used for
+;;   most source code of GNUnet 0.13.1, or later versions, as published by
+;;   GNUnet e.V.
+
+;; Upstream author: Christian Grothoff
+;; Upstream source: gnunet-0.13.1/util/container_meta_data.c
+;; Scheme port author: Maxime Devos
+;; Scheme module: (gnu gnunet metadata)
+;; Brief: Storing of meta data
+
+;; Deviations from upstream:
+;;  * the name of the plugin metadata has been extracted with
+;;    is not included.
+;;  * file names in meta-data are not automatically POSIXified.
+
+;; TODO: (de-)serialisation, dependencies, other procedures
+(library (gnu gnunet metadata)
+  (export meta-item? meta-item-mime-type meta-item-data meta-item-format
+         make-meta-item
+         meta-data?)
+  (import (rnrs base)
+         (rnrs records syntactic)
+         (rnrs bytevectors)
+         (only (srfi srfi-31) rec)
+         (only (srfi srfi-45) delay force))
+
+  ;; Meta data item
+  (define-record-type (<meta-item> %make-meta-item meta-item?)
+    ;; Mime-type of data (an ASCII string, or #f).
+    (fields (immutable mime-type meta-item-mime-type)
+           ;; The actual meta data (bytevector).
+           (immutable data %meta-item-data)
+           ;; Type of the meta data (<meta-type>).
+           (immutable type meta-item-type)
+           ;; Format of the meta data.
+           (immutable format meta-item-format))
+    (opaque #t)
+    (sealed #t))
+
+  (define (meta-data-item-size item)
+    "How large is the @lisp{meta-item-data} of the <meta-item>
+@var{item}? Expressed in bytes."
+    (bytevector-length (%meta-item-data item)))
+
+  (define (meta-item=? x y)
+    "Are two <meta-item> equal?"
+    (assert (meta-item? x))
+    (assert (meta-item? y))
+    (equal? x y))
+
+  (define (make-meta-item mime-type data type format)
+    "Construct a meta data item"
+    ;; TODO: make strings read-only when running on Guile Scheme.
+    ;; (RNRS scheme doesn't have a string-set! procedure,
+    ;; so portable sandboxes can still use this module safely)
+    (assert (or mime-type (string? mime-type)))
+
+    (%make-meta-item mime-type data type format))
+
+  ;; Meta data to associate with a file, directory or namespace.
+  (define-record-type (<meta-data> %make-meta-data meta-data?)
+    ;; Vector of the meta data items.
+    ;; (TODO: perhaps a functional deque would be faster)
+    (fields (immutable items meta-data-items)
+           ;; Complete serialized and compressed buffer of the items,
+           ;; as a promised bytevector.
+           (immutable sbuf meta-data-sbuf-promise))
+    (opaque #t)
+    (sealed #t))
+
+  (define (%vector->meta-data item-vec)
+    "Create a fresh <meta-data> with some items (no type-checking)"
+    (rec meta-data
+        (%make-meta-data item-vec
+                         (delay (make-sbuf meta-data)))))
+
+  (define (create-meta-data)
+    "Create a fresh <meta-data>"
+    (%vector->meta-data (vector)))
+
+  ;; TODO: perhaps this may be useful?
+  #; (define (forget-sbuf meta-data)
+    "The serialization buffer is no longer relevant, regenerate it
+lazyily.
+
+@var{meta-data}: meta data to forget serialization buffer of"
+  frob)
+
+  ;; GNUNET_CONTAINER_meta_data_test_equal isn't ported.
+  ;; It doesn't compare the mime types, so it doesn't check
+  ;; for equality in the sense of @lisp{equal?}.
+  (define (meta-data=? x y)
+    "Test if two MDs are equal.  We consider them equal if
+the meta types, formats, content and mime type match.
+(Warning: the C port doesn't check the mime type)"
+    "Compare two meta data items for equality.
+
+Warning: two equal MD are not necessarily @lisp{equal?} (TODO: yet)."
+    (assert (meta-data? x))
+    (assert (meta-data? y))
+    ;; ignore meta-data-sbuf-promise
+    (or (eq? x y)
+       (and (equal? (meta-data-items x)
+                    (meta-data-items y)))))
+
+  (define (meta-data-extend meta type format data-mime-type data)
+    "Extend metadata.  Note that the list of meta data items is
+sorted by size (largest first).
+
+Return the updated meta-data, and #f if this entry already exists, #t
+otherwise.  If the entry already exists (identified by @var{type}
+and @var{data}), don't change the old entry, except for defining
+the mime type if it wasn't set previously, and making the meta
+format more specific.
+
+Deviation from upstream: upstream changes directory separators to
+POSIX style ('/') for some meta data, this port doesn't.
+
+Entries are identified by @var{type} and @var{data}.
+
+@var{meta} metadata to extend
+@var{type} libextractor-type describing the meta data
+@var{format} basic format information about data
+@var{data-mime-type} mime-ype of data (not of original file);
+  can be @lisp{#f} (if mime-type is not known) (immutable)
+@var{data} actual meta-data found (bytevector)"
+    (assert (meta-data? meta))
+    (assert (extractor:metatype type))
+    (assert (extractor:metaformat format))
+    (assert (or (not data-mime-type) (string? data-mime-type)))
+    (assert (bytevector? data))
+    ;; Figure out where to insert or set the meta data.
+    ;; TODO: binary search instead of linear search
+    (let ((items (meta-data-items data))
+         (items-length (vector-length items)))
+      (let loop ((i 0))
+       (cond ((or (>= i items-length)
+                  (< (meta-item-data-size (vector-ref items i))))
+              ;; A new entry: insert at the end of the item vector,
+              ;; or earlier. TODO: read-only bytevectors
+              (let* ((meta-item (%make-meta-item data-mime-type
+                                                 (bytevector-copy data)
+                                                 type
+                                                 format))
+                     (new-items (vector-insert items i meta-item)))
+                (values (%vector->meta-data new-items)
+                        #t)))
+             ((and (equal? (meta-item-type (vector-ref items i))
+                           type)
+                   (bytevector=? (%meta-item-data (vector-ref items i))
+                                 data))
+              ;; If format and mime-type aren't changed,
+              ;; just keep the old structure (freshness is not required).
+              (let* ((item (vector-ref items i))
+                     (new-mime-type (or (meta-item-mime-type item)
+                                        data-mime-type))
+                     (old-format (meta-item-format item))
+                     (new-format
+                      (if (and (equal? old-format extractor:C_STRING)
+                               (equal? format extractor:UTF8))
+                          extractor:UTF8
+                          old-format))
+                     (new-item (%make-meta-item new-mime-type
+                                                (meta-ite-data item)
+                                                meta-item-data
+                                                meta-item-format)))
+                (if (equal? old-item new-item)
+                    (values meta #f)
+                    (%vector->meta-data (vector-replace items i
+                                                        new-item)))))
+             (else (loop (+ 1 i))))))))
+

-- 
To stop receiving notification emails like this one, please contact
gnunet@gnunet.org.