[Openmcl-cvs-notifications] r15146 - in /trunk/source: level-1/linux-files.lisp lib/ccl-export-syms.lisp
gb at clozure.com
gb at clozure.com
Mon Dec 19 15:13:30 CST 2011
Author: gb
Date: Mon Dec 19 15:13:29 2011
New Revision: 15146
Log:
Optionally use environment variables to initilize CCL's notion of
some filesystem paths, if CCL:*TRUST-PATHS-FROM-ENVIRONMENT* is true
(as it is by default.)
Specifically:
- on Unix systems (including Android), try to use the value of the =
"HOME" environment variable to initialize (USER-HOMEDIR-PATHNAME).
- On Android (only) for now, make TEMP-PATHNAME try to use the value of =
TMPDIR if the directory component of the value returned by #_tmpnam
doesn't exist. (It seems to be "/tmp", which would make sense if
/tmp existed on Android.)
It's possible that someone might have "HOME" set incorrectly, and that
trusting (easily spoofed) environment variables opens security
vulnerabilities. (The glibc docs mention the latter possibility, then
note that env variables are usually used because of their convenience.)
Fixes ticket:892 and fixes ticket:893.
Modified:
trunk/source/level-1/linux-files.lisp
trunk/source/lib/ccl-export-syms.lisp
Modified: trunk/source/level-1/linux-files.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/level-1/linux-files.lisp (original)
+++ trunk/source/level-1/linux-files.lisp Mon Dec 19 15:13:29 2011
@@ -233,18 +233,52 @@
(when (eql 0 (%get-byte buf i))
(return i))))))
=
+(defparameter *trust-paths-from-environment* t
+ "When true (as it is by default), environment variables can be used
+to initialize CCL's notion of some filesystem paths. This may expose
+CCL or your application to greater security risks in some cases; if you're
+concerned about that, you may want to save an image with this variable
+set to NIL.")
+
+
(defun temp-pathname ()
"Return a suitable pathname for a temporary file. A different name is r=
eturned
each time this is called in a session. No file by that name existed when =
last
checked, though no guarantee is given that one hasn't been created since."
(native-to-pathname
- #-windows-target (get-foreign-namestring (#_tmpnam (%null-ptr)))
+ #-windows-target
+ #-android-target (get-foreign-namestring (#_tmpnam (%null-ptr)))
+ #+android-target
+ ;; Android dutifully implements #_tmpnam and returns a namestring
+ ;; in /tmp, but of course they don't usually provide /tmp .
+ (let* ((s (get-foreign-namestring (#_tmpnam (%null-ptr)))))
+ (if (probe-file (make-pathname :directory (pathname-directory s) :d=
efaults nil))
+ s
+ (let* ((dirname (or (and *trust-paths-from-environment*
+ (let* ((p (getenv "TMPDIR")))
+ (and p
+ (eq (nth-value 1 (%probe-file-x p=
))
+ :directory)
+ p)))
+ "/data/local/tmp"))
+ (filename (make-string 8)))
+ (loop
+ (flet ((random-char ()
+ (let* ((n (random 62)))
+ (cond ((< n 10) (code-char (+ (char-code #\0) n)))
+ ((< n 36) (code-char (+ (char-code #\A) (- n=
10))))
+ (t (code-char (+ (char-code #\a) (- n 36))))=
))))
+ (dotimes (i (length filename))
+ (setf (schar filename i) (random-char)))
+ (let* ((path (make-pathname :name filename :directory dirna=
me :defaults nil)))
+ (unless (probe-file path)
+ (return (namestring path)))))))))
#+windows-target (rlet ((buffer (:array :wchar_t #.#$MAX_PATH)))
(#_GetTempPathW #$MAX_PATH buffer)
(with-filename-cstrs ((c-prefix "ccl")) =
(#_GetTempFileNameW buffer c-prefix 0 buffer)
(#_DeleteFileW buffer)
- (%get-native-utf-16-cstring buffer)))))
+ (%get-native-utf-16-cstring buffer)))))
=
(defun current-directory-name ()
"Look up the current working directory of the Clozure CL process; unless
@@ -901,32 +935,37 @@
(unless (%null-ptr-p p)
(return (get-foreign-namestring p))))))
#-windows-target
- #+android-target "/data/local" ; for now
- #-android-target
- (rlet ((pwd :passwd)
- (result :address pwd))
- (do* ((buflen 512 (* 2 buflen)))
- ()
- (%stack-block ((buf buflen))
- (let* ((err
- #-solaris-target
- (#_getpwuid_r userid pwd buf buflen result)
- #+solaris-target
- (external-call "__posix_getpwuid_r"
- :uid_t userid
- :address pwd
- :address buf
- :int buflen
- :address result
- :int)))
- (if (eql 0 err)
- (let* ((rp (%get-ptr result))
- (dir (and (not (%null-ptr-p rp))
- (get-foreign-namestring (pref rp :passwd.pw_dir)))))
- (return (if (and dir (eq (%unix-file-kind dir) :directory))
- dir)))
- (unless (eql err #$ERANGE)
- (return nil))))))))
+ (or (and *trust-paths-from-environment*
+ (let* ((p (getenv "HOME")))
+ (and p
+ (eq (nth-value 1 (%probe-file-x p)) :directory)
+ p)))
+ #+android-target "/data/local" ; for now
+ #-android-target
+ (rlet ((pwd :passwd)
+ (result :address pwd))
+ (do* ((buflen 512 (* 2 buflen)))
+ ()
+ (%stack-block ((buf buflen))
+ (let* ((err
+ #-solaris-target
+ (#_getpwuid_r userid pwd buf buflen result)
+ #+solaris-target
+ (external-call "__posix_getpwuid_r"
+ :uid_t userid
+ :address pwd
+ :address buf
+ :int buflen
+ :address result
+ :int)))
+ (if (eql 0 err)
+ (let* ((rp (%get-ptr result))
+ (dir (and (not (%null-ptr-p rp))
+ (get-foreign-namestring (pref rp :passwd.=
pw_dir)))))
+ (return (if (and dir (eq (%unix-file-kind dir) :director=
y))
+ dir)))
+ (unless (eql err #$ERANGE)
+ (return nil)))))))))
=
(defun %delete-file (name)
(with-filename-cstrs ((n name))
Modified: trunk/source/lib/ccl-export-syms.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/lib/ccl-export-syms.lisp (original)
+++ trunk/source/lib/ccl-export-syms.lisp Mon Dec 19 15:13:29 2011
@@ -322,6 +322,7 @@
file-locked-p
directoryp
delete-directory
+ *trust-paths-from-environment*
=
=
*module-search-path*
More information about the Openmcl-cvs-notifications
mailing list