#!/usr/bin/perl -w
# virt-edit
# Copyright (C) 2009-2010 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., 675 Mass Ave, Cambridge, MA 02139, USA.

use warnings;
use strict;

use Sys::Guestfs;
use Sys::Guestfs::Lib qw(open_guest get_partitions resolve_windows_path
  inspect_all_partitions inspect_partition
  inspect_operating_systems mount_operating_system);
use Pod::Usage;
use Getopt::Long;
use File::Temp qw/tempfile/;
use Locale::TextDomain 'libguestfs';

=encoding utf8

=head1 NAME

virt-edit - Edit a file in a virtual machine

=head1 SYNOPSIS

 virt-edit [--options] domname file

 virt-edit [--options] disk.img [disk.img ...] file

 virt-edit [domname|disk.img] file -e 'expr'

=head1 WARNING

You must I<not> use C<virt-edit> on live virtual machines.  If you do
this, you risk disk corruption in the VM.  C<virt-edit> tries to stop
you from doing this, but doesn't catch all cases.

=head1 DESCRIPTION

C<virt-edit> is a command line tool to edit C<file> where C<file>
exists in the named virtual machine (or disk image).

If you want to just view a file, use L<virt-cat(1)>.  For more complex
cases you should look at the L<guestfish(1)> tool.

=head1 EXAMPLES

Edit the named files interactively:

 virt-edit mydomain /boot/grub/grub.conf

 virt-edit mydomain /etc/passwd

You can also edit files non-interactively (see
L</NON-INTERACTIVE EDITING> below).
To change the init default level to 5:

 virt-edit mydomain /etc/inittab -e 's/^id:.*/id:5:initdefault:/'

=head1 OPTIONS

=over 4

=cut

my $help;

=item B<--help>

Display brief help.

=cut

my $version;

=item B<--version>

Display version number and exit.

=cut

my $backup;

=item B<--backup extension> | B<-b extension>

Create a backup of the original file I<in the guest disk image>.
The backup has the original filename with C<extension> added.

Usually the first character of C<extension> would be a dot C<.>
so you would write:

 virt-edit -b .orig [etc]

By default, no backup file is made.

=cut

my $uri;

=item B<--connect URI> | B<-c URI>

If using libvirt, connect to the given I<URI>.  If omitted, then we
connect to the default libvirt hypervisor.

If you specify guest block devices directly, then libvirt is not used
at all.

=cut

my $expr;

=item B<--expr EXPR> | B<-e EXPR>

Instead of launching the external editor, non-interactively
apply the Perl expression C<EXPR> to each line in the file.
See L</NON-INTERACTIVE EDITING> below.

Be careful to properly quote the expression to prevent it from
being altered by the shell.

=back

=cut

GetOptions ("help|?" => \$help,
            "version" => \$version,
            "connect|c=s" => \$uri,
            "expr|e=s" => \$expr,
            "backup|b=s" => \$backup,
    ) or pod2usage (2);
pod2usage (1) if $help;
if ($version) {
    my $g = Sys::Guestfs->new ();
    my %h = $g->version ();
    print "$h{major}.$h{minor}.$h{release}$h{extra}\n";
    exit
}

pod2usage (__"virt-edit: no image, VM names or filenames to edit given")
    if @ARGV <= 1;

my $filename = pop @ARGV;

my $g;
if ($uri) {
    $g = open_guest (\@ARGV, address => $uri, rw => 1);
} else {
    $g = open_guest (\@ARGV, rw => 1);
}

$g->launch ();

# List of possible filesystems.
my @partitions = get_partitions ($g);

# Now query each one to build up a picture of what's in it.
my %fses =
    inspect_all_partitions ($g, \@partitions,
      use_windows_registry => 0);

my $oses = inspect_operating_systems ($g, \%fses);

my @roots = keys %$oses;
die __"multiboot operating systems are not supported by virt-edit" if @roots > 1;
my $root_dev = $roots[0];

my $os = $oses->{$root_dev};
mount_operating_system ($g, $os, 0);

my ($fh_not_used, $tempname) = tempfile (UNLINK => 1);

# Allow this to fail in case eg. the file does not exist.
$g->download($filename, $tempname);

my $do_upload = $tempname;

