+ (* Try to determine the nature of each partition.
+ * Root? Swap? Architecture? etc.
+ *)
+ let all_partitions : (partition * nature) list =
+ (* Output of 'file' command for Linux swap file. *)
+ let swap = Pcre.regexp "Linux.*swap.*file" in
+ (* Contents of /etc/redhat-release. *)
+ let rhel = Pcre.regexp "(?:Red Hat Enterprise Linux|CentOS|Scientific Linux).*release (\\d+)(?:\\.(\\d+))?" in
+ let fedora = Pcre.regexp "Fedora.*release (\\d+)" in
+ (* Contents of /etc/debian_version. *)
+ let debian = Pcre.regexp "^(\\d+)\\.(\\d+)" in
+ (* Output of 'file' on certain executables. *)
+ let i386 = Pcre.regexp ", Intel 80386," in
+ let x86_64 = Pcre.regexp ", x86-64," in
+ let itanic = Pcre.regexp ", IA-64," in
+
+ (* Examine the filesystem mounted on 'mnt' to determine the
+ * operating system, and, if Linux, the distro.
+ *)
+ let detect_os mnt =
+ if is_dir (mnt ^ "/Windows") = Some true &&
+ is_file (mnt ^ "/autoexec.bat") = Some true then
+ WindowsRoot
+ else if is_dir (mnt ^ "/etc") = Some true &&
+ is_dir (mnt ^ "/sbin") = Some true &&
+ is_dir (mnt ^ "/var") = Some true then (
+ if is_file (mnt ^ "/etc/redhat-release") = Some true then (
+ let chan = open_in (mnt ^ "/etc/redhat-release") in
+ let lines = input_all_lines chan in
+ close_in chan;
+
+ match lines with
+ | [] -> (* empty /etc/redhat-release ...? *)
+ LinuxRoot (UnknownArch, OtherLinux)
+ | line::_ -> (* try to detect OS from /etc/redhat-release *)
+ try
+ let subs = Pcre.exec ~rex:rhel line in
+ let major = int_of_string (Pcre.get_substring subs 1) in
+ let minor =
+ try int_of_string (Pcre.get_substring subs 2)
+ with Not_found -> 0 in
+ LinuxRoot (UnknownArch, RHEL (major, minor))
+ with
+ Not_found | Failure "int_of_string" ->
+ try
+ let subs = Pcre.exec ~rex:fedora line in
+ let version = int_of_string (Pcre.get_substring subs 1) in
+ LinuxRoot (UnknownArch, Fedora version)
+ with
+ Not_found | Failure "int_of_string" ->
+ LinuxRoot (UnknownArch, OtherLinux)
+ )
+ else if is_file (mnt ^ "/etc/debian_version") = Some true then (
+ let chan = open_in (mnt ^ "/etc/debian_version") in
+ let lines = input_all_lines chan in
+ close_in chan;
+
+ match lines with
+ | [] -> (* empty /etc/debian_version ...? *)
+ LinuxRoot (UnknownArch, OtherLinux)
+ | line::_ -> (* try to detect version from /etc/debian_version *)
+ try
+ let subs = Pcre.exec ~rex:debian line in
+ let major = int_of_string (Pcre.get_substring subs 1) in
+ let minor = int_of_string (Pcre.get_substring subs 2) in
+ LinuxRoot (UnknownArch, Debian (major, minor))
+ with
+ Not_found | Failure "int_of_string" ->
+ LinuxRoot (UnknownArch, OtherLinux)
+ )
+ else
+ LinuxRoot (UnknownArch, OtherLinux)
+ ) else if is_dir (mnt ^ "/grub") = Some true &&
+ is_file (mnt ^ "/grub/stage1") = Some true then (
+ LinuxBoot
+ ) else
+ NotRoot (* mountable, but not a root filesystem *)
+ in
+
+ (* Examine the Linux root filesystem mounted on 'mnt' to
+ * determine the architecture. We do this by looking at some
+ * well-known binaries that we expect to be there.
+ *)
+ let detect_architecture mnt =
+ let cmd = "file -bL " ^ quote (mnt ^ "/sbin/init") in
+ match shget cmd with
+ | Some (str::_) when Pcre.pmatch ~rex:i386 str -> I386
+ | Some (str::_) when Pcre.pmatch ~rex:x86_64 str -> X86_64
+ | Some (str::_) when Pcre.pmatch ~rex:itanic str -> IA64
+ | _ -> UnknownArch
+ in
+
+ List.map (
+ fun part ->
+ let dev = dev_of_partition part in (* Get /dev device. *)
+
+ let nature =
+ (* Use 'file' command to detect if it is swap. *)
+ let cmd = "file -sbL " ^ quote dev in
+ match shget cmd with
+ | Some (str::_) when Pcre.pmatch ~rex:swap str -> LinuxSwap
+ | _ ->
+ (* Blindly try to mount the device. *)
+ let cmd = "mount -o ro " ^ quote dev ^ " /mnt/root" in
+ match shwithstatus cmd with
+ | 0 ->
+ let os = detect_os "/mnt/root" in
+ let nature =
+ match os with
+ | LinuxRoot (UnknownArch, distro) ->
+ let architecture = detect_architecture "/mnt/root" in
+ LinuxRoot (architecture, distro)
+ | os -> os in
+ sh "umount /mnt/root";
+ nature
+
+ | _ -> UnknownNature (* not mountable *)
+
+ in
+
+ eprintf "partition detection: %s is %s\n%!"
+ dev (string_of_nature nature);
+
+ (part, nature)
+ ) all_partitions
+ in
+
+ printf "virt-p2v.ml finished detecting hard drives\n%!";
+