From 1e0ff599f0b4c48d701107fb14a92629115963be Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Fri, 9 Nov 2007 19:24:40 +0000 Subject: [PATCH] Lynn Quam noted that callbacks did not work on his system. This happened because the callback trampoline used malloc'ed space which were not executable by default. Change this so that the trampoline is executable. code/unix.lisp, code/unix-glibc2.lisp: o Add UNIX-MPROTECT code/exports.lisp: o Export UNIX-MPROTECT code/alieneval.lisp: o Make sure the malloc'ed trampoline area is executable. general-info/release-19e.txt: o Update --- code/alieneval.lisp | 13 ++++++++++++- code/exports.lisp | 4 ++-- code/unix-glibc2.lisp | 11 +++++++++-- code/unix.lisp | 10 +++++++++- general-info/release-19e.txt | 3 +++ 5 files changed, 35 insertions(+), 6 deletions(-) diff --git a/code/alieneval.lisp b/code/alieneval.lisp index 485d36d09..66b274616 100644 --- a/code/alieneval.lisp +++ b/code/alieneval.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/alieneval.lisp,v 1.64 2005/11/11 22:30:38 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/alieneval.lisp,v 1.65 2007/11/09 19:24:35 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -2218,6 +2218,17 @@ type and arg types, so we can detect incompatible redefinitions." (extern-alien "malloc" (function system-area-pointer unsigned)) length)) (fill-pointer code)) + ;; Make sure the malloc'ed area is executable. + (let* ((page-size (get-page-size)) + ;; mprotect wants address on a page boundary, so round down + ;; the address and round up the length + (code-base (sys:int-sap (* page-size + (floor (sys:sap-int code) page-size)))) + (len (* page-size (ceiling length page-size)))) + (unless (unix::unix-mprotect code-base len + (logior unix:prot_exec unix:prot_read unix:prot_write)) + (warn "Unable to mprotect ~S bytes (~S) at ~S (~S). Callbacks may not work." + len length code-base code))) (new-assem:segment-map-output segment (lambda (sap length) (kernel:system-area-copy sap 0 fill-pointer 0 diff --git a/code/exports.lisp b/code/exports.lisp index 6c6e73dca..6bec4299f 100644 --- a/code/exports.lisp +++ b/code/exports.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.262 2007/11/05 15:25:03 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.263 2007/11/09 19:24:36 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -211,7 +211,7 @@ "PROT_READ" "PROT_WRITE" "PROT_EXEC" "PROT_NONE" "MAP_SHARED" "MAP_PRIVATE" "MAP_FIXED" "MAP_ANONYMOUS" "MS_ASYNC" "MS_SYNC" "MS_INVALIDATE" - "UNIX-MMAP" "UNIX-MUNMAP" "UNIX-MSYNC" + "UNIX-MMAP" "UNIX-MUNMAP" "UNIX-MSYNC" "UNIX-MPROTECT" "KBDCGET" "KBDCRESET" "KBDCRST" "KBDCSET" "KBDCSSTD" "KBDGCLICK" "KBDSCLICK" "KBDSGET" "L_INCR" "L_SET" "L_XTND" "OFF-T" "O_APPEND" "O_CREAT" "O_EXCL" "O_RDONLY" "O_RDWR" diff --git a/code/unix-glibc2.lisp b/code/unix-glibc2.lisp index 039e21e86..539ca9b85 100644 --- a/code/unix-glibc2.lisp +++ b/code/unix-glibc2.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/unix-glibc2.lisp,v 1.40 2007/11/06 07:16:05 cshapiro Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/unix-glibc2.lisp,v 1.41 2007/11/09 19:24:36 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -81,7 +81,7 @@ prot_read prot_write prot_exec prot_none map_shared map_private map_fixed map_anonymous ms_async ms_sync ms_invalidate - unix-mmap unix-munmap unix-msync + unix-mmap unix-munmap unix-msync unix-mprotect unix-pathname unix-file-mode unix-fd unix-pid unix-uid unix-gid unix-setitimer unix-getitimer unix-access r_ok w_ok x_ok f_ok unix-chdir unix-chmod setuidexec @@ -278,6 +278,13 @@ (type (signed-byte 32) flags)) (syscall ("msync" system-area-pointer size-t int) t addr length flags)) +(defun unix-mprotect (addr length prot) + (declare (type system-area-pointer addr) + (type (unsigned-byte 32) length) + (type (integer 1 7) prot)) + (syscall ("mprotect" system-area-pointer size-t int) + t addr length prot)) + ;;;; Lisp types used by syscalls. (deftype unix-pathname () 'simple-string) diff --git a/code/unix.lisp b/code/unix.lisp index c53b11baf..42a8225a5 100644 --- a/code/unix.lisp +++ b/code/unix.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/unix.lisp,v 1.115 2007/11/06 07:16:05 cshapiro Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/unix.lisp,v 1.116 2007/11/09 19:24:36 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -39,6 +39,7 @@ map_shared map_private map_fixed map_anonymous ms_async ms_sync ms_invalidate unix-mmap unix-munmap unix-msync + unix-mprotect unix-pathname unix-file-mode unix-fd unix-pid unix-uid unix-gid unix-setitimer unix-getitimer @@ -1082,6 +1083,13 @@ (type (unsigned-byte 32) length)) (syscall ("munmap" system-area-pointer size-t) t addr length)) +(defun unix-mprotect (addr length prot) + (declare (type system-area-pointer addr) + (type (unsigned-byte 32) length) + (type (integer 1 7) prot)) + (syscall ("mprotect" system-area-pointer size-t int) + t addr length prot)) + (defun unix-setuid (uid) "Set the user ID of the calling process to UID. If the calling process is the super-user, set the real diff --git a/general-info/release-19e.txt b/general-info/release-19e.txt index 3d5c02c90..7c6179d99 100644 --- a/general-info/release-19e.txt +++ b/general-info/release-19e.txt @@ -43,6 +43,7 @@ New in this release: - Preliminary support for external formats. Currently only iso8859-1 and utf-8 are supported. Utf-8 support is limited since CMUCL only has 8-bit characters. + - UNIX-MPROTECT added to access mprotect. * ANSI compliance fixes: - BOA constructors with &AUX variables are handled better now. @@ -131,6 +132,8 @@ New in this release: labels/flet functions. Untracing should work. Redefining a function should automatically retrace the local functions if they were traced previously. + - Callbacks should now work on systems where malloc'ed space does + not normally allow execution of code. * Trac Tickets: - #8 fixed so logs of bignums and ratios that won't fit into a -- GitLab