From 4511f58d0cec81a94d4d0569a8c4b9d722739214 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Wed, 24 Jan 2007 06:53:08 +0000
Subject: [PATCH] fix some error handling and support for short-lived UTF-32
 string encoding

svn: r5445
---
 collects/wxme/doc.txt |  7 +++++++
 collects/wxme/wxme.ss | 29 ++++++++++++++++++++++-------
 2 files changed, 29 insertions(+), 7 deletions(-)

diff --git a/collects/wxme/doc.txt b/collects/wxme/doc.txt
index 1d869e0788..93d906f6de 100644
--- a/collects/wxme/doc.txt
+++ b/collects/wxme/doc.txt
@@ -60,6 +60,13 @@ an unrecognized snip class is encountered in a WXME stream. When set to
 a true value, instances of unrecognized snip classes are simply
 omitted from the transformed stream.
 
+> broken-wxme-big-endian?
+
+A parameter. Some old and short-lived WXME formats depended on the
+endian order of the machine where the file was saved. Set this
+parameter to pick the endian order to use when reading the file; the
+default is the current platform's endian order.
+
 > (wxme-read port)
 
 Like `read', but for a stream that starts with WXME-format data. If
diff --git a/collects/wxme/wxme.ss b/collects/wxme/wxme.ss
index a87103daf3..8a53d72d16 100644
--- a/collects/wxme/wxme.ss
+++ b/collects/wxme/wxme.ss
@@ -265,7 +265,10 @@
 
   (define (read-a-string who port vers what)
     (let ([s (read-raw-string who port vers what)])
-      (subbytes s 0 (sub1 (bytes-length s)))))
+      (let ([len (bytes-length s)])
+        (when (zero? len)
+          (read-error who "non-empty raw string" what port))
+        (subbytes s 0 (sub1 len)))))
 
   (define (read-integer who port vers what)
     (cond
@@ -307,7 +310,7 @@
                               #t
                               (if (vers . > . 1)
                                   #t
-                                  (system-big-endian?)))]))
+                                  (broken-wxme-big-endian?)))]))
       
   (define (read-inexact who port vers what)
     (cond
@@ -321,12 +324,13 @@
       (floating-point-bytes->real (read-bytes 8 port)
                                   (if (vers . > . 1)
                                       #t
-                                      (system-big-endian?)))]))
+                                      (broken-wxme-big-endian?)))]))
       
 
   (define (read-error who expected what port)
-    (error who "WXME format problem while reading for ~a (expected ~a) from port: ~v"
-           what expected port))
+    (error who "WXME format problem while reading for ~a (expected ~a) from port: ~e around position: ~a"
+           what expected port
+           (file-position port)))
 
   (define (skip-data port vers len)
     (if (vers . >= . 8)
@@ -369,9 +373,17 @@
                      (read-error who "size of read byte string is not a multiple of 4" "string-snip content" port))
                    (let loop ([pos 0][accum null])
                      (if (= pos (bytes-length s))
-                         (string->bytes/utf-8 (apply string (reverse accum)))
+                         (begin
+                           (string->bytes/utf-8 (apply string (reverse accum))))
                          (loop (+ pos 4)
-                               (cons (integer-bytes->integer (subbytes s pos (+ pos 4)))
+                               (cons (integer->char
+                                      (let ([v (integer-bytes->integer (subbytes s pos (+ pos 4)) #f
+                                                                       (broken-wxme-big-endian?))])
+                                        (unless (or (<= 0 v #xD7FF)
+                                                    (<= #xE000 v #x10FFFF))
+                                          (read-error who "UTF-32 character; probably an endian order mismatch" 
+                                                      "string-snip content" port))
+                                        v))
                                      accum))))]
                   [(cvers . > . 2) s])))]
             [(equal? name #"wxmedia")
@@ -591,6 +603,8 @@
 
   (define unknown-extensions-skip-enabled (make-parameter #f))
 
+  (define broken-wxme-big-endian? (make-parameter (system-big-endian?)))
+
   (define (is-wxme-stream? p)
     (and (regexp-match-peek #rx#"^(?:#reader[(]lib\"read[.]ss\"\"wxme\"[)])?WXME01[0-9][0-9] ##[ \r\n]" p)
          #t))
@@ -635,6 +649,7 @@
                     [register-lib-mapping! (string? string? . -> . void?)])
 
   (provide unknown-extensions-skip-enabled
+           broken-wxme-big-endian?
            snip-reader<%>
            readable<%>
            wxme-read