Files
libguestfs/daemon/blkid.ml
Richard W.M. Jones 250ee85839 Rework Std_utils.Option so it works like the OCaml stdlib module
OCaml 4.08 introduces a stdlib Option module which looks a bit like
ours but has a number of differences.  In particular our functions
Option.may and Option.default have no corresponding functions in
stdlib, although there are close enough equivalents.

This change was automated using this command:

$ perl -pi.bak \
  -e 's/Option.may/Option.iter/g; s/Option.default /Option.value ~default:/g' \
  `git ls-files`

Update common module to include:

  commit cffa077323fafcdfcf78e230c022afa891a6b3ff
  Author: Richard W.M. Jones <rjones@redhat.com>
  Date:   Mon Feb 20 12:11:51 2023 +0000

    mlstdutils: Rework the Option module to be compatible with stdlib
2023-02-20 12:14:08 +00:00

36 lines
1.3 KiB
OCaml

(* guestfs-inspection
* Copyright (C) 2009-2023 Red Hat Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version.
*
* 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 General Public License for more details.
*
* You should have received a copy of the GNU General Public License along
* with this program; if not, write to the Free Software Foundation, Inc.,
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
*)
open Std_utils
open Utils
let rec vfs_type { Mountable.m_device = device } =
Option.value ~default:"" (get_blkid_tag device "TYPE")
and get_blkid_tag device tag =
let r, out, err =
commandr "blkid"
[(* Adding -c option kills all caching, even on RHEL 5. *)
"-c"; "/dev/null";
"-o"; "value"; "-s"; tag; device] in
match r with
| 0 -> Some (String.chomp out) (* success *)
| 2 -> None (* means tag not found *)
| _ -> failwithf "blkid: %s: %s: %s" device tag err