diff --git a/lib/xapi-fdcaps/operations.ml b/lib/xapi-fdcaps/operations.ml
new file mode 100644
index 00000000..4b1580ab
--- /dev/null
+++ b/lib/xapi-fdcaps/operations.ml
@@ -0,0 +1,206 @@
+(*
+ * Copyright (C) 2023 Cloud Software Group
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+open Properties
+
+type +!'a props = {
+    props: ('b, 'c) Properties.props
+  ; custom_ftruncate: (int64 -> unit) option
+  ; fd: Safefd.t
+}
+  constraint 'a = ('b, 'c) Properties.props
+
+type +!'a t = 'a props constraint 'a = (_, _) Properties.t
+
+type (+!'a, +!'b) make = ('a, 'b) Properties.t t
+
+let dump ppf =
+  Fmt.(
+    Dump.(
+      record
+        [
+          field "props" (fun t -> t.props) pp
+        ; field "custom_ftruncate"
+            (fun t -> Option.is_some t.custom_ftruncate)
+            bool
+        ; field "fd" (fun t -> t.fd) Safefd.dump
+        ]
+    )
+  )
+    ppf
+
+let pp ppf =
+  Fmt.(
+    record
+      ~sep:Fmt.(any "; ")
+      [
+        field "props" (fun t -> t.props) pp
+      ; field "custom_ftruncate"
+          (fun t -> Option.is_some t.custom_ftruncate)
+          bool
+      ; field "fd" (fun t -> t.fd) Safefd.pp
+      ]
+  )
+    ppf
+
+let close t = Safefd.idempotent_close_exn t.fd
+
+let with_fd t f =
+  let finally () = close t in
+  Fun.protect ~finally (fun () -> f t)
+
+module Syntax = struct let ( let@ ) f x = f x end
+
+open Syntax
+
+let with_fd2 (fd1, fd2) f =
+  let@ fd1 = with_fd fd1 in
+  let@ fd2 = with_fd fd2 in
+  f (fd1, fd2)
+
+let make ?custom_ftruncate props fd : 'a t =
+  {fd= Safefd.of_file_descr fd; props; custom_ftruncate}
+
+let make_ro_exn kind fd = make (Properties.make `rdonly kind) fd
+
+let make_wo_exn kind fd = make (Properties.make `wronly kind) fd
+
+let make_rw_exn ?custom_ftruncate kind fd =
+  make (Properties.make `rdwr kind) ?custom_ftruncate fd
+
+let pipe () =
+  let kind = `fifo in
+  let ro, wo = Unix.pipe ~cloexec:true () in
+  (make_ro_exn kind ro, make_wo_exn kind wo)
+
+let socketpair domain typ proto =
+  let kind = `sock in
+  let fd1, fd2 = Unix.socketpair ~cloexec:true domain typ proto in
+  (make_rw_exn kind fd1, make_rw_exn kind fd2)
+
+let openfile_ro kind path flags =
+  make_ro_exn kind
+  @@ Unix.openfile path (Unix.O_RDONLY :: Unix.O_CLOEXEC :: flags) 0
+
+let openfile_rw ?custom_ftruncate kind path flags =
+  make_rw_exn ?custom_ftruncate kind
+  @@ Unix.openfile path (Unix.O_RDWR :: Unix.O_CLOEXEC :: flags) 0
+
+let openfile_wo kind path flags =
+  make_wo_exn kind
+  @@ Unix.openfile path (Unix.O_WRONLY :: Unix.O_CLOEXEC :: flags) 0
+
+let creat path flags perm =
+  make_rw_exn `reg
+  @@ Unix.openfile path
+       (Unix.O_RDWR :: Unix.O_CREAT :: Unix.O_EXCL :: Unix.O_CLOEXEC :: flags)
+       perm
+
+let dev_null_out () = openfile_wo `chr "/dev/null" []
+
+let dev_null_in () = openfile_ro `chr "/dev/null" []
+
+let dev_zero () = openfile_ro `chr "/dev/zero" []
+
+let shutdown_recv t =
+  Unix.shutdown (Safefd.unsafe_to_file_descr_exn t.fd) Unix.SHUTDOWN_RECEIVE
+
+let shutdown_send t =
+  Unix.shutdown (Safefd.unsafe_to_file_descr_exn t.fd) Unix.SHUTDOWN_SEND
+
+let shutdown_all t =
+  Unix.shutdown (Safefd.unsafe_to_file_descr_exn t.fd) Unix.SHUTDOWN_ALL
+
+let ftruncate t size =
+  match t.custom_ftruncate with
+  | None ->
+      Unix.LargeFile.ftruncate (Safefd.unsafe_to_file_descr_exn t.fd) size
+  | Some f ->
+      f size
+
+let lseek t off whence =
+  Unix.LargeFile.lseek (Safefd.unsafe_to_file_descr_exn t.fd) off whence
+
+let read t buf off len =
+  Unix.read (Safefd.unsafe_to_file_descr_exn t.fd) buf off len
+
+let single_write_substring t buf off len =
+  Unix.single_write_substring (Safefd.unsafe_to_file_descr_exn t.fd) buf off len
+
+let set_nonblock t = Unix.set_nonblock (Safefd.unsafe_to_file_descr_exn t.fd)
+
+let clear_nonblock t = Unix.clear_nonblock (Safefd.unsafe_to_file_descr_exn t.fd)
+
+let with_tempfile ?size () f =
+  let name, ch =
+    Filename.open_temp_file ~mode:[Open_binary] "xapi_fdcaps" "tmp"
+  in
+  let finally () =
+    close_out_noerr ch ;
+    try Unix.unlink name with Unix.Unix_error (_, _, _) -> ()
+  in
+  let@ () = Fun.protect ~finally in
+  let t = ch |> Unix.descr_of_out_channel |> make_wo_exn `reg in
+  let@ t = with_fd t in
+  size |> Option.iter (fun size -> ftruncate t size) ;
+  f (name, t)
+
+let check_output cmd args =
+  let cmd = Filename.quote_command cmd args in
+  let ch = Unix.open_process_in cmd in
+  let finally () =
+    try
+      let (_ : Unix.process_status) = Unix.close_process_in ch in
+      ()
+    with _ -> ()
+  in
+  Fun.protect ~finally @@ fun () ->
+  let out = In_channel.input_all ch |> String.trim in
+  match Unix.close_process_in ch with
+  | Unix.WEXITED 0 ->
+      out
+  | _ ->
+      failwith (Printf.sprintf "%s exited nonzero" cmd)
+
+let with_temp_blk ?(sector_size = 512) ?delay_read_ms:_ ?delay_write_ms:_ name f
+    =
+  let blkdev =
+    check_output "losetup"
+      [
+        "--show"
+      ; "--sector-size"
+      ; string_of_int sector_size
+      ; "--direct-io=on"
+      ; "--find"
+      ; name
+      ]
+  in
+  let custom_ftruncate size =
+    Unix.LargeFile.truncate name size ;
+    let (_ : string) = check_output "losetup" ["--set-capacity"; name] in
+    ()
+  in
+  let finally () =
+    let (_ : string) = check_output "losetup" ["--detach"; blkdev] in
+    ()
+  in
+  let@ () = Fun.protect ~finally in
+  let@ t = with_fd @@ openfile_rw ~custom_ftruncate `blk blkdev [] in
+  f (blkdev, t)
+
+let setup () = Sys.set_signal Sys.sigpipe Sys.Signal_ignore
+
+module For_test = struct
+  let unsafe_fd_exn t = Safefd.unsafe_to_file_descr_exn t.fd
+end
diff --git a/lib/xapi-fdcaps/operations.mli b/lib/xapi-fdcaps/operations.mli
new file mode 100644
index 00000000..9163adb6
--- /dev/null
+++ b/lib/xapi-fdcaps/operations.mli
@@ -0,0 +1,210 @@
+(*
+ * Copyright (C) 2023 Cloud Software Group
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+(** Statically enforce file descriptor capabilities using type parameters.
+
+ *)
+
+open Properties
+
+(** a file descriptor with properties
+  Upper bounds are avoided here so that this type can be used in functors
+ *)
+type +!'a props constraint 'a = (_, _) Properties.props
+
+(** like {!type:props} but with upper bounds on properties *)
+type +!'a t = 'a props constraint 'a = (_, _) Properties.t
+
+(** convenience type for declaring properties *)
+type (+!'a, +!'b) make = ('a, 'b) Properties.t t
+
+val pp : _ t Fmt.t
+(** [pp formatter t] pretty prints [t] on [formatter]. *)
+
+val dump : _ t Fmt.t
+(** [dump formatter t] prints a debug representation of [t] on [formatter]. *)
+
+val close : _ t -> unit
+(** [close t] closes t. Doesn't raise an exception if it is already closed.
+  Other errors from the underlying {!val:Unix.close} are propagated.
+ *)
+
+val with_fd : 'a t -> ('a t -> 'b) -> 'b
+(** [with_fd t f] calls [f t] and always closes [t] after [f] finishes.
+  [f] can also close [t] earlier if it wants to without a double close error.
+*)
+
+val with_fd2 : 'a t * 'b t -> ('a t * 'b t -> 'c) -> 'c
+(** [with_fd2 fd1 fd2 f] calls [f fd1 fd2] and always closes [t] after [f] finishes. *)
+
+module Syntax : sig
+  val ( let@ ) : ('a -> 'b) -> 'a -> 'b
+  (** [let@ fd = with_fd t in ... use fd] *)
+end
+
+val pipe : unit -> ([> rdonly], [> fifo]) make * ([> wronly], [> fifo]) make
+(** [pipe ()] creates an unnamed pipe.
+  @see {!val:Unix.pipe}
+ *)
+
+val socketpair :
+     Unix.socket_domain
+  -> Unix.socket_type
+  -> int
+  -> ([> rdwr], [> sock]) make * ([> rdwr], [> sock]) make
+(** [socketpair domain type protocol] creates a socket pair.
+  @see {!val:Unix.socketpair}
+ *)
+
+val openfile_ro : 'a -> string -> Unix.open_flag list -> ([> rdonly], 'a) make
+(** [openfile_ro kind path flags] opens an existing [path] readonly.
+
+  @param kind [path] is expected to be this file kind
+  @see {!val:Unix.openfile}
+
+  @raises Invalid_argument if [path] is not kind
+ *)
+
+val openfile_rw :
+     ?custom_ftruncate:(int64 -> unit)
+  -> 'a
+  -> string
+  -> Unix.open_flag list
+  -> ([> rdwr], 'a) make
+(** [openfile_rw kind path flags] opens an existing [path] readwrite.
+
+  @param kind [path] is expected to be this file kind
+  @see {!val:Unix.openfile}
+
+  @raises Invalid_argument if [path] is not kind
+ *)
+
+val openfile_wo : 'a -> string -> Unix.open_flag list -> ([> wronly], 'a) make
+(** [openfile_wo kind path flags] opens an existing [path] writeonly.
+
+  @param kind [path] is expected to be this file kind
+  @see {!val:Unix.openfile}
+
+  @raises Invalid_argument if [path] is not kind
+ *)
+
+val creat : string -> Unix.open_flag list -> int -> ([> rdwr], [> reg]) make
+(** [creat path flags perms] creates [path] readwrite. The path must not already exist.
+
+  @param perms initial permissions for [path]
+  @see {!val:Unix.openfile}
+
+  @raises Invalid_argument if [path] is not kind
+ *)
+
+val dev_null_out : unit -> ([> wronly], [> chr]) make
+(** [dev_null_out ()] is "/dev/null" opened for writing *)
+
+val dev_null_in : unit -> ([> rdonly], [> chr]) make
+(** [dev_null_in ()] is "/dev/null" opened for reading *)
+
+val dev_zero : unit -> ([> rdonly], [> chr]) make
+(** [dev_zero ()] is "/dev/zero" opened for reading *)
+
+val shutdown_recv : ([< readable], [< sock]) make -> unit
+(** [shutdown_recv t] shuts down receiving on [t].
+
+  @see {!Unix.shutdown}
+ *)
+
+val shutdown_send : ([< writable], [< sock]) make -> unit
+(** [shutdown_send t] shuts down sending on [t].
+
+  @see {!Unix.shutdown}
+ *)
+
+val shutdown_all : ([< rdwr], [< sock]) make -> unit
+(** [shutdown_all t] shuts down both receiving and sending on [t].
+
+  @see {!Unix.shutdown}
+ *)
+
+val ftruncate : ([< writable], [< truncatable]) make -> int64 -> unit
+(** [ftruncate t size] sets the size of the regular file [t] to [size].
+
+  @see {!Unix.ftruncate}
+ *)
+
+val lseek : (_, [< seekable]) make -> int64 -> Unix.seek_command -> int64
+(** [lseek t off whence] sets the position of [t] to [off] with origin specified by [whence].
+
+  @see {!Unix.lseek}
+*)
+
+val read : ([< readable], _) make -> bytes -> int -> int -> int
+(** [read t buf off len]
+  @see {!Unix.read}
+ *)
+
+val single_write_substring :
+  ([< writable], _) make -> string -> int -> int -> int
+(** [single_write_substring t buf off len]
+
+  @see {!Unix.single_write_substring}
+*)
+
+val set_nonblock : (_, [< espipe]) make -> unit
+(** [set_nonblock t].
+
+  Only pipes, FIFOs and sockets are guaranteed to not block when this flag is set.
+  Although it is possible to set regular files and block devices as non-blocking, they currently still block
+  (although according to the manpage this may change in the future)
+
+  @see {!Unix.set_nonblock}
+ *)
+
+val clear_nonblock : _ t -> unit
+(** [clear_nonblock t].
+
+  We do not restrict clearing the non-blocking flag: that is just reverting back to default behaviour.
+  
+  @see {!Unix.clear_nonblock}
+ *)
+
+val with_tempfile :
+  ?size:int64 -> unit -> (string * ([> wronly], [> reg]) make -> 'a) -> 'a
+(** [with_tempfile () f] calls [f (name, outfd)] with the name of a temporary file and a file descriptor opened for writing.
+  Deletes the temporary file when [f] finishes. *)
+
+val with_temp_blk :
+     ?sector_size:int
+  -> ?delay_read_ms:float
+  -> ?delay_write_ms:float
+  -> string
+  -> (string * ([> rdwr], [> blk]) make -> 'a)
+  -> 'a
+(** [with_temp_blk ?sector_size ?delay_read ?delay_write path f] calls [f (name, fd)] with a name and file descriptor pointing to a block device.
+  The block device is temporarily created on top of [path].
+
+  Deletes the block device when [f] finishes.
+  Only works when run as root.
+
+  @param sector_size between 512 and 4096
+  @param delay_read_ms delays read operations by specified milliseconds
+  @param delay_write_ms delays write operations by specified milliseconds
+*)
+
+val setup : unit -> unit
+(** [setup ()] installs a SIGPIPE handler *)
+
+(**/**)
+
+module For_test : sig
+  val unsafe_fd_exn : _ t -> Unix.file_descr
+end
diff --git a/lib/xapi-fdcaps/test/dune b/lib/xapi-fdcaps/test/dune
index dd16b6aa..b8d21788 100644
--- a/lib/xapi-fdcaps/test/dune
+++ b/lib/xapi-fdcaps/test/dune
@@ -1,6 +1,6 @@
 (tests
 	(package xapi-fdcaps)
-	(names test_safefd test_properties)
+	(names test_safefd test_properties test_operations)
 	(libraries xapi_fdcaps alcotest fmt)
 )
 
diff --git a/lib/xapi-fdcaps/test/test_operations.ml b/lib/xapi-fdcaps/test/test_operations.ml
new file mode 100644
index 00000000..f3c22f36
--- /dev/null
+++ b/lib/xapi-fdcaps/test/test_operations.ml
@@ -0,0 +1,262 @@
+(*
+ * Copyright (C) 2023 Cloud Software Group
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+open Xapi_fdcaps
+open Properties
+open Operations
+open Syntax
+
+let b = Bytes.make 256 'x'
+
+let read_fd fd =
+  let (_ : int) = read fd b 0 (Bytes.length b) in
+  ()
+
+let check_unsafe_raises ?(exn = Unix.EBADF) name t op =
+  (* if we bypass the type safety then we should get an error at runtime,
+     but only when the capability is 'no', not when it is 'removed'
+  *)
+  let fd = For_test.unsafe_fd_exn t in
+  let msg = Printf.sprintf "%s when <%s: no; ..>" name name in
+  let exn = Unix.Unix_error (exn, name, "") in
+  Alcotest.check_raises msg exn @@ fun () -> op fd
+
+let error_read_fd (t : ([< wronly], _) make) =
+  let@ fd = check_unsafe_raises "read" t in
+  let (_ : int) = Unix.read fd b 0 (Bytes.length b) in
+  ()
+
+let str = "test"
+
+let write_fd fd =
+  let (_ : int) = single_write_substring fd str 0 (String.length str) in
+  ()
+
+let error_write_fd (t : ([< rdonly], _) make) =
+  let@ fd = check_unsafe_raises "single_write" t in
+  let (_ : int) = Unix.single_write_substring fd str 0 (String.length str) in
+  ()
+
+let test_ro fd = read_fd fd ; error_write_fd fd
+
+let test_wo fd = write_fd fd ; error_read_fd fd
+
+let test_lseek t =
+  let actual = lseek t 0L Unix.SEEK_SET in
+  Alcotest.(check' int64) ~msg:"starting position" ~expected:0L ~actual ;
+  let expected = 17L in
+  let actual = lseek t expected Unix.SEEK_SET in
+  Alcotest.(check' int64) ~msg:"jump1 position" ~expected ~actual ;
+  let actual = lseek t 3L Unix.SEEK_CUR in
+  Alcotest.(check' int64) ~msg:"jump2 position" ~expected:20L ~actual
+
+let error_lseek (t : (_, [< espipe]) make) =
+  let@ fd = check_unsafe_raises ~exn:Unix.ESPIPE "lseek" t in
+  let (_ : int) = Unix.lseek fd 0 Unix.SEEK_CUR in
+  ()
+
+let test_ftruncate t =
+  let expected = 4000L in
+  ftruncate t expected ;
+  let actual = lseek t 0L Unix.SEEK_END in
+  Alcotest.(check' int64) ~msg:"size after ftruncate" ~expected ~actual
+
+type not_truncate = [blk | chr | dir | lnk | fifo | sock]
+
+let error_ftruncate (t : (_, [< not_truncate]) make) =
+  let@ fd = check_unsafe_raises ~exn:Unix.EINVAL "ftruncate" t in
+  Unix.LargeFile.ftruncate fd 4000L
+
+type not_sock = [reg | blk | chr | dir | lnk | fifo]
+
+let error_shutdown (t : (_, [< not_sock]) make) =
+  let@ fd = check_unsafe_raises ~exn:Unix.ENOTSOCK "shutdown" t in
+  Unix.shutdown fd Unix.SHUTDOWN_RECEIVE
+
+let test_fd2 make ops =
+  ops
+  |> List.map @@ fun (name, op1, op2) ->
+     let test () =
+       let@ fd1, fd2 = with_fd2 @@ make () in
+       pp Fmt.stdout fd1 ;
+       dump Fmt.stdout fd1 ;
+       (* the 2 operations may depend on each-other, e.g. write and read on a pipe, so must be part of same testcase *)
+       set_nonblock fd1 ;
+       set_nonblock fd2 ;
+       op2 fd2 ;
+       op1 fd1 ;
+       clear_nonblock fd1 ;
+       clear_nonblock fd2
+     in
+     Alcotest.(test_case name `Quick) test
+
+let test_fd with_make ops =
+  ops
+  |> List.map @@ fun (name, op) ->
+     let test () =
+       let@ fd = with_make () in
+       op fd
+     in
+     Alcotest.(test_case name `Quick) test
+
+let test_pipe =
+  test_fd2 pipe
+    [
+      ("wo,ro", test_ro, test_wo)
+    ; ("error_lseek", error_lseek, error_lseek)
+    ; ("error_ftruncate", error_ftruncate, error_ftruncate)
+    ; ("error_shutdown", error_shutdown, error_shutdown)
+    ]
+
+let test_sock =
+  let make () = socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0 in
+  test_fd2 make
+    [
+      ("read,write", read_fd, write_fd)
+    ; ("error_lseek", error_lseek, error_lseek)
+    ; ("error_ftruncate", error_ftruncate, error_ftruncate)
+    ]
+
+let with_fd fd f = pp Fmt.stdout fd ; dump Fmt.stdout fd ; with_fd fd f
+
+let with_tempfile () f =
+  let@ name, fd = with_tempfile () in
+  Fmt.pf Fmt.stdout "%s: %a@." name pp fd ;
+  f (name, fd)
+
+let test_single make f () =
+  let@ t = with_fd @@ make () in
+  error_shutdown t ; f t
+
+let test_safe_close () =
+  let@ t = with_fd @@ dev_null_in () in
+  close t ; close t
+
+let test_regular =
+  let with_make () f =
+    let@ _name, out = with_tempfile () in
+    f out
+  in
+  test_fd with_make
+    [
+      ("wo", test_wo)
+    ; ("lseek", test_lseek)
+    ; ("ftruncate", test_ftruncate)
+    ; ("error_shutdown", error_shutdown)
+    ]
+
+let test_sock_shutdown_r () =
+  let@ fd1, fd2 = with_fd2 @@ socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0 in
+  shutdown_recv fd1 ;
+  let exn = Unix.Unix_error (Unix.EPIPE, "single_write", "") in
+  let@ () = Alcotest.check_raises "write after shutdown of other end" exn in
+  write_fd fd2
+
+let test_sock_shutdown_w () =
+  let@ _fd1, fd2 = with_fd2 @@ socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0 in
+  write_fd fd2 ;
+  shutdown_send fd2 ;
+  let exn = Unix.Unix_error (Unix.EPIPE, "single_write", "") in
+  let@ () = Alcotest.check_raises "write after shutdown" exn in
+  write_fd fd2
+
+let test_sock_shutdown_all () =
+  let@ fd1, fd2 = with_fd2 @@ socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0 in
+  write_fd fd2 ;
+  shutdown_all fd2 ;
+  let exn = Unix.Unix_error (Unix.EPIPE, "single_write", "") in
+  let () =
+    let@ () = Alcotest.check_raises "write after shutdown" exn in
+    write_fd fd2
+  in
+  let@ () = Alcotest.check_raises "write after shutdown" exn in
+  write_fd fd1
+
+let test_block sector_size =
+  let with_make () f =
+    let@ name, fd = with_tempfile () in
+    ftruncate fd 8192L ;
+    let run () =
+      try
+        let@ _blkname, fd = with_temp_blk ~sector_size name in
+        f fd
+      with Failure _ ->
+        let bt = Printexc.get_raw_backtrace () in
+        Printexc.raise_with_backtrace (Failure "with_temp_blk") bt
+    in
+    if Unix.geteuid () = 0 then
+      run ()
+    else
+      Alcotest.check_raises "non-root fails to create blockdevice"
+        (Failure "with_temp_blk") run
+  in
+  test_fd with_make
+    [("read", read_fd); ("write", write_fd); ("lseek", test_lseek)]
+
+let test_block_nest =
+  let with_make () f =
+    if Unix.geteuid () <> 0 then
+      Alcotest.skip () ;
+    let@ name, fd = with_tempfile () in
+    ftruncate fd 8192L ;
+    let@ blkname, _fd = with_temp_blk ~sector_size:4096 name in
+    let@ _blkname, fd = with_temp_blk ~sector_size:512 blkname in
+    f fd
+  in
+  test_fd with_make
+    [("read", read_fd); ("write", write_fd); ("lseek", test_lseek)]
+
+let test_creat () =
+  let name = Filename.temp_file __MODULE__ (Unix.getpid () |> string_of_int) in
+  Unix.unlink name ;
+  let@ fd1 = with_fd @@ creat name [] 0o600 in
+  pp Fmt.stdout fd1 ;
+  read_fd fd1 ;
+  write_fd fd1 ;
+  let@ fd2 = with_fd @@ openfile_rw `reg name [] in
+  pp Fmt.stdout fd2 ; read_fd fd2 ; write_fd fd2
+
+let tests =
+  Alcotest.
+    [
+      test_case "/dev/null in" `Quick @@ test_single dev_null_in test_ro
+    ; test_case "/dev/null out" `Quick @@ test_single dev_null_out test_wo
+    ; test_case "/dev/zero" `Quick @@ test_single dev_zero test_ro
+    ; test_case "safe close" `Quick test_safe_close
+    ; test_case "socket shutdown read" `Quick test_sock_shutdown_r
+    ; test_case "socket shutdown write" `Quick test_sock_shutdown_w
+    ; test_case "socket shutdown both" `Quick test_sock_shutdown_all
+    ; test_case "create" `Quick test_creat
+    ]
+
+(* this must be the last test *)
+let test_no_leaks () =
+  Gc.full_major () ;
+  Alcotest.(check' int)
+    ~msg:"Check for no FD leaks" ~expected:0 ~actual:(Safefd.leaked ())
+
+let () =
+  setup () ;
+  Sys.enable_runtime_warnings true ;
+  Alcotest.run ~show_errors:true "xapi_fdcaps"
+    [
+      ("pipe", test_pipe)
+    ; ("socket", test_sock)
+    ; ("regular", test_regular)
+    ; ("block 512", test_block 512)
+    ; ("block 4k", test_block 4096)
+    ; ("block 512 on 4k", test_block_nest)
+    ; ("xapi_fdcaps", tests)
+    ; ("no fd leaks", [Alcotest.test_case "no leaks" `Quick test_no_leaks])
+    ]