1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68
|
(in-package #:org.shirakumo.file-attributes)
(defconstant AT-FDCWD -100)
(defconstant STATX-MODE #x00000002)
(defconstant STATX-UID #x00000008)
(defconstant STATX-GID #x00000010)
(defconstant STATX-ATIME #x00000020)
(defconstant STATX-MTIME #x00000040)
(defconstant STATX-BTIME #x00000800)
(cffi:defcfun (cstatx "statx") :int
(dirfd :int)
(path :string)
(flags :int)
(mask :unsigned-int)
(statx :pointer))
(cffi:defcstruct statx-timestamp
(sec :int64)
(nsec :uint32))
(cffi:defcstruct statx
(mask :uint32)
(blksize :uint32)
(attributes :uint64)
(nlink :uint32)
(uid :uint32)
(gid :uint32)
(mode :uint16)
(ino :uint64)
(size :uint64)
(blocks :uint64)
(attributes-mask :uint64)
(atime (:struct statx-timestamp))
(btime (:struct statx-timestamp))
(ctime (:struct statx-timestamp))
(mtime (:struct statx-timestamp))
(rdev-major :uint32)
(rdev-minor :uint32)
(dev-major :uint32)
(dev-minor :uint32)
(mount-id :uint64)
(spare :uint64 :count 13))
(defun statx (path mask)
(cffi:with-foreign-object (statx '(:struct statx))
(if (= 0 (cstatx AT-FDCWD (enpath path) 0 mask statx))
(cffi:mem-ref statx '(:struct statx))
(error "Statx failed"))))
(when (cffi:foreign-symbol-pointer "statx")
(define-implementation access-time (file)
(unix->universal (getf (getf (statx file STATX-ATIME) 'atime) 'sec)))
(define-implementation modification-time (file)
(unix->universal (getf (getf (statx file STATX-MTIME) 'mtime) 'sec)))
(define-implementation creation-time (file)
(unix->universal (getf (getf (statx file STATX-BTIME) 'btime) 'sec)))
(define-implementation group (file)
(getf (statx file STATX-GID) 'gid))
(define-implementation owner (file)
(getf (statx file STATX-UID) 'uid))
(define-implementation attributes (file)
(getf (statx file STATX-MODE) 'mode)))
|