posix: add device mknod support

dune-project

@@ -50,6 +50,7 @@
  (depends
   (eio (= :version))
   (iomux (>= 0.2))
+  (alcotest (and (>= 1.7.0) :with-test))
   (mdx (and (>= 2.4.1) :with-test))
   (lintcstubs-arity :with-test)
   (conf-bash :with-test)

eio_posix.opam

@@ -12,6 +12,7 @@ depends: [
   "dune" {>= "3.9"}
   "eio" {= version}
   "iomux" {>= "0.2"}
+  "alcotest" {>= "1.7.0" & with-test}
   "mdx" {>= "2.4.1" & with-test}
   "lintcstubs-arity" {with-test}
   "conf-bash" {with-test}

lib_eio/file.ml

@@ -4,6 +4,18 @@ module Unix_perm = struct
   type t = int
 end
 
+module Dev = struct
+  type t = int64
+
+  let of_int64 x = x
+  let to_int64 x = x
+
+  let equal = Int64.equal
+  let compare = Int64.compare
+
+  let pp ppf t = Fmt.pf ppf "0x%Lx" t
+end
+
 module Stat = struct
   type kind = [
     | `Unknown
@@ -27,14 +39,14 @@ module Stat = struct
     | `Socket -> Fmt.string ppf "socket"
 
   type t = {
-    dev : Int64.t;
+    dev : Dev.t;
     ino : Int64.t;
     kind : kind;
     perm : Unix_perm.t;
     nlink : Int64.t;
     uid : Int64.t;
     gid : Int64.t;
-    rdev : Int64.t;
+    rdev : Dev.t option;
     size : Optint.Int63.t;
     blksize : Int64.t;
     blocks : Int64.t;
@@ -45,14 +57,14 @@ module Stat = struct
 
   let pp ppf t =
     Fmt.record [
-      Fmt.field "dev" (fun t -> t.dev) Fmt.int64;
+      Fmt.field "dev" (fun t -> t.dev) Dev.pp;
       Fmt.field "ino" (fun t -> t.ino) Fmt.int64;
       Fmt.field "kind" (fun t -> t.kind) pp_kind;
       Fmt.field "perm" (fun t -> t.perm) (fun ppf i -> Fmt.pf ppf "0o%o" i);
       Fmt.field "nlink" (fun t -> t.nlink) Fmt.int64;
       Fmt.field "uid" (fun t -> t.uid) Fmt.int64;
       Fmt.field "gid" (fun t -> t.gid) Fmt.int64;
-      Fmt.field "rdev" (fun t -> t.rdev) Fmt.int64;
+      Fmt.field "rdev" (fun t -> t.rdev) (Fmt.option ~none:(Fmt.any "n/a") Dev.pp);
       Fmt.field "size" (fun t -> t.size) Optint.Int63.pp;
       Fmt.field "blksize" (fun t -> t.blksize) Fmt.int64;
       Fmt.field "blocks" (fun t -> t.blocks) Fmt.int64;

lib_eio/file.mli

@@ -13,6 +13,32 @@ module Unix_perm : sig
   (** This is the same as {!Unix.file_perm}, but avoids a dependency on [Unix]. *)
 end
 
+(** Device numbers. *)
+module Dev : sig
+  type t = private int64
+  (** An opaque identifier for a device, as the OS reports it.
+      On Unix, {!Eio_unix.Dev} can split it into major and minor numbers.
+      On Windows, it is the volume serial number which has no such structure.
+
+      @since 1.5 *)
+
+  val of_int64 : int64 -> t
+  (** [of_int64 x] is the device with raw value [x]. *)
+
+  val to_int64 : t -> int64
+  (** [to_int64 t] is the raw value of [t], as the OS represents it. *)
+
+  val equal : t -> t -> bool
+  (** [equal a b] is [true] if [a] and [b] identify the same device. *)
+
+  val compare : t -> t -> int
+  (** [compare a b] orders device numbers arbitrarily but consistently. *)
+
+  val pp : t Fmt.t
+  (** [pp] formats the raw value in hex.
+      Use {!Eio_unix.Dev.pp} to get the Unix [major:minor] form. *)
+end
+
 (** Portable file stats. *)
 module Stat : sig
 
@@ -32,14 +58,15 @@ module Stat : sig
   (** Pretty printer for {!type-kind}. *)
 
   type t = {
-    dev : Int64.t;              (** Device containing the filesystem where the file resides. *)
+    dev : Dev.t;                (** Device containing the filesystem where the file resides. *)
     ino : Int64.t;              (** Inode number. *)
     kind : kind;                (** File type. *)
     perm : Unix_perm.t;         (** Permissions (mode). *)
     nlink : Int64.t;            (** Number of hard links. *)
     uid : Int64.t;              (** User ID of owner. *)
     gid : Int64.t;              (** Group ID of owner. *)
-    rdev : Int64.t;             (** Device's ID (if this is a device). *)
+    rdev : Dev.t option;        (** The device this refers to, if [kind] is [`Character_special]
+                                    or [`Block_device]. Always [None] otherwise or on Windows. *)
     size : Optint.Int63.t;      (** Total size in bytes. *)
     blksize : Int64.t;          (** Preferred block size for efficient filesystem I/O. *)
     blocks : Int64.t;           (** Number of 512-byte blocks allocated (disk usage is [blocks * 512]). *)

lib_eio/unix/dev.ml

@@ -0,0 +1,21 @@
+type t = Eio.File.Dev.t
+
+external make_raw : int -> int -> int64 = "eio_unix_makedev"
+external major_raw : int64 -> int = "eio_unix_dev_major"
+external minor_raw : int64 -> int = "eio_unix_dev_minor"
+
+let major t = major_raw (Eio.File.Dev.to_int64 t)
+let minor t = minor_raw (Eio.File.Dev.to_int64 t)
+
+let pp f t = Fmt.pf f "%d:%d" (major t) (minor t)
+
+let make ~major:maj ~minor:mnr =
+  if maj < 0 || mnr < 0 then
+    Fmt.invalid_arg "Dev.make: negative major or minor number (%d:%d)" maj mnr;
+  let t = Eio.File.Dev.of_int64 (make_raw maj mnr) in
+  (* [makedev] silently truncates, so check by taking it apart again. *)
+  if major t <> maj || minor t <> mnr then
+    Fmt.invalid_arg
+      "Dev.make: %d:%d is out of range for this platform (it became %a)"
+      maj mnr pp t;
+  t

lib_eio/unix/dev.mli

@@ -0,0 +1,25 @@
+(** Unix device numbers.
+
+    This is the Unix view of {!Eio.File.Dev.t}, to split the device into a
+    major number identifying the driver and the minor number identifying the
+    device it controls. How many bits each gets is platform-specific, so a
+    device number made on one system should not be used on another.
+
+    @since 1.5 *)
+
+type t = Eio.File.Dev.t
+
+val make : major:int -> minor:int -> t
+(** [make ~major ~minor] combines the two numbers (see [makedev(3)]).
+
+    @raise Invalid_argument if either number is negative, or does not fit in
+           the bits this platform gives it. *)
+
+val major : t -> int
+(** [major t] is the major number of [t]. *)
+
+val minor : t -> int
+(** [minor t] is the minor number of [t]. *)
+
+val pp : t Fmt.t
+(** [pp] formats a device number as [major:minor]. *)

lib_eio/unix/dune

@@ -16,6 +16,7 @@
    primitives.h.new
    (run %{bin:lintcstubs_arity_cmt}
         %{dep:.eio_unix.objs/byte/eio_unix__Fd.cmt}
+        %{dep:.eio_unix.objs/byte/eio_unix__Dev.cmt}
         %{dep:.eio_unix.objs/byte/eio_unix__Private.cmt}
         %{dep:.eio_unix.objs/byte/eio_unix__Cap.cmt}
         %{dep:.eio_unix.objs/byte/eio_unix__Fork_action.cmt}

lib_eio/unix/eio_unix.ml

@@ -4,6 +4,7 @@ module Fd = Fd
 module Resource = Resource
 module Private = Private
 module Err = Err
+module Dev = Dev
 
 include Types
 

lib_eio/unix/eio_unix.mli

@@ -28,6 +28,9 @@ end
 module Fd = Fd
 (** A safe wrapper for {!Unix.file_descr}. *)
 
+module Dev = Dev
+(** Splitting {!Eio.File.Dev.t} into major and minor numbers. *)
+
 (** Eio resources backed by an OS file descriptor. *)
 module Resource : sig
   type 'a t = ([> `Unix_fd] as 'a) Eio.Resource.t
@@ -152,6 +155,21 @@ module Private : sig
   val chown : flags:int -> uid:int64 -> gid:int64 -> Fd.t -> string -> unit
   val chown_unix : flags:int -> uid:int64 -> gid:int64 -> Unix.file_descr -> string -> unit
 
+  val rdev_of_int64 : kind:Eio.File.Stat.kind -> int64 -> Dev.t option
+  (** [rdev_of_int64 ~kind x] is [Some x] if [kind] is a device, or [None] otherwise. *)
+
+  type node_kind = [
+    | `Fifo                           (** FIFO (named pipe). *)
+    | `Socket                         (** Unix-domain socket. *)
+    | `Regular_file                   (** Regular file. *)
+    | `Character_special of Dev.t     (** Character device with the given device number. *)
+    | `Block_device of Dev.t          (** Block device with the given device number. *)
+  ]
+  (** The kind of node {!mknod} should create. *)
+
+  val mknod : Fd.t -> string -> kind:node_kind -> perm:int -> unit
+  val mknod_unix : Unix.file_descr -> string -> kind:node_kind -> perm:int -> unit
+
   val getaddrinfo : service:string -> string -> Eio.Net.Sockaddr.t list
 
   val setsockopt : Fd.t -> 'a Eio.Net.Sockopt.t -> 'a -> unit

lib_eio/unix/eio_unix_stubs.c

@@ -7,6 +7,11 @@
 #include <sys/stat.h>
 #include <sys/types.h>
 #include <string.h>
+#ifdef __linux__
+/* [makedev] and friends have lived here rather than in <sys/types.h>
+   since glibc 2.28. See makedev(3). */
+# include <sys/sysmacros.h>
+#endif
 #ifdef _WIN32
 # include <winsock2.h>
 # include <ws2tcpip.h>
@@ -136,6 +141,64 @@ CAMLprim value eio_unix_fchownat(value v_fd, value v_path, value v_uid, value v_
 #endif
 }
 
+CAMLprim value eio_unix_makedev(value v_major, value v_minor) {
+#ifdef _WIN32
+  caml_unix_error(EOPNOTSUPP, "makedev not supported on Windows", Nothing);
+#else
+  return caml_copy_int64((int64_t) makedev(Int_val(v_major), Int_val(v_minor)));
+#endif
+}
+
+CAMLprim value eio_unix_dev_major(value v_dev) {
+#ifdef _WIN32
+  caml_unix_error(EOPNOTSUPP, "major not supported on Windows", Nothing);
+#else
+  return Val_int(major((dev_t) Int64_val(v_dev)));
+#endif
+}
+
+CAMLprim value eio_unix_dev_minor(value v_dev) {
+#ifdef _WIN32
+  caml_unix_error(EOPNOTSUPP, "minor not supported on Windows", Nothing);
+#else
+  return Val_int(minor((dev_t) Int64_val(v_dev)));
+#endif
+}
+
+/* Keep in sync with [mknod_unix] in private.ml. */
+#ifndef _WIN32
+static mode_t eio_unix_node_type(value v_kind) {
+  switch (Int_val(v_kind)) {
+    case 0: return S_IFIFO;
+    case 1: return S_IFSOCK;
+    case 2: return S_IFREG;
+    case 3: return S_IFCHR;
+    case 4: return S_IFBLK;
+    default: caml_invalid_argument("mknodat: unknown node kind");
+  }
+}
+#endif
+
+CAMLprim value eio_unix_mknodat(value v_fd, value v_path, value v_kind, value v_perm, value v_dev) {
+#ifdef _WIN32
+  caml_unix_error(EOPNOTSUPP, "mknodat not supported on Windows", v_path);
+#else
+  CAMLparam2(v_path, v_dev);
+  char *path;
+  mode_t mode = eio_unix_node_type(v_kind) | (Int_val(v_perm) & 07777);
+  dev_t dev = (dev_t) Int64_val(v_dev);
+  int ret;
+  caml_unix_check_path(v_path, "mknodat");
+  path = caml_stat_strdup(String_val(v_path));
+  caml_enter_blocking_section();
+  ret = mknodat(Int_val(v_fd), path, mode, dev);
+  caml_leave_blocking_section();
+  caml_stat_free_preserving_errno(path);
+  if (ret == -1) caml_uerror("mknodat", v_path);
+  CAMLreturn(Val_unit);
+#endif
+}
+
 #ifndef _WIN32
 static int caml_eai_of_unix(int eai) {
   switch (eai) {

lib_eio/unix/primitives.h

@@ -20,9 +20,13 @@ CAMLprim value eio_unix_cap_enter(value);
 CAMLprim value eio_unix_readlinkat(value, value, value);
 CAMLprim value eio_unix_fchmodat(value, value, value, value);
 CAMLprim value eio_unix_fchownat(value, value, value, value, value);
+CAMLprim value eio_unix_mknodat(value, value, value, value, value);
 CAMLprim value eio_unix_getaddrinfo(value, value);
 CAMLprim value caml_eio_sockopt_int_set(value, value, value);
 CAMLprim value caml_eio_sockopt_int_get(value, value);
 CAMLprim value caml_eio_sockopt_string_set(value, value, value);
 CAMLprim value caml_eio_sockopt_string_get(value, value);
+CAMLprim value eio_unix_makedev(value, value);
+CAMLprim value eio_unix_dev_major(value);
+CAMLprim value eio_unix_dev_minor(value);
 CAMLprim value eio_unix_is_blocking(value);

lib_eio/unix/private.ml

@@ -51,6 +51,37 @@ let chown_unix ~flags ~uid ~gid fd path =
 let chown ~flags ~uid ~gid fd path =
   Fd.use_exn "chown" fd (fun fd -> chown_unix ~uid ~gid ~flags fd path)
 
+(* [st_rdev] is only meaningful for device nodes *)
+let rdev_of_int64 ~kind x =
+  match kind with
+  | `Character_special | `Block_device -> Some (Eio.File.Dev.of_int64 x)
+  | _ -> None
+
+type node_kind = [
+  | `Fifo
+  | `Socket
+  | `Regular_file
+  | `Character_special of Dev.t
+  | `Block_device of Dev.t
+]
+
+external eio_mknodat : Unix.file_descr -> string -> int -> int -> int64 -> unit = "eio_unix_mknodat"
+
+let mknod_unix fd path ~kind ~perm =
+  (* Keep the tags in sync with [eio_unix_node_type] in eio_unix_stubs.c. *)
+  let tag, dev =
+    match kind with
+    | `Fifo -> 0, 0L
+    | `Socket -> 1, 0L
+    | `Regular_file -> 2, 0L
+    | `Character_special dev -> 3, Eio.File.Dev.to_int64 dev
+    | `Block_device dev -> 4, Eio.File.Dev.to_int64 dev
+  in
+  eio_mknodat fd path tag perm dev
+
+let mknod fd path ~kind ~perm =
+  Fd.use_exn "mknod" fd (fun fd -> mknod_unix fd path ~kind ~perm)
+
 type sockaddr = [ `Tcp of Eio.Net.Ipaddr.v4v6 * int
                 | `Udp of Eio.Net.Ipaddr.v4v6 * int ]
 

lib_eio_linux/low_level.ml

@@ -360,15 +360,16 @@ let float_of_time s ns =
 
 let eio_of_statx x =
   let module X = Uring.Statx in
+  let kind = X.kind x in
   { Eio.File.Stat.
-    dev     = X.dev x;
+    dev     = Eio.File.Dev.of_int64 (X.dev x);
     ino     = X.ino x;
-    kind    = X.kind x;
+    kind;
     perm    = X.perm x;
     nlink   = X.nlink x;
     uid     = X.uid x;
     gid     = X.gid x;
-    rdev    = X.rdev x;
+    rdev    = Eio_unix.Private.rdev_of_int64 ~kind (X.rdev x);
     size    = X.size x |> Optint.Int63.of_int64;
     blksize = X.blksize x;
     blocks  = X.blocks x;
@@ -721,6 +722,14 @@ let chmod ~follow ~mode dirfd path =
       )
   with Unix.Unix_error (code, name, arg) -> raise @@ Err.v code name arg
 
+let mknod kind ~perm dirfd path =
+  try
+    with_parent_dir_fd dirfd path @@ fun parent leaf ->
+    Eio_unix.run_in_systhread ~label:"mknod" (fun () ->
+        Eio_unix.Private.mknod parent leaf ~kind ~perm
+      )
+  with Unix.Unix_error (code, name, arg) -> raise @@ Err.v code name arg
+
 let chown ~follow ?(uid=(-1L)) ?(gid=(-1L)) dirfd path =
   try
     Switch.run @@ fun sw ->

lib_eio_linux/low_level.mli

@@ -183,6 +183,9 @@ val rename : dir_fd -> string -> dir_fd -> string -> unit
 val symlink : link_to:string -> dir_fd -> string -> unit
 (** [symlink ~link_to dir path] creates a new symlink at [dir / path] pointing to [link_to]. *)
 
+val mknod : Eio_unix.Private.node_kind -> perm:int -> dir_fd -> string -> unit
+(** [mknod kind ~perm dir path] creates a fs node of type [kind] at [dir / path]. *)
+
 val chmod : follow:bool -> mode:int -> dir_fd -> string -> unit
 (** [chmod ~follow ~mode dir path] changes the file mode bits of [dir / path]. *)