#################### main pod documentation begin ################### =head1 NAME Zymonic::Decryptor::Message::Status - Zymonic Decryptor Status Message. =head1 SYNOPSIS This is a Message class that returns the status of the decryptor's key holding. =head1 DESCRIPTION This is a Message class that returns the status of the decryptor's key holding. =head1 USAGE The message should simply be: { messagetype => 'Status' } The response will be: { key_a => { present => 'Y or N', decoded => 'Y or N', primary => 'Y or N', kek_part_1_last_sent => 'date and time', kek_part_2_last_sent => 'date and time', }, key_b => { present => 'Y or N', decoded => 'Y or N', primary => 'Y or N', kek_part_1_last_sent => 'date and time', kek_part_2_last_sent => 'date and time', }, } =head1 BUGS None we're aware of... =head1 SUPPORT As in the license, Zymonic is provided without warranty or support unless purchased separately, however... If you email zymonic-support@zednax.com your issue will be noted and may receive a response. For security issues, please contact zymonic-security@zednax.com and someone will respond within 8 working hours. =head1 AUTHOR Alex Masidlover et al. CPAN ID: MODAUTHOR Zednax Limited alex.masidlover@zednax.com http://www.zednax.com =head1 COPYRIGHT This program is free software licensed under the... Zymonic Public License 1.0 The full text of the license can be found in the LICENSE file included with this module. Other licenses may be acceptable if including parts of Zymonic in larger projects, please contact Zednax for details. =head1 SEE ALSO perl(1). =cut #################### main pod documentation end ################### package Zymonic::Decryptor::Message::Status; use strict; use warnings; BEGIN { use Exporter (); use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); $VERSION = '0.01'; @ISA = qw(Exporter); #Give a hoot don't pollute, do not export more than needed by default @EXPORT = qw(); @EXPORT_OK = qw(); %EXPORT_TAGS = (); } use base 'Zymonic::Decryptor::Message'; #################### subroutine header begin #################### =head2 respond Usage : my $response = $mh->repsond($in) Purpose : This is the response handler method for decryptor messages. Returns : a response hashref Argument : a message hashref Throws : nothing Comment : The 'base' response is just a ping... See Also : =cut #################### subroutine header end #################### sub respond { my $self = shift; my $in = shift; # Check system is loaded return { error => 'Requested system not loaded.' } unless ref( $self->{decryptor_server}->{systems}->{ $in->{system} } ); $self->{decryptor_server}->connection_log('Checking Decryptor Status'); # Check for decoded key and make sure only Y or N gets through # i.e. avoid a typo returning the private key... my %key_status = (); foreach my $key (qw(a b)) { $key_status{$key} = $self->{decryptor_server}->key_status( $in->{system}, $key ); $key_status{$key}->{decoded} =~ s/[^YN]//g; } return { map { 'key_' . $_ => $key_status{$_} } keys(%key_status) }; } 1;