remove some uses of old accessors

The newer ones are harder to use incorrectly,
and perform some validation.

1 files changed, 164 insertions, 233 deletions

diff --git a/gnu/gnunet/metadata.scm b/gnu/gnunet/metadata.scm
index 2152c71..b870dcd 100644
--- a/gnu/gnunet/metadata.scm
+++ b/gnu/gnunet/metadata.scm
@@ -51,6 +51,9 @@
           (only (gnu extractor metatypes)
                 integer->meta-type
                 meta-type?)
+          (gnu gnunet utils netstruct)
+          (gnu gnunet utils bv-slice)
+          (gnu gnunet metadata struct)
           (only (gnu gnunet utils decompress) decompress)
           (only (gnu gnunet utils hat-let) let^)
           (only (srfi srfi-31) rec)
@@ -216,56 +219,6 @@ meta data) name of extracting plugin
                                                          new-item)))))
               (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.
-
-  ;; Entry of serialized meta data.
-  (define sizeof-MetaDataEntry 20)
-
-  (define (MetaDataEntry.type bv offset)
-    "Meta data type.  Corresponds to a @code{<meta-type>}"
-    (integer->meta-type (bytevector-u32-ref bv offset (endianness big))))
-
-  (define (MetaDataEntry.format bv offset)
-    "Meta data format.  Corresponds to a @code{<meta-format>}"
-    (integer->meta-format
-     (bytevector-u32-ref bv (+ offset 4) (endianness big))))
-
-  (define (MetaDataEntry.data-size bv offset)
-    "Number of bytes of meta data."
-    (bytevector-u32-ref bv (+ offset 8) (endianness big)))
-
-  (define (MetaDataEntry.plugin-name-length bv offset)
-    "Number of bytes in the plugin name including 0-terminator.
-0 for NULL."
-    (bytevector-u32-ref bv (+ offset 12) (endianness big)))
-
-  (define (MetaDataEntry.mime-type-length bv offset)
-    "Number of bytes in the mime type including 0-terminator.
-0 for NULL."
-    (bytevector-u32-ref bv (+ offset 16) (endianness big)))
-
   (define (vector-insert vec i x)
     "Insert @var{x} into the vector @var{vec} at offset @var{i}"
     (vector-unfold (lambda (j)
@@ -287,149 +240,141 @@ Other version numbers are not yet defined."
       (bytevector-copy! bv offset bv-new 0 length)
       bv-new))
 
-  ;; TODO: bytevector slices
-  (define meta-data-deserialize
-    (case-lambda
-      "Deserialize meta-data, as a <meta-data>.
+  (define (meta-data-deserialize slice)
+    "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}.
+The serialized meta-data is passed as a readable slice @var{slice}.
+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-MetaDataHeader) #f)
-              (! version (bitwise-and (MetaDataHeader.version bv offset)
-                                      HEADER_VERSION_MASK))
-              (? (not (= 2 version)) #f) ; unsupported version
-              (! ic (MetaDataHeader.entries bv offset))
-              (! data-size (MetaDataHeader.size bv offset))
-              (? (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 (MetaDataHeader.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 (make-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-name-length
-                                    -1)))))
-                 #f)
-              ;; FIXME plen or entry-data-length
-              ;; Does not include terminating \0.
-              (! plugin-bv
-                 (and (> plugin-name-length 0)
-                      (bv-slice cdata-bv (+ mdata-offset left)
-                                (- plugin-name-length 1))))
-              ;; 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-length))))
-             (loop-metadata (+ i 1)
-                            new-md
-                            left)))))
+    ;; Argument checks
+    (let^ ((!! (slice? slice))
+           (!! (slice-readable? slice))
+           ;; Header checks
+           (? (< (size-length slice) (sizeof MetaDataHeader ())) #f)
+           (! header (slice-slice slice 0 (sizeof MetaDataHeader ())))
+           (! version (bitwise-and (read% MetaDataHeader ("version") header)
+                                   HEADER_VERSION_MASK))
+           (? (not (= 2 version)) #f) ; unsupported version
+           (! ic (read% MetaDataHeader ("entries") header))
+           (! data-size (read% MetaDataHeader ("size") header))
+           (? (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
+                         (read% MetaDataHeader ("version") header)))))
+           (! cdata
+              (let ((maybe-compressed
+                     (slice-slice slice (sizeof MetaDataHeader ()))))
+                (cond ((not compressed?)
+                       maybe-compressed)
+                      ((>= 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
+                       (decompress maybe-compressed data-size)))))
+           ;; Check decompression was successful
+           (? (not cdata) #f)
+           (! mdata (slice-slice cdata (* ic (sizeof MetaDataEntry ()))))
+           ;; Loop over metadata
+           (/o/ loop-metadata
+                (i 0)
+                (md (make-meta-data))
+                (left (- data-size (* ic (sizeof MetaDataEntry ())))))
+           (? (>= i ic) md) ;; all metadata is deserialised
+           (! from-entry-till-end
+              (slice-slice cdata (* ic (sizeof MetaDataEntry ()))))
+           (! entry-header
+              (slice-slice from-entry-till-end
+                           0 (sizeof MetaDataEntry)))
+           (! format (read% MetaDataEntry ("format") entry-header))
+           ;; Bail out if the metaformat is unrecognised
+           ;; FIXME why did I write 0 here?
+           (? (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
+              (read% MetaDataEntry ("data-size") entry-header))
+           (! plugin-name-length
+              (read% MetaDataEntry ("plugin-name-length") entry-header))
+           (! mime-type-length
+              (read% MetaDataEntry ("mime-type-length") entry-header))
+           (? (> 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-name-length
+                                 -1)))))
+              #f)
+           ;; FIXME plen or entry-data-length
+           ;; Does not include terminating \0.
+           (! plugin-bv
+              (and (> plugin-name-length 0)
+                   (bv-slice cdata-bv (+ mdata-offset left)
+                             (- plugin-name-length 1))))
+           ;; 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
+               (read% MetaDataEntry ("type") entry)
+               format
+               mime-type-string
+               (bv-slice cdata-bv meta-data-offset
+                         entry-data-length))))
+          (loop-metadata (+ i 1)
+                         new-md
+                         left)))
 
   (define (break)
     "This state seems rather suspicious, but not necessarily incorrect."
@@ -455,7 +400,7 @@ of the metadata acceptable)"
     (let^ ((! size
               (vector-fold
                (lambda (m)
-                 (+ sizeof-MetaDataEntry
+                 (+ (sizeof MetaDataEntry ())
                     (meta-item-data-size m)
                     ;; Is ASCII, therefore
                     ;; string length and
@@ -474,47 +419,34 @@ of the metadata acceptable)"
               #f)
            (! ent-bv (make-bytevector size))
            (! mdata-offset
-              (* sizeof-MetaDataEntry
+              (* (sizeof MetaDataEntry ())
                  (meta-data-item-count meta-data)))
            (_ (let^ ((/o/ meta-item-loop
                           (i 0)
                           (off (- size
-                                  (* sizeof-MetaDataEntry
+                                  (* (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)))
+                     (! ent-offset (* i (sizeof MetaDataEntry ())))
+                     (_ (set%! MetaDataEntry (type) ent-slice (meta-item-type item)))
+                     (_ (set%! MetaDataEntry (format) ent-slice (meta-item-format item)))
+                     (_ (set%! MetaDataEntry (data-size) ent-slice (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)))
+                     (_ (set%! MetaDataEntry ("plugin-name-length") ent
+                               (if plugin-bv
+                                   (1+ (bytevector-length plugin-bv))
+                                   0)))
+                     (_ (set%! MetaDataEntry ("mime-type-length") ent
+                               (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
@@ -573,14 +505,15 @@ of the metadata acceptable)"
            (! 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)))
+              (let^ ((! result (make-slice/read-write
+                                (sizeof MetaDataHeader ())))
+                     (_ (set%! MetaDataHeader (version) result 2))
+                     (_ (set%! MetaDataHeader (entries) result 0))
+                     (_ (set%! MetaDataHeader (size!)   result 0 0)))
                     result-bv))
            (! left size)
            (! ent-offset
-              (+ (* i sizeof-MetaDataEntry)))
+              (+ (* i (sizeof MetaDataEntry ()))))
               ;; TODO in upstream, it is possible to request
               ;; no compression
            (! cdata (try-compression ent-bv ent-offset left))
@@ -588,21 +521,19 @@ of the metadata acceptable)"
               (if cdata
                   (bytevector-length cdata)
                   left))
-           (! hdr (make-bytevector (+ sizeof-MetaDataHeader
+           (! 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)))
+           (_ (set%! MetaDataHeader (size) hdr left))
+           (_ (set%! MetaDataHeader (entries) hdr
+                     (meta-data-item-count meta-data)))
            (!! (==> cdata (< (bytevector-length cdata) left)))
-           (_ (set-MetaDataHeader.version! hdr 0
-                                           (bitwise-ior
-                                            2
-                                            (if cdata
-                                                HEADER_COMPRESSED
-                                                0))))
+           (_ (set%! MetaDataHeader (version hdr)
+                     (bitwise-ior 2 (if cdata
+                                        HEADER_COMPRESSED
+                                        0))))
            (_  (bytevector-copy! (or cdata ent-bv)
                                  (if cdata 0 ent-offset)
-                                 hdr sizeof-MetaDataHeader
+                                 hdr (sizeof MetaDataHeader ())
                                  maybe-compressed-length)))
           hdr)))