Ignore:
Timestamp:
Jan 29, 2008, 12:49:47 AM (12 years ago)
Author:
gz
Message:

implement copy-file directly (rather than by run-program), add copy-file-attributes

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-1/linux-files.lisp

    r8271 r8343  
    201201  (cwd path))
    202202
     203(defmacro with-filename-cstrs (&rest rest)
     204  `(#+darwin-target with-utf-8-cstrs #-darwin-target with-cstrs ,@rest))
     205
    203206(defun %chdir (dirname)
    204   (#+darwin-target with-utf-8-cstrs #-darwin-target with-cstrs ((dirname dirname))
     207  (with-filename-cstrs ((dirname dirname))
    205208    (syscall syscalls::chdir dirname)))
    206209
     
    210213    (when (and (> len 0) (eql (char name (1- len)) #\/))
    211214      (setq name (subseq name 0 (1- len))))
    212     (#+darwin-target with-utf-8-cstrs #-darwin-target with-cstrs ((name name))
     215    (with-filename-cstrs ((name name))
    213216      (syscall syscalls::mkdir name mode))))
    214217
    215218(defun %rmdir (name)
    216219  (let* ((last (1- (length name))))
    217     (#+darwin-target with-utf-8-cstrs #-darwin-target with-cstrs ((name name))
     220    (with-filename-cstrs ((name name))
    218221      (when (and (>= last 0)
    219222                 (eql (%get-byte name last) (char-code #\/)))
     
    269272       (pref stat :stat.st_ino)
    270273       (pref stat :stat.st_uid)
    271        (pref stat :stat.st_blksize))
     274       (pref stat :stat.st_blksize)
     275       #+linux-target
     276       (pref stat :stat.st_mtim.tv_usec)
     277       #-linux-target
     278       (round (pref stat :stat.st_mtimespec.tv_nsec) 1000)
     279       (pref stat :stat.st_gid))
    272280      (values nil nil nil nil nil nil nil)))
    273281
    274282
    275283(defun %%stat (name stat)
    276   (#+darwin-target with-utf-8-cstrs #-darwin-target with-cstrs ((cname name))
     284  (with-filename-cstrs ((cname name))
    277285    (%stat-values
    278286     #+linux-target
     
    291299
    292300(defun %%lstat (name stat)
    293   (#+darwin-target with-utf-8-cstrs #-darwin-target with-cstrs ((cname name))
     301  (with-filename-cstrs ((cname name))
    294302    (%stat-values
    295303     #+linux-target
     
    341349    "unknown"))
    342350
     351(defun try-hard-to-get-errno (err)
     352  (when (eq err -1)
     353    (let ((nerr (%get-errno)))
     354      (unless (eq nerr 0) (setq err nerr))))
     355  #+darwin-target
     356  (when (eq err -1)
     357    ;; Not thread safe, but what else can I do??
     358    (let ((nerr (pref (foreign-symbol-address "_errno") :signed)))
     359      (unless (eq nerr 0) (setq err nerr))))
     360  err)
     361
     362(defun copy-file-attributes (source-path dest-path)
     363  "Copy the mode, owner, group and modification time of source-path to dest-path.
     364   Returns T if succeeded, NIL if some of the attributes couldn't be copied due to
     365   permission problems.  Any other failures cause an error to be signalled"
     366  (multiple-value-bind (win mode ignore mtime-sec ignore uid ignore mtime-usec gid)
     367                       (%stat (native-translated-namestring source-path) t)
     368    (declare (ignore ignore))
     369    (unless win
     370      (error "Cannot get attributes of ~s" source-path))
     371    (with-filename-cstrs ((cnamestr (native-translated-namestring dest-path)))
     372      (macrolet ((errchk (form)
     373                   `(let ((err ,form))
     374                      (unless (eql err 0)
     375                        (setq win nil)
     376                        ;; We need the real errno so we can tell if it's a permission
     377                        ;; error or something else...
     378                        (when (eql err -1)
     379                          (setq err (try-hard-to-get-errno err)))
     380                        (unless (eql err #$EPERM) (%errno-disp err dest-path))))))
     381        (errchk (#_chmod cnamestr mode))
     382        (errchk (%stack-block ((times (record-length (:array (:struct :timeval) 2))))
     383                  (setf (pref times :timeval.tv_sec) mtime-sec)
     384                  (setf (pref times :timeval.tv_usec) mtime-usec)
     385                  (%incf-ptr times (record-length :timeval))
     386                  (setf (pref times :timeval.tv_sec) mtime-sec)
     387                  (setf (pref times :timeval.tv_usec) mtime-usec)
     388                  (%incf-ptr times (- (record-length :timeval)))
     389                  (#_utimes cnamestr times)))
     390        (errchk (#_chown cnamestr uid gid))))
     391    win))
    343392
    344393#+linux-target
     
    406455    (setq namestring (current-directory-name)))
    407456  (%stack-block ((resultbuf #$PATH_MAX))
    408     (#+darwin-target with-utf-8-cstrs #-darwin-target with-cstrs ((name namestring #|(tilde-expand namestring)|#))
     457    (with-filename-cstrs ((name namestring #|(tilde-expand namestring)|#))
    409458      (let* ((result (#_realpath name resultbuf)))
    410459        (declare (dynamic-extent result))
     
    477526
    478527(defun %utimes (namestring)
    479   (#+darwin-target with-utf-8-cstrs #-darwin-target with-cstrs ((cnamestring namestring))
     528  (with-filename-cstrs ((cnamestring namestring))
    480529    (let* ((err (#_utimes cnamestring (%null-ptr))))
    481530      (declare (fixnum err))
     
    495544
    496545(defun %open-dir (namestring)
    497   (#+darwin-target with-utf-8-cstrs #-darwin-target with-cstrs ((name namestring))
     546  (with-filename-cstrs ((name namestring))
    498547    (let* ((DIR (#_opendir name)))
    499548      (unless (%null-ptr-p DIR)
Note: See TracChangeset for help on using the changeset viewer.