mirrors/libguestfs
1
0
Fork 0
mirror of https://github.com/libguestfs/libguestfs.git synced 2026-03-21 22:53:37 +00:00
Code Issues Packages Projects Releases Wiki Activity

mllib: Combine small Unix library call bindings into Unix_utils module.

Browse Source 
Concatenate six small modules containing Unix/POSIX library call
bindings into a single module called Unix_utils.

The previous modules and the library functions bound were:

 - Dev_t:   makedev(3), major(3), minor(3)
 - Exit:    _exit(2)
 - Fnmatch: fnmatch(3)
 - Fsync:   sync(2)
 - Mkdtemp: mkdtemp(3)
 - StatVFS: statvfs(2)
This commit is contained in:
Richard W.M. Jones
2017-02-22 14:05:32 +00:00
parent 6130411a59
commit 4b6a482bc8
37 changed files with 370 additions and 670 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
builder/builder.ml
View File

@@ -21,6 +21,7 @@ open Common_gettext.Gettext
module G = Guestfs
open Common_utils
open Unix_utils
open Password
open Planner
open Utils

1
builder/sigchecker.ml
View File

@@ -18,6 +18,7 @@
open Common_gettext.Gettext
open Common_utils
open Unix_utils
open Utils

1
dib/dib.ml
View File

@@ -18,6 +18,7 @@
open Common_gettext.Gettext
open Common_utils
open Unix_utils
open Cmdline
open Utils

7
docs/C_SOURCE_FILES
View File

@@ -325,15 +325,10 @@ lib/whole-file.c
lua/lua-guestfs.c
make-fs/make-fs.c
mllib/common_utils-c.c
mllib/dev_t-c.c
mllib/dummy.c
mllib/exit-c.c
mllib/fnmatch-c.c
mllib/fsync-c.c
mllib/getopt-c.c
mllib/mkdtemp-c.c
mllib/progress-c.c
mllib/statvfs-c.c
mllib/unix_utils-c.c
mllib/uri-c.c
mllib/visit-c.c
mllib/xml-c.c

21
mllib/Makefile.am
View File

@@ -31,20 +31,15 @@ SOURCES_MLI = \
xml.mli \
xpath_helpers.mli \
checksums.mli \
unix_utils.mli \
common_utils.mli \
curl.mli \
dev_t.mli \
exit.mli \
fnmatch.mli \
fsync.mli \
getopt.mli \
JSON.mli \
mkdtemp.mli \
planner.mli \
progress.mli \
regedit.mli \
registry.mli \
StatVFS.mli \
stringMap.mli \
URI.mli \
visit.mli
@@ -56,21 +51,16 @@ SOURCES_ML = \
stringMap.ml \
common_gettext.ml \
getopt.ml \
dev_t.ml \
unix_utils.ml \
common_utils.ml \
fsync.ml \
progress.ml \
URI.ml \
mkdtemp.ml \
visit.ml \
fnmatch.ml \
planner.ml \
registry.ml \
regedit.ml \
StatVFS.ml \
JSON.ml \
curl.ml \
exit.ml \
checksums.ml \
xml.ml \
xpath_helpers.ml
@@ -82,14 +72,9 @@ SOURCES_C = \
../common/options/uri.c \
../common/progress/progress.c \
common_utils-c.c \
dev_t-c.c \
exit-c.c \
fnmatch-c.c \
fsync-c.c \
getopt-c.c \
mkdtemp-c.c \
progress-c.c \
statvfs-c.c \
unix_utils-c.c \
uri-c.c \
visit-c.c \
xml-c.c

21
mllib/StatVFS.ml
View File

@@ -1,21 +0,0 @@
(* virt tools interface to statvfs
* Copyright (C) 2016 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.
*)
(** Binding for [statvfs], but just for getting disk free space. *)
external free_space : string -> int64 = "guestfs_int_mllib_statvfs_free_space"

23
mllib/StatVFS.mli
View File

