Skip to content

Commit

Permalink
Fix a corner case in RUN-PROGRAM with very long argument strings
Browse files Browse the repository at this point in the history
 Argument string of length on the order of MOST-POSITIVE-FIXNUM
 could lead to severe crashes.

 I don't know why we bothered declaring FIXNUMs in RUN-PROGRAM.

 Also, play with the null termination code a bit, but, really,
 such long strings will only end up failing in the OS.

 Fixes lp#787237
  • Loading branch information
pkhuong committed Jun 11, 2011
1 parent 0a3d799 commit edd4f63
Showing 1 changed file with 17 additions and 7 deletions.
24 changes: 17 additions & 7 deletions src/code/run-program.lisp
Original file line number Diff line number Diff line change
Expand Up @@ -458,39 +458,49 @@ status slot."
:element-type :default
:dual-channel-p t)))))

(defmacro round-bytes-to-words (n)
;; Null terminate strings only C-side: otherwise we can run into
;; A-T-S-L even for simple encodings like ASCII. Multibyte encodings
;; may need more than a single byte of zeros; assume 4 byte is enough
;; for everyone.
(defmacro round-null-terminated-bytes-to-words (n)
(let ((bytes-per-word (/ sb-vm:n-machine-word-bits sb-vm:n-byte-bits)))
`(logandc2 (the fixnum (+ (the fixnum ,n)
(1- ,bytes-per-word))) (1- ,bytes-per-word))))
`(logandc2 (the sb-vm:signed-word (+ (the fixnum ,n)
4 (1- ,bytes-per-word)))
(1- ,bytes-per-word))))

(defun string-list-to-c-strvec (string-list)
(let* ((bytes-per-word (/ sb-vm:n-machine-word-bits sb-vm:n-byte-bits))
;; We need an extra for the null, and an extra 'cause exect
;; clobbers argv[-1].
(vec-bytes (* bytes-per-word (+ (length string-list) 2)))
(octet-vector-list (mapcar (lambda (s)
(string-to-octets s :null-terminate t))
(string-to-octets s))
string-list))
(string-bytes (reduce #'+ octet-vector-list
:key (lambda (s)
(round-bytes-to-words (length s)))))
(round-null-terminated-bytes-to-words
(length s)))))
(total-bytes (+ string-bytes vec-bytes))
;; Memory to hold the vector of pointers and all the strings.
(vec-sap (sb-sys:allocate-system-memory total-bytes))
(string-sap (sap+ vec-sap vec-bytes))
;; Index starts from [1]!
(vec-index-offset bytes-per-word))
(declare (index string-bytes vec-bytes total-bytes)
(declare (sb-vm:signed-word vec-bytes)
(sb-vm:word string-bytes total-bytes)
(sb-sys:system-area-pointer vec-sap string-sap))
(dolist (octets octet-vector-list)
(declare (type (simple-array (unsigned-byte 8) (*)) octets))
(let ((size (length octets)))
;; Copy string.
(sb-kernel:copy-ub8-to-system-area octets 0 string-sap 0 size)
;; NULL-terminate it
(setf (sap-ref-32 string-sap size) 0)
;; Put the pointer in the vector.
(setf (sap-ref-sap vec-sap vec-index-offset) string-sap)
;; Advance string-sap for the next string.
(setf string-sap (sap+ string-sap (round-bytes-to-words size)))
(setf string-sap (sap+ string-sap
(round-null-terminated-bytes-to-words size)))
(incf vec-index-offset bytes-per-word)))
;; Final null pointer.
(setf (sap-ref-sap vec-sap vec-index-offset) (int-sap 0))
Expand Down

0 comments on commit edd4f63

Please sign in to comment.