Changeset 15146

Timestamp:

Dec 19, 2011, 1:13:29 PM (13 years ago)

Author:

Gary Byers

Message:

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.

Location:

trunk/source

Files:

• level-1/linux-files.lisp (modified) (4 diffs)
• lib/ccl-export-syms.lisp (modified) (1 diff)

trunk/source/level-1/linux-files.lisp

@@ -234 +234 @@
           (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 returned
@@ -239 +247 @@
 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) :defaults 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 dirname :defaults nil)))
+                 (unless (probe-file path)
+                   (return (namestring path)))))))))
      #+windows-target (rlet ((buffer (:array :wchar_t #.#$MAX_PATH)))
                         (#_GetTempPathW #$MAX_PATH buffer)
@@ -245 +279 @@
                             (#_GetTempFileNameW buffer c-prefix 0 buffer)
                               (#_DeleteFileW buffer)
-                                (%get-native-utf-16-cstring buffer)))))
+                              (%get-native-utf-16-cstring buffer)))))
 
 (defun current-directory-name ()
@@ -902 +936 @@
           (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) :directory))
+                            dir)))
+                (unless (eql err #$ERANGE)
+                  (return nil)))))))))
 
 (defun %delete-file (name)

trunk/source/lib/ccl-export-syms.lisp

@@ -323 +323 @@
      directoryp
      delete-directory
+     *trust-paths-from-environment*