API-DirectAdmin

 view release on metacpan or  search on metacpan

lib/API/DirectAdmin.pm  view on Meta::CPAN

# for init subclasses
init_components(
    domain => 'Domain',
    mysql  => 'Mysql',
    user   => 'User',
    dns    => 'DNS',
    ip     => 'Ip',
);

# init
sub new {
    my $class = shift;
    $class = ref ($class) || $class;
    
    my $self = {
        auth_user   => '',
        auth_passwd => '',
        host        => '',
        ip          => '',
        debug       => $DEBUG,
	    allow_https => 1,

lib/API/DirectAdmin.pm  view on Meta::CPAN

    };

    confess "Required auth_user!"   unless $self->{auth_user};
    confess "Required auth_passwd!" unless $self->{auth_passwd};
    confess "Required host!"        unless $self->{host};

    return bless $self, $class;
}

# initialize components
sub init_components {
    my ( %c ) = @_;
    my $caller = caller;

    for my $alias (  keys %c ) {

        my $item = $c{$alias};

        my $sub = sub {
            my( $self ) = @_;
            $self->{"_$alias"} ||= $self->load_component($item);
            return $self->{"_$alias"} || confess "Not implemented!";
        };
        
        no strict 'refs';
 
        *{"$caller\::$alias"} = $sub;
    }
}

# loads component package and creates object
sub load_component {
    my ( $self, $item ) = @_;

    my $pkg = ref($self) . '::' . $item;

    my $module = "$pkg.pm";
       $module =~ s/::/\//g;

    local $@;
    eval { require $module };
    if ( $@ ) {
	confess "Failed to load $pkg: $@";
    }

    return $pkg->new(directadmin => $self);

}

# Filter hash
# STATIC(HASHREF: hash, ARRREF: allowed_keys)
# RETURN: hashref only with allowed keys
sub filter_hash {
    my ($self, $hash, $allowed_keys) = @_;
    
    return {} unless defined $hash;
    
    confess "Wrong params" unless ref $hash eq 'HASH' && ref $allowed_keys eq 'ARRAY';

    my $new_hash = { };

    foreach my $allowed_key (@$allowed_keys) {
        if (exists $hash->{$allowed_key}) {

lib/API/DirectAdmin.pm  view on Meta::CPAN

        }
        elsif (exists $hash->{lc $allowed_key}) {
            $new_hash->{$allowed_key} = $hash->{lc $allowed_key};
        };
    }

    return $new_hash;
}

# all params derived from get_auth_hash
sub query {
    my ( $self, %params ) = @_;

    my $command   = delete $params{command};
    my $fields    = $params{allowed_fields} || '';

    my $allowed_fields;
    warn 'query_abstract ' . Dumper( \%params ) if $self->{debug};

    confess "Empty command" unless $command;

lib/API/DirectAdmin.pm  view on Meta::CPAN

        params 	      => $params,
    );
    
    carp Dumper $server_answer if $self->{debug};

    return $server_answer;
}

# Kill slashes at start / end string
# STATIC(STRING:input_string)
sub kill_start_end_slashes {
    my ($self ) = @_;

    for ( $self->{host} ) {
        s/^\/+//sgi;
        s/\/+$//sgi;
    }

    return 1;
}

# Make full query string 
# STATIC(HASHREF: params)
# params:
# host*
# port*
# param1
# param2 
# ...
sub mk_full_query_string {
    my ( $self, $params ) = @_;

    confess "Wrong params: " . Dumper( $params ) unless ref $params eq 'HASH' 
                                                        && scalar keys %$params
                                                        && $self->{host}
                                                        && $params->{command};

    my $allow_https = defined $params->{allow_https} ? $params->{allow_https} : $self->{allow_https};
    delete $params->{allow_https};
   

lib/API/DirectAdmin.pm  view on Meta::CPAN

    my $auth_passwd = $self->{auth_passwd};

    $self->kill_start_end_slashes();

    my $query_path = ( $allow_https ? 'https' : 'http' ) . "://$auth_user:$auth_passwd\@$host:$port/$command?";
    return $query_path . $self->mk_query_string($params);
}

