From e647a293844cdc3553ddb201c8c8557700e90cc3 Mon Sep 17 00:00:00 2001 From: Oleg Date: Wed, 22 Jan 2020 13:32:48 -0500 Subject: [PATCH 1/7] few primus-lisp updates We add a stub for realloc - surprisingly many allocations are done by passing a null pointer to realloc, and an analysis that is based on a tracing of allocation/freeing memory won't notice such call. Also, this PR fixes a minor bug in the method name in: there is no signal enter-jmp, so we can't depend on it. Also, we add a new behavior of the `free` call processing in memcheck-malloc: now, if the pointer being freed in unknown, i.e. there wasn't any memory allocation for it in the current primus machine, then we allocate one-byte length region and then release it. The justification is simple: by doing so, we are able to find more bugs like use-after-free or double-free, e.g. in some library, where any path we take won't necessarily contain the chain of calls like `malloc->free->memory-access/free` because such path exists only in the user code but not in the library itself. --- .../primus_lisp/lisp/simple-memory-allocator.lisp | 14 ++++++++++++-- plugins/primus_lisp/primus_lisp_main.ml | 2 +- plugins/primus_test/lisp/check-value.lisp | 2 +- plugins/primus_test/lisp/memcheck-malloc.lisp | 3 +++ plugins/primus_test/lisp/memcheck.lisp | 6 ++++++ 5 files changed, 23 insertions(+), 4 deletions(-) diff --git a/plugins/primus_lisp/lisp/simple-memory-allocator.lisp b/plugins/primus_lisp/lisp/simple-memory-allocator.lisp index 6d4613794..a4c620853 100644 --- a/plugins/primus_lisp/lisp/simple-memory-allocator.lisp +++ b/plugins/primus_lisp/lisp/simple-memory-allocator.lisp @@ -43,8 +43,18 @@ (if failed 0 (set brk (+ brk n)) (malloc/fill-edges ptr n) - (+ ptr *malloc-guard-edges*)))))) - + (let ((ptr (+ ptr *malloc-guard-edges*))) + (dict-add 'malloc/regions ptr n) + ptr)))))) + +(defun realloc (ptr len) + (declare (external "realloc")) + (let ((len' (dict-get 'malloc/regions ptr))) + (if (not len') (malloc len) + (if (>= len' len) ptr + (let ((new_ptr (malloc len))) + (if (not new_ptr) new_ptr + (copy-right new_ptr ptr len'))))))) ;; in our simplistic malloc implementation, free is just a nop (defun free (p) diff --git a/plugins/primus_lisp/primus_lisp_main.ml b/plugins/primus_lisp/primus_lisp_main.ml index 0527a97eb..fb68b16b4 100644 --- a/plugins/primus_lisp/primus_lisp_main.ml +++ b/plugins/primus_lisp/primus_lisp_main.ml @@ -100,7 +100,7 @@ module Signals(Machine : Primus.Machine.S) = struct signal pc_change word one {|(pc-change PC) is emitted when PC is updated|}; signal eval_cond value one - {|(eval_cond V) is emitted after evaluating a conditional to V|}; + {|(eval-cond V) is emitted after evaluating a conditional to V|}; signal jumping (value,value) pair {|(jumping C D) is emitted before jump to D occurs under the condition C|}; diff --git a/plugins/primus_test/lisp/check-value.lisp b/plugins/primus_test/lisp/check-value.lisp index a254d7a7b..41d9ed9c9 100644 --- a/plugins/primus_test/lisp/check-value.lisp +++ b/plugins/primus_test/lisp/check-value.lisp @@ -51,7 +51,7 @@ (check-value/unchecked pc) (dict-del 'check-value/required taint)))) -(defmethod enter-jmp (cnd dst) +(defmethod eval-cond (cnd) (check-value-clear cnd)) diff --git a/plugins/primus_test/lisp/memcheck-malloc.lisp b/plugins/primus_test/lisp/memcheck-malloc.lisp index 5671e6172..42b4bb738 100644 --- a/plugins/primus_test/lisp/memcheck-malloc.lisp +++ b/plugins/primus_test/lisp/memcheck-malloc.lisp @@ -3,6 +3,9 @@ (defmethod call (name ptr) (when (and ptr (= name 'free) (not (= ptr *malloc-zero-sentinel*))) + (when (and ptr + (not (memcheck-is-allocated 'malloc ptr))) + (memcheck-acquire 'malloc ptr 1)) (memcheck-release 'malloc ptr))) (defmethod loaded (ptr) diff --git a/plugins/primus_test/lisp/memcheck.lisp b/plugins/primus_test/lisp/memcheck.lisp index f2244c381..920667d9a 100644 --- a/plugins/primus_test/lisp/memcheck.lisp +++ b/plugins/primus_test/lisp/memcheck.lisp @@ -24,6 +24,12 @@ (require incident) ;; Public Interface + +(defun memcheck-is-allocated (heap ptr) + (or + (region-contains (symbol-concat 'memcheck/live heap) ptr) + (region-contains (symbol-concat 'memcheck/dead heap) ptr))) + (defun memcheck-release (heap ptr) (let ((dead (region-contains (symbol-concat 'memcheck/dead heap) ptr))) (if dead (memcheck/report-double-release ptr) From bf31a282661ad1f13dee1bea021939826e36c093 Mon Sep 17 00:00:00 2001 From: Oleg Date: Tue, 28 Jan 2020 15:44:02 -0500 Subject: [PATCH 2/7] encoded length --- .../lisp/simple-memory-allocator.lisp | 53 ++++++++++++------- 1 file changed, 35 insertions(+), 18 deletions(-) diff --git a/plugins/primus_lisp/lisp/simple-memory-allocator.lisp b/plugins/primus_lisp/lisp/simple-memory-allocator.lisp index a4c620853..31068ff7e 100644 --- a/plugins/primus_lisp/lisp/simple-memory-allocator.lisp +++ b/plugins/primus_lisp/lisp/simple-memory-allocator.lisp @@ -29,32 +29,49 @@ (defun memory/allocate (ptr len) (if *malloc-initialize-memory* - (memory-allocate ptr n *malloc-initial-value*) - (memory-allocate ptr n))) + (memory-allocate ptr len *malloc-initial-value*) + (memory-allocate ptr len))) -(defun malloc (n) +(defun word-size () (/ (word-width) 8)) + +(defun encode-memory-length(ptr len) + (write-word ptr_t ptr len)) + +(defun decode-memory-length(ptr) + (read-word ptr_t ptr)) + +(defun decode-memory-length'(ptr) + (if ptr (decode-memory-length (- ptr (word-size))) 0)) + +(defun malloc_internal (n) "allocates a memory region of size N" - (declare (external "malloc")) (if (= n 0) *malloc-zero-sentinel* (if (malloc-will-reach-limit n) 0 - (let ((n (+ n (* 2 *malloc-guard-edges*))) + (let ((width (word-size)) + (full (+ n (* 2 *malloc-guard-edges*) width)) (ptr brk) - (failed (memory/allocate ptr n))) + (failed (memory/allocate ptr full))) (if failed 0 - (set brk (+ brk n)) - (malloc/fill-edges ptr n) - (let ((ptr (+ ptr *malloc-guard-edges*))) - (dict-add 'malloc/regions ptr n) - ptr)))))) + (set brk (+ brk full)) + (malloc/fill-edges ptr full) + (set ptr (+ ptr *malloc-guard-edges*)) + (encode-memory-length ptr n) + (+ ptr width)))))) + +(defun malloc (n) + "allocates a memory region of size N" + (declare (external "malloc")) + (malloc_internal n)) -(defun realloc (ptr len) +(defun realloc (ptr new) (declare (external "realloc")) - (let ((len' (dict-get 'malloc/regions ptr))) - (if (not len') (malloc len) - (if (>= len' len) ptr - (let ((new_ptr (malloc len))) - (if (not new_ptr) new_ptr - (copy-right new_ptr ptr len'))))))) + (let ((old (decode-memory-length' ptr)) + (ptr' (malloc new)) + (dst ptr')) + (if (not ptr) ptr' + (when (and ptr ptr') + (copy-right dst ptr old)) + ptr'))) ;; in our simplistic malloc implementation, free is just a nop (defun free (p) From 8e74a24103a5fc4128294ebfb72f2dd9f5aa82cb Mon Sep 17 00:00:00 2001 From: Oleg Date: Wed, 29 Jan 2020 14:07:25 -0500 Subject: [PATCH 3/7] removed unused function --- plugins/primus_lisp/lisp/simple-memory-allocator.lisp | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/plugins/primus_lisp/lisp/simple-memory-allocator.lisp b/plugins/primus_lisp/lisp/simple-memory-allocator.lisp index 31068ff7e..dd4903308 100644 --- a/plugins/primus_lisp/lisp/simple-memory-allocator.lisp +++ b/plugins/primus_lisp/lisp/simple-memory-allocator.lisp @@ -43,8 +43,9 @@ (defun decode-memory-length'(ptr) (if ptr (decode-memory-length (- ptr (word-size))) 0)) -(defun malloc_internal (n) +(defun malloc (n) "allocates a memory region of size N" + (declare (external "malloc")) (if (= n 0) *malloc-zero-sentinel* (if (malloc-will-reach-limit n) 0 (let ((width (word-size)) @@ -58,11 +59,6 @@ (encode-memory-length ptr n) (+ ptr width)))))) -(defun malloc (n) - "allocates a memory region of size N" - (declare (external "malloc")) - (malloc_internal n)) - (defun realloc (ptr new) (declare (external "realloc")) (let ((old (decode-memory-length' ptr)) From 2491fcdea38c21e0251d20b102a52c31ac0356e0 Mon Sep 17 00:00:00 2001 From: Oleg Date: Fri, 31 Jan 2020 15:15:10 -0500 Subject: [PATCH 4/7] rewrote realloc --- plugins/primus_lisp/lisp/init.lisp | 17 ++++-- .../lisp/simple-memory-allocator.lisp | 60 ++++++++++++------- plugins/primus_test/lisp/memcheck-malloc.lisp | 3 +- plugins/primus_test/lisp/memcheck.lisp | 2 +- 4 files changed, 52 insertions(+), 30 deletions(-) diff --git a/plugins/primus_lisp/lisp/init.lisp b/plugins/primus_lisp/lisp/init.lisp index 26c1cf1e9..b4354c090 100644 --- a/plugins/primus_lisp/lisp/init.lisp +++ b/plugins/primus_lisp/lisp/init.lisp @@ -4,13 +4,22 @@ (defconstant nil false "nil is another name for false") (defmacro when (cnd body) - "(when CND BODY) if CND is true then evaluates BODY and returns the - value of last expression in BODY, otherwise returns false." + "(when CND BODY) if CND evaluates to true, then BODY is evaluated and + the value of the last expression in BODY becomes the value of the + whole expression. Otherwise, if CND evaluates to false, nil is returned." (if cnd (prog body) ())) +(defmacro unless (cnd body) + "(unless CND BODY) if CND evaluates to false, then BODY is evaluated and + the value of the last expression in BODY becomes the value of the + whole expression. Otherwise, if CND evaluates to true, nil is returned." + (if (not cnd) () body)) + (defmacro until (c b) - "(unit COND BODY) if CND is not true then evaluates BODY and returns - the value of the last expression in BODY, otherwise returns false. " + "(until COND BODY) if COND evaluates to true, then the whole expression + evaluates to nil and BODY is not evaluated. Otherwise, if COND evaluates + to false, then BODY is evaluated until COND evaluates to true and the value + of the last evaluation of BODY becomes the value of the whole expression." (while (not c) b)) (defun non-zero (x) diff --git a/plugins/primus_lisp/lisp/simple-memory-allocator.lisp b/plugins/primus_lisp/lisp/simple-memory-allocator.lisp index dd4903308..0d0851287 100644 --- a/plugins/primus_lisp/lisp/simple-memory-allocator.lisp +++ b/plugins/primus_lisp/lisp/simple-memory-allocator.lisp @@ -32,42 +32,56 @@ (memory-allocate ptr len *malloc-initial-value*) (memory-allocate ptr len))) -(defun word-size () (/ (word-width) 8)) - -(defun encode-memory-length(ptr len) +(defun malloc/put-chunk-size (ptr len) (write-word ptr_t ptr len)) -(defun decode-memory-length(ptr) - (read-word ptr_t ptr)) - -(defun decode-memory-length'(ptr) - (if ptr (decode-memory-length (- ptr (word-size))) 0)) +(defun malloc/get-chunk-size (ptr) + (let ((header-size (/ (word-width) 8))) + (if ptr (read-word ptr_t (- ptr header-size)) 0))) (defun malloc (n) "allocates a memory region of size N" (declare (external "malloc")) (if (= n 0) *malloc-zero-sentinel* (if (malloc-will-reach-limit n) 0 - (let ((width (word-size)) - (full (+ n (* 2 *malloc-guard-edges*) width)) + (let ((header-size (/ (word-width) 8)) + (chunk-size (+ n (* 2 *malloc-guard-edges*) header-size)) (ptr brk) - (failed (memory/allocate ptr full))) + (failed (memory/allocate ptr chunk-size))) (if failed 0 - (set brk (+ brk full)) - (malloc/fill-edges ptr full) + (set brk (+ brk chunk-size)) + (malloc/fill-edges ptr chunk-size) (set ptr (+ ptr *malloc-guard-edges*)) - (encode-memory-length ptr n) - (+ ptr width)))))) + (malloc/put-chunk-size ptr n) + (+ ptr header-size)))))) + + +;; pre: ptr is not null +(defun realloc/update-chunk-size (ptr len) + (malloc/put-chunk-size ptr len) + ptr) + +;; pre: both old-ptr and new-len are not null +(defun realloc/update-chunk (old-ptr new-len) + (let ((old-len (malloc/get-chunk-size old-ptr))) + (if (>= old-len len) (realloc/update-chunk-size ptr len) + (let ((new-ptr (malloc new-len))) + (when new-ptr (memcpy new-ptr old-ptr old-len)) + (free old-ptr) + new-ptr)))) + +(defun realloc/as-malloc (len) + (malloc len)) + +(defun realloc/as-free (ptr) + (free ptr) + *malloc-zero-sentinel*) -(defun realloc (ptr new) +(defun realloc (ptr len) (declare (external "realloc")) - (let ((old (decode-memory-length' ptr)) - (ptr' (malloc new)) - (dst ptr')) - (if (not ptr) ptr' - (when (and ptr ptr') - (copy-right dst ptr old)) - ptr'))) + (if (not ptr) (realloc/as-malloc len) + (if (not len) (realloc/as-free ptr) + (realloc/update-chunk ptr len)))) ;; in our simplistic malloc implementation, free is just a nop (defun free (p) diff --git a/plugins/primus_test/lisp/memcheck-malloc.lisp b/plugins/primus_test/lisp/memcheck-malloc.lisp index 42b4bb738..6a6033743 100644 --- a/plugins/primus_test/lisp/memcheck-malloc.lisp +++ b/plugins/primus_test/lisp/memcheck-malloc.lisp @@ -3,8 +3,7 @@ (defmethod call (name ptr) (when (and ptr (= name 'free) (not (= ptr *malloc-zero-sentinel*))) - (when (and ptr - (not (memcheck-is-allocated 'malloc ptr))) + (unless (memcheck-is-tracked 'malloc ptr) (memcheck-acquire 'malloc ptr 1)) (memcheck-release 'malloc ptr))) diff --git a/plugins/primus_test/lisp/memcheck.lisp b/plugins/primus_test/lisp/memcheck.lisp index 920667d9a..e08258940 100644 --- a/plugins/primus_test/lisp/memcheck.lisp +++ b/plugins/primus_test/lisp/memcheck.lisp @@ -25,7 +25,7 @@ ;; Public Interface -(defun memcheck-is-allocated (heap ptr) +(defun memcheck-is-tracked (heap ptr) (or (region-contains (symbol-concat 'memcheck/live heap) ptr) (region-contains (symbol-concat 'memcheck/dead heap) ptr))) From 90d5d18875c272c9e13017c372d176970b4eeadf Mon Sep 17 00:00:00 2001 From: Oleg Date: Fri, 31 Jan 2020 15:28:34 -0500 Subject: [PATCH 5/7] refactored a little --- .../primus_lisp/lisp/simple-memory-allocator.lisp | 13 +++++-------- 1 file changed, 5 insertions(+), 8 deletions(-) diff --git a/plugins/primus_lisp/lisp/simple-memory-allocator.lisp b/plugins/primus_lisp/lisp/simple-memory-allocator.lisp index 0d0851287..a9f9c0c96 100644 --- a/plugins/primus_lisp/lisp/simple-memory-allocator.lisp +++ b/plugins/primus_lisp/lisp/simple-memory-allocator.lisp @@ -37,7 +37,7 @@ (defun malloc/get-chunk-size (ptr) (let ((header-size (/ (word-width) 8))) - (if ptr (read-word ptr_t (- ptr header-size)) 0))) + (read-word ptr_t (- ptr header-size)))) (defun malloc (n) "allocates a memory region of size N" @@ -56,7 +56,6 @@ (+ ptr header-size)))))) -;; pre: ptr is not null (defun realloc/update-chunk-size (ptr len) (malloc/put-chunk-size ptr len) ptr) @@ -66,20 +65,18 @@ (let ((old-len (malloc/get-chunk-size old-ptr))) (if (>= old-len len) (realloc/update-chunk-size ptr len) (let ((new-ptr (malloc new-len))) - (when new-ptr (memcpy new-ptr old-ptr old-len)) - (free old-ptr) + (when new-ptr + (memcpy new-ptr old-ptr old-len) + (free old-ptr)) new-ptr)))) -(defun realloc/as-malloc (len) - (malloc len)) - (defun realloc/as-free (ptr) (free ptr) *malloc-zero-sentinel*) (defun realloc (ptr len) (declare (external "realloc")) - (if (not ptr) (realloc/as-malloc len) + (if (not ptr) (malloc len) (if (not len) (realloc/as-free ptr) (realloc/update-chunk ptr len)))) From e393461c787068d1318ee59d1d72e4f41e3b1967 Mon Sep 17 00:00:00 2001 From: Oleg Date: Wed, 5 Feb 2020 10:53:36 -0500 Subject: [PATCH 6/7] renaming --- .../primus_lisp/lisp/simple-memory-allocator.lisp | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/plugins/primus_lisp/lisp/simple-memory-allocator.lisp b/plugins/primus_lisp/lisp/simple-memory-allocator.lisp index a9f9c0c96..f6173a304 100644 --- a/plugins/primus_lisp/lisp/simple-memory-allocator.lisp +++ b/plugins/primus_lisp/lisp/simple-memory-allocator.lisp @@ -55,15 +55,20 @@ (malloc/put-chunk-size ptr n) (+ ptr header-size)))))) +(defun realloc (ptr len) + (declare (external "realloc")) + (if (not ptr) (malloc len) + (if (not len) (realloc/as-free ptr) + (realloc/update-chunk ptr len)))) -(defun realloc/update-chunk-size (ptr len) +(defun realloc/shrink-chunk (ptr len) (malloc/put-chunk-size ptr len) ptr) ;; pre: both old-ptr and new-len are not null (defun realloc/update-chunk (old-ptr new-len) (let ((old-len (malloc/get-chunk-size old-ptr))) - (if (>= old-len len) (realloc/update-chunk-size ptr len) + (if (>= old-len len) (realloc/shrink-chunk ptr len) (let ((new-ptr (malloc new-len))) (when new-ptr (memcpy new-ptr old-ptr old-len) @@ -74,11 +79,6 @@ (free ptr) *malloc-zero-sentinel*) -(defun realloc (ptr len) - (declare (external "realloc")) - (if (not ptr) (malloc len) - (if (not len) (realloc/as-free ptr) - (realloc/update-chunk ptr len)))) ;; in our simplistic malloc implementation, free is just a nop (defun free (p) From a1ced409eaffd92f5d2e2f65c247bbaabb11e160 Mon Sep 17 00:00:00 2001 From: oleg Date: Thu, 13 Feb 2020 09:54:12 -0500 Subject: [PATCH 7/7] removed unresolved names handling from promiscuous --- plugins/primus_promiscuous/primus_promiscuous_main.ml | 5 ----- 1 file changed, 5 deletions(-) diff --git a/plugins/primus_promiscuous/primus_promiscuous_main.ml b/plugins/primus_promiscuous/primus_promiscuous_main.ml index ea1563001..09d32a31f 100644 --- a/plugins/primus_promiscuous/primus_promiscuous_main.ml +++ b/plugins/primus_promiscuous/primus_promiscuous_main.ml @@ -219,14 +219,9 @@ module Main(Machine : Primus.Machine.S) = struct Linker.link ~name:Primus.Interpreter.division_by_zero_handler (module DoNothing) - let ignore_unresolved_names = - Linker.link ~name:Primus.Linker.unresolved_handler - (module DoNothing) - let init () = Machine.sequence [ setup_vars; ignore_division_by_zero; - ignore_unresolved_names; Primus.Interpreter.pagefault >>> pagefault; Primus.Interpreter.leave_pos >>> step; Primus.Interpreter.leave_blk >>> mark_visited;