mirror of https://github.com/fspc/gbootroot.git
You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
216 lines
5.2 KiB
216 lines
5.2 KiB
24 years ago
|
package UML;
|
||
|
|
||
|
use Expect;
|
||
|
use IO::File;
|
||
|
use strict;
|
||
|
|
||
|
sub new {
|
||
|
my $proto = shift;
|
||
|
my $class = ref($proto) || $proto;
|
||
|
my $me = { kernel => 'linux',
|
||
|
arguments => '',
|
||
|
login_prompt => 'login:',
|
||
|
login => 'root',
|
||
|
password_prompt => 'Password:',
|
||
|
password => 'root',
|
||
|
prompt => 'darkstar:.*#',
|
||
|
halt => 'halt',
|
||
|
expect_handle => undef };
|
||
|
|
||
|
while(@_){
|
||
|
my $arg = shift;
|
||
|
if($arg eq 'kernel'){
|
||
|
$me->{kernel} = shift;
|
||
|
}
|
||
|
elsif($arg eq 'arguments'){
|
||
|
$me->{arguments} = shift;
|
||
|
}
|
||
|
elsif($arg eq 'login_prompt'){
|
||
|
$me->{login_prompt} = shift;
|
||
|
}
|
||
|
elsif($arg eq 'login'){
|
||
|
$me->{login} = shift;
|
||
|
}
|
||
|
elsif($arg eq 'password_prompt'){
|
||
|
$me->{password_prompt} = shift;
|
||
|
}
|
||
|
elsif($arg eq 'password'){
|
||
|
$me->{password} = shift;
|
||
|
}
|
||
|
elsif($arg eq 'prompt'){
|
||
|
$me->{prompt} = shift;
|
||
|
}
|
||
|
elsif($arg eq 'halt'){
|
||
|
$me->{halt} = shift;
|
||
|
}
|
||
|
else {
|
||
|
die "UML::new : Unknown argument - $arg";
|
||
|
}
|
||
|
}
|
||
|
bless($me, $class);
|
||
|
return $me;
|
||
|
}
|
||
|
|
||
|
sub boot {
|
||
|
my $me = shift;
|
||
|
my $log_file = shift;
|
||
|
my $log;
|
||
|
|
||
|
if(defined($me->{expect_handle})){
|
||
|
warn "UML::boot : already booted";
|
||
|
return;
|
||
|
}
|
||
|
my $cmd = "$me->{kernel} $me->{arguments}";
|
||
|
$me->{expect_handle} = Expect->spawn($cmd);
|
||
|
if(defined($log_file)){
|
||
|
$log = $me->open_log($log_file);
|
||
|
$me->{expect_handle}->log_stdout(0);
|
||
|
}
|
||
|
$me->{expect_handle}->expect(undef, "$me->{login_prompt}");
|
||
|
$me->{expect_handle}->print("$me->{login}\n");
|
||
|
$me->{expect_handle}->expect(undef, "$me->{password_prompt}");
|
||
|
$me->{expect_handle}->print("$me->{password}\n");
|
||
|
$me->{expect_handle}->expect(undef, "-re", "$me->{prompt}");
|
||
|
return($log);
|
||
|
}
|
||
|
|
||
|
sub command {
|
||
|
my $me = shift;
|
||
|
my $cmd = shift;
|
||
|
my %globals = ( "Kernel panic" => "", "$me->{prompt}" => "-re" );
|
||
|
my @expects = ( @_ );
|
||
|
my @strings = ();
|
||
|
|
||
|
foreach my $key (keys(%globals)){
|
||
|
$globals{$key} eq "-re" and push @expects, "-re";
|
||
|
push @expects, $key;
|
||
|
}
|
||
|
foreach my $str (@expects){
|
||
|
$str ne "-re" and push @strings, $str;
|
||
|
}
|
||
|
$me->{expect_handle}->print("$cmd\n");
|
||
|
my @match = $me->{expect_handle}->expect(undef, @expects);
|
||
|
defined $match[0] and $match[0]--;
|
||
|
if(defined($match[1])){
|
||
|
die "Expect error : $match[1]";
|
||
|
}
|
||
|
elsif(defined($globals{$strings[$match[0]]})){
|
||
|
$strings[$match[0]] eq "Kernel panic" and die "panic";
|
||
|
return(undef);
|
||
|
}
|
||
|
else {
|
||
|
$me->{expect_handle}->expect(undef, "-re", "$me->{prompt}");
|
||
|
return($match[0]);
|
||
|
}
|
||
|
}
|
||
|
|
||
|
sub open_log {
|
||
|
my $me = shift;
|
||
|
my $file = shift;
|
||
|
my $fh = new IO::File "$file";
|
||
|
my $have_logs = $me->{expect_handle}->set_group();
|
||
|
my @logs;
|
||
|
|
||
|
if(!defined($have_logs)){
|
||
|
@logs = ();
|
||
|
}
|
||
|
else {
|
||
|
@logs = $me->{expect_handle}->set_group();
|
||
|
}
|
||
|
if(defined($fh)){
|
||
|
my $log = Expect->exp_init(\*$fh);
|
||
|
push @logs, $log;
|
||
|
$me->{expect_handle}->set_group(@logs);
|
||
|
return $log;
|
||
|
}
|
||
|
return undef;
|
||
|
}
|
||
|
|
||
|
sub close_log {
|
||
|
my $me = shift;
|
||
|
my $log = shift;
|
||
|
my @logs = $me->{expect_handle}->set_group();
|
||
|
|
||
|
foreach my $i (0..$#logs){
|
||
|
if($logs[$i] == $log){
|
||
|
splice @logs, $i, 1;
|
||
|
$log->hard_close();
|
||
|
}
|
||
|
}
|
||
|
if(!@logs){
|
||
|
my $fh = new IO::File "> /dev/null";
|
||
|
push @logs, Expect->exp_init(\*$fh);
|
||
|
}
|
||
|
$me->{expect_handle}->set_group(@logs);
|
||
|
}
|
||
|
|
||
|
sub halt {
|
||
|
my $me = shift;
|
||
|
|
||
|
$me->{expect_handle}->print("$me->{halt}\n");
|
||
|
$me->{expect_handle}->expect(undef);
|
||
|
}
|
||
|
|
||
|
sub kill {
|
||
|
my $me = shift;
|
||
|
|
||
|
$me->{expect_handle}->hard_close();
|
||
|
}
|
||
|
|
||
|
1;
|
||
|
|
||
|
=head1 NAME
|
||
|
|
||
|
UML - class to control User-mode Linux
|
||
|
|
||
|
=head1 SYNOPSIS
|
||
|
|
||
|
use UML;
|
||
|
|
||
|
#################
|
||
|
# class methods #
|
||
|
#################
|
||
|
$uml = UML->new(kernel => $path_to_kernel, # default "linux"
|
||
|
arguments => $kernel_arguments, # ""
|
||
|
login_prompt => $login_prompt, # "login:"
|
||
|
login => $account_name, # "root"
|
||
|
password_prompt => $password_prompt, # "Password:"
|
||
|
password => $account_password, # "root"
|
||
|
prompt => $shell_prompt_re, # "darkstar:.*#"
|
||
|
halt => $halt_command); # "halt"
|
||
|
$uml->boot();
|
||
|
$uml->command($command_string);
|
||
|
$uml->halt();
|
||
|
|
||
|
#######################
|
||
|
# object data methods #
|
||
|
#######################
|
||
|
|
||
|
########################
|
||
|
# other object methods #
|
||
|
########################
|
||
|
|
||
|
=head1 DESCRIPTION
|
||
|
|
||
|
The UML class is used to control the execution of a user-mode kernel.
|
||
|
All of the arguments to UML::new are optional and will be defaulted if
|
||
|
not present. The arguments and their values are as follows:
|
||
|
kernel - the filename of the kernel executable
|
||
|
arguments - a string containing the kernel command line
|
||
|
login_prompt - a string matching the login prompt
|
||
|
login - the account to log in to
|
||
|
password_prompt - a string matching the password prompt
|
||
|
password - the account's password
|
||
|
prompt - a regular expression matching the shell prompt
|
||
|
halt - the command used to halt the virtual machine
|
||
|
|
||
|
Once constructed, the UML object may be booted. UML::boot() will
|
||
|
return after it has successfully logged in.
|
||
|
|
||
|
Then, UML::command may be called as many times as desired. It will
|
||
|
return when the command has finished and the next shell prompt has
|
||
|
been seen.
|
||
|
|
||
|
When the testing is finished, UML::halt() is called to shut the
|
||
|
virtual machine down.
|