[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[gnunet-scheme] 32/324: remove some uses of old accessors
|
From: |
gnunet |
|
Subject: |
[gnunet-scheme] 32/324: remove some uses of old accessors |
|
Date: |
Tue, 21 Sep 2021 13:21:12 +0200 |
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 61b013c733aaaca2723ab6af5cdf441dec53ab1f
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Mon Jan 4 19:38:20 2021 +0100
remove some uses of old accessors
The newer ones are harder to use incorrectly,
and perform some validation.
---
gnu/gnunet/metadata.scm | 397 +++++++++++++++++------------------------
gnu/gnunet/metadata/struct.scm | 21 ++-
2 files changed, 181 insertions(+), 237 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)))
diff --git a/gnu/gnunet/metadata/struct.scm b/gnu/gnunet/metadata/struct.scm
index 7d8c420..1b54c6a 100644
--- a/gnu/gnunet/metadata/struct.scm
+++ b/gnu/gnunet/metadata/struct.scm
@@ -31,7 +31,8 @@
MetaType MetaFormat)
(import (only (gnu gnunet utils netstruct)
structure/packed u32/big
- sizeof wrap-reader-setter)
+ sizeof wrap-reader-setter
+ offset)
(only (gnu extractor metaformats)
integer->meta-format meta-format->integer)
(only (gnu extractor metatypes)
@@ -47,11 +48,14 @@
;; Version is 1 for a NULL pointer
;; Version 2 is for 0.9.x (and possibly higher)
;; Other version numbers are not yet defined.
- (version u32/big)
+ ("version" u32/big)
;; How many MD entries are there?
- (entries u32/big)
+ ("entries" u32/big)
;; Number of bytes of meta data
- (size u32/big)))
+ ("size" u32/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.
(assert (= (sizeof MetaDataHeader ()) 12))
@@ -60,6 +64,15 @@
(define-syntax MetaFormat
(wrap-reader-setter u32/big integer->meta-format meta-format->integer))
+ (assert (= (sizeof MetaType ()) 4))
+ (assert (= (sizeof MetaFormat ()) 4))
+ ;; catch some old issues
+ (assert (= (offset MetaType ()) 0))
+ (assert (= (offset MetaFormat ()) 0))
+ (assert (= (offset MetaDataHeader ("version")) 0))
+ (assert (= (offset MetaDataHeader ("entries")) 4))
+ (assert (= (offset MetaDataHeader ("size")) 8))
+
(define-syntax MetaDataEntry
(structure/packed
;; Meta data type
--
To stop receiving notification emails like this one, please contact
gnunet@gnunet.org.
- [gnunet-scheme] 24/324: Regularise naming convention, (continued)
- [gnunet-scheme] 24/324: Regularise naming convention, gnunet, 2021/09/21
- [gnunet-scheme] 25/324: Extend let^, gnunet, 2021/09/21
- [gnunet-scheme] 30/324: Correct maximum in metaformats.scm and metatypes.scm, gnunet, 2021/09/21
- [gnunet-scheme] 26/324: Port meta-data-serialize/uncached, gnunet, 2021/09/21
- [gnunet-scheme] 29/324: Define meta data structures systematically, gnunet, 2021/09/21
- [gnunet-scheme] 31/324: fix netstruct, and implement wrap-reader-setter, gnunet, 2021/09/21
- [gnunet-scheme] 28/324: Define library for structures, gnunet, 2021/09/21
- [gnunet-scheme] 34/324: scripts: add incomplete script for publishing a store item, gnunet, 2021/09/21
- [gnunet-scheme] 33/324: include some notes on reverse-engineering GNUdirs, gnunet, 2021/09/21
- [gnunet-scheme] 36/324: scripts: publish-store: eliminate add-name, gnunet, 2021/09/21
- [gnunet-scheme] 32/324: remove some uses of old accessors,
gnunet <=
- [gnunet-scheme] 41/324: scripts: publish-store: fix predicate of --format option, gnunet, 2021/09/21
- [gnunet-scheme] 38/324: scripts: publish-store: publish whole trees, gnunet, 2021/09/21
- [gnunet-scheme] 37/324: scripts: publish-store: publish individual files, gnunet, 2021/09/21
- [gnunet-scheme] 40/324: scripts: publish-store: allow setting all options, gnunet, 2021/09/21
- [gnunet-scheme] 39/324: guix: suggest a package definition, gnunet, 2021/09/21
- [gnunet-scheme] 35/324: scripts: publish-store: compute file tree, gnunet, 2021/09/21
- [gnunet-scheme] 43/324: scripts: publish-store: exit after main function, gnunet, 2021/09/21
- [gnunet-scheme] 48/324: scripts: download-store: download json container, gnunet, 2021/09/21
- [gnunet-scheme] 45/324: scripts: publish-store: fix '--config' option parsing, gnunet, 2021/09/21
- [gnunet-scheme] 46/324: scripts: download-store: parse input arguments, gnunet, 2021/09/21