Changeset 10400


Ignore:
Timestamp:
Aug 8, 2008, 10:38:37 AM (11 years ago)
Author:
gb
Message:

Simpler CCL-DIRECTORY (from trunk.)

Make a bad idea (use of $HOME) worse in USER-HOMEDIR-PATHNAME.

Initialize *USER-HOMEDIR-PATHNAME* a little later in the cold load.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/level-1/l1-pathnames.lisp

    r9788 r10400  
    629629     
    630630             
     631
    631632(defun ccl-directory ()
    632633  (let* ((dirpath (getenv "CCL_DEFAULT_DIRECTORY")))
    633634    (if dirpath
    634635      (native-to-directory-pathname dirpath)
    635       (let* ((directory-containing-heap-image
    636               (make-pathname :directory (pathname-directory (%realpath (heap-image-name)))))
    637              (rpath (merge-pathnames
    638                      #+darwinppc-target "../Resources/ccl/"
    639                      #+linux-target "Resources/ccl/"
    640                      directory-containing-heap-image)))
    641         (or (probe-file rpath)
    642             directory-containing-heap-image)))))
    643 
     636      (make-pathname :directory (pathname-directory (%realpath (heap-image-name)))))))
    644637
    645638(defun user-homedir-pathname (&optional host)
    646639  "Return the home directory of the user as a pathname."
    647640  (declare (ignore host))
    648   (let* ((native (or #+ccl-0711 (getenv "HOME")
    649                      (get-user-home-dir (getuid)))))
    650     (if native
    651       (native-to-directory-pathname native))))
    652 
    653 
    654 
    655 (defloadvar *user-homedir-pathname* (user-homedir-pathname))
     641  (let* ((native
     642          (ignore-errors
     643            (truename
     644             (native-to-directory-pathname (or #+ccl-0711 (getenv "HOME")
     645                                               (get-user-home-dir (getuid))))))))
     646    (if (and native (eq :absolute (car (pathname-directory native))))
     647      native
     648      ;; Another plausible choice here is
     649      ;; #p"/tmp/.hidden-directory-of-some-irc-bot-in-eastern-europe/"
     650      ;; Of course, that might already be the value of $HOME.  Anyway,
     651      ;; the user's home directory just contains "config files" (like
     652      ;; SSH keys), and spoofing it can't hurt anything.
     653      (make-pathname :directory '(:absolute) :defaults nil))))
     654
     655
     656
    656657
    657658(defun translate-logical-pathname (pathname &key)
     
    671672               (signal-file-error $xnotranslation pathname)))))))
    672673
     674(defloadvar *user-homedir-pathname* (user-homedir-pathname))
     675
     676
    673677;;; Hide this from COMPILE-FILE, for obscure cross-compilation reasons
    674678
Note: See TracChangeset for help on using the changeset viewer.