File: linux.lisp

package info (click to toggle)
acl2 8.6%2Bdfsg-2
  • links: PTS
  • area: main
  • in suites: trixie
  • size: 1,111,420 kB
  • sloc: lisp: 17,818,294; java: 125,359; python: 28,122; javascript: 23,458; cpp: 18,851; ansic: 11,569; perl: 7,678; xml: 5,591; sh: 3,976; makefile: 3,833; ruby: 2,633; yacc: 1,126; ml: 763; awk: 295; csh: 233; lex: 197; php: 178; tcl: 49; asm: 23; haskell: 17
file content (68 lines) | stat: -rw-r--r-- 1,877 bytes parent folder | download | duplicates (2)
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)))