File Coverage

blib/lib/Net/Proxmox/VE/Access.pm

Criterion	Covered	Total	%
statement	15	197	7.6
branch	0	186	0.0
condition	0	24	0.0
subroutine	5	32	15.6
pod	27	27	100.0
total	47	466	10.0

#!/bin/false
# vim: softtabstop=2 tabstop=2 shiftwidth=2 ft=perl expandtab smarttab
# PODNAME: Net::Proxmox::VE::Access
# ABSTRACT: Functions for the 'access' portion of the API

use strict;
use warnings;

package Net::Proxmox::VE::Access;
$Net::Proxmox::VE::Access::VERSION = '0.37';
use parent 'Exporter';

use Carp qw( croak );

use JSON::MaybeXS qw(decode_json);

our @EXPORT =
  qw(
  access
  access_domains access_groups access_roles
  create_access_domains create_access_groups create_access_roles create_access_users
  delete_access_domains delete_access_groups delete_access_roles delete_access_users
  get_access_domains get_access_groups get_access_roles get_access_users
  update_access_domains update_access_groups update_access_roles update_access_users
  login check_login_ticket clear_login_ticket
  get_access_acl update_access_acl
  update_access_password
  );


my $base = '/access';

sub access {

    my $self = shift or return;

    return $self->get($base);

}


sub access_domains {

    my $self = shift or return;

    return $self->get( $base, 'domains' )

}


sub create_access_domains {

    my $self = shift or return;
    my @p = @_;

    croak 'No arguments for create_access_domains()' unless @p;
    my %args;

    if ( @p == 1 ) {
        croak 'Single argument not a hash for create_access_domains()'
          unless ref $a eq 'HASH';
        %args = %{ $p[0] };
    }
    else {
        croak 'Odd number of arguments for create_access_domains()'
          if ( scalar @p % 2 != 0 );
        %args = @p;
    }

    return $self->post( $base, 'domains', \%args )

}


sub get_access_domains {

    my $self = shift or return;

    my $a = shift or croak 'No realm for get_access_domains()';
    croak 'realm must be a scalar for get_access_domains()' if ref $a;

    return $self->get( $base, 'domains', $a )

}


sub update_access_domains {

    my $self   = shift or return;
    my $realm = shift or croak 'No realm provided for update_access_domains()';
    croak 'realm must be a scalar for update_access_domains()' if ref $realm;
    my @p = @_;

    croak 'No arguments for update_access_domains()' unless @p;
    my %args;

    if ( @p == 1 ) {
        croak 'Single argument not a hash for update_access_domains()'
          unless ref $a eq 'HASH';
        %args = %{ $p[0] };
    }
    else {
        croak 'Odd number of arguments for update_access_domains()'
          if ( scalar @p % 2 != 0 );
        %args = @p;
    }

    return $self->put( $base, 'domains', $realm, \%args )

}


sub delete_access_domains {

    my $self = shift or return;
    my $a    = shift or croak 'No argument given for delete_access_domains()';

    return $self->delete( $base, 'domains', $a )

}


sub access_groups {

    my $self = shift or return;

    return $self->get( $base, 'groups' )

}


sub create_access_groups {

    my $self = shift or return;
    my @p = @_;

    croak 'No arguments for create_access_groups()' unless @p;
    my %args;

    if ( @p == 1 ) {
        croak 'Single argument not a hash for create_access_groups()'
          unless ref $a eq 'HASH';
        %args = %{ $p[0] };
    }
    else {
        croak 'Odd number of arguments for create_access_groups()'
          if ( scalar @p % 2 != 0 );
        %args = @p;
    }

    return $self->post( $base, 'groups', \%args )

}


sub get_access_groups {

    my $self = shift or return;

    my $a = shift or croak 'No groupid for get_access_groups()';
    croak 'groupid must be a scalar for get_access_groups()' if ref $a;

    return $self->get( $base, 'groups', $a )

}


sub update_access_groups {

    my $self   = shift or return;
    my $realm = shift or croak 'No realm provided for update_access_groups()';
    croak 'realm must be a scalar for update_access_groups()' if ref $realm;
    my @p = @_;

    croak 'No arguments for update_access_groups()' unless @p;
    my %args;

    if ( @p == 1 ) {
        croak 'Single argument not a hash for update_access_groups()'
          unless ref $a eq 'HASH';
        %args = %{ $p[0] };
    }
    else {
        croak 'Odd number of arguments for update_access_groups()'
          if ( scalar @p % 2 != 0 );
        %args = @p;
    }

    return $self->put( $base, 'groups', $realm, \%args )

}


sub delete_access_groups {

    my $self = shift or return;
    my $a    = shift or croak 'No argument given for delete_access_groups()';

    return $self->delete( $base, 'groups', $a )

}



sub access_roles {

    my $self = shift or return;

    return $self->get( $base, 'roles' )

}


sub create_access_roles {

    my $self = shift or return;
    my @p = @_;

    croak 'No arguments for create_access_roles()' unless @p;
    my %args;

    if ( @p == 1 ) {
        croak 'Single argument not a hash for create_access_roles()'
          unless ref $a eq 'HASH';
        %args = %{ $p[0] };
    }
    else {
        croak 'Odd number of arguments for create_access_roles()'
          if ( scalar @p % 2 != 0 );
        %args = @p;
    }

    return $self->post( $base, 'roles', \%args )

}


sub get_access_roles {

    my $self = shift or return;

    my $a = shift or croak 'No roleid for get_access_roles()';
    croak 'roleid must be a scalar for get_access_roles()' if ref $a;

    return $self->get( $base, 'roles', $a )

}


