From: Christophe Rhodes <csr21@cantab.net>
Date: Thu, 17 Apr 2008 14:05:01 +0000 (+0000)
Subject: 1.0.16.2: Fix FASL header checking logic
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=e3b3baf2f433b51d1864255c0e3adf1e58abcfc2;p=sbcl.git

1.0.16.2: Fix FASL header checking logic
	We mustn't read a word argument before we're sure that the
	wordsize is right; otherwise we risk trying to create a string
	of length approximately 2^32.
	... reported by stassats@gmail.com on sbcl-devel 2008-04-16
---

diff --git a/NEWS b/NEWS
index dd9f3e8..f9192b1 100644
--- a/NEWS
+++ b/NEWS
@@ -2,6 +2,8 @@
 changes in sbcl-1.0.17 relative to 1.0.16:
   * bug fix: invalid optimization of heap-allocated alien variable
     reference.
+  * bug fix: fasl header checking is less vulnerable to different
+    platform word lengths.
 
 changes in sbcl-1.0.16 relative to 1.0.15:
   * minor incompatible change: revert the changes to sb-posix's error
diff --git a/src/code/load.lisp b/src/code/load.lisp
index 1a0bcea..4c7ce9c 100644
--- a/src/code/load.lisp
+++ b/src/code/load.lisp
@@ -312,26 +312,25 @@
                  (read-string-as-bytes stream result)
                  result)))
         ;; Read and validate implementation and version.
-        (let* ((implementation (keywordicate (string-from-stream)))
-               (fasl-version (read-word-arg))
+        (let ((implementation (keywordicate (string-from-stream)))
+              (expected-implementation +backend-fasl-file-implementation+))
+          (unless (string= expected-implementation implementation)
+            (error 'invalid-fasl-implementation
+                   :stream stream
+                   :implementation implementation
+                   :expected expected-implementation)))
+        (let* ((fasl-version (read-word-arg))
                (sbcl-version (if (<= fasl-version 76)
                                  "1.0.11.18"
                                  (string-from-stream)))
-               (expected-version (sb!xc:lisp-implementation-version))
-               (expected-implementation +backend-fasl-file-implementation+))
-          (cond ((string/= expected-implementation implementation)
-                 (error 'invalid-fasl-implementation
-                        :stream stream
-                        :implementation implementation
-                        :expected expected-implementation))
-                ((string/= expected-version sbcl-version)
-                 (restart-case
-                     (error 'invalid-fasl-version
-                            :stream stream
-                            :version sbcl-version
-                            :expected expected-version)
-                   (continue ()
-                     :report "Load the fasl file anyway")))))
+               (expected-version (sb!xc:lisp-implementation-version)))
+          (unless (string= expected-version sbcl-version)
+            (restart-case
+                (error 'invalid-fasl-version
+                       :stream stream
+                       :version sbcl-version
+                       :expected expected-version)
+              (continue () :report "Load the fasl file anyway"))))
         ;; Read and validate *FEATURES* which affect binary compatibility.
         (let ((faff-in-this-file (string-from-stream)))
           (unless (string= faff-in-this-file *features-affecting-fasl-format*)
diff --git a/version.lisp-expr b/version.lisp-expr
index 4779f81..f89b06d 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.16.1"
+"1.0.16.2"