/usr/local/CPAN/Nagios-NSCA/Nagios/NSCA/Encrypt.pm


package Nagios::NSCA::Encrypt;
use strict;
use warnings;
use base 'Nagios::NSCA::Base';
use constant DEFAULT_ENCRYPTION_ALGORITHM => 'NONE';
use constant DEFAULT_ENCRYPTION_KEY => "";

our $VERSION = sprintf("%d", q$Id: Encrypt.pm,v 1.2 2006/04/10 22:39:38 matthew Exp $ =~ /\s(\d+)\s/);

### CLASS METHODS ###

sub new {
    my ($class, %args) = @_;
    my $fields = {
        iv => undef,
        key => DEFAULT_ENCRYPTION_KEY,
        algorithm => DEFAULT_ENCRYPTION_ALGORITHM,
    };
    my $self = $class->SUPER::new(%args);
    $self->_initFields($fields);

    # Set arguments passed in to the constructor
    $self->iv($args{iv});
    $self->key($args{key});
    $self->algorithm($args{algorithm});

    return $self;
}

sub hasMcrypt {
    my $class = shift;
    eval { require Mcrypt };
    return($@ ? 0 : 1);
}

sub numberToName {
    my ($class, $number) = @_;

    # Make sure we have a number
    if (not defined $number or $number !~ /^\d+$/) {
        $number ||= "undef";
        die "Invalid encryption number: $number\n";
    }

    my @map = $class->listAlgorithms();
    my $name = $map[$number];

    if (not $name or $name eq 'NOT_IMPLEMENTED') {
        die "Invalid encryption number: $number\n";
    }

    return $name;
}

sub listAlgorithms {
    return qw(NONE XOR DES 3DES CAST_128 CAST_256 XTEA 3WAY BLOWFISH TWOFISH
              LOKI97 RC2 ARCFOUR NOT_IMPLEMENTED RIJNDAEL_128 RIJNDAEL_192
              RIJNDAEL_256 NOT_IMPLEMENTED NOT_IMPLEMENTED WAKE SERPENT
              NOT_IMPLEMENTED ENIGMA GOST SAFER_SK64 SAFER_SK128 SAFERPLUS);
}

sub _algorithmIsListed {
    my ($class, $algorithm) = @_;

    # NOT_IMPLEMENTED is a special sentinal value to act as a place holder in
    # an array.  Disallow it as a legal type.
    return 0 if not $algorithm or $algorithm eq 'NOT_IMPLEMENTED';

    # See if the algorithm is listed.
    my %map = map {$_ => 1} $class->listAlgorithms;
    return exists $map{$algorithm};
}

sub hasAlgorithm {
    my ($class, $algorithm) = @_;

    # Make sure that algorithm is listed as a valid algorithm.  This doesn't
    # mean it works, however.
    return 0 if not $class->_algorithmIsListed($algorithm);

    # Just b/c it's listed doesn't mean Mcrypt was compiled with it, so test
    # that.  NONE and XOR are special non-Mcrypt encryption types.
    if ($algorithm ne 'NONE' and $algorithm ne 'XOR') {
        eval { $class->_getMcryptObject($algorithm) };
        return 0 if $@;
    }

    return 1;
}

### Accessors ###

sub encrypt {
    my ($self, $data) = @_;
    my $result;

    if ($self->algorithm eq 'NONE') {
        $result = $data;
    } elsif ($self->algorithm eq 'XOR') {
        $result = $self->_encryptXOR($data);
    } else {
        my $encrypter = $self->_makeEncrypter();
        $result = $encrypter->encrypt($data);
    }

    return $result;
}

sub decrypt {
    my ($self, $data) = @_;
    my $result;

    if ($self->algorithm eq 'NONE') {
        $result = $data;
    } elsif ($self->algorithm eq 'XOR') {
        $result = $self->_decryptXOR($data);
    } else {
        my $encrypter = $self->_makeEncrypter();
        $result = $encrypter->decrypt($data);
    }

    return $result;
}

### Private Methods ###

sub _encryptXOR {
    my ($self, $data) = @_;
    warn "XOR unimplemented.\n";
    return $data;
}

sub _decryptXOR {
    my ($self, $data) = @_;
    warn "XOR unimplemented.\n";
    return $data;
}

sub _getMcryptObject {
    my ($self, $algorithm) = @_;
    my $td;

    # Make sure we have Mcrypt and the algorithm is an Mcrypt algorithm, the
    # NONE and XOR types are legal but aren't implemented via Mcrypt.
    if (not $self->hasMcrypt()) {
        die "The Perl Mcrypt library does not appear to be installed.\n";
    } elsif (not $self->_algorithmIsListed($algorithm)) {
        $algorithm ||= "undef";
        die "Algorithm \"$algorithm\" is not known.\n";
    } elsif ($algorithm eq 'NONE' or $algorithm eq 'XOR') {
        die "Algorithm \"$algorithm\" is internal and not implemented by " .
            "Mcrypt.\n";
    }

    # Load up the library and try and create the object.
    require Mcrypt;
    no strict 'refs';  # So we can load up the algorithm symbolically
    my $algo = "Mcrypt::$algorithm";
    eval {
        $td = Mcrypt->new(algorithm => &$algo,
                          mode => &Mcrypt::CFB, 
                          verbose => 0);
    };

    if (not $td or $@) {
        die "Mcrypt failed to load.  Was $algorithm compiled into Mcrypt?\n";
    }

    return $td;
}

sub _makeEncrypter {
    my $self = shift;

    # Load up Mcrypt and create the object.
    my $td = $self->_getMcryptObject($self->algorithm);

    # Possibly shorten the given IV and key to the desired size.
    my $iv = substr($self->iv, 0, $td->{IV_SIZE});
    my $key = substr($self->key, 0, $td->{KEY_SIZE});
    $td->init($key, $iv);

    return $td;
}

1;