kvmtool
changeset 8 54bfff297ed4
parent 7 ebe549994431
child 9 e1956a6cd928
equal deleted inserted replaced
7:ebe549994431 8:54bfff297ed4
    12 
    12 
    13 my $ME      = basename $0;
    13 my $ME      = basename $0;
    14 my $opt_dev = "/dev/kvm";
    14 my $opt_dev = "/dev/kvm";
    15 my $opt_dir = "/var/lib/kvm";
    15 my $opt_dir = "/var/lib/kvm";
    16 
    16 
    17 my $KVM = "kvm";
    17 my $KVM     = "kvm";
    18 my $CONFIG = "%s.kvm.conf";
    18 my $CONFIG  = "%s.kvm.conf";
    19 my $PIDFILE = "$ENV{HOME}/.kvm-%s.pid";
    19 my $PIDFILE = "$ENV{HOME}/.kvm-%s.pid";
    20 my $KILL = 15;
    20 my $KILL    = 15;
    21 
    21 
    22 sub _start(@);
    22 sub _start(@);
    23 sub _kill(@);
    23 sub _kill(@);
    24 
    24 
    25 MAIN: {
    25 MAIN: {
    26 
    26 
    27     GetOptions(
    27     GetOptions(
    28         "h|help" => sub { pod2usage(-verbose => 1, -exit => 0) },
    28         "h|help" => sub { pod2usage(-verbose => 1, -exit => 0) },
    29         "m|man"  => sub { pod2usage(-verbose => 2, -exit => 0) },
    29         "m|man"  => sub { pod2usage(-verbose => 2, -exit => 0) },
    30         "dev=s"  => \$opt_dev,
    30         "dev=s"  => \$opt_dev,
    31 	"dir=s"	 => \$opt_dir,
    31         "dir=s"  => \$opt_dir,
    32     ) or pod2usage(-exit => 1);
    32     ) or pod2usage(-exit => 1);
    33 
    33 
    34     my $cmd = shift;
    34     my $cmd = shift;
    35 
    35 
    36     -w $opt_dev or die "$ME: write access to $opt_dev: $!\n";
    36     -w $opt_dev or die "$ME: write access to $opt_dev: $!\n";
    37     -w $opt_dir or die "$ME: write access to $opt_dir: $!\n";
    37     -w $opt_dir or die "$ME: write access to $opt_dir: $!\n";
    38 
    38 
    39     _start(@ARGV) if $cmd eq "start";
    39     _start(@ARGV) if $cmd eq "start";
    40     _kill(@ARGV) if $cmd eq "kill";
    40     _kill(@ARGV)  if $cmd eq "kill";
    41     die "internal error\n";
    41     die "internal error\n";
    42 
    42 
    43 }
    43 }
    44 
    44 
    45 sub get_config($) {
    45 sub get_config($) {
    46     defined(my $kvm = shift) or pod2usage;
    46     defined(my $kvm = shift) or pod2usage;
    47     my @config = slurp sprintf($CONFIG, $kvm), { chomp => 1 };
    47     my @config = slurp sprintf($CONFIG, $kvm), { chomp => 1 };
    48     (shift @config) =~ /^#\s+kvm/
    48     (shift @config) =~ /^#\s+kvm/
    49 	or die "wrong file format („# kvm” expected)\n";
    49       or die "wrong file format („# kvm” expected)\n";
    50 
    50 
    51     if (not /^-pidfile/ ~~ @config) {
    51     if (not /^-pidfile/ ~~ @config) {
    52 	push @config, sprintf "-pidfile $PIDFILE", $kvm;
    52         push @config, sprintf "-pidfile $PIDFILE", $kvm;
    53     }
    53     }
    54 
    54 
    55     if (not /^-name/ ~~ @config) {
    55     if (not /^-name/ ~~ @config) {
    56 	push @config, "-name $kvm";
    56         push @config, "-name $kvm";
    57     };
    57     }
    58 
    58 
    59     return @config;
    59     return @config;
    60 }
    60 }
    61 
    61 
    62 sub _kill(@) {
    62 sub _kill(@) {
    63     my $kvm = shift;
    63     my $kvm    = shift;
    64     my @config = get_config($kvm);
    64     my @config = get_config($kvm);
    65 
    65 
    66     (/^-pidfile\s+(?<pidfile>.*)/ ~~ @config);
    66     (/^-pidfile\s+(?<pidfile>.*)/ ~~ @config);
    67     my $pid = slurp $+{pidfile}, { chomp => 1 };
    67     my $pid = slurp $+{pidfile}, { chomp => 1 };
    68 
    68 
    72 
    72 
    73     exit;
    73     exit;
    74 }
    74 }
    75 
    75 
    76 sub _start(@) {
    76 sub _start(@) {
    77     my $kvm = shift;
    77     my $kvm    = shift;
    78     my @config = get_config($kvm);
    78     my @config = get_config($kvm);
    79 
    79 
    80     defined(my $pid = fork) or die "Can't fork: $!\n";
    80     defined(my $pid = fork) or die "Can't fork: $!\n";
    81 
    81 
    82     if ($pid == 0) {
    82     if ($pid == 0) {
    83 	exec $KVM "kvm-$KVM" => map { split } @config;
    83         exec $KVM "kvm-$KVM" => map { split } @config;
    84 	die "Can't exec: $!";
    84         die "Can't exec: $!";
    85     }
    85     }
    86 
    86 
    87     exit;
    87     exit;
    88 }
    88 }
    89 
    89