[gnunet-scheme] 26/324: Port meta-data-serialize/uncached

[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 63a197d251349b46437c626c621a414ff6a1557a
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Wed Nov 11 21:07:19 2020 +0100

    Port meta-data-serialize/uncached
---
 gnu/gnunet/metadata.scm | 179 +++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 177 insertions(+), 2 deletions(-)

diff --git a/gnu/gnunet/metadata.scm b/gnu/gnunet/metadata.scm
index 7d0c3d7..2152c71 100644
--- a/gnu/gnunet/metadata.scm
+++ b/gnu/gnunet/metadata.scm
@@ -429,5 +429,180 @@ TODO: perhaps a variant raising conditions may be more 
informative."
                            entry-data-length))))
             (loop-metadata (+ i 1)
                            new-md
-                           left))))))
-
+                           left)))))
+
+  (define (break)
+    "This state seems rather suspicious, but not necessarily incorrect."
+    #f)
+
+  (define-syntax ==>
+    (syntax-rules ()
+      ((_ P Q)
+       (if P
+          Q
+          #t))))
+
+  (define (meta-data-serialize/uncached meta-data options)
+    ;; TODO: serialisation cache
+    "Serialize @var{meta-data} into a fresh bytevector
+
+Return the number of bytes written on success,
+or @code{#f} on error. (FIXME: raise a condition instead)
+
+@var{meta-data} <meta-data> to serialize
+@var{options}: TODO (which compression method to use, is a subset
+of the metadata acceptable)"
+    (let^ ((! size
+             (vector-fold
+              (lambda (m)
+                (+ sizeof-MetaDataEntry
+                   (meta-item-data-size m)
+                   ;; Is ASCII, therefore
+                   ;; string length and
+                   ;; byte length
+                   ;; coincide.
+                   (or (string-length
+                        (meta-item-plugin-name m))
+                       0)
+                   (or (string-length
+                        (meta-item-mime-type m))
+                       0)))
+              0
+              (meta-data-items meta-data)))
+          (? (>= size GNUNET_MAX_MALLOC_CHECKED)
+             ;; too large to be processed by upstream
+             #f)
+          (! ent-bv (make-bytevector size))
+          (! mdata-offset
+             (* sizeof-MetaDataEntry
+                (meta-data-item-count meta-data)))
+          (_ (let^ ((/o/ meta-item-loop
+                         (i 0)
+                         (off (- size
+                                 (* sizeof-MetaDataEntry
+                                    (meta-data-item-count meta-data)))))
+                    (? (>= i (meta-data-item-count meta-data))
+                       (assert (= 0 off))
+                       'done)
+                    (! item (vector-ref (meta-data-items meta-data) i))
+                    (! ent-offset (* i sizeof-MetaDataEntry))
+                    (_ (set-MetaDataEntry.type!
+                        ent-bv
+                        ent-offset
+                        (meta-item-type item)))
+                    (_ (set-MetaDataEntry.format!
+                        ent-bv
+                        ent-offset
+                        (meta-item-format item)))
+                    (_ (set-MetaDataEntry.data-size!
+                        ent-bv
+                        ent-offset
+                        (meta-item-data-size item)))
+                    (! pname (meta-item-plugin-name item))
+                    (! mime (meta-item-mime-type item))
+                    (! plugin-bv (and pname (string->utf8 pname)))
+                    (! mime-bv (and mime (string->utf8 mime)))
+                    ;; Add 1 byte for terminating \0.
+                    (_ (set-MetaDataEntry.plugin-name-length
+                        ent-bv
+                        ent-offset
+                        (if plugin-bv
+                            (+ 1 (bytevector-length plugin-bv))
+                            0)))
+                    (_ (set-MetaDataEntry.mime-type-length
+                        ent-bv
+                        ent-offset
+                        (if mime-bv
+                            (+ 1 (bytevector-length mime-bv))
+                            0)))
+                    (! off (- off (meta-item-data-size item)))
+                    ;; Check for \0 bytes
+                    ;; TODO: perform this check elsewhere
+                    ;; TODO: check all bytes
+                    (? (not (==> (member (meta-item-format item)
+                                         `(,METAFORMAT_C_STRING
+                                           ,METAFORMAT_UTF8))
+                                 (= (bytevector-u8-ref
+                                     (%meta-item-data item)
+                                     (bytevector-length
+                                      (%meta-item-data item)))
+                                    0)))
+                       (break))
+                    (_ (bytevector-copy!
+                        (%meta-item-data item)
+                        0
+                        ent-bv
+                        (+ mdata-offset off)
+                        (meta-item-data-size item)))
+                    ;; Copy mime type, plugin name
+                    ;; and add a terminating \0 byte.
+                    (! off (- off (if plugin-bv
+                                      (+ 1 (bytevector-length plugin-bv))
+                                      0)))
+                    (_ (when plugin-bv
+                         (bytevector-copy!
+                          plugin-bv 0
+                          ent-bv (+ mdata-offset off)
+                          (bytevector-length plugin-bv))
+                         (bytevector-u8-set!
+                          ent-bv
+                          (+ mdata-offset off
+                             (bytevector-length plugin-bv))
+                          0)))
+                    (! off (- off
+                              (if mime-bv
+                                  (+ 1 (bytevector-length mime-bv))
+                                  0)))
+                    (_ (when mime-bv
+                         (bytevector-copy!
+                          mime-bv 0
+                          ent-bv (+ mdata-offset off)
+                          (bytevector-length mime-bv))
+                         (bytevector-u8-set!
+                          ent-bv
+                          (+ mdata-offset off
+                             (bytevector-length mime-bv))
+                          0))))
+                   (meta-item-loop
+                    (+ 1 i)
+                    off)))
+          ;; Don't include upstream loop #2, it is a loop
+          ;; for throwing away meta data until
+          ;; everything fits in the buffer ... which doesn't
+          ;; have a use (yet).
+          (! i 0)
+          (? (>= i (meta-data-item-count meta-data))
+             ;; No meta data, only write header
+             (let^ ((! result-bv (make-bytevector sizeof-MetaDataHeader))
+                    (_ (set-MetaDataHeader.version! result-bv 0 2))
+                    (_ (set-MetaDataHeader.entries! result-bv 0 0))
+                    (_ (set-MetaDataHeader.size!    result-bv 0 0)))
+                   result-bv))
+          (! left size)
+          (! ent-offset
+             (+ (* i sizeof-MetaDataEntry)))
+             ;; TODO in upstream, it is possible to request
+             ;; no compression
+          (! cdata (try-compression ent-bv ent-offset left))
+          (! maybe-compressed-length
+             (if cdata
+                 (bytevector-length cdata)
+                 left))
+          (! hdr (make-bytevector (+ sizeof-MetaDataHeader
+                                     maybe-compessed-length)))
+          ;; TODO proper #f or condition on overflow
+          (_ (set-MetaDataHeader.size! hdr 0 left))
+          (_ (set-MetaDataHeader.entries!
+              hdr 0 (meta-data-item-count meta-data)))
+          (!! (==> cdata (< (bytevector-length cdata) left)))
+          (_ (set-MetaDataHeader.version! hdr 0
+                                          (bitwise-ior
+                                           2
+                                           (if cdata
+                                               HEADER_COMPRESSED
+                                               0))))
+          (_  (bytevector-copy! (or cdata ent-bv)
+                                (if cdata 0 ent-offset)
+                                hdr sizeof-MetaDataHeader
+                                maybe-compressed-length)))
+         hdr)))

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