On Friday, 21 July 2017 22:36:19 CEST Richard W.M. Jones wrote:
+let rec with_mounted mountable f = + match mountable.m_type with + | MountablePath -> + (* This corner-case happens for Mountable_or_Path parameters, where + * a path was supplied by the caller. The path (the m_device + * field) is relative to the sysroot. + *) + f (Sysroot.sysroot_path mountable.m_device) + + | MountableDevice -> + let cmd tmpdir = + ignore (command "mount" [mountable.m_device; tmpdir]) in + _with_mounted cmd f + + | MountableBtrfsVol subvol -> + let cmd tmpdir = + ignore (command "mount" ["-o"; "subvol=" ^ subvol (* XXX quoting? *); + mountable.m_device; tmpdir]) in + _with_mounted cmd f + +and _with_mounted mount_cmd f = + let tmpdir = Mkdtemp.temp_dir "btrfs" in + + (* This is the cleanup function which is called to unmount and + * remove the temporary directory. This is called on error and + * ordinary exit paths. + *) + let finally () = + ignore (Sys.command (sprintf "umount %s" (quote tmpdir))); + rmdir tmpdir + in + + protect ~finally ~f:(fun () -> mount_cmd tmpdir; f tmpdir)
As minor note: this subhelper (_with_mounted) could be moved inside with_mounted, so there is no risk to use it "accidentally" elsewhere in btrfs.ml. (Yes, I know the parameters are different, so a '_' typo would give a build error, but you can get what I mean here.) Thanks, -- Pino Toscano