[gnunet-scheme] 15/324: Define a meta data deserialisation procedure

[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 1cb6569276e9ab27efefa685b81a6e0649ecfc99
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Sun Nov 8 18:25:34 2020 +0000

    Define a meta data deserialisation procedure
    
    TODO: missing dependencies, imports, ...
---
 gnu/gnunet/metadata.scm | 188 +++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 185 insertions(+), 3 deletions(-)

diff --git a/gnu/gnunet/metadata.scm b/gnu/gnunet/metadata.scm
index 3980065..75e6fe1 100644
--- a/gnu/gnunet/metadata.scm
+++ b/gnu/gnunet/metadata.scm
@@ -36,9 +36,18 @@
   (export meta-item? meta-item-mime-type meta-item-data meta-item-format
          make-meta-item meta-item=?
          meta-data? create-meta-data meta-data-extend meta-data=?)
-  (import (rnrs base)
+  (import (rnrs arithmetic bitwise)
+         (rnrs base)
+         (rnrs control)
          (rnrs records syntactic)
          (rnrs bytevectors)
+         (rnrs lists)
+         (only (gnu extractor metaformats)
+               METAFORMAT_UTF8
+               METAFORMAT_C_STRING
+               METAFORMAT_BINARY)
+         (only (gnu gnunet utils decompress) decompress)
+         (only (gnu gnunet utils hat-let) let^)
          (only (srfi srfi-31) rec)
          (only (srfi srfi-45) delay force))
 
@@ -187,12 +196,185 @@ meta data) name of extracting plugin
                           extractor:UTF8
                           old-format))
                      (new-item (%make-meta-item new-mime-type
-                                                (meta-ite-data item)
+                                                (meta-item-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))))))))
+             (else (loop (+ 1 i)))))))
+
+  ;; Header for serialized meta data
+  (define sizeof-MetaDataHeader 4)
+
+  (define (MetaDataHeader.version bv offset)
+    "The version of the MD serialization.  The highest bit is used to
+indicate compression.
+
+Version 0 is traditional (pre-0.9) meta data (unsupported)
+Version is 1 for a NULL pointer
+Version 2 is for 0.9.x (and possibly higher)
+Other version numbers are not yet defined."
+    (bytevector-u32-ref bv offset (endianness big)))
+
+  (define (MetaDataHeader.entries bv offset)
+    "How many MD entries are there?"
+    (bytevector-u32-ref bv (+ offset 4) (endianness big)))
+
+  (define (MetaDataHeader.size bv offset)
+    "Size of the decompressed meta data"
+    (bytevector-u32-ref bv (+ offset 8) (endianness big)))
+  ;; This is followed by 'entries' values of type 'struct MetaDataEntry'
+  ;; and then by 'entry' plugin names, mime-types and data blocks
+  ;; as specified in those meta data entries.
+
+  ;; TODO: bytevector slices
+  (define meta-data-deserialize
+    (case-lambda
+      "Deserialize meta-data, as a <meta-data>.
+
+The serialized meta-data is passed as a bytevector
+@var{bv}, starting at offset @var{offset} and of byte-length
+@var{size}. In case of success, return an appropriate
+@code{<meta-data>}. In case of a parsing error, return @code{#f}.
+(Unsupported versions count as parsing errors.)
+
+TODO: perhaps a variant raising conditions may be more informative."
+      ((bv) (meta-data-deserialize bv 0 (bytevector-length bv)))
+      ((bv offset size)
+       ;; Argument checks
+       (let^ ((!! (bytevector? bv))
+             (!! (and (integer? offset) (exact? offset)))
+             (!! (and (integer? size) (exact? size)))
+             (!! (and (<= 0 offset) (<= offset (bytevector-length bv))))
+             (!! (and (<= 0 size)
+                      (<= (+ offset size) (bytevector-length bv))))
+             ;; Header checks
+             (? (< size sizeof-MetaData) #f)
+             (! version (bitwise-and (MetaData.version bv offset)
+                                     HEADER_VERSION_MASK))
+             (? (not (= 2 version)) #f) ; unsupported version
+             (! ic (MetaData.entries bv offset size))
+             (! data-size (MetaData.dataSize bv offset size))
+             (? (or (> (* ic sizeof-MetaDataEntry) data-size)
+                    (and (not (= 0 ic))
+                         ;; TODO: isn't this clause redundant?
+                         (< data-size
+                            (* ic sizeof-MetaDataEntry))))
+                #f)
+             ;; Decompression
+             (! compressed?
+                (not (= 0 (bitwise-and (MetaData.version bv offset)))))
+             (<- (cdata-bv cdata-offset)
+                 (cond ((not compressed?)
+                        (values bv (+ offset sizeof-MetaDataHeader)))
+                       ((>= data-size GNUNET_MAX_MALLOC_CHECKED)
+                        ;; make sure we don't blow our memory limit because
+                        ;; of a mal-formed message... 40 MiB seems rather
+                        ;; large to encounter in the wild, so this
+                        ;; is unlikely to be a problem.
+                        #f)
+                       (else
+                        (values
+                         (decompress bv
+                                     (+ offset sizeof-MetaDataHeader)
+                                     data-size)
+                         0))))
+             ;; Check decompression was successful
+             (? (not cdata-bv) #f)
+             (! mdata-offset (+ cdata-offset
+                                (* ic sizeof-MetaDataEntry)))
+             ;; Loop over metadata
+             (/o/ loop-metadata
+                  (i 0)
+                  (md (create-meta-data))
+                  (left (- data-size (* ic sizeof-MetaDataEntry))))
+             (? (>= i ic) md) ;; all metadata is deserialised
+             (! entry-offset
+                (+ cdata-offset (* ic sizeof-MetaDataEntry)))
+             (! format (MetaDataEntry.format bv entry-offset))
+             ;; Bail out if the metaformat is unrecognised
+             (? (not (member 0 `(,METAFORMAT_UTF8 ,METAFORMAT_C_STRING
+                                                  ,METAFORMAT_BINARY)))
+                ;; TODO: upstream returns incomplete @var{md}
+                ;; in this case! Return NULL instead!
+                ;; (An incomplete @var{md} is returned in
+                ;; some other cases as well.)
+                #f)
+             (! entry-data-length
+                (MetaDataEntry.data-size cdata-bv entry-offset))
+             (! plugin-name-length
+                (MetaDataEntry.plugin-name-length cdata-bv
+                                                  entry-offset))
+             (! mime-type-length
+                (MetaDataEntry.mime-type-length cdata-bv
+                                                entry-offset))
+             (? (> entry-data-length left) #f)
+             (! left (- left entry-data-length))
+             (! meta-data-offset
+                (+ mdata-offset left))
+             ;; Strings are terminated with a \0
+             ;; TODO: upstream doesn't check the location of
+             ;; the **first** \0. Is this intentional or irrelevant?
+             (? (and (member format
+                             `(,METAFORMAT_UTF8 ,METAFORMAT_C_STRING))
+                     (or (= 0 entry-data-length)
+                         (not (= (bytevector-u8-ref
+                                  cdata-bv
+                                  (+ meta-data-offset
+                                     (- entry-data-length 1)))))))
+                #f)
+             (? (> plugin-name-length left) #f)
+             (! left (- left plugin-name-length))
+             (? (and (> plugin-name-length 0)
+                     (not (= 0 (bytevector-u8-ref
+                                cdata-bv
+                                (+ mdata-offset
+                                   left
+                                   plugin-data-length
+                                   -1)))))
+                #f)
+             ;; FIXME plen or entry-data-length
+             ;; Does not include terminating \0.
+             (! plugin-bv
+                (and (> plugin-name-length 0)
+                     (make-bytevector (- plugin-name-length 1))))
+             (_ (if plugin-bv
+                    (bytevector-copy! cdata-bv
+                                      (+ mdata-offset left)
+                                      plugin-bv
+                                      0
+                                      (bytevector-length plugin-bv))))
+             ;; There isn't any formal requirement for
+             ;; being encoded as UTF-8 as far as I know,
+             ;; but in practice this will probably be ASCII,
+             ;; which is a subset of UTF-8.
+             (! plugin-string
+                (and plugin-bv (utf8->string plugin-bv)))
+             (? (> mime-type-length left) #f)
+             (! left (- left mime-type-length))
+             (? (and (> mime-type-length 0)
+                     (< 0 (bytevector-u8-ref cdata-bv
+                                             (+ mdata-offset
+                                                mime-type-length
+                                                -1))))
+                #f)
+             (! mime-type-string
+                (and (< 0 mime-type-length)
+                     (utf8->string (bv-slice cdata-bv
+                                             (+ mdata-offset
+                                                left -1)
+                                             (- mime-type-length 1)))))
+             (! new-md
+                (meta-data-extend
+                 md plugin-string
+                 (MetaDataEntry.type cdata-bv entry-offset)
+                 format
+                 mime-type-string
+                 (bv-slice cdata-bv meta-data-offset
+                           entry-data-size))))
+            (loop-metadata (+ i 1)
+                           new-md
+                           left))))))
 

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