#
# Chroot.pm: chroot library for sbuild
# Copyright © 2005      Ryan Murray <rmurray@debian.org>
# Copyright © 2005-2008 Roger Leigh <rleigh@debian.org>
# Copyright © 2008      Simon McVittie <smcv@debian.org>
#
# 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, see
# <http://www.gnu.org/licenses/>.
#
#######################################################################

package Sbuild::Chroot;

use Sbuild qw(copy debug debug2);
use Sbuild::Base;
use Sbuild::ChrootInfo;
use Sbuild::ChrootSetup qw(basesetup);
use Sbuild qw($devnull shellescape);

use strict;
use warnings;
use POSIX;
use FileHandle;
use File::Temp ();
use File::Basename qw(basename);

BEGIN {
    use Exporter ();
    our (@ISA, @EXPORT);

    @ISA = qw(Exporter Sbuild::Base);

    @EXPORT = qw();
}

sub new {
    my $class = shift;
    my $conf = shift;
    my $chroot_id = shift;

    my $self = $class->SUPER::new($conf);
    bless($self, $class);

    my @filter;
    @filter = @{$self->get_conf('ENVIRONMENT_FILTER')}
	if (defined($self->get_conf('ENVIRONMENT_FILTER')));

    $self->set('Session ID', "");
    $self->set('Chroot ID', $chroot_id) if defined $chroot_id;
    $self->set('Defaults', {
	'COMMAND' => [],
	'INTCOMMAND' => [], # Private
	'EXPCOMMAND' => [], # Private
	'ENV' => {},
	'ENV_FILTER' => \@filter,
	'USER' => 'root',
	'CHROOT' => 1,
	'PRIORITY' => 0,
	'DIR' => '/',
	'SETSID' => 0,
	'STREAMIN' => undef,
	'STREAMOUT' => undef,
	'STREAMERR' => undef});

    return $self;
}

sub _setup_options {
    my $self = shift;

    if (basesetup($self, $self->get('Config'))) {
	print STDERR "Failed to set up chroot\n";
	return 0;
    }

    return 1;
}

sub get_option {
    my $self = shift;
    my $options = shift;
    my $option = shift;

    my $value = undef;
    $value = $self->get('Defaults')->{$option} if
	(defined($self->get('Defaults')) &&
	 defined($self->get('Defaults')->{$option}));
    $value = $options->{$option} if
	(defined($options) &&
	 exists($options->{$option}));

    return $value;
}

sub log_command {
    my $self = shift;
    my $options = shift;

    my $priority = $options->{'PRIORITY'};

    if ((defined($priority) && $priority >= 1) || $self->get_conf('DEBUG')) {
	my $command;
	if ($self->get_conf('DEBUG')) {
	    $command = $options->{'EXPCOMMAND'};
	} else {
	    $command = $options->{'COMMAND'};
	}

	$self->log_info(join(" ", @$command), "\n");
    }
}

# create a temporary file or directory inside the chroot
sub mktemp {
    my $self = shift;
    my $options = shift;

    my $user = "root";
    $user = $options->{'USER'} if defined $options->{'USER'};

    my $dir = "/";
    $dir = $options->{'DIR'} if defined $options->{'DIR'};

    my $mktempcmd = ['mktemp'];

    if (defined $options->{'DIRECTORY'} && $options->{'DIRECTORY'}) {
	push(@{$mktempcmd}, "-d");
    }

    if (defined $options->{'TEMPLATE'}) {
	push(@{$mktempcmd}, $options->{'TEMPLATE'});
    }

    my $pipe = $self->pipe_command({ COMMAND => $mktempcmd, USER => $user, DIR => $dir });
    if (!$pipe) {
	$self->log_error("cannot open pipe\n");
	return;
    }
    chomp (my $tmpdir = do { local $/; <$pipe> });
    close $pipe;
    if ($?) {
	if (defined $options->{'TEMPLATE'}) {
	    $self->log_error("cannot run mktemp " . $options->{'TEMPLATE'} . ": $!\n");
	} else {
	    $self->log_error("cannot run mktemp: $!\n");
	}
	return;
    }
    return $tmpdir;
}

