view release on metacpan or  search on metacpan

lib/DracPerl/Client.pm  view on Meta::CPAN

use DracPerl::Factories::DellDefaultCommand;
use DracPerl::Factories::CommandCollection;
use DracPerl::CollectionMappings;
use DracPerl::Models::Auth;

has 'ua' => ( lazy => 1, is => 'ro', builder => '_build_ua' );

has 'url'      => ( is => 'ro', isa => 'Str', required => 1 );
has 'user'     => ( is => 'ro', isa => 'Str', required => 1 );
has 'password' => ( is => 'ro', isa => 'Str', required => 1 );

has 'max_retries' => ( is => 'ro', isa => 'Int', default => 5 );
has 'token'       => ( is => 'rw', isa => 'Str', default => 0 );

has 'log' => (
    is      => 'ro',
    default => sub {
        Log::Any::Adapter->set('Stdout');
        return Log::Any->get_logger;
    }
);

sub _build_ua {
    my $ua = LWP::UserAgent->new();
    $ua->ssl_opts( verify_hostname => 0 );
    $ua->cookie_jar( {} );

    #Thanks Spotify for theses two headers.
    #https://github.com/spotify/moob/blob/master/lib/moob/idrac7.rb#L23
    $ua->default_header( 'Accept-Encoding' => 'gzip,deflate,sdch' );
    $ua->default_header( 'Accept-Language' => 'en-US,en;q=0.8,sv;q=0.6' );

    $ua->default_header( 'Accept' => '*/*' );

    return $ua;
}

sub openSession {
    my ( $self, $saved_session ) = @_;

    unless ($saved_session) {
        $self->log->debug("Opening new session");
        return $self->_login;
    }

    $self->log->debug("Resuming opened session");
    $self->token( $saved_session->{token} );
    $self->ua->cookie_jar( $saved_session->{cookie_jar} );
    $self->ua->default_header( "ST2", $self->token );
    return 1;
}

sub closeSession {
    my ($self) = @_;

    my $logout_page = $self->ua->post( $self->url . "/data/logout" );

    $self->token(0);
    $self->ua->default_header( "ST2", $self->token );
    $self->log->debug( "Logging out : " . $logout_page->decoded_content );
    return 1;
}

sub saveSession {
    my ($self) = @_;

    return 0 unless $self->token;

    $self->log->info("Saving the session");
    return {
        token      => $self->token,
        cookie_jar => $self->ua->cookie_jar
    };
}

sub isAlive {
    my ($self) = @_;
    use Data::Dumper;
    my $response = $self->ua->get( $self->url . "TreeList.xml" );

    return 0 unless $response->is_success;

  # We don't really care about parsing the XML here, we just want to make sure
  # it is returning *something*
    return 0 unless $response->decoded_content =~ m/<TreeNodes>/;

    return 1;

}

sub _login {
    my $self = shift;

    my $login_form = $self->ua->get( $self->url . "/login.html" );

    if ( $login_form->is_success ) {
        $self->log->info("Login Step 0 success");
    }
    else {
        $self->log->error( "iDrac login page is unreacheable : "
                . $self->url
                . "/login.html" );
        die();
    }

    my $response_raw;
    my $response_xml;
    my $auth_model;
    my $need_to_retry = 1;
    my $current_tries = 1;
    my $logged;

    while ($need_to_retry) {

        $response_raw = $self->ua->post(
            $self->url . "/data/login",
            {   user     => $self->user,
                password => $self->password
            }
        );

        if ( $response_raw->is_success ) {
            $auth_model = DracPerl::Models::Auth->new(
                xml => $response_raw->decoded_content );
            $logged = !$auth_model->auth_result;
        }

        $need_to_retry = 0 if $logged;
        $need_to_retry = 0 if $current_tries > $self->max_retries - 1;

        if ($logged) {
            $self->log->info( "Sucessfully performed login step 1 ( Attempt "
                    . $current_tries . "/"
                    . $self->max_retries
                    . ")" );
        }
        else {
            $self->log->error( "Failed login step 1. ( Attempt "
                    . $current_tries . "/"
                    . $self->max_retries
                    . ")" );
        }

        $current_tries++;
    }

    die( "Logging failed after " . $self->max_retries . " attempts" )
        unless $logged;

    $self->log->debug(
        "Login Step 1 response : " . $response_raw->decoded_content );

    my @tokens_parts = reverse split( "=", $auth_model->forward_url );

    $self->log->info( "Success while opening session / " . $tokens_parts[0] );

    $self->token( $tokens_parts[0] ) if $tokens_parts[0];
    $self->ua->default_header( "ST2", $self->token );
    return 1;
}

sub getCustomModel {
    my ( $self, $name ) = @_;

    my $result
        = $self->get(
        { custom_commands => DracPerl::CollectionMappings::get_query($name) }
        );
    return $result unless $result->{success};
    return $result->{$name};
}

sub get {
    my ( $self, $args ) = @_;

    $self->openSession() unless $self->token;

    my $commands    = $args->{commands};
    my $collections = $args->{collections};

    unless ( scalar @{$commands} || scalar @{$collections} ) {
        $self->log->error("No commands or collections specified");
        return 0;
    }

    my $query = $self->_build_query_string( $commands, $collections );

    my $response = $self->ua->post( $self->url . "/data?get=" . $query );

    if ( $response->is_success ) {
        $self->log->info("Sucessfully fetched $query");
    }
    else {
        $self->log->error("Error while fetching $query");
    }

    my $raw_response = $response->decoded_content;

    return $self->_parse_response( $commands, $collections, $raw_response );
}

sub _parse_response {
    my ( $self, $commands, $collections, $xml ) = @_;

    #TODO : Snake-case the commands before putting them in the hash
    my $result;

    foreach my $command ( @{$commands} ) {
        my $model = DracPerl::Factories::DellDefaultCommand->create( $command,
            { xml => $xml } );
        $result->{$command} = $model;
    }

    foreach my $collection ( @{$collections} ) {
        my $model
            = DracPerl::Factories::CommandCollection->create( $collection,
            { xml => $xml } );
        $result->{$collection} = $model;
    }

    return $result
        || {
        success => 0,
        message => 'XML returned matched no model',
        raw     => $xml
        };
}

sub _build_query_string {
    my ( $self, $commands, $collections ) = @_;

    my $query = '';

    $query = join( ',', @{$commands} );

    #TODO : Deduplicate
    my @collections_queries
        = map { DracPerl::CustomCommandsMappings::get_query($_) }
        @{$collections};

    $query .= join( ',', @collections_queries );

    return $query;
}

sub set {
    die("Not implemented yet");
}

=head1 NAME

DracPerl::Client - API Client for Dell's management interface (iDRAC)

=head1 AUTHOR

Jules Decol - @Apcros