#!/usr/bin/perl -T

package VServer;
our $VERSION = '1.5';

use strict;
use warnings;

sub get_context_id_by_name($) {
    my $vserver = shift;
    if ($vserver =~ /^([-a-z0-9._]*)$/) {
        $vserver = $1;
    };

    my $dir = "/etc/vservers/$vserver";
    return unless -d $dir;

    open(my $context, '<', "$dir/context") || return undef;

    my $cid = undef;
    while (<$context>) {
        if ($_ =~ m/([0-9]*)/) {
            $cid = $1;
            last;
        }
    }

    close $context;
    return $cid;
}

sub get_context_id_by_dir($) {
    my $dir = shift;
    my $id = undef;

    open(my $info, "<", "$dir/info") || return undef;
    while (<$info>) {
        if ($_ =~ m/^ID:\s*([0-9.]+)$/) {
            $id = $1;
            last;
        }
    }
    close($info);

    return $id;
}

sub get_proc_dir($) {
    my $context = shift;
    my $dir = "/proc/virtual/$context/";

    return $dir if (-d $dir);
    return undef;
}

sub get_config_dir($) {
    my $context = shift;

    my $dir = qx(/usr/sbin/vuname --xid $context --get context 2> /dev/null);
    return undef unless ($? eq 0);

    chomp($dir);
    return $dir;
}

sub get_name($) {
    my $context = shift;
    my $dir = get_config_dir($context) || return undef;
    my $name = undef;

    open(my $file, "<", "$dir/name") || return undef;
    while (<$file>) {
        chomp($name = $_);
        last;
    }
    close($file);

    return $name;
}

sub get_loadavg($) {
    my $id = shift;
    my $dir = get_proc_dir($id) || return undef;
    my @load = undef;

    open(my $cvirt, "<", "$dir/cvirt") || return undef;
    while (<$cvirt>) {
        if ($_ =~ m/^loadavg:\s*([0-9.]+)\s*([0-9.]+)\s*([0-9.]+)$/) {
            @load = ($1, $2, $3);
            last;
        }
    }
    close($cvirt);

    return @load;
}


1;
__END__

=pod

=head1 NAME

VServer - little perl helpers for handling linux-vserver

=head1 SYNOPSIS

    use VServer;
    my $id = VServer::get_context_id("name");

=head1 DESCRIPTION

This module contains some functions for interfacing linux-vserver
with perl. It does not use the libvserver library, but reading files
in I</proc/virtual/> and I</etc/vservers/> and executing lightwight
external tools like I<vuname>.

=head2 Methods

=over 4

=item B<get_context_id_by_name($vserver_name)>

Returns the context id for a vserver given by its name. If an
invalid name is supplied or any other error occurs, B<undef>
is returned.

=item B<get_context_id_by_dir($proc_dir)>

Returns the context id for a vserver given by the path in the
I</proc/virtual/> tree. This could be done by parsing the path,
but the function uses the I<info> file and parsing the C<ID:> line.
If the I<info> file is not found or does not contain a line starting
with C<ID:>, B<undef> is returned.

=item B<get_proc_dir($context)>

Build the directory in C</proc/virtual/> for the given context id.
The directory is build with the following template:
I</proc/virtual/$context/>. If the resulting directory does not exist
(e.g. because the vserver is not running), B<undef> is returned.

=item B<get_config_dir($context)>

Returns the config directory for the given context id. This is done
by calling C</usr/sbin/vuname>. If any error occurs, B<undef> is
returned.

=item B<get_name($context)>

Returns the name of the vserver specified by the given context id.
This uses B<get_config_dir($context)> and reading the name file
inside the config directory. If any error occurs, B<undef> is
returned.

=item B<get_loadavg($context)>

Returns the three (load1, load5, load15) load values for the vserver
specified by the given context id. The functions reads the B<cvirt>
file inside the I</proc> directory of the vserver and parses the
loadavg values. The function returns the three values or B<undef>
if any error occurs.

=back

=head1 AUTHORS

Alexander Sulfrian <alexander@sulfrian.net>

=cut