if (!defined $expr) {
    # Interactively edit the file.
    my $oldctime = (stat ($tempname))[10];

    my $editor = $ENV{EDITOR};
    $editor ||= "vi";
    system ("$editor $tempname") == 0
        or die "edit failed: $editor: $?";

    my $newctime = (stat ($tempname))[10];

    if ($oldctime == $newctime) {
        $do_upload = undef;
        print __"File not changed.\n";
    }
} else {
    my ($fh, $tempout) = tempfile (UNLINK => 1);

    # Apply a Perl expression to the lines of the file.
    open IFILE, $tempname or die "$tempname: $!";
    my $lineno = 0;
    while (<IFILE>) {
        $lineno++;
        eval $expr;
        die if $@;
        print $fh $_ or die "print: $!";
    }
    close $fh;

    $do_upload = $tempout;
}

if (defined $do_upload) {
    # Upload to a new file, so if it fails we don't end up with
    # a partially written file.  Give the new file a completely
    # random name so we have only a tiny chance of overwriting
    # some existing file.
    my $dirname = $filename;
    $dirname =~ s{/[^/]+$}{/};

    my @chars = ('a'..'z', 'A'..'Z', '0'..'9');
    my $newname = $dirname;
    foreach (0..7) {
        $newname .= $chars[rand @chars];
    }

    $g->upload ($do_upload, $newname);

    # Backup or overwrite?
    $g->mv ($filename, "$filename$backup") if defined $backup;
    $g->mv ($newname, $filename);

    $g->umount_all ();
    $g->sync ();
}

undef $g;

exit 0;

=head1 NON-INTERACTIVE EDITING

C<virt-edit> normally calls out to C<$EDITOR> (or vi) so
the system administrator can interactively edit the file.

There are two ways also to use C<virt-edit> from scripts in order to
make automated edits to files.  (Note that although you I<can> use
C<virt-edit> like this, it's less error-prone to write scripts
directly using the libguestfs API and Augeas for configuration file
editing.)

The first method is to temporarily set C<$EDITOR> to any script or
program you want to run.  The script is invoked as C<$EDITOR tmpfile>
and it should update C<tmpfile> in place however it likes.

The second method is to use the C<-e> parameter of C<virt-edit> to run
a short Perl snippet in the style of L<sed(1)>.  For example to
replace all instances of C<foo> with C<bar> in a file:

 virt-edit domname filename -e 's/foo/bar/'

The full power of Perl regular expressions can be used (see
L<perlre(1)>).  For example to delete root's password you could do:

 virt-edit domname /etc/passwd -e 's/^root:.*?:/root::/'

What really happens is that the snippet is evaluated as a Perl
expression for each line of the file.  The line, including the final
C<\n>, is passed in C<$_> and the expression should update C<$_> or
leave it unchanged.

To delete a line, set C<$_> to the empty string.  For example, to
delete the C<apache> user account from the password file you can do:

 virt-edit mydomain /etc/passwd -e '$_ = "" if /^apache:/'

To insert a line, prepend or append it to C<$_>.  However appending
lines to the end of the file is rather difficult this way since there
is no concept of "last line of the file" - your expression just
doesn't get called again.  You might want to use the first method
(setting C<$EDITOR>) if you want to do this.

The variable C<$lineno> contains the current line number.
As is traditional, the first line in the file is number C<1>.

The return value from the expression is ignored, but the expression
may call C<die> in order to abort the whole program, leaving the
original file untouched.

Remember when matching the end of a line that C<$_> may contain the
final C<\n>, or (for DOS files) C<\r\n>, or if the file does not end
with a newline then neither of these.  Thus to match or substitute
some text at the end of a line, use this regular expression:

 /some text(\r?\n)?$/

Alternately, use the perl C<chomp> function, being careful not to
chomp C<$_> itself (since that would remove all newlines from the
file):

 my $m = $_; chomp $m; $m =~ /some text$/

=head1 ENVIRONMENT VARIABLES

=over 4

=item C<EDITOR>

If set, this string is used as the editor.  It may contain arguments,
eg. C<"emacs -nw">

If not set, C<vi> is used.

=back

=head1 SEE ALSO

L<guestfs(3)>,
L<guestfish(1)>,
L<virt-cat(1)>,
L<Sys::Guestfs(3)>,
L<Sys::Guestfs::Lib(3)>,
L<Sys::Virt(3)>,
L<http://libguestfs.org/>,
L<perl(1)>,
L<perlre(1)>.

=head1 AUTHOR

Richard W.M. Jones L<http://people.redhat.com/~rjones/>

=head1 COPYRIGHT

Copyright (C) 2009-2010 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., 675 Mass Ave, Cambridge, MA 02139, USA.