# copy a file from the outside into the chroot
sub copy_to_chroot {
    my $self = shift;
    my $source = shift;
    my $dest = shift;
    my $options = shift;

    # if the destination inside the chroot is a directory, then the file has
    # to be copied into that directory with the same filename as outside
    if($self->test_directory($dest)) {
	$dest .= '/' . (basename $source);
    }

    my $pipe = $self->get_write_file_handle($dest, $options);
    if (!defined $pipe) {
	$self->log_error("get_write_file_handle failed\n");
	return;
    }

    local *INFILE;
    if(!open(INFILE, "<", $source)) {
	$self->log_error("cannot open $source\n");
	close $pipe;
	return;
    }

    while ( (read (INFILE, my $buffer, 65536)) != 0 ) {
	print $pipe $buffer;
    }

    close INFILE;
    close $pipe;

    return 1;
}

# copy a file inside the chroot to the outside
sub copy_from_chroot {
    my $self = shift;
    my $source = shift;
    my $dest = shift;
    my $options = shift;

    my $pipe = $self->get_read_file_handle($source, $options);
    if (!defined $pipe) {
	$self->log_error("get_read_file_handle failed\n");
	return;
    }

    # if the destination outside the chroot is a directory, then the file has
    # to be copied into that directory with the same filename as inside
    if (-d $dest) {
	$dest .= '/' . (basename $source);
    }

    local *OUTFILE;
    if(!open(OUTFILE, ">", $dest)) {
	$self->log_error("cannot open $dest\n");
	close $pipe;
	return;
    }

    while ( (read ($pipe, my $buffer, 65536)) != 0 ) {
	print OUTFILE $buffer;
    }

    close OUTFILE;
    close $pipe;

    return 1;
}

# returns a file handle to read a file inside the chroot
sub get_read_file_handle {
    my $self = shift;
    my $source = shift;
    my $options = shift;

    my $user = "root";
    $user = $options->{'USER'} if defined $options->{'USER'};

    my $dir = "/";
    $dir = $options->{'DIR'} if defined $options->{'DIR'};

    my $escapedsource = shellescape $source;

    my $pipe = $self->pipe_command({
	    COMMAND => [ "sh", "-c", "cat $escapedsource" ],
	    DIR => $dir,
	    USER => $user,
	    PIPE => 'in'
	});
    if (!$pipe) {
	$self->log_error("cannot open pipe\n");
	return;
    }

    return $pipe;
}

# returns a string with the content of a file inside the chroot
sub read_file {
    my $self = shift;
    my $source = shift;
    my $options = shift;

    my $pipe = $self->get_read_file_handle($source, $options);
    if (!defined $pipe) {
	$self->log_error("get_read_file_handle failed\n");
	return;
    }

    my $content = do { local $/; <$pipe> };
    close $pipe;

    return $content;
}

# returns a file handle to write to a file inside the chroot
sub get_write_file_handle {
    my $self = shift;
    my $dest = shift;
    my $options = shift;

    my $user = "root";
    $user = $options->{'USER'} if defined $options->{'USER'};

    my $dir = "/";
    $dir = $options->{'DIR'} if defined $options->{'DIR'};

    my $escapeddest = shellescape $dest;

    my $pipe = $self->pipe_command({
	    COMMAND => [ "sh", "-c", "cat > $escapeddest" ],
	    DIR => $dir,
	    USER => $user,
	    PIPE => 'out'
	});
    if (!$pipe) {
	$self->log_error("cannot open pipe\n");
	return;
    }

    return $pipe;
}

sub read_command {
    my $self = shift;
    my $options = shift;

    $options->{PIPE} = "in";

    my $pipe = $self->pipe_command($options);
    if (!$pipe) {
	$self->log_error("cannot open pipe\n");
	return;
    }

    my $content = do { local $/; <$pipe> };
    close $pipe;

    if ($?) {
	$self->log_error("read_command failed to execute " . $options->{COMMAND}->[0] . "\n");
	return;
    }

    return $content;
}

# writes a string to a file inside the chroot
sub write_file {
    my $self = shift;
    my $dest = shift;
    my $content = shift;
    my $options = shift;

    my $pipe = $self->get_write_file_handle($dest, $options);
    if (!defined $pipe) {
	$self->log_error("get_read_file_handle failed\n");
	return;
    }

    print $pipe $content;
    close $pipe;

    return 1;
}

