1.1--- a/lisp/ffi/btrfs/btrfs.asd	Tue Jul 02 22:05:25 2024 -0400
     1.2+++ b/lisp/ffi/btrfs/btrfs.asd	Wed Jul 03 14:43:21 2024 -0400
     1.3@@ -19,7 +19,8 @@
     1.4   :depends-on (:sb-grovel :std)
     1.5   :components ((:file "pkg")
     1.6                (grovel-constants-file "constants"
     1.7-                                      :package :btrfs))
     1.8+                                      :package :btrfs)
     1.9+               (:file "util" :depends-on ("pkg" "constants")))
    1.10   :in-order-to ((test-op (test-op "btrfs/tests"))))
    1.11   
    1.12 (defsystem "btrfs/tests"

     2.1--- a/lisp/ffi/btrfs/constants.lisp	Tue Jul 02 22:05:25 2024 -0400
     2.2+++ b/lisp/ffi/btrfs/constants.lisp	Wed Jul 03 14:43:21 2024 -0400
     2.3@@ -19,18 +19,18 @@
     2.4               ((* t) stime "struct timespec" "stime")
     2.5               ((* t) rtime "struct timespec" "rtime"))
     2.6              nil t)
     2.7- (:integer btrfs-lib-major "BTRFS_LIB_MAJOR" t t)
     2.8- (:integer btrfs-lib-minor "BTRFS_LIB_MINOR" t t)
     2.9- (:integer btrfs-lib-patchlevel "BTRFS_LIB_PATCHLEVEL" t t)
    2.10- (:integer btrfs-lib-version "BTRFS_LIB_VERSION" t t)
    2.11- (:integer btrfs-subvol-rdonly "BTRFS_SUBVOL_RDONLY" t t)
    2.12- (:integer btrfs-subvol-qgroup-inherit "BTRFS_SUBVOL_QGROUP_INHERIT" t t)
    2.13- (:integer btrfs-device-spec-by-id "BTRFS_DEVICE_SPEC_BY_ID" t t)
    2.14- (:integer btrfs-subvol-spec-by-id "BTRFS_SUBVOL_SPEC_BY_ID" t t)
    2.15- (:integer btrfs-vol-arg-v2-flags-supported "BTRFS_VOL_ARG_V2_FLAGS_SUPPORTED" t t)
    2.16- (:integer btrfs-fsize-size "BTRFS_FSIZE_SIZE" t t)
    2.17- (:integer btrfs-fsize-size "BTRFS_UUID_SIZE" t t)
    2.18- (:integer btrfs-qgroup-inherit-set-limits "BTRFS_QGROUP_INHERIT_SET_LIMITS" t t)
    2.19+ (:integer +btrfs-lib-major+ "BTRFS_LIB_MAJOR" t t)
    2.20+ (:integer +btrfs-lib-minor+ "BTRFS_LIB_MINOR" t t)
    2.21+ (:integer +btrfs-lib-patchlevel+ "BTRFS_LIB_PATCHLEVEL" t t)
    2.22+ (:integer +btrfs-lib-version+ "BTRFS_LIB_VERSION" t t)
    2.23+ (:integer +btrfs-subvol-rdonly+ "BTRFS_SUBVOL_RDONLY" t t)
    2.24+ (:integer +btrfs-subvol-qgroup-inherit+ "BTRFS_SUBVOL_QGROUP_INHERIT" t t)
    2.25+ (:integer +btrfs-device-spec-by-id+ "BTRFS_DEVICE_SPEC_BY_ID" t t)
    2.26+ (:integer +btrfs-subvol-spec-by-id+ "BTRFS_SUBVOL_SPEC_BY_ID" t t)
    2.27+ (:integer +btrfs-vol-arg-v2-flags-supported+ "BTRFS_VOL_ARG_V2_FLAGS_SUPPORTED" t t)
    2.28+ (:integer +btrfs-fsize-size+ "BTRFS_FSIZE_SIZE" t t)
    2.29+ (:integer +btrfs-fsize-size+ "BTRFS_UUID_SIZE" t t)
    2.30+ (:integer +btrfs-qgroup-inherit-set-limits+ "BTRFS_QGROUP_INHERIT_SET_LIMITS" t t)
    2.31  ;; ioctl
    2.32  (:structure btrfs-qgroup-limit 
    2.33              ("struct btrfs_qgroup_limit"

     3.1--- a/lisp/ffi/btrfs/pkg.lisp	Tue Jul 02 22:05:25 2024 -0400
     3.2+++ b/lisp/ffi/btrfs/pkg.lisp	Wed Jul 03 14:43:21 2024 -0400
     3.3@@ -18,7 +18,12 @@
     3.4   (:use :cl :std :sb-alien)
     3.5   (:nicknames :btrfs)
     3.6   (:export
     3.7-   :define-btrfs-ioctl))
     3.8+   :define-btrfs-ioctl
     3.9+   :btrfs-util-error :btrfs-util-error*
    3.10+   :btrfs-util-strerror
    3.11+   :btrfs-util-subvolume-iter-destroy
    3.12+   :btrfs-util-subvolume-iterator-get-fd
    3.13+   :btrfs-util-qgroup-inherit-destroy))
    3.14 
    3.15 (in-package :btrfs/pkg)
    3.16 
    3.17@@ -27,66 +32,3 @@
    3.18 (define-alien-loader "btrfsutil" t "/usr/lib/")
    3.19 
    3.20 (defmacro define-btrfs-ioctl () "Define a wrapper for IOCTLs exposed by BTRFS.")
    3.21-
    3.22-(define-alien-enum (btrfs-util-error int)
    3.23-                   :ok 0
    3.24-                   :stop-iteration 1
    3.25-                   :no-memory 2
    3.26-                   :invalid-argument 3
    3.27-                   :not-btrfs 4
    3.28-                   :not-subvolume 5
    3.29-                   :subvolume-not-found 6
    3.30-                   :error-open-failed 7
    3.31-                   :error-rmdir-failed 8
    3.32-                   :error-unlink-failed 9
    3.33-                   :error-stat-failed 10
    3.34-                   :error-statfs-failed 11
    3.35-                   :error-search-failed 12
    3.36-                   :error-ino-lookup-failed 13
    3.37-                   :error-subvol-getflags-failed 14
    3.38-                   :error-subvol-setflags-failed 15
    3.39-                   :error-subvol-create-failed 16
    3.40-                   :error-snap-create-failed 17
    3.41-                   :error-snap-destroy-failed 18
    3.42-                   :error-default-subvol-failed 19
    3.43-                   :error-sync-failed 20
    3.44-                   :error-start-sync-failed 21
    3.45-                   :error-wait-sync-failed 22
    3.46-                   :error-get-subvol-info-failed 23
    3.47-                   :error-get-subvol-rootref-failed 24
    3.48-                   :error-ino-lookup-user-failed 25
    3.49-                   :error-fs-info-failed 26)
    3.50-
    3.51-(define-alien-routine btrfs-util-strerror c-string (err btrfs-util-error))
    3.52-(define-alien-routine btrfs-util-sync btrfs-util-error (path c-string))
    3.53-(define-alien-routine btrfs-util-fs-sync btrfs-util-error (path c-string))
    3.54-(define-alien-routine btrfs-util-sync-fd btrfs-util-error (fd int))
    3.55-(define-alien-routine btrfs-util-fs-sync-fd btrfs-util-error (fd int))
    3.56-(define-alien-routine btrfs-util-start-sync btrfs-util-error
    3.57-  (path c-string)
    3.58-  (transid (* (unsigned 64))))
    3.59-(define-alien-routine btrfs-util-fs-start-sync btrfs-util-error
    3.60-  (path c-string)
    3.61-  (transid (* (unsigned 64))))
    3.62-(define-alien-routine btrfs-util-fs-start-sync-fd btrfs-util-error
    3.63-  (fd int)
    3.64-  (transid (* (unsigned 64))))
    3.65-
    3.66-(define-alien-routine btrfs-util-wait-sync btrfs-util-error (path c-string) (transid (unsigned 64)))
    3.67-
    3.68-(define-alien-routine btrfs-util-wait-sync-fd btrfs-util-error (fd int) (transid (unsigned 64)))
    3.69-
    3.70-(define-alien-routine btrfs-util-fs-wait-sync-fd btrfs-util-error (fd int) (transid (unsigned 64)))
    3.71-
    3.72-(define-alien-routine btrfs-util-is-subvolume btrfs-util-error (path c-string))
    3.73-
    3.74-(define-alien-routine btrfs-util-subvolume-is-valid btrfs-util-error (path c-string))
    3.75-
    3.76-(define-alien-routine btrfs-util-is-subvolume-fd btrfs-util-error (fd int))
    3.77-
    3.78-(define-alien-routine btrfs-util-subvolume-is-valid-fd btrfs-util-error (fd int))
    3.79-
    3.80-(define-alien-routine btrfs-util-subvolume-id btrfs-util-error (path c-string) (id-ret (* (unsigned 64))))
    3.81-
    3.82-;; TODO 2024-06-30: L203
    3.83-(define-alien-routine btrfs-util-subvolume-get-id btrfs-util-error (path c-string) (id-ret (* (unsigned 64))))

     4.1--- a/lisp/ffi/btrfs/tests.lisp	Tue Jul 02 22:05:25 2024 -0400
     4.2+++ b/lisp/ffi/btrfs/tests.lisp	Wed Jul 03 14:43:21 2024 -0400
     4.3@@ -2,7 +2,7 @@
     4.4 
     4.5 ;;; Code:
     4.6 (defpackage btrfs/tests
     4.7-  (:use :cl :rt :btrfs))
     4.8+  (:use :cl :std :rt :btrfs :sb-alien))
     4.9 (in-package :btrfs/tests)
    4.10 
    4.11 (defsuite :btrfs)
    4.12@@ -10,5 +10,29 @@
    4.13 (load-btrfs)
    4.14 (load-btrfsutil)
    4.15 
    4.16+(defvar *test-btrfs-pathname* (directory-path (symbol-name (gensym "/tmp/btrfs"))))
    4.17+
    4.18 (deftest sanity ()
    4.19-  (is (typep btrfs-lib-version 'fixnum)))
    4.20+  (is (typep +btrfs-lib-version+ 'fixnum))
    4.21+  (is (eq 0 (btrfs-util-error :ok)))
    4.22+  (is (equal "Cannot allocate memory" (btrfs-util-strerror (btrfs-util-error :no-memory))))
    4.23+  (is (btrfs::allocate-btrfs-qgroup-limit))
    4.24+  (is (btrfs::allocate-btrfs-util-subvolume-info)))
    4.25+
    4.26+;; for a complete test we need to be have fs permissions.
    4.27+
    4.28+;; To run these tests, pass a filesystem path as fixture input when running as
    4.29+;; root.
    4.30+
    4.31+(deftest basic (:skip t)
    4.32+  ;; will only work when root filesystem is BTRFS
    4.33+  (is (zerop (btrfs::btrfs-util-subvolume-is-valid "/")))
    4.34+  (is (zerop (btrfs::btrfs-util-fs-sync "/")))
    4.35+  ;; (sb-alien:with-alien ((id (unsigned 64)))
    4.36+  ;;   (btrfs-util-strerror (btrfs::btrfs-util-subvolume-get-default "/" (addr id))))
    4.37+  (sb-alien:with-alien ((id (unsigned 64))
    4.38+                        (path c-string (make-alien-string ""))
    4.39+                        (iter (* btrfs-util-subvolume-iterator)))
    4.40+    (btrfs-util-subvolume-iter-create "/" 0 0 (addr iter))
    4.41+    (btrfs-util-subvolume-iter-destroy iter)))
    4.42+  

     5.1--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     5.2+++ b/lisp/ffi/btrfs/util.lisp	Wed Jul 03 14:43:21 2024 -0400
     5.3@@ -0,0 +1,185 @@
     5.4+;;; util.lisp --- BtrfsUtil Alien Bindings
     5.5+
     5.6+;; 
     5.7+
     5.8+;;; Code:
     5.9+(in-package :btrfs)
    5.10+
    5.11+(eval-always
    5.12+  (define-opaque btrfs-util-qgroup-inherit nil t)
    5.13+  (define-opaque btrfs-util-subvolume-iterator nil t))
    5.14+
    5.15+(define-alien-enum (btrfs-util-error int)
    5.16+                   :ok 0
    5.17+                   :stop-iteration 1
    5.18+                   :no-memory 2
    5.19+                   :invalid-argument 3
    5.20+                   :not-btrfs 4
    5.21+                   :not-subvolume 5
    5.22+                   :subvolume-not-found 6
    5.23+                   :error-open-failed 7
    5.24+                   :error-rmdir-failed 8
    5.25+                   :error-unlink-failed 9
    5.26+                   :error-stat-failed 10
    5.27+                   :error-statfs-failed 11
    5.28+                   :error-search-failed 12
    5.29+                   :error-ino-lookup-failed 13
    5.30+                   :error-subvol-getflags-failed 14
    5.31+                   :error-subvol-setflags-failed 15
    5.32+                   :error-subvol-create-failed 16
    5.33+                   :error-snap-create-failed 17
    5.34+                   :error-snap-destroy-failed 18
    5.35+                   :error-default-subvol-failed 19
    5.36+                   :error-sync-failed 20
    5.37+                   :error-start-sync-failed 21
    5.38+                   :error-wait-sync-failed 22
    5.39+                   :error-get-subvol-info-failed 23
    5.40+                   :error-get-subvol-rootref-failed 24
    5.41+                   :error-ino-lookup-user-failed 25
    5.42+                   :error-fs-info-failed 26)
    5.43+
    5.44+(define-alien-routine btrfs-util-strerror c-string (err btrfs-util-error))
    5.45+
    5.46+(define-alien-routine btrfs-util-subvolume-iter-destroy void
    5.47+  (iter (* btrfs-util-subvolume-iterator)))
    5.48+
    5.49+(define-alien-routine btrfs-util-subvolume-iterator-get-fd int
    5.50+  (iter (* btrfs-util-subvolume-iterator)))
    5.51+
    5.52+(define-alien-routine btrfs-util-qgroup-inherit-destroy void
    5.53+  (inherit (* btrfs-util-qgroup-inherit)))
    5.54+
    5.55+(macrolet ((def (name &rest args)
    5.56+               `(progn
    5.57+                  (define-alien-routine ,name btrfs-util-error ,@args)
    5.58+                  (export ',name))))
    5.59+  (def btrfs-util-fs-sync (path c-string))
    5.60+  (def btrfs-util-fs-sync-fd (fd int))
    5.61+  (def btrfs-util-fs-start-sync
    5.62+      (path c-string)
    5.63+      (transid (* (unsigned 64))))
    5.64+  (def btrfs-util-fs-start-sync-fd
    5.65+      (fd int)
    5.66+      (transid (* (unsigned 64))))
    5.67+  (def btrfs-util-fs-wait-sync (path c-string) (transid (unsigned 64)))
    5.68+  (def btrfs-util-fs-wait-sync-fd (fd int) (transid (unsigned 64)))
    5.69+  (def btrfs-util-subvolume-is-valid (path c-string))
    5.70+  (def btrfs-util-subvolume-is-valid-fd (fd int))
    5.71+  (def btrfs-util-subvolume-get-id (path c-string) (id-ret (* (unsigned 64))))
    5.72+  (def btrfs-util-subvolume-get-id-fd (fd int) (id-ret (* (unsigned 64))))
    5.73+  (def btrfs-util-subvolume-get-path
    5.74+      (path c-string)
    5.75+      (id (unsigned 64))
    5.76+    (path-ret (* c-string)))
    5.77+  (def btrfs-util-subvolume-get-path-fd
    5.78+      (fd int)
    5.79+      (id (unsigned 64))
    5.80+    (path-ret (* c-string)))
    5.81+  (def btrfs-util-subvolume-get-info
    5.82+      (path c-string)
    5.83+      (id (unsigned 64))
    5.84+    (subvol (* btrfs-util-subvolume-info)))
    5.85+  (def btrfs-util-subvolume-get-info-fd
    5.86+      (fd int)
    5.87+      (id (unsigned 64))
    5.88+    (subvol (* btrfs-util-subvolume-info)))
    5.89+  (def btrfs-util-subvolume-get-read-only
    5.90+      (path c-string)
    5.91+      (ret (* boolean)))
    5.92+  (def btrfs-util-subvolume-get-read-only-fd
    5.93+      (fd int)
    5.94+      (ret (* boolean)))
    5.95+  (def btrfs-util-subvolume-set-read-only
    5.96+      (path c-string)
    5.97+      (read-only boolean))
    5.98+  (def btrfs-util-subvolume-set-read-only-fd
    5.99+      (fd int)
   5.100+      (read-only boolean))
   5.101+  (def btrfs-util-subvolume-get-default
   5.102+      (path c-string)
   5.103+      (id-ret (* (unsigned 64))))
   5.104+  (def btrfs-util-subvolume-get-default-fd
   5.105+      (fd int)
   5.106+      (id-ret (* (unsigned 64))))
   5.107+  (def btrfs-util-subvolume-set-default
   5.108+      (path c-string)
   5.109+      (id (unsigned 64)))
   5.110+  (def btrfs-util-subvolume-set-default-fd
   5.111+      (fd int)
   5.112+      (id (unsigned 64)))
   5.113+  (def btrfs-util-subvolume-create
   5.114+      (path c-string)
   5.115+      (flags (* int))
   5.116+    (unused (* (unsigned 64)))
   5.117+    (qgroup-inherit (* btrfs-util-qgroup-inherit)))
   5.118+  (def btrfs-util-subvolume-create-fd
   5.119+      (fd int)
   5.120+      (name c-string)
   5.121+    (flags int)
   5.122+    (unused (* (unsigned 64)))
   5.123+    (qgroup-inherit (* btrfs-util-qgroup-inherit)))
   5.124+  (def btrfs-util-subvolume-snapshot
   5.125+      (source c-string)
   5.126+      (path c-string)
   5.127+    (flags int)
   5.128+    (unused (* (unsigned 64)))
   5.129+    (qgroup-inherit (* btrfs-util-qgroup-inherit)))
   5.130+  (def btrfs-util-subvolume-snapshot-fd
   5.131+      (fd int)
   5.132+      (path c-string)
   5.133+    (flags int)
   5.134+    (unused (* (unsigned 64)))
   5.135+    (qgroup-inherit (* btrfs-util-qgroup-inherit)))
   5.136+  (def btrfs-util-subvolume-snapshot-fd2
   5.137+      (fd int)
   5.138+      (parent-fd int)
   5.139+    (name c-string)
   5.140+    (flags int)
   5.141+    (unused (* (unsigned 64)))
   5.142+    (qgroup-inherit (* btrfs-util-qgroup-inherit)))
   5.143+  (def btrfs-util-subvolume-delete
   5.144+      (path c-string)
   5.145+      (flags int))
   5.146+  (def btrfs-util-subvolume-delete-fd
   5.147+      (parent-fd int)
   5.148+      (name c-string)
   5.149+    (flags int))
   5.150+  (def btrfs-util-subvolume-delete-by-id-fd
   5.151+      (fd int)
   5.152+      (subvolid (unsigned 64)))
   5.153+  (def btrfs-util-subvolume-iter-create
   5.154+      (path c-string)
   5.155+      (top (unsigned 64))
   5.156+    (flags int)
   5.157+    (ret (* (* btrfs-util-subvolume-iterator))))
   5.158+  (def btrfs-util-subvolume-iter-create-fd
   5.159+      (fd int)
   5.160+      (top (unsigned 64))
   5.161+    (flags int)
   5.162+    (ret (* (* btrfs-util-subvolume-iterator))))
   5.163+  (def btrfs-util-subvolume-iter-next
   5.164+      (iter (* btrfs-util-subvolume-iterator))
   5.165+      (path-ret (* c-string))
   5.166+    (id-ret (* (unsigned 64))))
   5.167+  (def btrfs-util-subvolume-iter-next-info
   5.168+      (iter (* btrfs-util-subvolume-iterator))
   5.169+      (path-ret (* c-string))
   5.170+    (subvol (* btrfs-util-subvolume-info)))
   5.171+  (def btrfs-util-subvolume-list-deleted
   5.172+      (path c-string)
   5.173+      (ids (* (* (unsigned 64))))
   5.174+    (n (* size-t)))
   5.175+  (def btrfs-util-subvolume-list-deleted-fd
   5.176+      (fd int)
   5.177+      (ids (* (* (unsigned 64))))
   5.178+    (n (* size-t)))
   5.179+  (def btrfs-util-qgroup-inherit-create
   5.180+      (flags int)
   5.181+      (ret (* (* btrfs-util-qgroup-inherit))))
   5.182+  (def btrfs-util-qgroup-inherit-add-group
   5.183+      (inherit (* (* btrfs-util-qgroup-inherit)))
   5.184+      (qgroupid (unsigned 64)))
   5.185+  (def btrfs-util-qgroup-inherit-get-groups
   5.186+      (inherit (* btrfs-util-qgroup-inherit))
   5.187+      (groups (* (* (unsigned 64))))
   5.188+    (n (* size-t))))