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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1.1.1 - (hide 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 joko 1.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