sub write_command {
    my $self = shift;
    my $content = shift;
    my $options = shift;

    $options->{PIPE} = "out";

    my $pipe = $self->pipe_command($options);
    if (!$pipe) {
	$self->log_error("cannot open pipe\n");
	return;
    }

    if(!print $pipe $content) {
	$self->log_error("failed to print to file handle\n");
	close $pipe;
    }

    close $pipe;

    if ($?) {
	$self->log_error("write_command failed to execute " . $options->{COMMAND}->[0] . "\n");
	return;
    }

    return 1;
}

# rename a file inside the chroot
sub rename {
    my $self = shift;
    my $source = shift;
    my $dest = shift;
    my $options = shift;

    my $user = "root";
    $user = $options->{'USER'} if defined $options->{'USER'};

    my $dir = "/";
    $dir = $options->{'DIR'} if defined $options->{'DIR'};

    $self->run_command({ COMMAND => ["mv", $source, $dest], USER => $user, DIR => $dir});
    if ($?) {
	$self->log_error("Can't rename $source to $dest: $!\n");
	return 0;
    }

    return 1;
}

# create a directory inside the chroot
sub mkdir {
    my $self = shift;
    my $path = shift;
    my $options = shift;

    my $user = "root";
    $user = $options->{'USER'} if defined $options->{'USER'};

    my $dir = "/";
    $dir = $options->{'DIR'} if defined $options->{'DIR'};

    my $mkdircmd = [ "mkdir", $path ];

    if (defined $options->{'PARENTS'} && $options->{'PARENTS'}) {
	push(@{$mkdircmd}, "-p");
    }

    if (defined $options->{'MODE'}) {
	push(@{$mkdircmd}, "--mode", $options->{'MODE'});
    }

    $self->run_command({ COMMAND => $mkdircmd, USER => $user, DIR => $dir});
    if ($?) {
	$self->log_error("Can't mkdir $path: $!\n");
	return 0;
    }

    return 1;
}

sub test_internal {
    my $self = shift;
    my $path = shift;
    my $arg = shift;
    my $options = shift;

    my $user = "root";
    $user = $options->{'USER'} if defined $options->{'USER'};

    my $dir = "/";
    $dir = $options->{'DIR'} if defined $options->{'DIR'};

    $self->run_command({ COMMAND => [ "test", $arg, $path ], USER => $user, DIR => $dir});
    if ($? eq 0) {
	return 1;
    } else {
	return 0;
    }
}

# test if a path inside the chroot is a directory
sub test_directory {
    my $self = shift;
    my $path = shift;
    my $options = shift;

    return $self->test_internal($path, "-d", $options);
}

# test if a path inside the chroot is a regular file
sub test_regular_file {
    my $self = shift;
    my $path = shift;
    my $options = shift;

    return $self->test_internal($path, "-f", $options);
}

# test if a path inside the chroot is a regular readable file
sub test_regular_file_readable {
    my $self = shift;
    my $path = shift;
    my $options = shift;

    return $self->test_internal($path, "-r", $options);
}

# test if a path inside the chroot is a symlink
sub test_symlink {
    my $self = shift;
    my $path = shift;
    my $options = shift;

    return $self->test_internal($path, "-L", $options);
}

# remove a file inside the chroot
sub unlink {
    my $self = shift;
    my $path = shift;
    my $options = shift;

    my $user = "root";
    $user = $options->{'USER'} if defined $options->{'USER'};

    my $dir = "/";
    $dir = $options->{'DIR'} if defined $options->{'DIR'};

    my $rmcmd = [ "rm", $path ];

    if (defined $options->{'RECURSIVE'} && $options->{'RECURSIVE'}) {
	push(@{$rmcmd}, "-r");
    }

    if (defined $options->{'FORCE'} && $options->{'FORCE'}) {
	push(@{$rmcmd}, "-f");
    }

    if (defined $options->{'DIRECTORY'} && $options->{'DIRECTORY'}) {
	push(@{$rmcmd}, "-d");
    }

    $self->run_command({ COMMAND => $rmcmd, USER => $user, DIR => $dir});
    if ($?) {
	$self->log_error("Can't unlink $path: $!\n");
	return 0;
    }

    return 1;
}

# chmod a path inside the chroot
sub chmod {
    my $self = shift;
    my $path = shift;
    my $mode = shift;
    my $options = shift;

    my $user = "root";
    $user = $options->{'USER'} if defined $options->{'USER'};

    my $dir = "/";
    $dir = $options->{'DIR'} if defined $options->{'DIR'};

    my $chmodcmd = [ "chmod" ];

    if (defined $options->{'RECURSIVE'} && $options->{'RECURSIVE'}) {
	push(@{$chmodcmd}, "-R");
    }

    push(@{$chmodcmd}, $mode, $path);

    $self->run_command({ COMMAND => $chmodcmd, USER => $user, DIR => $dir});
    if ($?) {
	$self->log_error("Can't chmod $path to $mode: $!\n");
	return 0;
    }

    return 1;
}

# chown a path inside the chroot
sub chown {
    my $self = shift;
    my $path = shift;
    my $owner = shift;
    my $group = shift;
    my $options = shift;

    my $user = "root";
    $user = $options->{'USER'} if defined $options->{'USER'};

    my $dir = "/";
    $dir = $options->{'DIR'} if defined $options->{'DIR'};

    my $chowncmd = [ "chown" ];

    if (defined $options->{'RECURSIVE'} && $options->{'RECURSIVE'}) {
	push(@{$chowncmd}, "-R");
    }

    push(@{$chowncmd}, "$owner:$group", $path);

    $self->run_command({ COMMAND => $chowncmd, USER => $user, DIR => $dir});
    if ($?) {
	$self->log_error("Can't chown $path to $owner:$group: $!\n");
	return 0;
    }

    return 1;
}

# test if a program inside the chroot can be run
# we use the function name "can_run" as it is similar to the function in
# IPC::Cmd
sub can_run {
    my $self = shift;
    my $program = shift;
    my $options = shift;

    my $user = "root";
    $user = $options->{'USER'} if defined $options->{'USER'};

    my $dir = "/";
    $dir = $options->{'DIR'} if defined $options->{'DIR'};

    my $escapedprogram = shellescape $program;

    my $commandcmd = [ 'sh', '-c', "command -v $escapedprogram >/dev/null 2>&1" ];

    $self->run_command({ COMMAND => $commandcmd, USER => $user, DIR => $dir});
    if ($?) {
	return 0;
    }

    return 1;
}

# Note, do not run with $user="root", and $chroot=0, because root
# access to the host system is not allowed by schroot, nor required
# via sudo.
sub pipe_command_internal {
    my $self = shift;
    my $options = shift;

    my $pipetype = "-|";
    $pipetype = "|-" if (defined $options->{'PIPE'} &&
			 $options->{'PIPE'} eq 'out');

    my $pipe = undef;
    my $pid = open($pipe, $pipetype);
    if (!defined $pid) {
	warn "Cannot open pipe: $!\n";
    } elsif ($pid == 0) { # child
	if (!defined $options->{'PIPE'} ||
	    $options->{'PIPE'} ne 'out') { # redirect stdin
	    my $in = $self->get_option($options, 'STREAMIN');
	    if (defined($in) && $in && \*STDIN != $in) {
		open(STDIN, '<&', $in)
		    or warn "Can't redirect stdin\n";
	    }
	} else { # redirect stdout
	    my $out = $self->get_option($options, 'STREAMOUT');
	    if (defined($out) && $out && \*STDOUT != $out) {
		open(STDOUT, '>&', $out)
		    or warn "Can't redirect stdout\n";
	    }
	}
	# redirect stderr
	my $err = $self->get_option($options, 'STREAMERR');
	if (defined($err) && $err && \*STDERR != $err) {
	    open(STDERR, '>&', $err)
		or warn "Can't redirect stderr\n";
	}

	my $setsid = $self->get_option($options, 'SETSID');
	setsid() if defined($setsid) && $setsid;

	$self->exec_command($options);
    }

    debug2("Pipe (PID $pid, $pipe) created for: ",
	   join(" ", @{$options->{'COMMAND'}}),
	   "\n");

    $options->{'PID'} = $pid;

    return $pipe;
}

