Changeset 8335

Timestamp:

Jan 28, 2008, 2:53:18 PM (17 years ago)

Author:

gz

Message:

New fn COPY-FILE-ATTRIBUTES copies the mode, owner, group, and modification
time from one file to another.

In support of above:

• add two more values to %stat-values: the mtime usec's and the gid.
• hide some conditionalizations in a new macro: with-filename-cstrs.

File:

• branches/event-ide/ccl/level-1/linux-files.lisp (modified) (8 diffs)

branches/event-ide/ccl/level-1/linux-files.lisp

@@ -201 +201 @@
   (cwd path))
 
+(defmacro with-filename-cstrs (&rest rest)
+  `(#+darwin-target with-utf-8-cstrs #-darwin-target with-cstrs ,@rest))
+
 (defun %chdir (dirname)
-  (#+darwin-target with-utf-8-cstrs #-darwin-target with-cstrs ((dirname dirname))
+  (with-filename-cstrs ((dirname dirname))
     (syscall syscalls::chdir dirname)))
 
@@ -210 +213 @@
     (when (and (> len 0) (eql (char name (1- len)) #\/))
       (setq name (subseq name 0 (1- len))))
-    (#+darwin-target with-utf-8-cstrs #-darwin-target with-cstrs ((name name))
+    (with-filename-cstrs ((name name))
       (syscall syscalls::mkdir name mode))))
 
 (defun %rmdir (name)
   (let* ((last (1- (length name))))
-    (#+darwin-target with-utf-8-cstrs #-darwin-target with-cstrs ((name name))
+    (with-filename-cstrs ((name name))
       (when (and (>= last 0)
                  (eql (%get-byte name last) (char-code #\/)))
@@ -269 +272 @@
        (pref stat :stat.st_ino)
        (pref stat :stat.st_uid)
-       (pref stat :stat.st_blksize))
+       (pref stat :stat.st_blksize)
+       #+linux-target
+       (pref stat :stat.st_mtim.tv_usec)
+       #-linux-target
+       (round (pref stat :stat.st_mtimespec.tv_nsec) 1000)
+       (pref stat :stat.st_gid))
       (values nil nil nil nil nil nil nil)))
 
 
 (defun %%stat (name stat)
-  (#+darwin-target with-utf-8-cstrs #-darwin-target with-cstrs ((cname name))
+  (with-filename-cstrs ((cname name))
     (%stat-values
      #+linux-target
@@ -291 +299 @@
 
 (defun %%lstat (name stat)
-  (#+darwin-target with-utf-8-cstrs #-darwin-target with-cstrs ((cname name))
+  (with-filename-cstrs ((cname name))
     (%stat-values
      #+linux-target
@@ -341 +349 @@
     "unknown"))
 
+(defun try-hard-to-get-errno (err)
+  (declare (optimize (safety 0 speed 3)))
+  (when (eq err -1)
+    (let ((nerr (%get-errno)))
+      (unless (eq nerr 0) (setq err nerr))))
+  #+darwin-target
+  (when (eq err -1)
+    ;; Not thread safe, but when can we do??
+    (let ((nerr (pref (foreign-symbol-address "_errno") :signed)))
+      (unless (eq nerr 0) (setq err nerr))))
+  err)
+
+(defun copy-file-attributes (source-path dest-path)
+  "Copy the mode, owner, group and modification time of source-path to dest-path.
+   Returns T if succeeded, NIL if some of the attributes couldn't be copied due to
+   permission problems.  Any other failures cause an error to be signalled"
+  (multiple-value-bind (win mode ignore mtime-sec ignore uid ignore mtime-usec gid)
+                       (%stat (native-translated-namestring source-path) t)
+    (declare (ignore ignore))
+    (unless win
+      (error "Cannot get attributes of ~s" source-path))
+    (with-filename-cstrs ((cnamestr (native-translated-namestring dest-path)))
+      (macrolet ((errchk (form)
+                   `(let ((err ,form))
+                      (unless (eql err 0)
+                        (setq win nil)
+                        ;; We need the real errno so we can tell if it's a permission
+                        ;; error or something else...
+                        (when (eql err -1)
+                          (setq err (try-hard-to-get-errno err)))
+                        (unless (eql err #$EPERM) (%errno-disp err dest-path))))))
+        (errchk (#_chmod cnamestr mode))
+        (errchk (%stack-block ((times (record-length (:array (:struct :timeval) 2))))
+                  (setf (pref times :timeval.tv_sec) mtime-sec)
+                  (setf (pref times :timeval.tv_usec) mtime-usec)
+                  (%incf-ptr times (record-length :timeval))
+                  (setf (pref times :timeval.tv_sec) mtime-sec)
+                  (setf (pref times :timeval.tv_usec) mtime-usec)
+                  (%incf-ptr times (- (record-length :timeval)))
+                  (#_utimes cnamestr times)))
+        (errchk (#_chown cnamestr uid gid))))
+    win))
 
 #+linux-target
@@ -406 +456 @@
     (setq namestring (current-directory-name)))
   (%stack-block ((resultbuf #$PATH_MAX))
-    (#+darwin-target with-utf-8-cstrs #-darwin-target with-cstrs ((name namestring #|(tilde-expand namestring)|#))
+    (with-filename-cstrs ((name namestring #|(tilde-expand namestring)|#))
       (let* ((result (#_realpath name resultbuf)))
         (declare (dynamic-extent result))
@@ -477 +527 @@
 
 (defun %utimes (namestring)
-  (#+darwin-target with-utf-8-cstrs #-darwin-target with-cstrs ((cnamestring namestring))
+  (with-filename-cstrs ((cnamestring namestring))
     (let* ((err (#_utimes cnamestring (%null-ptr))))
       (declare (fixnum err))
@@ -495 +545 @@
 
 (defun %open-dir (namestring)
-  (#+darwin-target with-utf-8-cstrs #-darwin-target with-cstrs ((name namestring))
+  (with-filename-cstrs ((name namestring))
     (let* ((DIR (#_opendir name)))
       (unless (%null-ptr-p DIR)