sub update_access_roles {

    my $self   = shift or return;
    my $realm = shift or croak 'No realm provided for update_access_roles()';
    croak 'realm must be a scalar for update_access_roles()' if ref $realm;
    my @p = @_;

    croak 'No arguments for update_access_roles()' unless @p;
    my %args;

    if ( @p == 1 ) {
        croak 'Single argument not a hash for update_access_roles()'
          unless ref $a eq 'HASH';
        %args = %{ $p[0] };
    }
    else {
        croak 'Odd number of arguments for update_access_roles()'
          if ( scalar @p % 2 != 0 );
        %args = @p;
    }

    return $self->put( $base, 'roles', $realm, \%args )

}


sub delete_access_roles {

    my $self = shift or return;
    my $a    = shift or croak 'No argument given for delete_access_roles()';

    return $self->delete( $base, 'roles', $a )

}



sub access_users {

    my $self = shift or return;

    return $self->get( $base, 'users' )

}


sub create_access_users {

    my $self = shift or return;
    my @p = @_;

    croak 'No arguments for create_access_users()' unless @p;
    my %args;

    if ( @p == 1 ) {
        croak 'Single argument not a hash for create_access_users()'
          unless ref $a eq 'HASH';
        %args = %{ $p[0] };
    }
    else {
        croak 'Odd number of arguments for create_access_users()'
          if ( scalar @p % 2 != 0 );
        %args = @p;
    }

    return $self->post( $base, 'users', \%args )

}


sub get_access_users {

    my $self = shift or return;

    my $a = shift or croak 'No userid for get_access_users()';
    croak 'userid must be a scalar for get_access_users()' if ref $a;

    return $self->get( $base, 'users', $a )

}


sub update_access_users {

    my $self   = shift or return;
    my $realm = shift or croak 'No realm provided for update_access_users()';
    croak 'realm must be a scalar for update_access_users()' if ref $realm;
    my @p = @_;

    croak 'No arguments for update_access_users()' unless @p;
    my %args;

    if ( @p == 1 ) {
        croak 'Single argument not a hash for update_access_users()'
          unless ref $a eq 'HASH';
        %args = %{ $p[0] };
    }
    else {
        croak 'Odd number of arguments for update_access_users()'
          if ( scalar @p % 2 != 0 );
        %args = @p;
    }

    return $self->put( $base, 'users', $realm, \%args )

}


sub delete_access_users {

    my $self = shift or return;
    my $a    = shift or croak 'No argument given for delete_access_users()';

    return $self->delete( $base, 'users', $a )

}


sub check_login_ticket {

    my $self = shift or return;

    if (   $self->{ticket}
        && ref $self->{ticket} eq 'HASH'
        && $self->{ticket}
        && $self->{ticket}->{ticket}
        && $self->{ticket}->{CSRFPreventionToken}
        && $self->{ticket}->{username} eq $self->{params}->{username} . '@'
        . $self->{params}->{realm}
        && $self->{ticket_timestamp}
        && ( $self->{ticket_timestamp} + $self->{ticket_life} ) > time() )
    {
        return 1;
    }
    else {
        $self->clear_login_ticket;
    }

    return

}


sub clear_login_ticket {

    my $self = shift or return;

    if ( $self->{ticket} or $self->{timestamp} ) {
        $self->{ticket}           = undef;
        $self->{ticket_timestamp} = undef;
        return 1;
    }

    return

}


sub get_access_acl {

    my $self = shift or return;

    return $self->get( $base, 'acl' );

}


sub login {
    my $self = shift or return;

    # Prepare login request
    my $url = $self->url_prefix . '/api2/json/access/ticket';

    # Perform login request
    my $request_time = time();
    my $response     = $self->{ua}->post(
        $url,
        {
            'username' => $self->{params}->{username} . '@'
              . $self->{params}->{realm},
            'password' => $self->{params}->{password},
        },
    );

    if ( $response->is_success ) {
        # my $content           = $response->decoded_content;
        my $login_ticket_data = decode_json( $response->decoded_content );
        $self->{ticket} = $login_ticket_data->{data};

        # We use request time as the time to get the json ticket is undetermined,
        # id rather have a ticket a few seconds shorter than have a ticket that incorrectly
        # says its valid for a couple more
        $self->{ticket_timestamp} = $request_time;
        print "DEBUG: login successful\n"
          if $self->{params}->{debug};
        return 1;
    }
    else {

        print "DEBUG: login not successful\n"
          if $self->{params}->{debug};
        print "DEBUG: " . $response->status_line . "\n"
          if $self->{params}->{debug};

    }

    return;
}


sub update_access_acl {

    my $self = shift or return;
    my @p = @_;

    croak 'No arguments for update_acl()' unless @p;
    my %args;

    if ( @p == 1 ) {
        croak 'Single argument not a hash for update_acl()'
          unless ref $a eq 'HASH';
        %args = %{ $p[0] };
    }
    else {
        croak 'Odd number of arguments for update_acl()'
          if ( scalar @p % 2 != 0 );
        %args = @p;
    }

    return $self->put( $base, 'acl', \%args )

}


sub update_access_password {

    my $self = shift or return;
    my @p = @_;

    croak 'No arguments for update_password()' unless @p;
    my %args;

    if ( @p == 1 ) {
        croak 'Single argument not a hash for update_password()'
          unless ref $a eq 'HASH';
        %args = %{ $p[0] };
    }
    else {
        croak 'Odd number of arguments for update_password()'
          if ( scalar @p % 2 != 0 );
        %args = @p;
    }

    return $self->put( $base, 'password', \%args )

}


1;

__END__