[Libguestfs] [PATCH v2 3/3] daemon: Restore PCRE regular expressions in OCaml code.
Richard W.M. Jones
rjones at redhat.com
Tue Aug 1 15:54:46 UTC 2017
When parts of the daemon were previously converted to OCaml, the
previous PCRE regexps were converted to Str regexps. Restore the
original PCRE regexps.
There was also one case where an original call to glob(3) was replaced
by a Str regexp, and this is replaced by a PCRE regexp (although it is
in fact identical in this instance).
This updates commit b48da89dd6edce325f4c1f2956435c4d383ebe77
and commit eeda6edca19ea02ffea7f433501dd063e04cd819
and commit 2ca0fa778de5e748f4545eddf9798e7a723fe07e.
---
daemon/Makefile.am | 14 ++++++++++----
daemon/btrfs.ml | 14 +++++++-------
daemon/daemon-c.c | 6 ++++++
daemon/filearch.ml | 14 +++++++-------
daemon/md.ml | 4 ++--
5 files changed, 32 insertions(+), 20 deletions(-)
diff --git a/daemon/Makefile.am b/daemon/Makefile.am
index 1f7cb2277..fc1389f67 100644
--- a/daemon/Makefile.am
+++ b/daemon/Makefile.am
@@ -187,7 +187,8 @@ guestfsd_LDFLAGS = \
-L$(shell $(OCAMLC) -where) \
-L$(shell $(OCAMLC) -where)/hivex \
-L../common/mlutils \
- -L../common/mlstdutils
+ -L../common/mlstdutils \
+ -L../common/mlpcre
guestfsd_LDADD = \
../common/errnostring/liberrnostring.la \
../common/protocol/libprotocol.la \
@@ -293,7 +294,9 @@ OCAMLPACKAGES = \
-package str,unix,hivex \
-I $(top_srcdir)/common/mlstdutils \
-I $(top_srcdir)/common/mlutils \
- -I $(top_builddir)/common/utils/.libs
+ -I $(top_builddir)/common/utils/.libs \
+ -I $(top_srcdir)/common/mlpcre \
+ -I $(top_builddir)/common/mlpcre/.libs
OCAMLFLAGS = $(OCAML_FLAGS) $(OCAML_WARN_FLAGS)
@@ -305,6 +308,7 @@ OBJECTS = $(XOBJECTS)
CAMLRUN = asmrun
endif
OCAML_LIBS = \
+ -lmlpcre \
-lmlcutils \
-lmlstdutils \
-lmlhivex \
@@ -317,7 +321,8 @@ CLEANFILES += camldaemon.o
camldaemon.o: $(OBJECTS)
$(OCAMLFIND) $(BEST) -output-obj -o $@ \
$(OCAMLFLAGS) $(OCAMLPACKAGES) \
- -linkpkg mlcutils.$(MLARCHIVE) mlstdutils.$(MLARCHIVE) \
+ -linkpkg \
+ mlpcre.$(MLARCHIVE) mlcutils.$(MLARCHIVE) mlstdutils.$(MLARCHIVE) \
$(OBJECTS)
# OCaml dependencies.
@@ -325,7 +330,7 @@ depend: .depend
.depend: $(wildcard $(abs_srcdir)/*.mli) $(wildcard $(abs_srcdir)/*.ml)
rm -f $@ $@-t
- $(OCAMLFIND) ocamldep -I $(abs_srcdir) -I $(abs_top_builddir)/common/mlstdutils -I $(abs_top_builddir)/common/mlutils $^ | \
+ $(OCAMLFIND) ocamldep -I $(abs_srcdir) -I $(abs_top_builddir)/common/mlstdutils -I $(abs_top_builddir)/common/mlutils -I $(abs_top_builddir)/common/mlpcre $^ | \
$(SED) 's/ *$$//' | \
$(SED) -e :a -e '/ *\\$$/N; s/ *\\\n */ /; ta' | \
$(SED) -e 's,$(abs_srcdir)/,$(builddir)/,g' | \
@@ -362,6 +367,7 @@ daemon_utils_tests_THEOBJECTS = $(daemon_utils_tests_XOBJECTS)
endif
OCAMLLINKFLAGS = \
+ mlpcre.$(MLARCHIVE) \
mlcutils.$(MLARCHIVE) \
mlstdutils.$(MLARCHIVE) \
$(LINK_CUSTOM_OCAMLC_ONLY)
diff --git a/daemon/btrfs.ml b/daemon/btrfs.ml
index fc02abefa..c51689744 100644
--- a/daemon/btrfs.ml
+++ b/daemon/btrfs.ml
@@ -71,9 +71,9 @@ let rec with_mounted mountable f =
_with_mounted cmd f
let re_btrfs_subvolume_list =
- Str.regexp ("ID[ \t]+\\([0-9]+\\).*[ \t]" ^
- "top level[ \t]+\\([0-9]+\\).*[ \t]" ^
- "path[ \t]+\\(.*\\)")
+ PCRE.compile ("ID\\s+(\\d+).*\\s" ^
+ "top level\\s+(\\d+).*\\s" ^
+ "path\\s(.*)")
let btrfs_subvolume_list mountable =
(* Execute 'btrfs subvolume list <fs>', and split the output into lines *)
@@ -103,10 +103,10 @@ let btrfs_subvolume_list mountable =
*)
List.map (
fun line ->
- if Str.string_match re_btrfs_subvolume_list line 0 then (
- let id = Int64.of_string (Str.matched_group 1 line)
- and top_level_id = Int64.of_string (Str.matched_group 2 line)
- and path = Str.matched_group 3 line in
+ if PCRE.matches re_btrfs_subvolume_list line then (
+ let id = Int64.of_string (PCRE.sub 1)
+ and top_level_id = Int64.of_string (PCRE.sub 2)
+ and path = PCRE.sub 3 in
{
btrfssubvolume_id = id;
diff --git a/daemon/daemon-c.c b/daemon/daemon-c.c
index cbb3d8918..3ecaed4ca 100644
--- a/daemon/daemon-c.c
+++ b/daemon/daemon-c.c
@@ -65,6 +65,12 @@ guestfs_int_daemon_exn_to_reply_with_error (const char *func, value exn)
reply_with_error ("%s", String_val (Field (exn, 1)));
else if (STREQ (exn_name, "Invalid_argument"))
reply_with_error ("invalid argument: %s", String_val (Field (exn, 1)));
+ else if (STREQ (exn_name, "PCRE.Error")) {
+ value pair = Field (exn, 1);
+ reply_with_error ("PCRE error: %s (PCRE error code: %d)",
+ String_val (Field (pair, 0)),
+ Int_val (Field (pair, 1)));
+ }
else
reply_with_error ("internal error: %s: unhandled exception thrown: %s",
func, exn_name);
diff --git a/daemon/filearch.ml b/daemon/filearch.ml
index 505d8c78e..15ac4eeaa 100644
--- a/daemon/filearch.ml
+++ b/daemon/filearch.ml
@@ -25,9 +25,9 @@ open Unix_utils
open Utils
let re_file_elf =
- Str.regexp ".*ELF \\([0-9]+\\)-bit \\(MSB\\|LSB\\).*\\(executable\\|shared object\\|relocatable\\), \\([^,]+\\),"
+ PCRE.compile "ELF (\\d+)-bit (MSB|LSB).*(?:executable|shared object|relocatable), (.+?),"
-let re_file_elf_ppc64 = Str.regexp ".*64.*PowerPC"
+let re_file_elf_ppc64 = PCRE.compile ".*64.*PowerPC"
let initrd_binaries = [
"bin/ls";
@@ -48,10 +48,10 @@ let rec file_architecture orig_path =
file_architecture_of_magic magic orig_path orig_path
and file_architecture_of_magic magic orig_path path =
- if Str.string_match re_file_elf magic 0 then (
- let bits = Str.matched_group 1 magic in
- let endianness = Str.matched_group 2 magic in
- let elf_arch = Str.matched_group 4 magic in
+ if PCRE.matches re_file_elf magic then (
+ let bits = PCRE.sub 1 in
+ let endianness = PCRE.sub 2 in
+ let elf_arch = PCRE.sub 3 in
canonical_elf_arch bits endianness elf_arch
)
else if String.find magic "PE32 executable" >= 0 then
@@ -78,7 +78,7 @@ and canonical_elf_arch bits endianness elf_arch =
"sparc64"
else if substr "IA-64" then
"ia64"
- else if Str.string_match re_file_elf_ppc64 elf_arch 0 then (
+ else if PCRE.matches re_file_elf_ppc64 elf_arch then (
match endianness with
| "MSB" -> "ppc64"
| "LSB" -> "ppc64le"
diff --git a/daemon/md.ml b/daemon/md.ml
index 1fd00ebb8..5a40a2d83 100644
--- a/daemon/md.ml
+++ b/daemon/md.ml
@@ -25,7 +25,7 @@ open Utils
external is_raid_device : string -> bool =
"guestfs_int_daemon_is_raid_device" "noalloc"
-let re_md = Str.regexp "^md[0-9]+$"
+let re_md = PCRE.compile "^md[0-9]+$"
let list_md_devices () =
(* Look for directories under /sys/block matching md[0-9]+
@@ -33,7 +33,7 @@ let list_md_devices () =
*)
let devs = Sys.readdir "/sys/block" in
let devs = Array.to_list devs in
- let devs = List.filter (fun d -> Str.string_match re_md d 0) devs in
+ let devs = List.filter (fun d -> PCRE.matches re_md d) devs in
let devs = List.filter (
fun d -> is_directory (sprintf "/sys/block/%s/md" d)
) devs in
--
2.13.2
More information about the Libguestfs
mailing list