summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2016-04-25 17:18:58 +0200
committerLudovic Courtès <ludo@gnu.org>2016-04-25 23:27:09 +0200
commita1f708787d08e567da6118bacc481219884296ca (patch)
treef52aae575d806926e1349fc4f268ac9d5bd78618 /guix
parent785cfa8791b0d683830245f119ee6fd42e5356d3 (diff)
syscalls: Add 'statfs'.
* guix/build/syscalls.scm (<file-system>): New record type. (fsword): New macro. (%statfs): New C struct. (statfs): New procedure.
Diffstat (limited to 'guix')
-rw-r--r--guix/build/syscalls.scm71
1 files changed, 71 insertions, 0 deletions
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 468dc7eca2..d168293ee4 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -47,6 +47,20 @@
mount-points
swapon
swapoff
+
+ file-system?
+ file-system-type
+ file-system-block-size
+ file-system-block-count
+ file-system-blocks-free
+ file-system-blocks-available
+ file-system-file-count
+ file-system-free-file-nodes
+ file-system-identifier
+ file-system-maximum-name-length
+ file-system-fragment-size
+ statfs
+
processes
mkdtemp!
pivot-root
@@ -457,6 +471,63 @@ string TMPL and return its file name. TMPL must end with 'XXXXXX'."
(list err)))
(pointer->string result)))))
+
+(define-record-type <file-system>
+ (file-system type block-size blocks blocks-free
+ blocks-available files free-files identifier
+ name-length fragment-size
+ spare0 spare1 spare2)
+ file-system?
+ (type file-system-type)
+ (block-size file-system-block-size)
+ (blocks file-system-block-count)
+ (blocks-free file-system-blocks-free)
+ (blocks-available file-system-blocks-available)
+ (files file-system-file-count)
+ (free-files file-system-free-file-nodes)
+ (identifier file-system-identifier)
+ (name-length file-system-maximum-name-length)
+ (fragment-size file-system-fragment-size)
+ (spare0 file-system--spare0)
+ (spare1 file-system--spare1)
+ (spare2 file-system--spare2))
+
+(define-syntax fsword ;fsword_t
+ (identifier-syntax long))
+
+(define-c-struct %statfs
+ sizeof-statfs ;slightly overestimated
+ file-system
+ read-statfs
+ write-statfs!
+ (type fsword)
+ (block-size fsword)
+ (blocks uint64)
+ (blocks-free uint64)
+ (blocks-available uint64)
+ (files uint64)
+ (free-files uint64)
+ (identifier uint64) ;really "int[2]"
+ (name-length fsword)
+ (fragment-size fsword)
+ (spare0 int128) ;really "fsword[4]"
+ (spare1 int128)
+ (spare2 int64)) ;XXX: to match array alignment
+
+(define statfs
+ (let ((proc (syscall->procedure int "statfs" '(* *))))
+ (lambda (file)
+ "Return a <file-system> data structure describing the file system
+mounted at FILE."
+ (let* ((stat (make-bytevector sizeof-statfs))
+ (ret (proc (string->pointer file) (bytevector->pointer stat)))
+ (err (errno)))
+ (if (zero? ret)
+ (read-statfs stat 0)
+ (throw 'system-error "statfs" "~A: ~A"
+ (list file (strerror err))
+ (list err)))))))
+
;;;
;;; Containers.