New APIs: part_set_gpt_attributes and part_get_gpt_attributes

Allow reading and setting the GPT partition attribute flags.

daemon/parted.ml

@@ -17,6 +17,7 @@
  *)
 
 open Scanf
+open Printf
 
 open Std_utils
 
@@ -124,10 +125,29 @@ let part_get_parttype device =
   | _ ->
      failwithf "%s: cannot parse the output of parted" device
 
+let part_set_gpt_attributes device partnum attributes =
+  if partnum <= 0 then failwith "partition number must be >= 1";
+
+  udev_settle ();
+
+  let arg = sprintf "%d:=:%LX" partnum attributes in
+  let r, _, err =
+    commandr ~fold_stdout_on_stderr:true
+             "sgdisk" [ device; "-A"; arg ] in
+  if r <> 0 then
+    failwithf "sgdisk: %s" err;
+
+  udev_settle ()
+
 let extract_guid value =
   (* The value contains only valid GUID characters. *)
   String.sub value 0 (String.span value "-0123456789ABCDEF")
 
+let extract_hex value =
+  (* The value contains only valid numeric characters. *)
+  let str = String.sub value 0 (String.span value "0123456789ABCDEF") in
+  Int64.of_string ("0x" ^ str)
+
 let sgdisk_info_extract_field device partnum field extractor =
   if partnum <= 0 then failwith "partition number must be >= 1";
 
@@ -179,3 +199,6 @@ let rec part_get_gpt_type device partnum =
 and part_get_gpt_guid device partnum =
   sgdisk_info_extract_field device partnum "Partition unique GUID"
                             extract_guid
+and part_get_gpt_attributes device partnum =
+  sgdisk_info_extract_field device partnum "Attribute flags"
+                            extract_hex

daemon/parted.mli

@@ -30,3 +30,5 @@ val part_get_parttype : string -> string
 
 val part_get_gpt_type : string -> int -> string
 val part_get_gpt_guid : string -> int -> string
+val part_get_gpt_attributes : string -> int -> int64
+val part_set_gpt_attributes : string -> int -> int64 -> unit

generator/actions_core.ml

@@ -8265,6 +8265,43 @@ Return the type GUID of numbered GPT partition C<partnum>. For MBR partitions,
 return an appropriate GUID corresponding to the MBR type. Behaviour is undefined
 for other partition types." };
 
+  { defaults with
+    name = "part_set_gpt_attributes"; added = (1, 21, 1);
+    style = RErr, [String (Device, "device"); Int "partnum"; Int64 "attributes"], [];
+    impl = OCaml "Parted.part_set_gpt_attributes";
+    optional = Some "gdisk";
+    tests = [
+      InitGPT, Always, TestResult (
+        [["part_set_gpt_attributes"; "/dev/sda"; "1";
+          "4"];
+         ["part_get_gpt_attributes"; "/dev/sda"; "1"]],
+        "ret == 4"), [];
+    ];
+    shortdesc = "set the attribute flags of a GPT partition";
+    longdesc = "\
+Set the attribute flags of numbered GPT partition C<partnum> to C<attributes>. Return an
+error if the partition table of C<device> isn't GPT.
+
+See L<https://en.wikipedia.org/wiki/GUID_Partition_Table#Partition_entries>
+for a useful list of partition attributes." };
+
+  { defaults with
+    name = "part_get_gpt_attributes"; added = (1, 21, 1);
+    style = RInt64 "attributes", [String (Device, "device"); Int "partnum"], [];
+    impl = OCaml "Parted.part_get_gpt_attributes";
+    optional = Some "gdisk";
+    tests = [
+      InitGPT, Always, TestResult (
+        [["part_set_gpt_attributes"; "/dev/sda"; "1";
+          "0"];
+         ["part_get_gpt_attributes"; "/dev/sda"; "1"]],
+        "ret == 0"), [];
+    ];
+    shortdesc = "get the attribute flags of a GPT partition";
+    longdesc = "\
+Return the attribute flags of numbered GPT partition C<partnum>.
+An error is returned for MBR partitions." };
+
   { defaults with
     name = "rename"; added = (1, 21, 5);
     style = RErr, [String (Pathname, "oldpath"); String (Pathname, "newpath")], [];

generator/proc_nr.ml

@@ -510,6 +510,8 @@ let proc_nr = [
 500, "inspect_get_mountpoints";
 501, "inspect_get_filesystems";
 502, "inspect_get_drive_mappings";
+503, "part_set_gpt_attributes";
+504, "part_get_gpt_attributes";
 ]
 
 (* End of list.  If adding a new entry, add it at the end of the list

lib/MAX_PROC_NR

@@ -1 +1 @@
-502
+504