/[cvs]/nfo/perl/scripts/umltools/UML/Control.pm
ViewVC logotype

Contents of /nfo/perl/scripts/umltools/UML/Control.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1.1.1 - (show annotations) (vendor branch)
Tue Oct 22 02:25:56 2002 UTC (21 years, 6 months ago) by joko
Branch: nfo
CVS Tags: v000
Changes since 1.1: +0 -0 lines
+ initial import


1 package UML::Control;
2
3 use strict;
4 use warnings;
5
6 use UML::Config;
7 use UML::Utils;
8 use Data::Dumper;
9
10 # setup configuration
11 my $DEBUG_STEP = $UML::Config::DEBUG_STEP;
12 my $username_runas = $ENV{USER};
13 my $cmd_prefix = "";
14 if ($username_runas ne "service") {
15 # $cmd_prefix = "$sudo -u service";
16 }
17
18 END { print "\n"; }
19
20 my $lockdir = '/home/service/var/lock';
21
22 sub lock {
23 my $vhost_name = shift;
24 my $cmd = "> $lockdir/uml_$vhost_name.lock";
25 system($cmd);
26 }
27
28 sub unlock {
29 my $vhost_name = shift;
30 my $cmd = "$rm $lockdir/uml_$vhost_name.lock";
31 print "\n", "unlocking via \"$cmd\"", "\n";
32 system($cmd);
33 }
34
35 sub is_locked {
36 my $vhost_name = shift;
37 return (-e "$lockdir/uml_$vhost_name.lock");
38 }
39
40 sub ensureSafeAction {
41 my $vhost_name = shift;
42
43 if (!vhost_exists($vhost_name)) {
44 die("vhost \"$vhost_name\" does not exists, exit.");
45 }
46
47 if (is_locked($vhost_name)) {
48 die("\"$vhost_name\" is locked, unlock via \"rm $lockdir/uml_$vhost_name.lock\"!!!");
49 }
50 }
51
52 sub isDown {
53 my $vhost_name = shift;
54 my $rootfs = UML::Config::get_host_rootfs($vhost_name);
55 my $cmd = "$fuser $rootfs";
56 my $res = `$cmd`;
57 if ($res) {
58 return 0;
59 } else {
60 return 1;
61 }
62 }
63
64 sub waitForShutdown {
65 my $vhost_name = shift;
66 print "waiting for shutdown of \"$vhost_name\" ";
67 while (!isDown($vhost_name)) {
68 print ".";
69 sleep 3;
70 }
71 print "\n";
72 }
73
74
75 sub prepare {
76
77 my $vhost_name = shift;
78
79 # ensureSafeAction($vhost_name);
80 # lock($vhost_name);
81
82 my $userid = get_sys_userid();
83 #print "id: $userid", "\n";
84 if ($userid != 0) {
85 die(__PACKAGE__ . "::prepare can only be executed by root!");
86 }
87
88 my $vhost = get_host_cfg($vhost_name);
89 #print Dumper($vhost); exit;
90
91 my $vhost_path = get_host_basepath($vhost_name);
92 my $device_bridge = $vhost->{'bridge'}{'device'};
93
94 my $host_device = $vhost->{main}{'device'};
95 my $hostip = $vhost->{'main'}{'ip'};
96 my $netmask = $vhost->{'main'}{'netmask'};
97 my $broadcast = $vhost->{'main'}{'broadcast'};
98 my $ip = $vhost->{'net'}{'ip'};
99
100 my $cmd;
101
102
103 # network-bridge
104
105 my $owner_netbridge;
106 $owner_netbridge = $vhost->{'bridge'}{'owner'};
107 # use the identity of the user running this script
108 $owner_netbridge ||= "";
109
110
111 # # creating tap-devices with tunctl, if necessary
112 # $device_bridge =~ m/tap(\d+)/;
113 # my $tapnum = $1;
114 # while (get_tapnumber() lt $tapnum) {
115 # print "creating TAP", "\n";
116 # inc_tapnumber();
117 # }
118
119
120
121
122
123 # networking
124
125 $cmd = "$mount -o remount,rw /proc";
126 askCmd("", $cmd, "remounting /proc-filesystem read-write");
127
128 $cmd = "echo 1 > /proc/sys/net/ipv4/ip_forward";
129 askCmd("", $cmd, "enabling proxy-arp for \"$device_bridge\"");
130
131 $cmd = "$route del -host $ip dev $device_bridge gw $ip";
132 askCmd("", $cmd, "deleting route to \"$ip\" via \"$device_bridge\"");
133
134 #$cmd = "$ifconfig $device_bridge $hostip netmask $netmask broadcast $broadcast down";
135 $cmd = "$ifconfig $device_bridge $hostip netmask $netmask down";
136 askCmd("", $cmd, "shutting down device \"$device_bridge\"");
137
138
139 # initialize tap-device with tunctl
140 # determine user-id of device-owner
141 my $bridgeid = get_sys_userid($owner_netbridge);
142 # delete tap-device
143 $cmd = "$tunctl -d $device_bridge";
144 askCmd("", $cmd, "removing tap-device $device_bridge");
145 # create tap-device
146 $cmd = "$tunctl -t $device_bridge -u $bridgeid";
147 askCmd("", $cmd, "creating tap-device $device_bridge for owner $bridgeid");
148
149
150 $cmd = "$ifconfig $device_bridge $hostip netmask $netmask up";
151 askCmd("", $cmd, "setting up device \"$device_bridge\"");
152
153 $cmd = "$route add -host $ip dev $device_bridge gw $ip";
154 askCmd("", $cmd, "adding route to \"$ip\" via \"$device_bridge\"");
155
156 $cmd = "echo 1 > /proc/sys/net/ipv4/conf/$device_bridge/proxy_arp";
157 askCmd("", $cmd, "enabling proxy-arp for \"$device_bridge\"");
158
159 $cmd = "$arp -Ds $ip $host_device pub";
160 askCmd("", $cmd, "adding arp-entry for \"$ip\"");
161
162 $cmd = "$mount -o remount,r /proc";
163 askCmd("", $cmd, "remounting /proc-filesystem read-only");
164
165 $cmd = "$chmod 666 /dev/net/tun";
166 askCmd("", $cmd, "setting proper file-permissions on device");
167
168 $cmd = "/home/service/bin/iptables/iptables.accounting_tap $ip $device_bridge";
169 askCmd("", $cmd, "accounting-rules for \"$ip\"");
170
171 }
172
173 sub start {
174
175 my $vhost_name = shift;
176
177 my $vhost_t = get_host_cfg($vhost_name);
178 # print Dumper($vhost_t); exit;
179
180 # any other operations pending?
181 ensureSafeAction($vhost_name);
182
183 # don't try to start host if it seems to be up and running
184 if (!isDown($vhost_name)) {
185 print "$vhost_name is already running.", "\n";
186 return;
187 }
188
189 # get host config
190 my $vhost = get_host_cfg($vhost_name);
191
192 my $vhost_path = get_host_basepath($vhost_name);
193 my $device_bridge = $vhost->{'bridge'}{'device'};
194 my $ip = $vhost->{'net'}{'ip'};
195 my $host_device = $vhost->{main}{'device'};
196
197 my $owner;
198 $owner = get_sys_username();
199
200 # TODO: do an owner-check/change
201 # if ($owner != $owner_should_be) { ... }
202
203 #lock($vhost_name);
204
205 my $cmd;
206
207 #print "\n\n";
208
209 my $cmd_screen = "$screen -m -d -S $vhost_name ";
210
211 my $start_cmd = "
212 $cmd_screen $cmd_prefix $linux \\
213 mem=$vhost->{'mem'} \\
214 umid=$vhost->{'umid'} \\
215 uml_dir=$vhost_path/var \\
216 $host_device=tuntap,$device_bridge \\
217 ubd0=$vhost_path/rootfs/$vhost->{'rootfs'} \\
218 ubd1=$vhost_path/$vhost->{'swapfs'} \\
219 ubd2=$vhost_path/datafs/$vhost->{'datafs'}"; # > $vhost_path/boot.msg &";
220
221 # ubd2=$vhost_path/datafs/$vhost->{'datafs'} >> /dev/null"; # > $vhost_path/boot.msg";
222
223 askCmd("do it", $start_cmd, "starting \"$vhost_name\" on \"$ip\"");
224 unlock($vhost_name);
225
226 print "\n";
227
228 print <<EOM;
229 Please note:
230 Your linux called $vhost_name is running as $owner.
231 Since "screen" is used here, there are some issues you should know about:
232 You can't use the normal "su" to switch to this user from a root shell,
233 because the Terminal of this shell would still be owned by root.
234 (see http://groups.yahoo.com/group/gnu-screen/message/237)
235 This can simply be resolved by "chown"ing the tty-device to the
236 wanna-be user before doing a "su".
237 The program "sue" (included in this distribution) does exactly this.
238
239 Howto use your running linux:
240 - login via ssh to the specified ip-address or
241 - use "sue" and "screen" to switch to a running linux on the host system
242 #> sue <username>
243 #> screen -r <linuxname>
244 example:
245 #> sue service
246 #> screen -r quepasa
247
248 Detach from this screen by pressing: CTRL-A, CTRL-D
249
250 EOM
251
252 }
253
254
255 sub kill {
256
257 my $vhost_name = shift;
258
259 my $vhost = get_host_cfg($vhost_name);
260 my %vhost = %{$vhost};
261 my $vhost_path = get_host_basepath($vhost_name);
262
263 my $pid_main;
264
265 my $pidfile = "$vhost_path/var/$vhost_name/pid";
266 if (open FH, $pidfile) {
267 $pid_main = <FH>;
268 close FH;
269 chomp($pid_main);
270 }
271
272 my $cmd;
273
274 my $mconsole_file = "$vhost_path/var/$vhost_name/mconsole";
275 if (-e $mconsole_file) {
276 $cmd = "$uml_mconsole $mconsole_file halt";
277 #askCmd("do it", $cmd);
278 }
279
280 my @signals = (qw( TERM KILL ));
281
282 foreach my $signal (@signals) {
283
284 my $signame = 'SIG' . $signal;
285
286 # send signal to main process
287 if ($pid_main) {
288 print "sending main process the $signal signal", "\n";
289 #$cmd = "$kill -9 $pid_main";
290 $cmd = "$kill -s $signame $pid_main";
291 askCmd("do it", $cmd);
292 sleep 3;
293 }
294
295 # get list of processes
296 $cmd = "$ps ax";
297 my $procs = `$cmd`;
298 my @procs = split("\n", $procs);
299
300 # filter out child processes
301 my $regex = '\(' . $vhost_name . '\)';
302 @procs = grep(/$regex/, @procs);
303
304 next if (!@procs);
305 print "sending child processes the $signal signal", "\n";
306
307 # send signal to each process
308 foreach my $procline (@procs) {
309 $procline = substr($procline, 0, 80);
310 chomp($procline);
311 $procline =~ m/^[|\s]*(\w+)/;
312 my $pid = $1;
313 next if (!$pid);
314
315 if ($DEBUG_STEP) {
316 print $procline, "\n";
317 }
318 #$cmd = "$kill -9 $pid";
319 $cmd = "$kill -s $signal $pid";
320 askCmd("do it", $cmd);
321 }
322
323 # wait a bit
324 sleep 3;
325
326 }
327
328 }
329
330 sub stop {
331 my $vhost_name = shift;
332 stop_ssh($vhost_name);
333 }
334
335 sub stop_ssh {
336
337 my $vhost_name = shift;
338
339 my $vhost = get_host_cfg($vhost_name);
340 # print Dumper($vhost); exit;
341
342 my %vhost = %{$vhost};
343 my $vhost_path = get_host_basepath($vhost_name);
344
345 my $cmd;
346
347 ensureSafeAction($vhost_name);
348 lock($vhost_name);
349
350 # -----------------------------
351 # is: (via ssh-command) ;)
352 # done:
353 # - proper sync
354 # - proper shutdown
355 # todo:
356 # - abstract bd-account
357 # - automate setup of bd-account
358 my $ip = $vhost{'net'}{'ip'};
359 #my $remotecmd = "$sync && $poweroff";
360 #my $remotecmd = "$sync && $shutdown -h now";
361 my $remotecmd = "$sync && $halt";
362
363 print "Trying to reach $vhost_name via ssh to send shutdown command", "\n";
364 $cmd = "$cmd_prefix $ssh bd\@$ip \"$remotecmd\"";
365 askCmd("do it", $cmd);
366
367 unlock($vhost_name);
368
369 }
370
371 sub restart {
372
373 my $vhost_name = shift;
374 ensureSafeAction($vhost_name);
375
376 stop($vhost_name);
377 waitForShutdown($vhost_name);
378 start($vhost_name);
379
380 return;
381
382 lock($vhost_name);
383
384 my $vhost = get_host_cfg($vhost_name);
385 my %vhost = %{$vhost};
386 my $vhost_path = get_host_basepath($vhost_name);
387
388 my $cmd;
389 $cmd = "/usr/bin/uml_mconsole $vhost_path/var/$vhost_name/mconsole reboot";
390 askCmd("do it", $cmd);
391
392 unlock($vhost_name);
393
394 }
395
396 sub get_tapnumber {
397
398 my $infile = '/proc/net/dev';
399
400 open(FH, "<$infile");
401 my @lines = <FH>;
402 close(FH);
403
404 my $tapnumber = -1;
405 foreach (@lines) {
406 if (m/tap(\d+):/) {
407 my $tmp_tapnumber = $1;
408 if ($tmp_tapnumber gt $tapnumber) {
409 $tapnumber = $tmp_tapnumber;
410 }
411 }
412 }
413
414 return $tapnumber;
415
416 }
417
418 sub inc_tapnumber {
419 my $cmd;
420 $cmd = "/usr/bin/tunctl";
421 askCmd("do it", $cmd);
422 }
423
424 1;

MailToCvsAdmin">MailToCvsAdmin
ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed