Added vserverctl

diff --git a/vserverctl b/vserverctl
new file mode 100755 (executable)
index 0000000..40c8ade
--- /dev/null
+++ b/vserverctl
@@ -0,0 +1,242 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Data::Dumper;
+use Config::Auto;
+use File::Slurp qw(slurp write_file);
+use Carp;
+use File::Basename;
+
+my $baseDir = '/vserver/';
+my $profileBaseDir = $baseDir . '.profile/';
+my $startTime = time;
+
+my $action  = shift;
+my $vsname  = shift;
+my $profile = shift;
+
+my $ipaddr;
+my $scriptFH;
+
+printUsage() unless ( defined $action and $action =~ /^add|remove$/ );
+printUsage() unless ( defined $vsname and $vsname =~ /^\w[\w-]*$/ );
+
+if ( $action eq 'remove' ) {
+    unless ( -d '/etc/vservers/' . $vsname ) {
+        print "Vserver $vsname doesn't exist\n";
+        exit 1;
+    }
+    $profile = slurp('/etc/vservers/' . $vsname . '/profile');
+    chomp $profile;
+    $ipaddr = slurp('/etc/vservers/' . $vsname . '/interfaces/0/ip');
+    chomp $ipaddr;
+}
+
+printUsage() unless ( defined $profile and -d $profileBaseDir . $profile );
+
+my $vsroot  = $baseDir . $vsname . '/';
+my $config  = readConfig($profile);
+my $vsflags = 'nproc,ulimit,sched_prio,virt_mem,virt_uptime,virt_cpu,virt_load,hide_mount,hide_netif';
+$ipaddr     ||= getFreeIPAddress();
+my $ipmask  = '24';
+$ENV{LANG} = '';
+$ENV{DEBIAN_FRONTEND} = 'noninteractive';
+$ENV{VSNAME} = $vsname;
+$ENV{VSROOT} = $vsroot;
+$ENV{VSIPADDR} = $ipaddr;
+$ENV{VSRELEASE} = $config->{release};
+
+#use Data::Dumper;
+#print Dumper($config->{files}{files});
+#exit 1;
+
+if ( $action eq 'remove' ) {
+    print "Removing $vsname, $ipaddr, $profile\n";
+
+    if ( ! system('vserver', $vsname, 'running') ) {
+        print "Stopping existing vserver: $vsname\n";
+        system('vserver', $vsname, 'stop');
+    }
+
+    # Purge previous config and contents
+    system('rm', '-rf', '/etc/vservers/' . $vsname);
+    system('rm', '-rf', $vsroot);
+
+    open $scriptFH, '|-', '/bin/bash';
+    print {$scriptFH} $config->{files}{'remove-host'};
+    close $scriptFH;
+}
+if ( $action eq 'add' ) {
+    if ( -d '/etc/vservers/' . $vsname ) {
+        system($0, 'remove', $vsname);
+    }
+
+    system(
+        'vserver',
+        $vsname,
+        'build',
+        '-m'          => 'debootstrap',
+        '--rootdir'   => $baseDir,
+        '--hostname'  => $vsname,
+        '--interface' => "dummy0:${ipaddr}/${ipmask}",
+        '--flags'     => $vsflags,
+        '--',
+        '-d' => $config->{release},
+        '-m' => $config->{mirror},
+    );
+    system('vserver', $vsname, 'start');
+    write_file('/etc/vservers/' . $vsname . '/profile', $profile);
+    write_file($vsroot . 'etc/apt/sources.list', $config->{files}{aptsources});
+    # TODO: get the apt-key stuff working
+    system('vserver', $vsname, 'apt-get', 'update');
+
+    open $scriptFH, '|-', '/bin/bash';
+    print {$scriptFH} $config->{files}{'pre-host'};
+    close $scriptFH;
+    open $scriptFH, '|-', 'vserver', $vsname, 'exec', '/bin/bash';
+    print {$scriptFH} $config->{files}{'pre-vserver'};
+    close $scriptFH;
+
+    system('vserver', $vsname, 'apt-get', 'install', '--assume-yes', '--force-yes', split(/\s+/ms, $config->{files}{packages}));
+
+    my %files = split(/\s+/ms, $config->{files}{files});
+    foreach my $key ( keys %files ) {
+        print "FILE: '$key' => '${vsroot}$files{$key}'\n";
+        system('cp', $key, $vsroot . $files{$key});
+    }
+    my %templates = split(/\s+/ms, $config->{files}{templates});
+    foreach my $key ( keys %templates ) {
+        my $file = basename($key);
+        print "TEMPLATE: '$key' => '${vsroot}$templates{$key}'\n";
+        my $data = slurp($key);
+        $data =~ s/__VSNAME__/$vsname/g;
+        $data =~ s/__VSIPADDR__/$ipaddr/g;
+        write_file($vsroot . '.template', $data);
+        system('mv', $vsroot . '.template', $vsroot . $templates{$key} . $file);
+    }
+
+    open $scriptFH, '|-', 'vserver', $vsname, 'exec', '/bin/bash';
+    print {$scriptFH} $config->{files}{'post-vserver'};
+    close $scriptFH;
+    open $scriptFH, '|-', '/bin/bash';
+    print {$scriptFH} $config->{files}{'post-host'};
+    close $scriptFH;
+
+    my $totalTime = time - $startTime;
+    print "New vserver '$vsname' created in $totalTime seconds\n";
+}
+
+
+
+sub readConfig { # {{{
+    my $profile = shift;
+
+    my $defaultConfig = {
+        'name'                 => 'default',
+        'mirror'               => 'http://debian.catalyst.net.nz/debian',
+        'parent'               => undef,
+        'release'              => 'etch',
+        'inherit-files'        => 1,
+        'inherit-packages'     => 1,
+        'inherit-post-host'    => 1,
+        'inherit-remove-host'  => 1,
+        'inherit-post-vserver' => 1,
+        'inherit-pre-host'     => 1,
+        'inherit-pre-vserver'  => 1,
+        'inherit-aptsources'   => 1,
+        'inherit-templates'    => 1,
+    };
+
+    my $config = [];
+
+    my $cfg = readConfigFile($profileBaseDir . $profile . '/profile.conf');
+    $cfg->{name} = $profile;
+    unshift @{$config}, $cfg;
+
+    while ( defined $cfg->{parent} ) {
+        my $name = $cfg->{parent};
+        $cfg = readConfigFile($profileBaseDir . $name . '/profile.conf');
+        $cfg->{name} = $name;
+
+        unshift @{$config}, $cfg;
+    }
+    unshift @{$config}, $defaultConfig;
+
+    my $generatedConfig = {};
+
+    foreach my $cfg ( @{$config} ) {
+        foreach my $key ( qw(release mirror) ) {
+            $generatedConfig->{$key} = $cfg->{$key} if defined $cfg->{$key};
+        }
+        foreach my $key ( qw(aptsources packages templates files pre-host pre-vserver post-host post-vserver remove-host) ) {
+            my $inheritKey = 'inherit-' . $key;
+            $generatedConfig->{$inheritKey} = $cfg->{$inheritKey} if defined $cfg->{$inheritKey};
+
+            if ( $generatedConfig->{$inheritKey} ) {
+                $generatedConfig->{files}{$key} ||= '';
+            }
+            else {
+                $generatedConfig->{files}{$key} = '';
+            }
+
+            my $filename = $profileBaseDir . $cfg->{name} . '/' . $key;
+
+            if ( -e $filename ) {
+                my $data = slurp($filename);
+                if ( $key eq 'files' or $key eq 'templates' ) {
+                    $data =~ s{ ^ (\S+) }{$profileBaseDir$cfg->{name}/data/$1}xmsg;
+                }
+                $generatedConfig->{files}{$key} .= $data;
+            }
+        }
+    }
+    foreach my $key ( keys %{$generatedConfig->{files}} ) {
+        $generatedConfig->{files}{$key} =~ s{ \A \s* (.*?) \s* \z }{$1}xms;
+    }
+
+    return $generatedConfig;
+} # }}}
+sub readConfigFile { # {{{
+    my $filename = shift;
+
+    my $cfg = Config::Auto::parse($filename);
+
+    foreach my $key ( keys %{$cfg} ) {
+        next unless defined $cfg->{$key};
+        $cfg->{$key} = undef unless $cfg->{$key} =~ /\S/;
+
+        if ( $key =~ m{ \A inherit- }xms ) {
+            if ( $cfg->{$key} =~ m{ \A ( yes | y | true | 1 ) \z }ixms ) {
+                $cfg->{$key} = 1;
+            }
+            else {
+                $cfg->{$key} = 0;
+            }
+        }
+    }
+
+    return $cfg;
+} # }}}
+sub printUsage { # {{{
+    print "Usage\n\n";
+    print "vserverctl add|remove vserver_name [profile]\n\n";
+    exit 1;
+} # }}}
+sub getFreeIPAddress { # {{{
+    my $existingIp = { 1 => 1 };
+    foreach my $ipFile ( glob '/etc/vservers/*/interfaces/0/ip' ) {
+        my $ip = slurp($ipFile);
+        next unless $ip =~ m{ \A \s* \d+ \. \d+ \. \d+ \. (\d+) \s* \z }xms;
+        $existingIp->{$1} = 1;
+    }
+
+    for ( my $i = 1; $i < 255 ; $i++ ) {
+        return "10.0.0.$i" unless $existingIp->{$i};
+    }
+
+    return undef;
+} # }}}
+
+