# Note, do not run with $user="root", and $chroot=0, because root
# access to the host system is not allowed by schroot, nor required
# via sudo.
sub run_command_internal {
    my $self = shift;
    my $options = shift;

    my $pid = fork();

    if (!defined $pid) {
	warn "Cannot fork: $!\n";
    } elsif ($pid == 0) { # child

	# redirect stdin
	my $in = $self->get_option($options, 'STREAMIN');
	if (defined($in) && $in && \*STDIN != $in) {
	    open(STDIN, '<&', $in)
		or warn "Can't redirect stdin\n";
	}

	# redirect stdout
	my $out = $self->get_option($options, 'STREAMOUT');
	if (defined($out) && $out && \*STDOUT != $out) {
	    open(STDOUT, '>&', $out)
		or warn "Can't redirect stdout\n";
	}

	# redirect stderr
	my $err = $self->get_option($options, 'STREAMERR');
	if (defined($err) && $err && \*STDERR != $err) {
	    open(STDERR, '>&', $err)
		or warn "Can't redirect stderr\n";
	}

	my $setsid = $self->get_option($options, 'SETSID');
	setsid() if defined($setsid) && $setsid;

	$self->exec_command($options);
    }

    debug2("Pipe (PID $pid) created for: ",
	   join(" ", @{$options->{'COMMAND'}}),
	   "\n");

    waitpid($pid, 0);
}

# Note, do not run with $user="root", and $chroot=0, because root
# access to the host system is not allowed by schroot, nor required
# via sudo.
sub run_command {
    my $self = shift;
    my $options = shift;

    $options->{'INTCOMMAND'} = copy($options->{'COMMAND'});
    $options->{'INTCOMMAND_STR'} = copy($options->{'COMMAND_STR'});

    return $self->run_command_internal($options);
}

# Note, do not run with $user="root", and $chroot=0, because root
# access to the host system is not allowed by schroot, nor required
# via sudo.
sub pipe_command {
    my $self = shift;
    my $options = shift;

    $options->{'INTCOMMAND'} = copy($options->{'COMMAND'});
    $options->{'INTCOMMAND_STR'} = copy($options->{'COMMAND_STR'});

    return $self->pipe_command_internal($options);
}

sub get_internal_exec_string {
    return;
}

