Zeroize junk at end of heap spaces when saving core

Patch to save.c by Andreas Franke, test case by me

src/runtime/save.c

@@ -206,13 +206,10 @@ output_space(FILE *file, int id, lispobj *addr, lispobj *end,
         printf("writing %lu bytes from the %s space at %p\n",
                (long unsigned)bytes, names[id], addr);
 
-    /* FIXME: it sure would be nice to discover and document the behavior of this function
-     * with regard to aligning up the byte count as pertains to bytes spanned by a rounded
-     * up count that were not zeroized and would not have been written had we not rounded.
-     * That seems quite bogus to operate on bytes that the caller didn't promise were OK
-     * to be saved out (and didn't contain, say, a password and social security number) */
-    data = write_bytes(file, (char *)addr, ALIGN_UP(bytes, os_vm_page_size),
-                       file_offset, core_compression_level);
+    size_t aligned = ALIGN_UP(bytes, os_vm_page_size);
+    if (aligned > bytes)
+        memset((char*)addr + bytes, 0, aligned - bytes);
+    data = write_bytes(file, (char *)addr, aligned, file_offset, core_compression_level);
 
     write_lispobj(data, file);
     write_lispobj((uword_t)addr, file);

tests/input-manifest.lisp-expr

@@ -2,6 +2,7 @@
 ;;; is binary its diff view.
 ;;; Or not.
 (("alien-struct-by-value.impure.lisp" "tests/alien-struct-by-value.so")
+ ("alien.impure.lisp" "tests/alien-128.so")
  ("aprof.impure.lisp"
   "src/code/aprof.lisp"
   "src/code/shaketree.lisp")
@@ -44,7 +45,6 @@
  ("elfcore.test.sh" "src/runtime/shrinkwrap-sbcl")
  ("exit-hang.impure.lisp" "tests/fcb-threads.so")
  ("fcb-threads.impure.lisp" "tests/fcb-threads.so")
- ("alien.impure.lisp" "tests/alien-128.so")
  ("fifo-slow.impure.lisp" "contrib/sb-posix.fasl")
  ("filecompile.impure.lisp"
   "tests/data/wonky1.lisp"
@@ -85,6 +85,8 @@
   "../xperfecthash61.lisp-expr")
  ("redblack.pure.lisp" "tests/bbtree-test-util.lisp" "src/code/redblack.lisp")
  ("run-program.impure.lisp" "contrib/sb-posix.fasl")
+ ("save11.test.sh"
+  "src/code/repack-xref.lisp" "tools-for-build/corefile.lisp" "tools-for-build/editcore.lisp")
  ("sb-aclrepl.impure.lisp" "contrib/sb-aclrepl.fasl"
   "../contrib/sb-aclrepl/tests.lisp")
  ("sb-bsd-sockets.impure.lisp" "contrib/sb-bsd-sockets.fasl" "contrib/sb-posix.fasl"

tests/save10.test.sh

@@ -1,6 +1,5 @@
 . ./subr.sh
 
-this_file=`pwd`/save10.test.sh
 use_test_subdirectory
 
 tmpcore=$TEST_FILESTEM.core

tests/save11.test.sh

@@ -0,0 +1,20 @@
+. ./subr.sh
+
+create_test_subdirectory
+
+tmpfasl=$TEST_DIRECTORY/$TEST_FILESTEM.fasl
+tmpcore=$TEST_DIRECTORY/$TEST_FILESTEM.core
+set -e
+
+run_sbcl <<EOF
+  (load (compile-file "../src/code/repack-xref" :output-file "$tmpfasl"))
+  (save-lisp-and-die "$tmpcore")
+EOF
+run_sbcl <<EOF
+  (load "../tools-for-build/editcore")
+  (let ((result (sb-editcore::scan-for-end-of-page-garbage "$tmpcore")))
+    ;; result = number of junk words found
+    (sb-sys:os-exit (if (> result 0) 1 $EXIT_TEST_WIN)))
+EOF
+
+exit $?

tools-for-build/editcore.lisp

@@ -67,7 +67,7 @@
   id addr data-page page-adjust nwords)
 (defmethod print-object ((self core-space) stream)
   (print-unreadable-object (self stream :type t)
-    (format stream "~d" (space-id self))))
+    (format stream "~d @ #x~x" (space-id self) (space-addr self))))
 (defun space-size (space) (* (space-nwords space) n-word-bytes))
 (defun space-end (space) (+  (space-addr space) (space-size space)))
 (defun space-nbytes-aligned (space)
@@ -2140,3 +2140,34 @@
                              (space-addr space) (space-nwords space)))
                      (cdr spacemap))
              core-header parsed-header spacemap output)))))))
+
+;;; A diagnostic function to discover whether final GC left junk that should not be visible
+(defun scan-for-end-of-page-garbage (corefile-name)
+  (with-open-file (input corefile-name :element-type '(unsigned-byte 8))
+    (let* ((core-header (make-array +backend-page-bytes+ :element-type '(unsigned-byte 8)))
+           (core-offset (read-core-header input core-header t))
+           (parsed-header (parse-core-header input core-header core-offset))
+           (parsed-spacelist (core-header-space-list parsed-header))
+           (words-per-page (/ +backend-page-bytes+ n-word-bytes))
+           (total-bad 0))
+      (with-mapped-core (sap core-offset (core-header-total-npages parsed-header) input)
+        (let ((spacemap (cons sap (sort (copy-list parsed-spacelist) #'> :key #'space-addr))))
+          (dolist (space parsed-spacelist)
+            (multiple-value-bind (npages deficit) (ceiling (space-nwords space) words-per-page)
+              (unless (zerop deficit)
+                ;; words on the last page above the end of the used range should be 0.
+                (let* ((mapped-addr (int-sap (translate-ptr (space-addr space) spacemap)))
+                       (range-end (* npages +backend-page-bytes+))
+                       (range-begin (+ range-end (* deficit n-word-bytes))) ; deficit is negative
+                       (this-space-bad 0))
+                  (loop for byte-offset from range-begin below range-end by n-word-bytes
+                        when (/= (sap-ref-word mapped-addr byte-offset) 0)
+                        do (incf this-space-bad)
+                           (format t "~x = ~x~%"
+                                   (+ (space-addr space) byte-offset)
+                                   (sap-ref-word mapped-addr byte-offset)))
+                  (incf total-bad this-space-bad)
+                  (format t "~x is at ~x, ~D pages, remainder ~D, paddr ~X..~X, bad: ~D~%"
+                          (space-addr space) mapped-addr npages deficit
+                          range-begin range-end this-space-bad)))))))
+      total-bad)))