## Domain Registry Interface, virtual superclass for all DRD modules
##
## Copyright (c) 2005 Patrick Mevzek <netdri@dotandco.com>. All rights reserved.
##
## This file is part of Net::DRI
##
## Net::DRI is free software; you can redistribute it and/or modify
## it under the terms of the GNU General Public License as published by
## the Free Software Foundation; either version 2 of the License, or
## (at your option) any later version.
##
## See the LICENSE file that comes with this distribution for more details.
#
#
#
#########################################################################################
package Net::DRI::DRD;
use strict;
our $VERSION=do { my @r=(q$Revision: 1.6 $=~/\d+/g); sprintf("%d".".%02d" x $#r, @r); };
=pod
=head1 NAME
Net::DRI::DRD - Superclass of all Net::DRI Domain Registry Drivers
=head1 DESCRIPTION
Please see the README file for details.
=head1 SUPPORT
For now, support questions should be sent to:
E<lt>netdri@dotandco.comE<gt>
Please also see the SUPPORT file in the distribution.
=head1 SEE ALSO
=head1 AUTHOR
Patrick Mevzek, E<lt>netdri@dotandco.comE<gt>
=head1 COPYRIGHT
Copyright (c) 2005 Patrick Mevzek <netdri@dotandco.com>.
All rights reserved.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
See the LICENSE file that comes with this distribution for more details.
=cut
#####################################################################
sub new
{
my $proto=shift;
my $class=ref($proto) || $proto;
my $self={ info => $_[0] };
bless($self,$class);
return $self;
}
sub info
{
my ($self,$key)=@_;
return undef unless defined($self->{info});
return undef unless (defined($key) && exists($self->{info}->{$key}));
return $self->{info}->{$key};
}
sub is_my_tld
{
my ($self,$domain)=@_;
my ($tld)=($domain=~m/\.([^\.]+)$/);
my @tlds=grep { uc($_) eq uc($tld) } $self->tlds();
return (@tlds)? 1 : 0;
}
## Methods to be defined in subclasses:
sub name { Net::DRI::Exception::err_method_not_implemented("name in ".ref($_[0])); } ## No dot is allowed in name
sub tlds { Net::DRI::Exception::err_method_not_implemented("tlds in ".ref($_[0])); }
sub is_thick { Net::DRI::Exception::err_method_not_implemented("is_thick in ".ref($_[0])); }
sub periods { Net::DRI::Exception::err_method_not_implemented("periods in ".ref($_[0])); } ## should return an array
sub root_servers { Net::DRI::Exception::err_method_not_implemented("root_servers in ".ref($_[0])); }
sub transport_protocol_compatible { Net::DRI::Exception::err_method_not_implemented("transport_protocol_compatible in ".ref($_[0])); }
## We will need to deal with specific characters allowed/specific languages allowed
sub has_idn { Net::DRI::Exception::err_method_not_implemented("has_idn in ".ref($_[0])); }
sub verify_name_domain { Net::DRI::Exception::err_method_not_implemented("verify_name_domain in ".ref($_[0])); }
sub domain_operation_needs_is_mine { Net::DRI::Exception::err_method_not_implemented("domain_operation_needs_is_mine in ".ref($_[0])); }
##############################################################################################################
sub verify_name_host
{
my ($self,$ndr,$host)=@_;
$host=$ndr unless (defined($ndr) && $ndr && (ref($ndr) eq 'Net::DRI::Registry'));
$host=$host->get_names(1) if (ref($host));
my $r=$self->check_name($host);
return $r if ($r);
return 10 unless $self->is_my_tld($host);
return 0;
}
sub check_name
{
my ($self,$ndr,$data,$dots)=@_;
($data,$dots)=($ndr,$data) unless (defined($ndr) && $ndr && (ref($ndr) eq 'Net::DRI::Registry'));
return 1 unless (defined($data) && $data);
return 2 unless Net::DRI::Util::is_hostname($data);
my @d=split(/\./,$data);
return 3 if ($dots && 1+$dots!=@d);
return 0; #everything ok
}
sub verify_duration_create
{
my ($self,$ndr,$duration,$domain)=@_;
($duration,$domain)=($ndr,$duration) unless (defined($ndr) && $ndr && (ref($ndr) eq 'Net::DRI::Registry'));
my @d=$self->periods();
return undef unless @d;
return $d[0] unless (defined($duration));
foreach my $d (@d) { return $d if (0==Net::DRI::Util::compare_durations($d,$duration)) }
return undef;
}
sub verify_duration_renew
{
my ($self,$ndr,$duration,$domain,$curexp)=@_;
($duration,$domain,$curexp)=($ndr,$duration,$domain) unless (defined($ndr) && $ndr && (ref($ndr) eq 'Net::DRI::Registry'));
my @d=$self->periods();
if (defined($duration) && @d)
{
my $ok=0;
foreach my $d (@d)
{
next unless (0==Net::DRI::Util::compare_durations($d,$duration));
$ok=1;
last;
}
return 1 unless $ok;
if (defined($curexp) && ref($curexp) && $curexp->isa('DateTime'))
{
my $maxdelta=$d[-1];
my $newexp=$curexp+$duration; ## New expiration
my $now=DateTime->now(time_zone => $curexp->time_zone()->name());
my $cmp=DateTime->compare($newexp,$now+$maxdelta);
return 2 unless ($cmp == -1); ## we must have : curexp+duration < now + maxdelta
}
}
return 0; ## everything ok
}
sub verify_duration_transfer
{
my ($self,$ndr,$duration,$domain,$op)=@_;
($duration,$domain,$op)=($ndr,$duration,$domain) unless (defined($ndr) && $ndr && (ref($ndr) eq 'Net::DRI::Registry'));
return 0; ## everything ok
}
#####################################################################################################
sub err_invalid_domain_name
{
my $domain=shift;
Net::DRI::Exception->die(0,'DRD',1,'Invalid domain name : '.((defined($domain) && $domain)? $domain : '?'));
}
sub err_invalid_host_name
{
my $dh=shift;
$dh||='?';
Net::DRI::Exception->die(0,'DRD',2,'Invalid host name : '.((ref($dh))? $dh->get_names(1) : $dh));
}
########################################################################################################################
## Operations on DOMAINS
########################################################################################################################
sub domain_create_only
{
my ($self,$ndr,$domain,$rd)=@_;
err_invalid_domain_name($domain) if $self->verify_name_domain($domain);
my %rd=(defined($rd) && ref($rd))? %$rd : ();
$rd{duration}=$self->verify_duration_create($rd{duration},$domain);
Net::DRI::Exception->new(0,'DRD',3,'Invalid duration') unless (defined($rd{duration}) && (ref($rd{duration}) eq 'DateTime::Duration'));
Net::DRI::Util::check_isa($rd{ns},'Net::DRI::Data::Hosts') if (exists($rd{ns}));
my $rc=$ndr->process('domain','create',[$domain,\%rd]);
return $rc;
}
sub domain_create
{
my ($self,$ndr,$domain,$rd)=@_;
err_invalid_domain_name($domain) if $self->verify_name_domain($domain);
my %rd=(defined($rd) && ref($rd))? %$rd : ();
## TODO : if contacts && is_thick, make sure they exist, or create them
my @rc;
my $nsin=Net::DRI::Data::Hosts->new();
my $nsout=Net::DRI::Data::Hosts->new();
if (exists($rd{ns})) ## Separate nameserver (inside & outside of domain) + Create outside nameservers if needed
{
Net::DRI::Util::check_isa($rd{ns},'Net::DRI::Data::Hosts');
$rc[0]=[];
foreach (1..$rd{ns}->count())
{
my @a=$rd{ns}->get_details($_);
if ($a[0]=~m/^(.+\.)?${domain}$/i)
{
$nsin->add(@a);
} else
{
my $ns=Net::DRI::Data::Hosts->new_set(@a);
unless ($self->host_exist($ndr,$ns))
{
my $rc0=$self->host_create($ndr,$ns);
push @{$rc[0]},$rc0;
return wantarray? @rc : $rc0 unless $rc0->is_success();
}
$nsout->add(@a);
}
}
$rd{ns}=$nsout;
}
## TODO ($rc1) : if contacts && is_thick, make sure they exist, or create them
my $rc2=$self->domain_create_only($ndr,$domain,\%rd);
$rc[2]=$rc2;
return wantarray? @rc : $rc2 unless $rc2->is_success();
unless ($nsin->is_empty()) ## Create inside nameservers & add them
{
$rc[3]=[];
foreach (1..$nsin->count())
{
my $ns=Net::DRI::Data::Hosts->new_set($nsin->get_details($_));
my $rc3=$self->host_create($ndr,$ns);
push @{$rc[3]},$rc3;
return wantarray? @rc : $rc3 unless $rc3->is_success();
}
my $rc4=$self->domain_update_ns_add($ndr,$domain,$nsin);
$rc[4]=$rc4;
return wantarray? @rc : $rc4 unless $rc4->is_success();
}
if (exists($rd{status})) ## if provided, add status to domain
{
my $rc5=$self->domain_update_status_add($ndr,$domain,$rd{status});
$rc[5]=$rc5;
return wantarray? @rc : $rc5 unless $rc5->is_success();
}
my $rc6=$self->domain_info($ndr,$domain);
$rc[6]=$rc6;
return wantarray? @rc : $rc6;
}
sub domain_delete_only
{
my ($self,$ndr,$domain)=@_;
err_invalid_domain_name($domain) if $self->verify_name_domain($domain);
my $rc=$ndr->process('domain','delete',[$domain]);
return $rc;
}
sub domain_delete
{
my ($self,$ndr,$domain)=@_;
err_invalid_domain_name($domain) if $self->verify_name_domain($domain);
my @r;
my $rc1=$self->domain_info($ndr,$domain);
push @r,$rc1;
return wantarray()? @r : $rc1 unless $rc1->is_success();
my $ns=$ndr->get_info('ns');
unless ($ns->is_empty())
{
my $rc2=$self->domain_update_ns_del($ndr,$domain,$ns);
push @r,$rc2;
return wantarray()? @r : $rc2 unless $rc2->is_success();
}
my $rc=$ndr->process('domain','delete',[$domain]);
push @r,$rc;
return wantarray()? @r : $rc;
}
sub domain_info
{
my ($self,$ndr,$domain)=@_;
err_invalid_domain_name($domain) if $self->verify_name_domain($domain);
my $rc;
my $exist;
if (defined($exist=$ndr->get_info('exist','domain',$domain)) && $exist)
{
$ndr->set_info_from_cache('domain',$domain);
$rc=get_info('rc');
} else
{
$rc=$ndr->process('domain','info',[$domain]);
}
return $rc;
}
sub domain_check
{
my ($self,$ndr,$domain)=@_;
err_invalid_domain_name($domain) if $self->verify_name_domain($domain);
my $rc;
if (defined($ndr->get_info('exist','domain',$domain)))
{
$ndr->set_info_from_cache('domain',$domain);
$rc=$ndr->get_info('rc');
} else
{
$rc=$ndr->process('domain','check',[$domain]);
}
return $rc;
}
sub domain_exist
{
my ($self,$ndr,$domain)=@_;
err_invalid_domain_name($domain) if $self->verify_name_domain($domain);
my $rc=$ndr->domain_check($domain);
my $c=$rc->code();
return 1 if ($c==2302); ## object exists
return 0 if ($c==2303); ## object does not exist
return undef;
}
sub domain_update
{
my ($self,$ndr,$domain,$tochange)=@_;
my $fp=$ndr->protocol->nameversion();
err_invalid_domain_name($domain) if $self->verify_name_domain($domain);
Net::DRI::Util::check_isa($tochange,'Net::DRI::Data::Changes');
foreach my $t ($tochange->types())
{
Net::DRI::Exception->new(0,'DRD',6,"Change domain_update/${t} not handled") unless ($t=~m/^(?:ns|status)$/);
next if $ndr->protocol_capable('domain_update',$t);
Net::DRI::Exception->new(0,'DRD',5,"Protocol ${fp} is not capable of domain_update/${t}");
}
my %what=('ns' => [ $tochange->all_defined('ns') ],
'status' => [ $tochange->all_defined('status') ],
);
foreach (@{$what{ns}}) { Net::DRI::Util::check_isa($_,'Net::DRI::Data::Hosts'); }
foreach (@{$what{status}}) { Net::DRI::Util::check_isa($_,'Net::DRI::Data::StatusList'); }
foreach my $w (keys(%what))
{
my @s=@{$what{$w}};
next unless @s; ## no changes of that type
my $add=$tochange->add($w);
my $del=$tochange->del($w);
my $set=$tochange->set($w);
Net::DRI::Exception->new(0,'DRD',5,"Protocol ${fp} is not capable for domain_update/${w} to add") if (defined($add) &&
! $ndr->protocol_capable('domain_update',$w,'add'));
Net::DRI::Exception->new(0,'DRD',5,"Protocol ${fp} is not capable for domain_update/${w} to del") if (defined($del) &&
! $ndr->protocol_capable('domain_update',$w,'del'));
Net::DRI::Exception->new(0,'DRD',5,"Protocol ${fp} is not capable for domain_update/${w} to set") if (defined($set) &&
! $ndr->protocol_capable('domain_update',$w,'set'));
Net::DRI::Exception->new(0,'DRD',6,"Change domain_update/${w} with simultaneous set and add or del not supported") if (defined($set) && (defined($add) || defined($del)));
}
my $rc=$ndr->process('domain','update',[$domain,$tochange]);
return $rc;
}
sub domain_update_ns_add { my ($self,$ndr,$domain,$ns)=@_; return $self->domain_update_ns($ndr,$domain,$ns,Net::DRI::Data::Hosts->new()); }
sub domain_update_ns_del { my ($self,$ndr,$domain,$ns)=@_; return $self->domain_update_ns($ndr,$domain,Net::DRI::Data::Hosts->new(),$ns); }
sub domain_update_ns_set { my ($self,$ndr,$domain,$ns)=@_; return $self->domain_update_ns($ndr,$domain,$ns); }
sub domain_update_ns
{
my ($self,$ndr,$domain,$nsadd,$nsdel)=@_;
Net::DRI::Util::check_isa($nsadd,'Net::DRI::Data::Hosts');
if (defined($nsdel)) ## add + del
{
Net::DRI::Util::check_isa($nsdel,'Net::DRI::Data::Hosts');
my $c=Net::DRI::Data::Changes->new();
$c->add('ns',$nsadd) unless ($nsadd->is_empty());
$c->del('ns',$nsdel) unless ($nsdel->is_empty());
return $self->domain_update($ndr,$domain,$c);
} else
{
return $self->domain_update($ndr,$domain,Net::DRI::Data::Changes->new_set('ns',$nsadd));
}
}
sub domain_update_status_add { my ($self,$ndr,$domain,$s)=@_; return $self->domain_update_status($ndr,$domain,$s,Net::DRI::Data::StatusList->new()); }
sub domain_update_status_del { my ($self,$ndr,$domain,$s)=@_; return $self->domain_update_status($ndr,$domain,Net::DRI::Data::StatusList->new(),$s); }
sub domain_update_status_set { my ($self,$ndr,$domain,$s)=@_; return $self->domain_update_status($ndr,$domain,$s); }
sub domain_update_status
{
my ($self,$ndr,$domain,$sadd,$sdel)=@_;
Net::DRI::Util::check_isa($sadd,'Net::DRI::Data::StatusList');
if (defined($sdel)) ## add + del
{
Net::DRI::Util::check_isa($sdel,'Net::DRI::Data::StatusList');
my $c=Net::DRI::Data::Changes->new();
$c->add('status',$sadd) unless ($sadd->is_empty());
$c->del('status',$sdel) unless ($sdel->is_empty());
return $self->domain_update($ndr,$domain,$c);
} else
{
return $self->domain_update($ndr,$domain,Net::DRI::Data::Changes->new_set('status',$sadd));
}
}
sub domain_renew
{
my ($self,$ndr,$domain,$duration,$curexp)=@_;
err_invalid_domain_name($domain) if $self->verify_name_domain($domain);
Net::DRI::Util::check_isa($duration,'DateTime::Duration') if defined($duration);
Net::DRI::Util::check_isa($curexp,'DateTime') if defined($curexp);
Net::DRI::Exception->new(0,'DRD',3,'Invalid duration') if $self->verify_duration_renew($duration,$domain,$curexp);
my $rc=$ndr->process('domain','renew',[$duration,$curexp]);
return $rc;
}
sub domain_transfer
{
my ($self,$ndr,$domain,$op)=@_;
err_invalid_domain_name($domain) if $self->verify_name_domain($domain);
Net::DRI::Exception::usererr_invalid_parameters("Transfer operation must be start,stop,accept,refuse or query") unless ($op=~m/^(?:start|stop|query|accept|refuse)$/);
Net::DRI::Exception->new(0,'DRD',3,'Invalid duration') if $self->verify_duration_transfer(undef,$domain,$op);
my $rc;
if ($op eq 'start')
{
$rc=$ndr->process('domain','transfer_start',[$domain]);
} elsif ($op eq 'stop')
{
$rc=$ndr->process('domain','transfer_cancel',[$domain]);
} elsif ($op eq 'query')
{
$rc=$ndr->process('domain','transfer_query',[$domain]);
} else ## accept/refuse
{
$rc=$ndr->process('domain','transfer_answer',[$domain,($op eq 'accept')? 1 : 0]);
}
return $rc;
}
sub domain_transfer_start { my ($self,$ndr,$domain)=@_; return $self->domain_transfer($ndr,$domain,'start'); }
sub domain_transfer_stop { my ($self,$ndr,$domain)=@_; return $self->domain_transfer($ndr,$domain,'stop'); }
sub domain_transfer_query { my ($self,$ndr,$domain)=@_; return $self->domain_transfer($ndr,$domain,'query'); }
sub domain_transfer_accept { my ($self,$ndr,$domain)=@_; return $self->domain_transfer($ndr,$domain,'accept'); }
sub domain_transfer_refuse { my ($self,$ndr,$domain)=@_; return $self->domain_transfer($ndr,$domain,'refuse'); }
sub domain_can
{
my ($self,$ndr,$domain,$what)=@_;
my $sok=$self->domain_status_allow($ndr,$domain,$what);
return 0 unless ($sok);
my $ismine=$self->domain_is_mine($ndr,$domain);
my $n=$self->domain_operation_needs_is_mine($domain,$what);
return undef unless (defined($n));
return ($ismine xor $n)? 0 : 1;
}
sub domain_status_allows_delete { my ($self,$ndr,$domain)=@_; return $self->domain_status_allows($ndr,$domain,'delete'); }
sub domain_status_allows_update { my ($self,$ndr,$domain)=@_; return $self->domain_status_allows($ndr,$domain,'update'); }
sub domain_status_allows_transfer { my ($self,$ndr,$domain)=@_; return $self->domain_status_allows($ndr,$domain,'transfer'); }
sub domain_status_allows_renew { my ($self,$ndr,$domain)=@_; return $self->domain_status_allows($ndr,$domain,'renew'); }
sub domain_status_allows
{
my ($self,$ndr,$domain,$what)=@_;
return 0 unless ($what=~m/^(?:delete|update|transfer|renew)$/);
my $s=$self->domain_current_status($ndr,$domain);
return 0 unless (defined($s));
return $s->can_delete() if ($what eq 'delete');
return $s->can_update() if ($what eq 'update');
return $s->can_transfer() if ($what eq 'transfer');
return $s->can_renew() if ($what eq 'renew');
return 0; ## failsafe
}
sub domain_current_status
{
my ($self,$ndr,$domain)=@_;
my $rc=$self->domain_info($ndr,$domain);
return undef unless $rc->is_success();
my $s=$ndr->get_info('status');
return undef unless (defined($s) && ref($s) && $s->isa('Net::DRI::Data::StatusList'));
return $s;
}
sub domain_is_mine
{
my ($self,$ndr,$domain)=@_;
my $clid=$self->info('clid');
return 0 unless defined($clid);
my $id;
eval
{
my $rc=$self->domain_info($ndr,$domain);
$id=$ndr->get_info('clID') if ($rc->is_success());
};
return 0 unless (!$@ && defined($id));
return ($clid=~m/^${id}$/)? 1 : 0;
}
########################################################################################################################
## Operations on HOSTS
########################################################################################################################
sub host_create
{
my ($self,$ndr,$dh)=@_;
err_invalid_host_name($dh) if $self->verify_name_host($dh);
my $rc=$ndr->process('host','create',[$dh]);
return $rc;
}
sub host_delete
{
my ($self,$ndr,$dh)=@_;
err_invalid_host_name($dh) if $self->verify_name_host($dh);
my $rc=$ndr->process('host','delete',[$dh]);
return $rc;
}
sub host_info
{
my ($self,$ndr,$dh)=@_;
my $name=(ref($dh))? $dh->get_names(1) : $dh;
err_invalid_host_name($name) if $self->verify_name_host($name);
my ($rc,$exist);
if (defined($exist=$ndr->get_info('exist','host',$name)) && $exist) ## check cache
{
$ndr->set_info_from_cache('host',$name);
$rc=$ndr->get_info('rc');
} else
{
$rc=$ndr->process('host','info',[$dh]); ## cache was empty, go to registry
}
return $rc unless $rc->is_success();
return (wantarray())? ($rc,$ndr->get_info('self')) : $rc;
}
sub host_check
{
my ($self,$ndr,$dh)=@_;
my $name=(ref($dh))? $dh->get_names(1) : $dh;
err_invalid_host_name($name) if $self->verify_name_host($name);
my $rc;
if (defined($ndr->get_info('exist','host',$name))) ## check cache
{
$ndr->set_info_from_cache('host',$name);
$rc=$ndr->get_info('rc');
} else
{
$rc=$ndr->process('host','check',[$dh]); ## go to registry
}
return $rc;
}
sub host_exist
{
my ($self,$ndr,$dh)=@_;
my $name=(ref($dh))? $dh->get_names(1) : $dh;
err_invalid_host_name($name) if $self->verify_name_host($name);
my $rc=$ndr->host_check($name);
my $c=$rc->code();
return 1 if ($c==2302); ## object exists
return 0 if ($c==2303); ## object does not exist
return undef;
}
sub host_update
{
my ($self,$ndr,$dh,$tochange)=@_;
my $fp=$ndr->protocol->nameversion();
err_invalid_host_name($dh) if $self->verify_name_host($dh);
Net::DRI::Util::check_isa($tochange,'Net::DRI::Data::Changes');
foreach my $t ($tochange->types())
{
Net::DRI::Exception->new(0,'DRD',6,"Change host_update/${t} not handled") unless ($t=~m/^(?:ip|status|name)$/);
next if $ndr->protocol_capable('host_update',$t);
Net::DRI::Exception->new(0,'DRD',5,"Protocol ${fp} is not capable of host_update/${t}");
}
my %what=('ip' => [ $tochange->all_defined('ip') ],
'status' => [ $tochange->all_defined('status') ],
'name' => [ $tochange->all_defined('name') ],
);
foreach (@{$what{ip}}) { Net::DRI::Util::check_isa($_,'Net::DRI::Data::Hosts'); }
foreach (@{$what{status}}) { Net::DRI::Util::check_isa($_,'Net::DRI::Data::StatusList'); }
foreach (@{$what{name}}) { err_invalid_host_name($_) if $self->verify_name_host($_); }
foreach my $w (keys(%what))
{
my @s=@{$what{$w}};
next unless @s; ## no changes of that type
my $add=$tochange->add($w);
my $del=$tochange->del($w);
my $set=$tochange->set($w);
Net::DRI::Exception->new(0,'DRD',5,"Protocol ${fp} is not capable for host_update/${w} to add") if (defined($add) &&
! $ndr->protocol_capable('host_update',$w,'add'));
Net::DRI::Exception->new(0,'DRD',5,"Protocol ${fp} is not capable for host_update/${w} to del") if (defined($del) &&
! $ndr->protocol_capable('host_update',$w,'del'));
Net::DRI::Exception->new(0,'DRD',5,"Protocol ${fp} is not capable for host_update/${w} to set") if (defined($set) &&
! $ndr->protocol_capable('host_update',$w,'set'));
Net::DRI::Exception->new(0,'DRD',6,"Change host_update/${w} with simultaneous set and add or del not supported") if (defined($set) && (defined($add) || defined($del)));
}
my $rc=$ndr->process('host','update',[$dh,$tochange]);
return $rc;
}
sub host_update_ip_add { my ($self,$ndr,$dh,$ip)=@_; return $self->host_update_ip($ndr,$ip,Net::DRI::Data::Hosts->new()); }
sub host_update_ip_del { my ($self,$ndr,$dh,$ip)=@_; return $self->host_update_ip($ndr,Net::DRI::Data::Hosts->new(),$ip); }
sub host_update_ip_set { my ($self,$ndr,$dh,$ip)=@_; return $self->host_update_ip($ndr,$ip); }
sub host_update_ip
{
my ($self,$ndr,$dh,$ipadd,$ipdel)=@_;
Net::DRI::Util::check_isa($ipadd,'Net::DRI::Data::Hosts');
if (defined($ipdel)) ## add + del
{
Net::DRI::Util::check_isa($ipdel,'Net::DRI::Data::Hosts');
my $c=Net::DRI::Data::Changes->new();
$c->add('ip',$ipadd) unless ($ipadd->is_empty());
$c->del('ip',$ipdel) unless ($ipdel->is_empty());
return $self->host_update($ndr,$dh,$c);
} else ## just set
{
return $self->host_update($ndr,$dh,Net::DRI::Data::Changes->new_set('ip',$ipadd));
}
}
sub host_update_status_add { my ($self,$ndr,$dh,$s)=@_; return $self->host_update_status($ndr,$dh,$s,Net::DRI::Data::StatusList->new()); }
sub host_update_status_del { my ($self,$ndr,$dh,$s)=@_; return $self->host_update_status($ndr,$dh,Net::DRI::Data::StatusList->new(),$s); }
sub host_update_status_set { my ($self,$ndr,$dh,$s)=@_; return $self->host_update_status($ndr,$dh,$s); }
sub host_update_status
{
my ($self,$ndr,$dh,$sadd,$sdel)=@_;
Net::DRI::Util::check_isa($sadd,'Net::DRI::Data::StatusList');
if (defined($sdel)) ## add + del
{
Net::DRI::Util::check_isa($sdel,'Net::DRI::Data::StatusList');
my $c=Net::DRI::Data::Changes->new();
$c->add('status',$sadd) unless ($sadd->is_empty());
$c->del('status',$sdel) unless ($sdel->is_empty());
return $self->host_update($ndr,$dh,$c);
} ## just set
{
return $self->host_update($ndr,$dh,Net::DRI::Data::Changes->new_set('status',$sadd));
}
}
sub host_update_name_set
{
my ($self,$ndr,$newname)=@_;
$newname=$newname->get_names(1) if ($newname && ref($newname) && $newname->can('get_details'));
err_invalid_host_name($newname) if $self->verify_name_host($newname);
return $self->host_update($ndr,Net::DRI::Data::Changes->new_set('name',$newname));
}
sub host_current_status
{
my ($self,$ndr,$dh)=@_;
my $rc=$self->host_info($ndr,$dh);
return undef unless $rc->is_success();
my $s=$ndr->get_info('status');
return undef unless (defined($s) && ref($s) && $s->isa('Net::DRI::Data::StatusList'));
return $s;
}
sub host_is_mine
{
my ($self,$ndr,$dh)=@_;
my $clid=$self->info('clid');
return 0 unless defined($clid);
my $id;
eval
{
my $rc=$self->host_info($ndr,$dh);
$id=$ndr->get_info('clID') if ($rc->is_success());
};
return 0 unless (!$@ && defined($id));
return ($clid=~m/^${id}$/)? 1 : 0;
}
##########################################################################################################################
## Operations on CONTACTS
##########################################################################################################################
############################################################################################
1;