# Make query string
# STATIC(HASHREF: params)
sub mk_query_string {
    my ($self, $params) = @_;

    return '' unless ref $params eq 'HASH' && scalar keys %$params;

    my %params = %$params;

    my $result = join '&', map { "$_=$params{$_}" } sort keys %params;

    return $result;
}

# Get + deparse
# STATIC(STRING: query_string)
sub process_query {
    my ( $self, %params ) = @_;

    my $query_string = $params{query_string};
    my $method 	     = $params{method};

    confess "Empty query string" unless $query_string;

    my $answer = $self->{fake_answer} ? $self->{fake_answer} : $self->mk_query_to_server( $method, $query_string, $params{params} );
    carp $answer if $self->{debug};

    return $answer;
}

# Make request to server and get answer
# STATIC (STRING: query_string)
sub mk_query_to_server {
    my ( $self, $method, $url, $params ) = @_;
    
    unless ( $method ~~ [ qw( POST GET ) ] ) {
        confess "Unknown request method: '$method'";
    }

    confess "URL is empty" unless $url;

    my $content;
    my $ua = LWP::UserAgent->new;

lib/API/DirectAdmin.pm  view on Meta::CPAN

	$content = $response->content;
    }
    
    warn "Answer: " . $content if $self->{debug};
    
    return $content if $params->{noparse};
    return $self->parse_answer($content);
}

