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
69
70
71
72
73
74
|
#|
This file is a part of file-attributes
(c) 2020 Shirakumo http://tymoon.eu (shinmera@tymoon.eu)
Author: Nicolas Hafner <shinmera@tymoon.eu>
|#
(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)))
|
