#!/usr/bin/perl -T

package VServer;
our $VERSION = '1.12';

use strict;
use warnings;
use POSIX;

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 = ();

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

    return \%load;
}

sub get_mem($) {
    my $context = shift;
    my $dir = get_proc_dir($context) || return undef;
    my $ps = POSIX::sysconf(&POSIX::_SC_PAGESIZE) || return undef;
    my %mem = ();

    open(my $limit, "<", "$dir/limit") || return undef;
    while (<$limit>) {
        if ($_ =~ m/^VM:\s*([0-9]+)\s/) {
            $mem{'vm'} = $1 * $ps;
        }
        elsif ($_ =~ m/RSS:\s*([0-9]+)\s/) {
            $mem{'rss'} = $1 * $ps;
        }
        elsif ($_ =~ m/ANON:\s*([0-9]+)\s/) {
            $mem{'anon'} = $1 * $ps;
        }
        elsif ($_ =~ m/VML:\s*([0-9]+)\s/) {
            $mem{'vml'} = $1 * $ps;
        }
    }
    close($limit);

    return \%mem;
}

sub get_net($) {
    my $context = shift;
    my $dir = get_proc_dir($context) || return undef;
    my %net = undef;

    open(my $cacct, "<", "$dir/cacct") || return undef;
    while (<$cacct>) {
        if ($_ =~ m/^UNIX:\s*[0-9]+\/([0-9]+)\s+[0-9]+\/([0-9]+)\s+[0-9]+\/([0-9]+)\s/) {
            $net{'unix'} = list($1, $2, $3);
        }
        elsif ($_ =~ m/^INET:\s*[0-9]+\/([0-9]+)\s+[0-9]+\/([0-9]+)\s+[0-9]+\/([0-9]+)\s/) {
            $net{'inet'} = list($1, $2, $3);
        }
        elsif ($_ =~ m/^INET6:\s*[0-9]+\/([0-9]+)\s+[0-9]+\/([0-9]+)\s+[0-9]+\/([0-9]+)\s/) {
            $net{'inet6'} = list($1, $2, $3);
        }
    }
    close($cacct);

    return \%net;
}

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 as hasref 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 a hashref or
B<undef> if any error occurs.

=item B<get_mem($context)>

Return memory information for the vserver specified by the given
context id. The function reads the B<limit> file inside the I</proc>
directory of the vserver, parses the memory information and
multiplies it with the pagesize. The function returns a hashref with
the following values or B<undef> if any error occurs:

=over

=item C<vm>

I<virtual memory>

=item C<rss>

I<resident set size>

=item C<anon>

I<anonymous memory>

=item C<vml>

I<virtual locked memory>

=back

=item B<get_net($context)>

Return socket information for the vserver specified by the given
context id. The function reads the B<cacct> file inside the I</proc>
directory of the vserver and parses the network information. The
function returns a hashref with an array of recieved, send and
error bytes for the follwoing values or B<undef> if any error
occurs:

=over

=item C<unix>

Bytes recieved, send and errored over unix domain sockets.

=item C<inet>

Bytes recieved, send and errored over IPv4 sockets.

=item C<inet6>

Bytes recieved, send and errored over IPv6 sockets.

=back

=back

=head1 AUTHORS

Alexander Sulfrian <alexander@sulfrian.net>

=cut