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/<br>|&#\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;
}