archive: require exact non-negative integer numeric fields

ober

d94f9ed4141a6b374f92665c72c6f251bc6e440e

diff --git a/lib/jasm/object/archive.ss b/lib/jasm/object/archive.ss
index 944d6da..7cf401c 100644
--- a/lib/jasm/object/archive.ss
+++ b/lib/jasm/object/archive.ss
@@ -134,7 +134,8 @@
 
     (define (read-decimal-field bv offset size)
       (let ([n (string->number (trim (read-fixed-string bv offset size)))])
-        (unless n (error 'read-archive-bytevector "invalid archive numeric field" offset size))
+        (unless (and n (integer? n) (exact? n) (>= n 0))
+          (error 'read-archive-bytevector "invalid archive numeric field" offset size))
         n))
 
     (define (archive-magic? bv)
diff --git a/tests/test-malformed-objects.ss b/tests/test-malformed-objects.ss
index 1540766..8d26edb 100644
--- a/tests/test-malformed-objects.ss
+++ b/tests/test-malformed-objects.ss
@@ -25,6 +25,21 @@
              (set! fail (+ fail 1))
              (printf "FAIL ~a: expected exception~%" name))))]))
 
+(define-syntax test-raises-message
+  (syntax-rules ()
+    [(_ name message body ...)
+     (let ([raised? #f] [got #f])
+       (guard (exn [#t (set! raised? #t)
+                    (set! got (if (message-condition? exn) (condition-message exn) exn))])
+         body ...)
+       (if (and raised? (equal? got message))
+           (begin
+             (set! pass (+ pass 1))
+             (printf "  ok ~a~%" name))
+           (begin
+             (set! fail (+ fail 1))
+             (printf "FAIL ~a: expected message ~s got ~s~%" name message got))))]))
+
 (def (put8! bv offset value)
   (bytevector-u8-set! bv offset (mod value #x100)))
 
@@ -116,6 +131,24 @@
     (put-ascii! bv 68 "abc")
     bv))
 
+(def (archive-with-rational-size)
+  (let ([bv (make-bytevector 72 (char->integer #\space))])
+    (put-ascii! bv 0 "!<arch>\n")
+    (put-ascii! bv 8 "foo.o/")
+    (put-ascii! bv 56 "1/2")
+    (put8! bv 66 (char->integer #\`))
+    (put8! bv 67 (char->integer #\newline))
+    bv))
+
+(def (archive-with-flonum-size)
+  (let ([bv (make-bytevector 72 (char->integer #\space))])
+    (put-ascii! bv 0 "!<arch>\n")
+    (put-ascii! bv 8 "foo.o/")
+    (put-ascii! bv 56 "1e3")
+    (put8! bv 66 (char->integer #\`))
+    (put8! bv 67 (char->integer #\newline))
+    bv))
+
 (def (elf-with-small-section-entry)
   (let ([bv (make-bytevector 64 0)])
     (put8! bv 0 #x7f)
@@ -206,5 +239,11 @@
 (test-raises "archive nonnumeric BSD long-name size"
   (read-archive-bytevector (archive-nonnumeric-bsd-long-name)))
 
+(test-raises-message "archive rational size rejected cleanly" "invalid archive numeric field"
+  (read-archive-bytevector (archive-with-rational-size)))
+
+(test-raises-message "archive flonum size rejected cleanly" "invalid archive numeric field"
+  (read-archive-bytevector (archive-with-flonum-size)))
+
 (printf "~%pass: ~a fail: ~a~%" pass fail)
 (when (> fail 0) (exit 1))