# This function must not print anything to standard output or standard error
# when it dies because its output will be treated as the output of the program
# it executes. So error handling can only happen with "die()".
sub exec_command {
    my $self = shift;
    my $options = shift;

    my @filter;
    my $chrootfilter = $self->get('Defaults')->{'ENV_FILTER'};
    push(@filter, @{$chrootfilter});

    my $commandfilter = $options->{'ENV_FILTER'};
    push(@filter, @{$commandfilter}) if defined($commandfilter);

    # Sanitise environment
    foreach my $var (keys %ENV) {
	my $match = 0;
	foreach my $regex (@filter) {
	    $match = 1 if
		$var =~ m/($regex)/;
	}
	delete $ENV{$var} if
	    $match == 0;
	if (!$match) {
	    debug2("Environment filter: Deleted $var\n");
	} else {
	    debug2("Environment filter: Kept $var\n");
	}
    }

    my $chrootenv = $self->get('Defaults')->{'ENV'};
    foreach (keys %$chrootenv) {
	$ENV{$_} = $chrootenv->{$_};
    }

    my $commandenv = $options->{'ENV'};
    foreach (keys %$commandenv) {
	$ENV{$_} = $commandenv->{$_};
    }

    # get_command_internal has to be called *after* $ENV was set because
    # depending on the backend, environment variables have to be handled
    # differently. For example the autopkgtest backend has to insert an
    # explicit call to env into the command so that the environment variables
    # survive.
    $self->get_command_internal($options);

    if (!defined($options->{'EXPCOMMAND'}) || $options->{'EXPCOMMAND'} eq ''
	|| !defined($options->{'COMMAND'}) || scalar(@{$options->{'COMMAND'}}) == 0
	|| !defined($options->{'INTCOMMAND'}) || scalar(@{$options->{'INTCOMMAND'}}) == 0) {
	die "get_command_internal failed during exec_command\n";
    }

    $self->log_command($options);

    my $command = $options->{'EXPCOMMAND'};

    my $program = $command->[0];
    $program = $options->{'PROGRAM'} if defined($options->{'PROGRAM'});

    debug2("PROGRAM: $program\n");
    debug2("COMMAND: ", join(" ", @{$options->{'COMMAND'}}), "\n");
    debug2("COMMAND_STR: ", $options->{'COMMAND'} // 'UNDEFINED', "\n");
    debug2("INTCOMMAND: ", join(" ", @{$options->{'INTCOMMAND'}}), "\n");
    debug2("INTCOMMAND_STR: ", $options->{'INTCOMMAND_STR:'} // 'UNDEFINED', "\n");
    debug2("EXPCOMMAND: ", join(" ", @{$options->{'EXPCOMMAND'}}), "\n");

    debug2("Environment set:\n");
    foreach (sort keys %ENV) {
	debug2('  ' . $_ . '=' . ($ENV{$_} || '') . "\n");
    }

    debug("Running command: ", join(" ", @$command), "\n");
    exec { $program } @$command;
    die "Failed to exec: $command->[0]: $!";
}

sub lock_chroot {
    my $self = shift;
    my $new_job = shift;
    my $new_pid = shift;
    my $new_user = shift;

    my $lockfile = '/var/lock/sbuild';
    my $max_trys = $self->get_conf('MAX_LOCK_TRYS');
    my $lock_interval = $self->get_conf('LOCK_INTERVAL');

    # The following command in run /inside/ the chroot to create the lockfile.
    my $command = <<"EOF";

    use strict;
    use warnings;
    use POSIX;
    use FileHandle;

    my \$lockfile="$lockfile";
    my \$try = 0;

  repeat:
    if (!sysopen( F, \$lockfile, O_WRONLY|O_CREAT|O_TRUNC|O_EXCL, 0644 )){
	if (\$! == EEXIST) {
	    # lock file exists, wait
	    goto repeat if !open( F, "<\$lockfile" );
	    my \$line = <F>;
	    my (\$job, \$pid, \$user);
	    close( F );
	    if (\$line !~ /^(\\S+)\\s+(\\S+)\\s+(\\S+)/) {
		print STDERR "Bad lock file contents (\$lockfile) -- still trying\\n";
	    } else {
		(\$job, \$pid, \$user) = (\$1, \$2, \$3);
		if (kill( 0, \$pid ) == 0 && \$! == ESRCH) {
		    # process no longer exists, remove stale lock
		    print STDERR "Removing stale lock file \$lockfile ".
			"(job \$job, pid \$pid, user \$user)\\n";
		    if (!unlink(\$lockfile)) {
			if (\$! != ENOENT) {
			    print STDERR "Cannot remove chroot lock file \$lockfile: \$!\\n";
			    exit 1;
			}
		    }
		}
	    }
	    ++\$try;
	    if (\$try > $max_trys) {
		print STDERR "Lockfile \$lockfile still present after " .
		    $max_trys * $lock_interval . " seconds -- giving up\\n";
		exit 1;
	    }
	    print STDERR "Another sbuild process (job \$job, pid \$pid by user \$user) is currently using the build chroot; waiting...\\n"
		if \$try == 1;
	    sleep $lock_interval;
	    goto repeat;
	} else {
	    print STDERR "Failed to create lock file \$lockfile: \$!\\n";
	    exit 1;
	}
    }

    F->print("$new_job $new_pid $new_user\\n");
    F->close();

    exit 0;
EOF

    $self->run_command(
	    { COMMAND => ['perl',
			  '-e',
			  $command],
	      USER => 'root',
	      PRIORITY => 0,
	      DIR => '/' });

    if ($?) {
	return 0;
    }
    return 1;
}

sub unlock_chroot {
    my $self = shift;

    my $lockfile = '/var/lock/sbuild';

    # The following command in run /inside/ the chroot to remove the lockfile.
    my $command = <<"EOF";

    use strict;
    use warnings;
    use POSIX;

    my \$lockfile="$lockfile";
    if (!unlink(\$lockfile)) {
	print STDERR "Cannot remove chroot lock file \$lockfile: \$!\\n"
	    if \$! != ENOENT;
	exit 1;
    }
    exit 0;
EOF

    debug("Removing chroot lock file $lockfile\n");
    $self->run_command(
	    { COMMAND => ['perl',
			  '-e',
			  $command],
	      USER => 'root',
	      PRIORITY => 0,
	      DIR => '/' });

    if ($?) {
	return 0;
    }
    return 1;
}

sub useradd {
    my $self = shift;
    my @args = @_;
    $self->run_command(
        { COMMAND => ['useradd', @args],
	  USER => 'root',
	  STREAMIN => $devnull,
	  STREAMOUT => $devnull,
	  DIR => '/' });
    if ($?) {
	return 1;
    }
    return 0;
}

sub groupadd {
    my $self = shift;
    my @args = @_;
    $self->run_command(
	    { COMMAND => ['groupadd', @args],
	      USER => 'root',
	      STREAMIN => $devnull,
	      STREAMOUT => $devnull,
	      DIR => '/' });
    if ($?) {
	return 1;
    }
    return 0;
}

1;