From f5d3c117582d25e1aa5b7ea37947653b2276585c Mon Sep 17 00:00:00 2001
From: Masaya Tojo <masaya@tojo.tokyo>
Date: Sun, 4 Aug 2024 18:56:16 +0900
Subject: Check the length of the given bytevector

---
 pnm/pbm.scm |  5 ++++-
 pnm/pgm.scm | 19 +++++++++++--------
 pnm/ppm.scm | 10 ++++++++--
 3 files changed, 23 insertions(+), 11 deletions(-)

(limited to 'pnm')

diff --git a/pnm/pbm.scm b/pnm/pbm.scm
index 32506e0..7e7bc78 100644
--- a/pnm/pbm.scm
+++ b/pnm/pbm.scm
@@ -37,7 +37,8 @@
                 (data (make-bytevector byte-count 0)))
            (make-pbm-image width height data)))
         ((width height data)
-         (let* ((byte-width (ceiling (/ width 8))))
+         (let* ((byte-width (ceiling (/ width 8)))
+                (byte-count (* byte-width height)))
            (define (xy->byte-idx+bit-idx x y)
              (let-values (((byte-x bit-x) (floor/ x 8)))
                (values (+ (* y byte-width)
@@ -52,4 +53,6 @@
                (let ((byte (bytevector-u8-ref data byte-idx)))
                  (bytevector-u8-set! data byte-idx
                                      (copy-bit (- 7 bit-idx) byte b)))))
+           (unless (= byte-count (bytevector-length data))
+             (error (string-append "(pnm pbm) make-pbm-image: Invalid bytevector length" byte-count)))
            (make-image 'pbm width height 1 data pixel-getter pixel-setter)))))))
diff --git a/pnm/pgm.scm b/pnm/pgm.scm
index 6c32dea..0f448f6 100644
--- a/pnm/pgm.scm
+++ b/pnm/pgm.scm
@@ -28,19 +28,18 @@
          (when (or (< maxval 0)
                    (< 65536 maxval))
            (error "(pnm pgm) make-pgm: maxval is out of range"))
-         (let ((data (make-bytevector (* width
-                                         height
-                                         (if (< maxval 256)
-                                             1
-                                             2))
-                                      0)))
+         (let* ((byte-count (* width height
+                               (if (< maxval 256)
+                                   1
+                                   2)))
+                (data (make-bytevector byte-count 0)))
            (make-pgm-image width height maxval data)))
         ((width height maxval data)
          (when (or (< maxval 0)
                    (< 65536 maxval))
            (error "(pnm pgm) make-pgm: maxval is out of range"))
          (if (< maxval 256)
-             (let ()
+             (let ((byte-count (* width height)))
                (define (xy->idx x y) (+ x (* y width)))
                (define (pixel-getter x y)
                  (let ((idx (xy->idx x y)))
@@ -48,8 +47,10 @@
                (define (pixel-setter x y v)
                  (let ((idx (xy->idx x y)))
                    (bytevector-u8-set! data idx v)))
+               (unless (= byte-count (bytevector-length data))
+                 (error (string-append "(pnm pbm) make-pbm-image: Invalid bytevector length" byte-count)))
                (make-image 'pgm width height maxval data pixel-getter pixel-setter))
-             (let ()
+             (let ((byte-count (* width height 2)))
                (define (xy->idx x y) (+ x (* y width)))
                (define (pixel-getter x y)
                  (let ((idx (xy->idx x y)))
@@ -60,6 +61,8 @@
                    (let-values (((v1 v2) (split-value v)))
                      (bytevector-u8-set! data idx v1)
                      (bytevector-u8-set! data (+ idx 1) v2))))
+               (unless (= byte-count (bytevector-length data))
+                 (error (string-append "(pnm pbm) make-pbm-image: Invalid bytevector length" byte-count)))
                (make-image 'pgm width height maxval data pixel-getter pixel-setter))))))
 
     (define (split-value v)
diff --git a/pnm/ppm.scm b/pnm/ppm.scm
index 4ca453e..95ce837 100644
--- a/pnm/ppm.scm
+++ b/pnm/ppm.scm
@@ -40,7 +40,8 @@
                    (< 65536 maxval))
            (error "(pnm ppm) make-ppm-image: Maxval is out of range"))
          (if (< maxval 256)
-             (let* ((w*3 (* width 3)))
+             (let* ((w*3 (* width 3))
+                    (byte-count (* w*3 height)))
                (define (xy->idx x y) (+ (* 3 x) (* y w*3)))
                (define (pixel-getter x y)
                  (let ((idx (xy->idx x y)))
@@ -52,8 +53,11 @@
                    (bytevector-u8-set! data idx r)
                    (bytevector-u8-set! data (+ idx 1) g)
                    (bytevector-u8-set! data (+ idx 2) b)))
+               (unless (= byte-count (bytevector-length data))
+                 (error (string-append "(pnm pbm) make-pbm-image: Invalid bytevector length" byte-count)))
                (make-image 'ppm width height maxval data pixel-getter pixel-setter))
-             (let* ((w*6 (* width 6)))
+             (let* ((w*6 (* width 6))
+                    (byte-count (* w*6 height)))
                (define (xy->idx x y) (+ (* 6 x) (* y w*6)))
                (define (pixel-getter x y)
                  (let ((idx (xy->idx x y)))
@@ -74,6 +78,8 @@
                      (bytevector-u8-set! data (+ idx 3) g2)
                      (bytevector-u8-set! data (+ idx 4) b1)
                      (bytevector-u8-set! data (+ idx 5) b2))))
+               (unless (= byte-count (bytevector-length data))
+                 (error (string-append "(pnm pbm) make-pbm-image: Invalid bytevector length" byte-count)))
                (make-image 'ppm width height maxval data pixel-getter pixel-setter))))))
 
     (define (split-value v)
-- 
cgit v1.2.3