1 #! /usr/bin/perl |
1 #! /usr/bin/perl |
2 # © 2009 Heiko Schlittermann |
2 # © 2009 Heiko Schlittermann |
|
3 |
|
4 # $opt_base/vm/{name}/ |
|
5 # |
3 |
6 |
4 use strict; |
7 use strict; |
5 use warnings; |
8 use warnings; |
6 use Getopt::Long; |
9 use Getopt::Long; |
7 use Pod::Usage; |
10 use Pod::Usage; |
8 use File::Basename; |
11 use File::Basename; |
9 use Perl6::Slurp; |
12 use Perl6::Slurp; |
10 use File::Path; |
13 use File::Path; |
11 use IO::File; |
14 use IO::File; |
12 use IO::Select; |
15 use IO::Select; |
|
16 use if $ENV{DEBUG} => qw(Smart::Comments); |
13 use feature qw(:5.10); |
17 use feature qw(:5.10); |
14 use if $ENV{DEBUG} => "Smart::Comments"; |
18 use if $ENV{DEBUG} => "Smart::Comments"; |
15 |
19 |
16 my $ME = basename $0; |
20 my $ME = basename $0; |
17 my $opt_dev = "/dev/kvm"; |
21 my $opt_dev = "/dev/kvm"; |
18 my $opt_monitor = 0; |
22 my $opt_base = "$ENV{HOME}/.$ME"; |
19 |
23 my $opt_cmd_monitor = undef; |
20 my $KVM = "kvm"; |
24 my $opt_config = undef; |
21 my $BASE = "$ENV{HOME}/.$ME"; |
25 my $opt_import = undef; |
22 my $CONFIG = "%s.kvm.conf"; |
26 |
23 my $KILL = 15; |
27 my $KVM = "kvm"; |
24 |
28 my $KILL = 15; |
25 sub _start(@); |
29 |
26 sub _kill(@); |
30 sub cmd_start(@); |
27 sub _monitor(@); |
31 sub cmd_kill(@); |
|
32 sub cmd_monitor(@); |
|
33 sub _import(@); |
|
34 |
|
35 sub _base_dir($) { "$opt_base/vm/$_[0]" } |
|
36 sub _running_config_file($) { "$opt_base/vm/$_[0]/running_config" } |
|
37 sub _user_config_file($) { "$opt_base/vm/$_[0]/config" } |
|
38 sub _monitor_link($) { "$opt_base/vm/$_[0]/monitor" } |
28 |
39 |
29 MAIN: { |
40 MAIN: { |
30 |
41 |
31 GetOptions( |
42 GetOptions( |
32 "h|help" => sub { pod2usage(-verbose => 1, -exit => 0) }, |
43 "h|help" => sub { pod2usage(-verbose => 1, -exit => 0) }, |
33 "man" => sub { pod2usage(-verbose => 2, -exit => 0) }, |
44 "man" => sub { pod2usage(-verbose => 2, -exit => 0) }, |
34 "m|monitor" => \$opt_monitor, |
45 "m|monitor" => \$opt_cmd_monitor, |
35 "dev=s" => \$opt_dev, |
46 "c|config=s" => \$opt_config, |
|
47 "d|base-dir=s" => \$opt_base, |
|
48 "i|import" => \$opt_import, |
|
49 "dev=s" => \$opt_dev, |
36 ) or pod2usage(-exit => 1); |
50 ) or pod2usage(-exit => 1); |
37 |
51 |
38 my $cmd = shift; |
|
39 |
|
40 -w $opt_dev or die "$ME: write access to $opt_dev: $!\n"; |
52 -w $opt_dev or die "$ME: write access to $opt_dev: $!\n"; |
41 |
53 |
42 given ($cmd) { |
54 given (shift) { |
43 when ("start") { |
55 when ("start") { |
44 _start(@ARGV); |
56 cmd_start(@ARGV); |
45 _monitor(@ARGV) if $opt_monitor; |
57 cmd_monitor(@ARGV) if $opt_cmd_monitor; |
46 } |
58 } |
47 when ("monitor") { _monitor(@ARGV) } |
59 when ("monitor") { cmd_monitor(@ARGV) } |
48 when ("kill") { _kill(@ARGV) } |
60 when ("kill") { cmd_kill(@ARGV) } |
49 default { pod2usage() }; |
61 default { pod2usage() }; |
50 } |
62 } |
51 |
63 |
52 } |
64 } |
53 |
65 |
54 sub read_config($) { |
66 sub cmd_kill(@) { |
55 defined(my $kvm = shift) or pod2usage; |
67 my ($kvm) = @_; |
56 my @config = slurp sprintf($CONFIG, $kvm), { chomp => 1 }; |
68 pod2usage() if not defined $kvm; |
57 (shift @config) =~ /^#\s+kvm/ |
69 my $config = config->load_running_config(_running_config_file $kvm); |
58 or die "wrong file format (\"# kvm\" expected)\n"; |
70 my $pidfile = $config->get("-pidfile"); |
59 |
71 my $pid = slurp $pidfile, { chomp => 1 }; |
60 push @config, "-name $kvm" unless /^-name\b/ ~~ @config; |
|
61 push @config, "-monitor pty" unless /^-monitor\b/ ~~ @config; |
|
62 push @config, "-pidfile $BASE/run/$kvm/pid" unless /^-pidfile\b/ ~~ @config; |
|
63 |
|
64 return @config; |
|
65 } |
|
66 |
|
67 sub _kill(@) { |
|
68 my $kvm = shift; |
|
69 my @config = read_config($kvm); |
|
70 |
|
71 (/^-pidfile\s+(?<pidfile>.*)/ ~~ @config); |
|
72 my $pid = slurp $+{pidfile}, { chomp => 1 }; |
|
73 |
72 |
74 kill $KILL => $pid; |
73 kill $KILL => $pid; |
75 waitpid($pid, 0); |
74 waitpid($pid, 0); |
76 unlink $+{pidfile}; |
75 unlink $pidfile, _monitor_link $kvm, _running_config_file $kvm; |
77 } |
76 |
78 |
77 } |
79 sub _start(@) { |
78 |
80 my $kvm = shift; |
79 sub cmd_start(@) { |
81 my @config = read_config($kvm); |
80 my ($kvm) = @_; |
82 |
81 pod2usage() if not defined $kvm; |
83 mkpath("$BASE/run/$kvm"); |
82 |
|
83 -d _base_dir $kvm or mkpath _base_dir $kvm; |
|
84 |
|
85 my $config = config->load_user_config( |
|
86 $kvm => defined $opt_config ? $opt_config : _user_config_file $kvm); |
|
87 |
|
88 -d dirname $config->get("-pidfile") |
|
89 or die "$ME: directory for pidfile (" |
|
90 . $config->get("-pidfile") |
|
91 . "): $!\n"; |
|
92 |
|
93 $config->save_user_config(_user_config_file $kvm) |
|
94 if defined $opt_config and defined $opt_import; |
|
95 |
|
96 $config->save_running_config(_running_config_file $kvm); |
84 |
97 |
85 defined(my $pid = open(VM, "-|")) or die "Can't fork: $!\n"; |
98 defined(my $pid = open(VM, "-|")) or die "Can't fork: $!\n"; |
86 |
99 |
87 if ($pid == 0) { |
100 if ($pid == 0) { |
88 open(STDERR, ">&STDOUT") |
101 open(STDERR, ">&STDOUT") |
89 or die "Can't redirect STDERR to STDOUT: $!\n"; |
102 or die "Can't redirect STDERR to STDOUT: $!\n"; |
90 exec $KVM "kvm-$kvm" => map { split " ", $_, 2 } @config; |
103 exec $KVM "kvm-$kvm" => $config->get_all(); |
91 die "Can't exec: $!"; |
104 die "Can't exec: $!"; |
92 } |
105 } |
93 |
106 |
94 <VM> ~~ /\s(\S+)$/; |
107 if (defined($_ = <VM>)) { |
95 symlink($1, "$BASE/run/$kvm/monitor"); |
108 print $_; |
96 } |
109 if (/char device redirected to (\S+)$/) { |
97 |
110 unlink(_monitor_link $kvm); |
98 sub _monitor(@) { |
111 symlink($1, _monitor_link $kvm); |
99 my $kvm = shift; |
112 exit; |
100 my @config = read_config($kvm); |
113 } |
101 my $i = new IO::File("<$BASE/run/$kvm/monitor"); |
114 |
102 my $o = new IO::File(">$BASE/run/$kvm/monitor"); |
115 wait; |
|
116 die "$ME: didn't start: (exit ", $? >> 8, ")\n"; |
|
117 |
|
118 } |
|
119 |
|
120 } |
|
121 |
|
122 sub cmd_monitor(@) { |
|
123 my ($kvm, $cmd) = (shift, "@_"); |
|
124 pod2usage() if not defined $kvm; |
|
125 |
|
126 |
|
127 my $monitor = _monitor_link $kvm; |
|
128 my $pts = readlink $monitor |
|
129 or die "$ME: $monitor: $!\n"; |
|
130 |
|
131 my $i = new IO::File("<$pts") or die "$pts: $!\n"; |
|
132 my $o = new IO::File(">$pts") or die "$pts: $!\n"; |
103 |
133 |
104 $o->autoflush(1); |
134 $o->autoflush(1); |
|
135 |
|
136 if (length $cmd) { |
|
137 die "passing a command to monitor is not yet implemented\n"; |
|
138 $_ = ""; |
|
139 while (not /^\(qemu\) /) { |
|
140 sysread($i, $_, 1, length); |
|
141 $_ = "" if /\n$/; |
|
142 } |
|
143 syswrite($o, "$cmd\n"); |
|
144 $_ = ""; |
|
145 while (not /^\(qemu\) /m) { |
|
146 sysread($i, $_, 1, length); |
|
147 } |
|
148 s/^.*?\r?\n//; |
|
149 s/(\r?\n).*?$/$1/; |
|
150 die "<$_>"; |
|
151 exit; |
|
152 } |
105 |
153 |
106 say("** to leave the monitor, just use the <ESC> key!"); |
154 say("** to leave the monitor, just use the <ESC> key!"); |
107 my $termio = `stty -g`; |
155 my $termio = `stty -g`; |
108 my $rows = (split " ", `stty size`)[0]; |
156 my $rows = (split " ", `stty size`)[0]; |
109 system("stty raw -echo"); |
157 system("stty raw -echo"); |
110 |
158 |
111 eval { |
159 eval { |
112 my $row = 0; |
160 my $row = 1; |
113 INPUT: |
161 INPUT: |
114 while (my @ready = IO::Select->new($i, \*STDIN)->can_read(undef)) { |
162 while (my @ready = IO::Select->new($i, \*STDIN)->can_read(undef)) { |
115 foreach my $fh (@ready) { |
163 foreach my $fh (@ready) { |
116 if ($fh == $i) { |
164 if ($fh == $i) { |
117 sysread($i, $_, 1) == 0 |
165 sysread($i, $_, 1) == 0 |
118 and last INPUT; |
166 and last INPUT; |
119 syswrite(STDOUT, $_); |
167 syswrite(STDOUT, $_); |
120 if (/\n/ and $row++ >= $rows) { |
168 if (/\n/ and $row++ >= $rows) { |
121 syswrite(STDOUT, "more..."); |
169 syswrite(STDOUT, "more..."); |
122 sysread(STDIN, $_, 1); |
170 sysread(STDIN, $_, 1); |
123 $row = 0; |
171 $row = 1; |
124 } |
172 } |
125 } |
173 } |
126 elsif ($fh == \*STDIN) { |
174 elsif ($fh == \*STDIN) { |
127 (sysread(STDIN, $_, 1) == 0 or /\e/) |
175 (sysread(STDIN, $_, 1) == 0 or /\e/) |
128 and print("\r\n"), last INPUT; |
176 and print("\r\n"), last INPUT; |
129 syswrite($o, $_); |
177 syswrite($o, $_); |
130 $row = 0; |
178 $row = 1; |
131 } |
179 } |
132 } |
180 } |
133 } |
181 } |
134 }; |
182 }; |
135 system("stty $termio"); |
183 system("stty $termio"); |
136 } |
184 } |
137 |
185 |
|
186 { |
|
187 |
|
188 package config; |
|
189 use strict; |
|
190 use warnings; |
|
191 use YAML::Syck; |
|
192 use Perl6::Slurp; |
|
193 use feature qw(:5.10); |
|
194 |
|
195 use Data::Dumper; |
|
196 |
|
197 my %data; |
|
198 |
|
199 sub load_user_config { |
|
200 my ($class, $kvm, $file) = @_; |
|
201 my $self = bless do { \my $x } |
|
202 => $class; |
|
203 |
|
204 my @config = slurp $file, { chomp => 1 }; |
|
205 |
|
206 $data{$self}{kvm} = $kvm; |
|
207 push @config, "-name $kvm" unless /^-name\b/ ~~ @config; |
|
208 push @config, "-monitor pty" unless /^-monitor\b/ ~~ @config; |
|
209 push @config, "-pidfile $opt_base/vm/$kvm/pid" |
|
210 unless /^-pidfile\b/ ~~ @config; |
|
211 $data{$self}{config} = \@config; |
|
212 |
|
213 return $self; |
|
214 } |
|
215 |
|
216 sub save_running_config { |
|
217 my ($self, $file) = @_; |
|
218 DumpFile($file, $data{$self}); |
|
219 } |
|
220 |
|
221 sub save_user_config { |
|
222 my ($self, $file) = @_; |
|
223 my $fh = new IO::File ">$file" or die "$file: $!\n"; |
|
224 $fh->print(join "\n", |
|
225 "# kvm configuration file", |
|
226 "# imported kvm config, you *may* edit this file", |
|
227 @{ $data{$self}{config} }); |
|
228 } |
|
229 |
|
230 sub load_running_config { |
|
231 my ($class, $file) = @_; |
|
232 my $self = bless do { \my $x } |
|
233 => $class; |
|
234 $data{$self} = LoadFile($file); |
|
235 return $self; |
|
236 } |
|
237 |
|
238 sub get { |
|
239 my ($self, $key) = @_; |
|
240 my @a = map { /^$key\s+(.*)/ ? $1 : () } @{ $data{$self}{config} }; |
|
241 return wantarray ? @a : $a[0]; |
|
242 } |
|
243 |
|
244 sub get_all { |
|
245 my ($self) = @_; |
|
246 return map { split " ", $_, 2 } grep !/^\s*#/, |
|
247 @{ $data{$self}{config} }; |
|
248 } |
|
249 |
|
250 sub DESTROY { |
|
251 my $self = shift; |
|
252 delete $data{$self}; |
|
253 } |
|
254 |
|
255 } |
|
256 |
138 __END__ |
257 __END__ |
139 |
258 |
140 =head1 NAME |
259 =head1 NAME |
141 |
260 |
142 kvmtool - tool to start and stop kvm w/o any X11 |
261 kvmtool - tool to start and stop kvm w/o any X11 |
143 |
262 |
144 =head1 SYNOPSIS |
263 =head1 SYNOPSIS |
145 |
264 |
146 kvmtool <start|kill|monitor> <name> |
265 kvmtool [options] start [--config <config> [--import]] [--monitor] <name> |
|
266 kvmtool [options] monitor <name> |
|
267 kvmtool [options] kill <name> |
147 |
268 |
148 =head1 DESCRITPTION |
269 =head1 DESCRITPTION |
149 |
270 |
|
271 =head1 COMMANDS |
|
272 |
|
273 =head2 start |
|
274 |
|
275 =head2 monitor |
|
276 |
150 =head1 OPTIONS |
277 =head1 OPTIONS |
151 |
278 |
|
279 Some of the following options are of general nature (as B<--base-dir>), some |
|
280 other options are only useful in combination with some specific action |
|
281 (as B<--monitor>). You may pass as many useless options as you want ;-) |
|
282 |
152 =over |
283 =over |
153 |
284 |
|
285 =item B<-c>|B<--config> I<config> |
|
286 |
|
287 Use the specified configuration instead of the one once imported. |
|
288 (default: I<undef>) |
|
289 |
|
290 =item B<-i>|B<--import> |
|
291 |
|
292 Import the specified configuration. (default: I<undef>) |
|
293 |
154 =item B<--dev>=I<device> |
294 =item B<--dev>=I<device> |
155 |
295 |
156 Pathname of the KVM device. (default: /dev/kvm) |
296 Pathname of the KVM device. (default: /dev/kvm) |
157 |
297 |
158 =item B<--dir>=I<dir> |
|
159 |
|
160 Directory for meta share information about KVMs. |
|
161 |
|
162 =item B<-h>|B<--help> |
298 =item B<-h>|B<--help> |
163 |
299 |
164 Show a short help page. |
300 Show a short help page. |
165 |
301 |
166 =item B<-m>|B<--man> |
302 =item B<-m>|B<--man> |