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 |