@@ -1,23 +0,0 @@
(* virt tools interface to statvfs
* Copyright (C) 2016 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.
*)
(** Binding for [statvfs], but just for getting disk free space. *)
val free_space : string -> int64
(** [free_space path] returns the free space available on the
filesystem that contains [path], in bytes. *)

4
mllib/common_utils.ml
View File

@@ -1028,8 +1028,8 @@ let is_partition dev =
if not (is_block_device dev) then false
else (
let rdev = (Unix.stat dev).Unix.st_rdev in
let major = Dev_t.major rdev in
let minor = Dev_t.minor rdev in
let major = Unix_utils.Dev_t.major rdev in
let minor = Unix_utils.Dev_t.minor rdev in
let path = sprintf "/sys/dev/block/%d:%d/partition" major minor in
Unix.access path [Unix.F_OK];
true

53
mllib/dev_t-c.c
View File

@@ -1,53 +0,0 @@
/* libguestfs OCaml tools common code
* Copyright (C) 2016 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.
*/
#include <config.h>
#include <stdio.h>
#include <stdlib.h>
#include <sys/types.h>
#include <sys/sysmacros.h>
#include <caml/mlvalues.h>
/* OCaml doesn't bind the dev_t calls makedev, major and minor. */
extern value guestfs_int_mllib_dev_t_makedev (value majv, value minv);
extern value guestfs_int_mllib_dev_t_major (value devv);
extern value guestfs_int_mllib_dev_t_minor (value devv);
/* NB: This is a "noalloc" call. */
value
guestfs_int_mllib_dev_t_makedev (value majv, value minv)
{
return Val_int (makedev (Int_val (majv), Int_val (minv)));
}
/* NB: This is a "noalloc" call. */
value
guestfs_int_mllib_dev_t_major (value devv)
{
return Val_int (major (Int_val (devv)));
}
/* NB: This is a "noalloc" call. */
value
guestfs_int_mllib_dev_t_minor (value devv)
{
return Val_int (minor (Int_val (devv)));
}

21
mllib/dev_t.ml
View File

@@ -1,21 +0,0 @@
(* libguestfs OCaml tools common code
* Copyright (C) 2016 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.
*)
external makedev : int -> int -> int = "guestfs_int_mllib_dev_t_makedev" "noalloc"
external major : int -> int = "guestfs_int_mllib_dev_t_major" "noalloc"
external minor : int -> int = "guestfs_int_mllib_dev_t_minor" "noalloc"

28
mllib/dev_t.mli
View File

@@ -1,28 +0,0 @@
(* virt-resize
* Copyright (C) 2016 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.
*)
(** Bindings for [dev_t] related functions [makedev], [major] and [minor]. *)
val makedev : int -> int -> int
(** makedev(3) *)
val major : int -> int
(** major(3) *)
val minor : int -> int
(** minor(3) *)

33
mllib/exit-c.c
View File

@@ -1,33 +0,0 @@
/* libguestfs OCaml tools common code
* Copyright (C) 2009-2017 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.
*/
#include <config.h>
#include <stdio.h>
#include <stdlib.h>
#include <unistd.h>
#include <caml/mlvalues.h>
extern int guestfs_int_mllib_exit (value rv) __attribute__((noreturn));
int
guestfs_int_mllib_exit (value rv)
{
_exit (Int_val (rv));
}

19
mllib/exit.ml
View File

@@ -1,19 +0,0 @@
(* libguestfs OCaml tools common code
* Copyright (C) 2016 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.
*)
external _exit : int -> 'a = "guestfs_int_mllib_exit" "noalloc"

20
mllib/exit.mli
View File

@@ -1,20 +0,0 @@
(* libguestfs OCaml tools common code
* Copyright (C) 2016 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.
*)
val _exit : int -> 'a
(** Call _exit directly, ie. do not run OCaml atexit handlers. *)

66
mllib/fnmatch-c.c
View File

@@ -1,66 +0,0 @@
/* Binding for fnmatch.
* Copyright (C) 2009-2017 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
*/
#include <config.h>
#include <stdlib.h>
#include <fnmatch.h>
#include <errno.h>
#include <caml/alloc.h>
#include <caml/memory.h>
#include <caml/mlvalues.h>
#include <caml/unixsupport.h>
#pragma GCC diagnostic ignored "-Wmissing-prototypes"
/* NB: These flags must appear in the same order as fnmatch.ml */
static int flags[] = {
FNM_NOESCAPE,
FNM_PATHNAME,
FNM_PERIOD,
FNM_FILE_NAME,
FNM_LEADING_DIR,
FNM_CASEFOLD,
};
value
guestfs_int_mllib_fnmatch (value patternv, value strv, value flagsv)
{
CAMLparam3 (patternv, strv, flagsv);
int f = 0, r;
/* Convert flags to bitmask. */
while (flagsv != Val_int (0)) {
f |= flags[Int_val (Field (flagsv, 0))];
flagsv = Field (flagsv, 1);
}
r = fnmatch (String_val (patternv), String_val (strv), f);
if (r == 0)
CAMLreturn (Val_true);
else if (r == FNM_NOMATCH)
CAMLreturn (Val_false);
else {
/* XXX The fnmatch specification doesn't mention what errors can
* be returned by fnmatch. Assume they are errnos for now.
*/
unix_error (errno, (char *) "fnmatch", patternv);
}
}

29
mllib/fnmatch.ml
View File

@@ -1,29 +0,0 @@
(* Binding for fnmatch.
* Copyright (C) 2009-2017 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
*)
(* NB: These flags must appear in the same order as fnmatch-c.c *)
type flag =
| FNM_NOESCAPE
| FNM_PATHNAME
| FNM_PERIOD
| FNM_FILE_NAME
| FNM_LEADING_DIR
| FNM_CASEFOLD
external fnmatch : string -> string -> flag list -> bool =
"guestfs_int_mllib_fnmatch"

37
mllib/fnmatch.mli
View File

@@ -1,37 +0,0 @@
(* Binding for fnmatch.
* Copyright (C) 2009-2017 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
*)
(** Binding for the fnmatch(3) function in glibc or gnulib. *)
type flag =
| FNM_NOESCAPE
| FNM_PATHNAME
| FNM_PERIOD
| FNM_FILE_NAME
| FNM_LEADING_DIR
| FNM_CASEFOLD
(** Flags passed to the fnmatch function. *)
val fnmatch : string -> string -> flag list -> bool
(** The [fnmatch pattern filename flags] function checks whether
the [filename] argument matches the wildcard in the [pattern]
argument. The [flags] is a list of flags. Consult the
fnmatch(3) man page for details of the flags.
The [filename] might be a filename element or a full path
(depending on the pattern and flags). *)

84
mllib/fsync-c.c
View File

@@ -1,84 +0,0 @@
/* libguestfs OCaml tools common code
* Copyright (C) 2013-2017 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.
*/
#include <config.h>
#include <stdio.h>
#include <stdlib.h>
#include <fcntl.h>
#include <unistd.h>
#include <errno.h>
#include <caml/alloc.h>
#include <caml/fail.h>
#include <caml/memory.h>
#include <caml/mlvalues.h>
#ifdef HAVE_CAML_UNIXSUPPORT_H
#include <caml/unixsupport.h>
#else
#define Nothing ((value) 0)
extern void unix_error (int errcode, char * cmdname, value arg) Noreturn;
#endif
/* OCaml doesn't bind any *sync* calls. */
extern value guestfs_int_mllib_sync (value unitv);
extern value guestfs_int_mllib_fsync_file (value filenamev);
/* NB: This is a "noalloc" call. */
value
guestfs_int_mllib_sync (value unitv)
{
sync ();
return Val_unit;
}
/* Flush all writes associated with the named file to the disk.
*
* Note the wording in the SUS definition:
*
* "The fsync() function forces all currently queued I/O operations
* associated with the file indicated by file descriptor fildes to the
* synchronised I/O completion state."
*
* http://pubs.opengroup.org/onlinepubs/007908775/xsh/fsync.html
*/
value
guestfs_int_mllib_fsync_file (value filenamev)
{
CAMLparam1 (filenamev);
const char *filename = String_val (filenamev);
int fd, err;
/* Note to do fsync you have to open for write. */
fd = open (filename, O_RDWR);
if (fd == -1)
unix_error (errno, (char *) "open", filenamev);
if (fsync (fd) == -1) {
err = errno;
close (fd);
unix_error (err, (char *) "fsync", filenamev);
}
if (close (fd) == -1)
unix_error (errno, (char *) "close", filenamev);
CAMLreturn (Val_unit);
}

20
mllib/fsync.ml
View File

@@ -1,20 +0,0 @@
(* libguestfs OCaml tools common code
* Copyright (C) 2013-2017 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.
*)
external sync : unit -> unit = "guestfs_int_mllib_sync" "noalloc"
external file : string -> unit = "guestfs_int_mllib_fsync_file"

25
mllib/fsync.mli
View File

@@ -1,25 +0,0 @@
(* virt-resize
* Copyright (C) 2013 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.
*)
(** Bindings for sync, fsync. *)
val sync : unit -> unit
(** sync(2) syscall. *)
val file : string -> unit
(** fsync a single file by name. *)

58
mllib/mkdtemp-c.c
View File

@@ -1,58 +0,0 @@
/* libguestfs OCaml tools common code
* Copyright (C) 2014-2017 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.
*/
#include <config.h>
#include <stdlib.h>
#include <errno.h>
#include <string.h>
#include <caml/alloc.h>
#include <caml/fail.h>
#include <caml/memory.h>
#include <caml/mlvalues.h>
#ifdef HAVE_CAML_UNIXSUPPORT_H
#include <caml/unixsupport.h>
#else
#define Nothing ((value) 0)
extern void unix_error (int errcode, char * cmdname, value arg) Noreturn;
#endif
#pragma GCC diagnostic ignored "-Wmissing-prototypes"
value
guestfs_int_mllib_mkdtemp (value val_pattern)
{
CAMLparam1 (val_pattern);
CAMLlocal1 (rv);
char *pattern, *ret;
pattern = strdup (String_val (val_pattern));
if (pattern == NULL)
unix_error (errno, (char *) "strdup", val_pattern);
ret = mkdtemp (pattern);
if (ret == NULL)
unix_error (errno, (char *) "mkdtemp", val_pattern);
rv = caml_copy_string (ret);
free (pattern);
CAMLreturn (rv);
}

24
mllib/mkdtemp.ml
View File

@@ -1,24 +0,0 @@
(* libguestfs OCaml tools common code
* Copyright (C) 2014-2017 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 Common_utils
external mkdtemp : string -> string = "guestfs_int_mllib_mkdtemp"
let temp_dir ?(base_dir = Filename.temp_dir_name) prefix suffix =
mkdtemp (base_dir // (prefix ^ "XXXXXX" ^ suffix))

29
mllib/mkdtemp.mli
View File

@@ -1,29 +0,0 @@
(* virt-builder
* Copyright (C) 2014 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.
*)
(** Functions to create temporary directories. *)
val mkdtemp : string -> string
(** [mkdtemp pattern] Tiny wrapper to the C [mkdtemp]. *)
val temp_dir : ?base_dir:string -> string -> string -> string
(** [temp_dir prefix suffix] creates a new unique temporary directory.
The optional [~base_dir:string] changes the base directory where
to create the new temporary directory; if not specified, the default
[Filename.temp_dir_name] is used. *)

50
mllib/statvfs-c.c
View File

@@ -1,50 +0,0 @@
/* virt tools interface to statvfs
* Copyright (C) 2013-2017 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.
*/
#include <config.h>
#include <stdio.h>
#include <stdlib.h>
#include <sys/statvfs.h>
#include <stdint.h>
#include <caml/alloc.h>
#include <caml/fail.h>
#include <caml/memory.h>
#include <caml/mlvalues.h>
extern value guestfs_int_mllib_statvfs_free_space (value pathv);
value
guestfs_int_mllib_statvfs_free_space (value pathv)
{
CAMLparam1 (pathv);
CAMLlocal1 (rv);
struct statvfs buf;
int64_t free_space;
if (statvfs (String_val (pathv), &buf) == -1) {
perror ("statvfs");
caml_failwith ("statvfs");
}
free_space = (int64_t) buf.f_bsize * buf.f_bavail;
rv = caml_copy_int64 (free_space);
CAMLreturn (rv);
}

200
mllib/unix_utils-c.c Normal file
View File

@@ -0,0 +1,200 @@
/* libguestfs OCaml tools common code
* Copyright (C) 2009-2017 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.
*/
#include <config.h>
#include <stdio.h>
#include <stdlib.h>
#include <stdint.h>
#include <string.h>
#include <unistd.h>
#include <fcntl.h>
#include <fnmatch.h>
#include <errno.h>
#include <sys/types.h>
#include <sys/sysmacros.h>
#include <sys/statvfs.h>
#include <caml/alloc.h>
#include <caml/fail.h>
#include <caml/memory.h>
#include <caml/mlvalues.h>
#ifdef HAVE_CAML_UNIXSUPPORT_H
#include <caml/unixsupport.h>
#else
#define Nothing ((value) 0)
extern void unix_error (int errcode, char * cmdname, value arg) Noreturn;
#endif
extern value guestfs_int_mllib_dev_t_makedev (value majv, value minv);
extern value guestfs_int_mllib_dev_t_major (value devv);
extern value guestfs_int_mllib_dev_t_minor (value devv);
extern int guestfs_int_mllib_exit (value rv) __attribute__((noreturn));
extern value guestfs_int_mllib_fnmatch (value patternv, value strv, value flagsv);
extern value guestfs_int_mllib_sync (value unitv);
extern value guestfs_int_mllib_fsync_file (value filenamev);
extern value guestfs_int_mllib_mkdtemp (value val_pattern);
extern value guestfs_int_mllib_statvfs_free_space (value pathv);
/* NB: This is a "noalloc" call. */
value
guestfs_int_mllib_dev_t_makedev (value majv, value minv)
{
return Val_int (makedev (Int_val (majv), Int_val (minv)));
}
/* NB: This is a "noalloc" call. */
value
guestfs_int_mllib_dev_t_major (value devv)
{
return Val_int (major (Int_val (devv)));
}
/* NB: This is a "noalloc" call. */
value
guestfs_int_mllib_dev_t_minor (value devv)
{
return Val_int (minor (Int_val (devv)));
}
/* NB: This is a "noalloc" call. */
int
guestfs_int_mllib_exit (value rv)
{
_exit (Int_val (rv));
}
/* NB: These flags must appear in the same order as unix_utils.ml */
static int flags[] = {
FNM_NOESCAPE,
FNM_PATHNAME,
FNM_PERIOD,
FNM_FILE_NAME,
FNM_LEADING_DIR,
FNM_CASEFOLD,
};
value
guestfs_int_mllib_fnmatch (value patternv, value strv, value flagsv)
{
CAMLparam3 (patternv, strv, flagsv);
int f = 0, r;
/* Convert flags to bitmask. */
while (flagsv != Val_int (0)) {
f |= flags[Int_val (Field (flagsv, 0))];
flagsv = Field (flagsv, 1);
}
r = fnmatch (String_val (patternv), String_val (strv), f);
if (r == 0)
CAMLreturn (Val_true);
else if (r == FNM_NOMATCH)
CAMLreturn (Val_false);
else {
/* XXX The fnmatch specification doesn't mention what errors can
* be returned by fnmatch. Assume they are errnos for now.
*/
unix_error (errno, (char *) "fnmatch", patternv);
}
}
/* NB: This is a "noalloc" call. */
value
guestfs_int_mllib_sync (value unitv)
{
sync ();
return Val_unit;
}
/* Flush all writes associated with the named file to the disk.
*
* Note the wording in the SUS definition:
*
* "The fsync() function forces all currently queued I/O operations
* associated with the file indicated by file descriptor fildes to the
* synchronised I/O completion state."
*
* http://pubs.opengroup.org/onlinepubs/007908775/xsh/fsync.html
*/
value
guestfs_int_mllib_fsync_file (value filenamev)
{
CAMLparam1 (filenamev);
const char *filename = String_val (filenamev);
int fd, err;
/* Note to do fsync you have to open for write. */
fd = open (filename, O_RDWR);
if (fd == -1)
unix_error (errno, (char *) "open", filenamev);
if (fsync (fd) == -1) {
err = errno;
close (fd);
unix_error (err, (char *) "fsync", filenamev);
}
if (close (fd) == -1)
unix_error (errno, (char *) "close", filenamev);
CAMLreturn (Val_unit);
}
value
guestfs_int_mllib_mkdtemp (value val_pattern)
{
CAMLparam1 (val_pattern);
CAMLlocal1 (rv);
char *pattern, *ret;
pattern = strdup (String_val (val_pattern));
if (pattern == NULL)
unix_error (errno, (char *) "strdup", val_pattern);
ret = mkdtemp (pattern);
if (ret == NULL)
unix_error (errno, (char *) "mkdtemp", val_pattern);
rv = caml_copy_string (ret);
free (pattern);
CAMLreturn (rv);
}
value
guestfs_int_mllib_statvfs_free_space (value pathv)
{
CAMLparam1 (pathv);
CAMLlocal1 (rv);
struct statvfs buf;
int64_t free_space;
if (statvfs (String_val (pathv), &buf) == -1) {
perror ("statvfs");
caml_failwith ("statvfs");
}
free_space = (int64_t) buf.f_bsize * buf.f_bavail;
rv = caml_copy_int64 (free_space);
CAMLreturn (rv);
}

58
mllib/unix_utils.ml Normal file
View File

@@ -0,0 +1,58 @@
(* mllib
* Copyright (C) 2009-2017 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.
*)
module Dev_t = struct
external makedev : int -> int -> int = "guestfs_int_mllib_dev_t_makedev" "noalloc"
external major : int -> int = "guestfs_int_mllib_dev_t_major" "noalloc"
external minor : int -> int = "guestfs_int_mllib_dev_t_minor" "noalloc"
end
module Exit = struct
external _exit : int -> 'a = "guestfs_int_mllib_exit" "noalloc"
end
module Fnmatch = struct
(* NB: These flags must appear in the same order as unix_utils-c.c *)
type flag =
| FNM_NOESCAPE
| FNM_PATHNAME
| FNM_PERIOD
| FNM_FILE_NAME
| FNM_LEADING_DIR
| FNM_CASEFOLD
external fnmatch : string -> string -> flag list -> bool =
"guestfs_int_mllib_fnmatch"
end
module Fsync = struct
external sync : unit -> unit = "guestfs_int_mllib_sync" "noalloc"
external file : string -> unit = "guestfs_int_mllib_fsync_file"
end
module Mkdtemp = struct
external mkdtemp : string -> string = "guestfs_int_mllib_mkdtemp"
let temp_dir ?(base_dir = Filename.temp_dir_name) prefix suffix =
mkdtemp (Filename.concat base_dir (prefix ^ "XXXXXX" ^ suffix))
end
module StatVFS = struct
external free_space : string -> int64 =
"guestfs_int_mllib_statvfs_free_space"
end

90
mllib/unix_utils.mli Normal file
View File

@@ -0,0 +1,90 @@
(* mllib
* Copyright (C) 2009-2017 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.
*)
(** Binding for various Unix/POSIX library functions which are not
provided by the OCaml stdlib. *)
module Dev_t : sig
(** Bindings for [dev_t] related functions [makedev], [major] and [minor]. *)
val makedev : int -> int -> int
(** makedev(3) *)
val major : int -> int
(** major(3) *)
val minor : int -> int
(** minor(3) *)
end
module Exit : sig
val _exit : int -> 'a
(** Call _exit directly, ie. do not run OCaml atexit handlers. *)
end
module Fnmatch : sig
(** Binding for the fnmatch(3) function in glibc or gnulib. *)
type flag =
| FNM_NOESCAPE
| FNM_PATHNAME
| FNM_PERIOD
| FNM_FILE_NAME
| FNM_LEADING_DIR
| FNM_CASEFOLD
(** Flags passed to the fnmatch function. *)
val fnmatch : string -> string -> flag list -> bool
(** The [fnmatch pattern filename flags] function checks whether
the [filename] argument matches the wildcard in the [pattern]
argument. The [flags] is a list of flags. Consult the
fnmatch(3) man page for details of the flags.
The [filename] might be a filename element or a full path
(depending on the pattern and flags). *)
end
module Fsync : sig
(** Bindings for sync, fsync. *)
val sync : unit -> unit
(** sync(2) syscall. *)
val file : string -> unit
(** fsync a single file by name. *)
end
module Mkdtemp : sig
(** Functions to create temporary directories. *)
val mkdtemp : string -> string
(** [mkdtemp pattern] Tiny wrapper to the C [mkdtemp]. *)
val temp_dir : ?base_dir:string -> string -> string -> string
(** [temp_dir prefix suffix] creates a new unique temporary directory.
The optional [~base_dir:string] changes the base directory where
to create the new temporary directory; if not specified, the default
[Filename.temp_dir_name] is used. *)
end
module StatVFS : sig
val free_space : string -> int64
(** [free_space path] returns the free space available on the
filesystem that contains [path], in bytes. *)
end

1
resize/resize.ml
View File

@@ -20,6 +20,7 @@ open Printf
open Common_utils
open Common_gettext.Gettext
open Unix_utils
open Getopt.OptionName
module G = Guestfs

1
sparsify/copying.ml
View File

@@ -25,6 +25,7 @@ open Printf
open Common_utils
open Common_gettext.Gettext
open Unix_utils
open Utils
open Cmdline

2
sysprep/sysprep_operation_backup_files.ml
View File

@@ -21,7 +21,7 @@ open Printf
open Common_gettext.Gettext
open Common_utils
open Visit
open Fnmatch
open Unix_utils.Fnmatch
open Sysprep_operation
open Utils

1
sysprep/sysprep_operation_script.ml
View File

@@ -21,6 +21,7 @@ open Unix
open Common_gettext.Gettext
open Common_utils
open Unix_utils
open Getopt.OptionName
open Sysprep_operation

1
v2v/changeuid.ml
View File

@@ -23,6 +23,7 @@ open Printf
open Common_utils
open Common_gettext.Gettext
open Unix_utils
open Utils

1
v2v/input_ova.ml
View File

@@ -20,6 +20,7 @@ open Printf
open Common_gettext.Gettext
open Common_utils
open Unix_utils
open Types
open Utils

1
v2v/output_glance.ml
View File

@@ -20,6 +20,7 @@ open Printf
open Common_gettext.Gettext
open Common_utils
open Unix_utils
open Types
open Utils

1
v2v/output_null.ml
View File

@@ -20,6 +20,7 @@ open Printf
open Common_gettext.Gettext
open Common_utils
open Unix_utils
open Types
open Utils

1
v2v/output_rhv.ml
View File

@@ -18,6 +18,7 @@
open Common_gettext.Gettext
open Common_utils
open Unix_utils
open Unix
open Printf

7
v2v/v2v.ml
View File

@@ -20,15 +20,16 @@ open Unix
open Printf
open Common_gettext.Gettext
module G = Guestfs
open Common_utils
open Unix_utils
open Types
open Utils
open Cmdline
module G = Guestfs
type conversion_mode =
| Copying of overlay list * target list
| In_place