# Parse answer
sub parse_answer {
    my ($self, $response) = @_;

    return '' unless $response;
    
    my %answer;
    $response =~ s/&#60br&#62|&#\d+//ig; # Some trash from answer
    $response =~ s/\n+/\n/ig;
    my @params = split /&/, $response;
    
    foreach my $param ( @params ) {

lib/API/DirectAdmin/Component.pm  view on Meta::CPAN

# Constructor class for API-DirectAdmin components

package API::DirectAdmin::Component;

use Modern::Perl '2010';
use Carp;

our $VERSION = 0.02;

sub new {
    my ( $class, %params ) = @_;
    $class = ref $class || $class;

    confess "Required API::DirectAdmin object!" unless $params{directadmin};

    return bless \%params, $class;
}

# API::DirectAdmin object
sub directadmin { $_[0]->{directadmin} }

1;

lib/API/DirectAdmin/DNS.pm  view on Meta::CPAN


use Modern::Perl '2010';
use Carp;

use base 'API::DirectAdmin::Component';

our $VERSION = 0.06;

# Return zone dump
# params: domain
sub dumpzone {
    my ($self, $params ) = @_;
    
    my %add_params = (
	noparse => 1,
    );
    
    my %params = (%$params, %add_params);
    
    my $zone = $self->directadmin->query(
        params         => \%params,
        command        => 'CMD_API_DNS_CONTROL',
        allowed_fields => 'domain noparse',
    );

    return _parse_zone($zone, $params->{domain}. '.', '') unless ref $zone eq 'HASH';
    return $zone;
}

# Add records A, MX, CNAME, NS, PTR, TXT, AAAA
# params: domain, type, name, value
sub add_record {
    my ($self, $params ) = @_;

    my %add_params = (
	action => 'add',
    );
    
    my %params = (%$params, %add_params);

    return $self->directadmin->query(
        params         => \%params,
        command        => 'CMD_API_DNS_CONTROL',
	method	       => 'POST',
        allowed_fields => "type name action value domain",
    );
}

# Remove records A, MX, CNAME, NS, PTR, TXT, AAAA, SRV
# params: domain, type, name, value
sub remove_record {
    my ($self, $params ) = @_;
    
    my %add_params = (
	action => 'select',
	lc $params->{type} . 'recs0' => "name=$params->{name}&value=$params->{value}",
    );
    
    delete $params->{type};
    
    my %params = (%$params, %add_params);

lib/API/DirectAdmin/DNS.pm  view on Meta::CPAN

			   aaaarecs0 
			   nsrecs0 
			   cnamerecs0 
			   srvrecs0 
			   ptrrecs0',
    );
}

# Special parser for zone dump
# Cropped code from Parse::DNS::Zone
sub _parse_zone {
    my ($zonetext, $origin) = @_;
    
    my $mrow;
    my $prev;
    my %zone;

    my $zentry = qr/^
	    (\S+)\s+ # name
	    (
		    (?: (?: IN | CH | HS ) \s+ \d+ \s+ ) |

lib/API/DirectAdmin/Domain.pm  view on Meta::CPAN

use Modern::Perl '2010';
use Data::Dumper;

use base 'API::DirectAdmin::Component';

our $VERSION = 0.05;

# Return domains list
# INPUT
# connection data for USER, not admin
sub list {
    my ($self ) = @_;

    my $responce = $self->directadmin->query(
	command => 'CMD_API_SHOW_DOMAINS',
    );
    
    return $responce->{list} if ref $responce eq 'HASH';
    return [];
}

# Add Domain to user account
# params: domain, php (ON|OFF), cgi (ON|OFF)
sub add {
    my ($self, $params ) = @_;
    
    my %add_params = (
	action => 'create',
    );
    
    my %params = (%$params, %add_params);
    
    #warn 'params ' . Dumper(\%params) if $DEBUG;

lib/API/DirectAdmin/Ip.pm  view on Meta::CPAN


use Modern::Perl '2010';

use base 'API::DirectAdmin::Component';

our $VERSION = 0.05;

# Return list of IP
# INPUT
# Admin connect params
sub list {
    my ($self ) = @_;

    my $responce = $self->directadmin->query(
	command => 'CMD_API_SHOW_RESELLER_IPS',
    );

    return $responce->{list} if ref $responce eq 'HASH';
    return [];
}

# Add Ip
# INPUT
# Admin connect params
# ip = 'IP.AD.DRE.SS'
# status = free|shared|owned (optional)
sub add {
    my ($self, $params ) = @_;
   
    my %add_params = (
	action   => 'add',
	add      => 'Submit',
	netmask  => '255.255.255.0',
	notify   => 'no',
    );
    
    my %params = (%$params, %add_params);

lib/API/DirectAdmin/Ip.pm  view on Meta::CPAN

			   netmask
			   notify
			   status',
    );
}

# Delete Ip
# INPUT
# Admin connect params
# select0 = 'IP.AD.DRE.SS'
sub remove {
    my ($self, $params ) = @_;
    
    my %add_params = (
	action   => 'select',
	delete   => 'Delete',
    );
    
    my %params = (%$params, %add_params);
    
    return $self->directadmin->query(

lib/API/DirectAdmin/Mysql.pm  view on Meta::CPAN

our $VERSION = 0.05;

# Create database for user
# Connection data MUST BE for user: auth_user => 'admin_login|user_login'
# auth_passwd => 'admin_passwd'
#    INPUT
#    name	=> 'DBNAME',
#    passwd	=> 'DBPASSWD',
#    passwd2	=> 'DBPASSWD',
#    user	=> 'DBLOGIN',
sub adddb {
    my ($self, $params ) = @_;
    
    $params->{action} = 'create';
    
    carp 'params ' . Dumper($params) if $self->{debug};
    
    my $responce = $self->directadmin->query(
	command        => 'CMD_API_DATABASES',
	method	       => 'POST',
	params         => $params,

lib/API/DirectAdmin/Mysql.pm  view on Meta::CPAN


    return 'FAIL';
}

# Delete database for user
# Connection data MUST BE for user: auth_user => 'admin_login|user_login'
# auth_passwd => 'admin_passwd'
#    INPUT
#    select0	=> 'DBNAME',
#    domain	=> 'DOMAIN.COM',
sub deldb {
    my ($self, $params ) = @_;
    
    $params->{action} = 'delete';

    carp 'params ' . Dumper($params) if $self->{debug};

    my $responce = $self->directadmin->query(
	command        => 'CMD_API_DATABASES',
	method	       => 'POST',
	params         => $params,

lib/API/DirectAdmin/Mysql.pm  view on Meta::CPAN

    
    carp '$responce ' . Dumper(\$responce) if $self->{debug};
    
    return $responce if $responce;    

    return 'FAIL';
}

# Get list of databases for authorized user.
# No params.
sub list {
    my ($self ) = @_;

    my $responce = $self->directadmin->query(
	command        => 'CMD_API_DATABASES',
	method	       => 'GET',
    );

    carp '$responce ' . Dumper($responce) if $self->{debug};

    return $responce->{list} if ref $responce eq 'HASH';

lib/API/DirectAdmin/User.pm  view on Meta::CPAN

package API::DirectAdmin::User;

use Modern::Perl '2010';
use Carp;

use base 'API::DirectAdmin::Component';

our $VERSION = 0.06;

# Return list of users (only usernames)
sub list {
    my ($self ) = @_;

    my $responce = $self->directadmin->query(
	command => 'CMD_API_SHOW_ALL_USERS',
    );

    return $responce->{list} if ref $responce eq 'HASH';
    return [];
}

# Create a New User
# params: username, domain, passwd, passwd2, package, ip, email
sub create {
    my ($self, $params ) = @_;
    
    my %add_params = (
	action   => 'create',
	add      => 'submit',
	notify 	 => 'no',
    );
    
    my %params = (%$params, %add_params);

lib/API/DirectAdmin/User.pm  view on Meta::CPAN

	    ip
	    email',
    );

    carp "Creating account: $responce->{text}, $responce->{details}" if $self->{debug};
    return $responce;
}

# Suspend user
# params: select0
sub disable {
    my ($self, $params ) = @_;
     
     my %add_params = (
	suspend	 => 'Suspend',
	location => 'CMD_SELECT_USERS',
    );
    
    my %params = (%$params, %add_params);
    
     my $responce = $self->directadmin->query(

lib/API/DirectAdmin/User.pm  view on Meta::CPAN

			   suspend
			   select0',
    );

    carp "Suspend account: $responce->{text}, $responce->{details}" if $self->{debug};
    return $responce;
}

# Unsuspend user
# params: select0
sub enable {
    my ($self, $params ) = @_;
     
     my %add_params = (
	suspend	 => 'Unsuspend',
	location => 'CMD_SELECT_USERS',
    );
    
    my %params = (%$params, %add_params);
    
    my $responce = $self->directadmin->query(

lib/API/DirectAdmin/User.pm  view on Meta::CPAN

			   select0',
    );

    carp "Unsuspend account: $responce->{text}, $responce->{details}" if $self->{debug};
    return $responce;    
    
}

# Delete user
# params: select0
sub delete {
    my ($self, $params ) = @_;
     
     my %add_params = (
	confirmed => 'Confirm',
	delete    => 'yes',
    );
    
    my %params = (%$params, %add_params);

    my $responce = $self->directadmin->query(

lib/API/DirectAdmin/User.pm  view on Meta::CPAN

			   delete
			   select0',
    );

    carp "Delete account: $responce->{text}, $responce->{details}" if $self->{debug};
    return $responce;
}

# Change passwd
# params: username, passwd, passwd2
sub change_password {
    my ($self, $params ) = @_;

    my $responce = $self->directadmin->query(
	command        => 'CMD_API_USER_PASSWD',
	method	       => 'POST',
	params         => $params,
	allowed_fields => 'passwd
			   passwd2
			   username',
    );

    carp "Change passwd account: $responce->{text}, $responce->{details}" if $self->{debug};
    return $responce;
}

# Change package for user
# params: user, package
sub change_package {
    my ($self, $params ) = @_;
    
    my $package = $params->{package};

    unless ( $self->{fake_answer} ) {
	unless ( $package ~~ $self->show_packages() ) {
	    return {error => 1, text => "No such package $package on server"};
	} 
    }
    

lib/API/DirectAdmin/User.pm  view on Meta::CPAN

			   package
			   user',
    );
    
    carp "Change package: $responce->{text}, $responce->{details}" if $self->{debug};
    return $responce;
}

# Show a list of user packages
# no params
sub show_packages {
    my ($self ) = @_;

    my $responce = $self->directadmin->query(
	command => 'CMD_API_PACKAGES_USER',
    )->{list};

    return $responce;
}

# Show user config
# params: user
sub show_user_config {
    my ( $self, $params ) = @_;

    my $responce = $self->directadmin->query(
	command => 'CMD_API_SHOW_USER_CONFIG',
	params  => $params,
	allowed_fields => 'user',
    );

    return $responce;
}



( run in 0.693 second using v1.01-cache-2.11-cpan-4d50c553e7e )