mirror of
https://github.com/libguestfs/libguestfs.git
synced 2026-03-22 07:03:38 +00:00
customize: use the common perl file editing code
Wrap edit_file_perl to OCaml, and use it instead of the OCaml version of it.
This commit is contained in:
@@ -101,6 +101,7 @@ deps = \
|
||||
$(top_builddir)/customize/hostname.cmx \
|
||||
$(top_builddir)/customize/timezone.cmx \
|
||||
$(top_builddir)/customize/firstboot.cmx \
|
||||
$(top_builddir)/customize/perl_edit-c.o \
|
||||
$(top_builddir)/customize/perl_edit.cmx \
|
||||
$(top_builddir)/customize/crypt-c.o \
|
||||
$(top_builddir)/customize/crypt.cmx \
|
||||
@@ -108,6 +109,7 @@ deps = \
|
||||
$(top_builddir)/customize/customize_cmdline.cmx \
|
||||
$(top_builddir)/customize/customize_run.cmx \
|
||||
$(top_builddir)/fish/guestfish-uri.o \
|
||||
$(top_builddir)/fish/guestfish-file-edit.o \
|
||||
index-scan.o \
|
||||
index-struct.o \
|
||||
index-parse.o \
|
||||
|
||||
@@ -49,6 +49,7 @@ SOURCES = \
|
||||
customize_main.ml \
|
||||
password.ml \
|
||||
password.mli \
|
||||
perl_edit-c.c \
|
||||
perl_edit.ml \
|
||||
perl_edit.mli \
|
||||
random_seed.ml \
|
||||
@@ -62,13 +63,15 @@ if HAVE_OCAML
|
||||
|
||||
deps = \
|
||||
$(top_builddir)/fish/guestfish-uri.o \
|
||||
$(top_builddir)/fish/guestfish-file-edit.o \
|
||||
$(top_builddir)/mllib/common_gettext.cmx \
|
||||
$(top_builddir)/mllib/common_utils.cmx \
|
||||
$(top_builddir)/mllib/config.cmx \
|
||||
$(top_builddir)/mllib/regedit.cmx \
|
||||
$(top_builddir)/mllib/uri-c.o \
|
||||
$(top_builddir)/mllib/uRI.cmx \
|
||||
crypt-c.o
|
||||
crypt-c.o \
|
||||
perl_edit-c.o
|
||||
|
||||
if HAVE_OCAMLOPT
|
||||
OBJECTS = $(deps)
|
||||
|
||||
55
customize/perl_edit-c.c
Normal file
55
customize/perl_edit-c.c
Normal file
@@ -0,0 +1,55 @@
|
||||
/* virt-customize - interface to edit_file_perl
|
||||
* 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.
|
||||
*/
|
||||
|
||||
#include <config.h>
|
||||
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <unistd.h>
|
||||
|
||||
#include <caml/alloc.h>
|
||||
#include <caml/memory.h>
|
||||
#include <caml/mlvalues.h>
|
||||
|
||||
#include "file-edit.h"
|
||||
|
||||
/**
|
||||
* We try to reuse the internals of the OCaml binding (for extracting
|
||||
* the guestfs handle, and raising errors); hopefully this should be safe,
|
||||
* as long as it's kept internal within the libguestfs sources.
|
||||
*/
|
||||
#include "../ocaml/guestfs-c.h"
|
||||
|
||||
#pragma GCC diagnostic ignored "-Wmissing-prototypes"
|
||||
|
||||
value
|
||||
virt_customize_edit_file_perl (value verbosev, value guestfsv, value filev,
|
||||
value exprv)
|
||||
{
|
||||
CAMLparam4 (verbosev, guestfsv, filev, exprv);
|
||||
int r;
|
||||
guestfs_h *g;
|
||||
|
||||
g = Guestfs_val (guestfsv);
|
||||
r = edit_file_perl (g, String_val (filev), String_val (exprv), NULL,
|
||||
Bool_val (verbosev));
|
||||
if (r == -1)
|
||||
ocaml_guestfs_raise_error (g, "edit_file_perl");
|
||||
|
||||
CAMLreturn (Val_unit);
|
||||
}
|
||||
@@ -16,63 +16,5 @@
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
||||
*)
|
||||
|
||||
open Common_gettext.Gettext
|
||||
open Common_utils
|
||||
|
||||
open Printf
|
||||
|
||||
(* Implement the --edit option.
|
||||
*
|
||||
* Code copied from virt-edit.
|
||||
*)
|
||||
let rec edit_file ~verbose (g : Guestfs.guestfs) file expr =
|
||||
let file_old = file ^ "~" in
|
||||
g#rename file file_old;
|
||||
|
||||
(* Download the file to a temporary. *)
|
||||
let tmpfile = Filename.temp_file "vbedit" "" in
|
||||
unlink_on_exit tmpfile;
|
||||
g#download file_old tmpfile;
|
||||
|
||||
do_perl_edit ~verbose g tmpfile expr;
|
||||
|
||||
(* Upload the file. Unlike virt-edit we can afford to fail here
|
||||
* so we don't need the temporary upload file.
|
||||
*)
|
||||
g#upload tmpfile file;
|
||||
|
||||
(* However like virt-edit we do need to copy attributes. *)
|
||||
g#copy_attributes ~all:true file_old file;
|
||||
g#rm file_old
|
||||
|
||||
and do_perl_edit ~verbose g file expr =
|
||||
(* Pass the expression to Perl via the environment. This sidesteps
|
||||
* any quoting problems with the already complex Perl command line.
|
||||
*)
|
||||
Unix.putenv "virt_edit_expr" expr;
|
||||
|
||||
(* Call out to a canned Perl script. *)
|
||||
let cmd = sprintf "\
|
||||
perl -e '
|
||||
$lineno = 0;
|
||||
$expr = $ENV{virt_edit_expr};
|
||||
while (<STDIN>) {
|
||||
$lineno++;
|
||||
eval $expr;
|
||||
die if $@;
|
||||
print STDOUT $_ or die \"print: $!\";
|
||||
}
|
||||
close STDOUT or die \"close: $!\";
|
||||
' < %s > %s.out" file file in
|
||||
|
||||
if verbose then
|
||||
eprintf "%s\n%!" cmd;
|
||||
|
||||
let r = Sys.command cmd in
|
||||
if r <> 0 then (
|
||||
eprintf (f_"virt-builder: error: could not evaluate Perl expression '%s'\n")
|
||||
expr;
|
||||
exit 1
|
||||
);
|
||||
|
||||
Unix.rename (file ^ ".out") file
|
||||
external edit_file : verbose:bool -> Guestfs.guestfs -> string -> string -> unit
|
||||
= "virt_customize_edit_file_perl"
|
||||
|
||||
@@ -13,6 +13,7 @@ cat/log.c
|
||||
cat/ls.c
|
||||
cat/visit.c
|
||||
customize/crypt-c.c
|
||||
customize/perl_edit-c.c
|
||||
daemon/9p.c
|
||||
daemon/acl.c
|
||||
daemon/augeas.c
|
||||
|
||||
@@ -97,10 +97,12 @@ deps = \
|
||||
$(top_builddir)/customize/hostname.cmx \
|
||||
$(top_builddir)/customize/timezone.cmx \
|
||||
$(top_builddir)/customize/firstboot.cmx \
|
||||
$(top_builddir)/customize/perl_edit-c.o \
|
||||
$(top_builddir)/customize/perl_edit.cmx \
|
||||
$(top_builddir)/customize/customize_cmdline.cmx \
|
||||
$(top_builddir)/customize/customize_run.cmx \
|
||||
$(top_builddir)/fish/guestfish-uri.o \
|
||||
$(top_builddir)/fish/guestfish-file-edit.o \
|
||||
sysprep_operation.cmx \
|
||||
$(patsubst %,sysprep_operation_%.cmx,$(operations)) \
|
||||
main.cmx
|
||||
|
||||
@@ -64,10 +64,12 @@ SOURCES_ML = \
|
||||
|
||||
SOURCES_C = \
|
||||
$(top_builddir)/fish/progress.c \
|
||||
$(top_builddir)/fish/file-edit.c \
|
||||
$(top_builddir)/mllib/tty-c.c \
|
||||
$(top_builddir)/mllib/progress-c.c \
|
||||
$(top_builddir)/mllib/mkdtemp-c.c \
|
||||
$(top_builddir)/customize/crypt-c.c \
|
||||
$(top_builddir)/customize/perl_edit-c.c \
|
||||
utils-c.c \
|
||||
xml-c.c \
|
||||
domainxml-c.c
|
||||
|
||||
Reference in New Issue
Block a user