| [vhffs-dev] [2020] Reworked Vhffs::Services::DNS, removed all Vhffs::Services::delete |
[ Thread Index |
Date Index
| More vhffs.org/vhffs-dev Archives
]
Revision: 2020
Author: gradator
Date: 2012-02-19 00:40:13 +0100 (Sun, 19 Feb 2012)
Log Message:
-----------
Reworked Vhffs::Services::DNS, removed all Vhffs::Services::delete
Database ON DELETE CASCADE FK handle deletion of object properties from deletion of the inherited Vhffs::Object, we do not need to define delete method from Vhffs::Services::* in most cases,
although, we do need a delete method for Users and Groups due to Vhffs::Services::MailUser and Vhffs::Services::MailGroup which are not inherited.
Modified Paths:
--------------
trunk/vhffs-api/src/Vhffs/Group.pm
trunk/vhffs-api/src/Vhffs/Object.pm
trunk/vhffs-api/src/Vhffs/Services/Bazaar.pm
trunk/vhffs-api/src/Vhffs/Services/Cron.pm
trunk/vhffs-api/src/Vhffs/Services/Cvs.pm
trunk/vhffs-api/src/Vhffs/Services/DNS.pm
trunk/vhffs-api/src/Vhffs/Services/Git.pm
trunk/vhffs-api/src/Vhffs/Services/Mail.pm
trunk/vhffs-api/src/Vhffs/Services/Mercurial.pm
trunk/vhffs-api/src/Vhffs/Services/Mysql.pm
trunk/vhffs-api/src/Vhffs/Services/Pgsql.pm
trunk/vhffs-api/src/Vhffs/Services/Repository.pm
trunk/vhffs-api/src/Vhffs/Services/Svn.pm
trunk/vhffs-panel/templates/dns/prefs.tt
Modified: trunk/vhffs-api/src/Vhffs/Group.pm
===================================================================
--- trunk/vhffs-api/src/Vhffs/Group.pm 2012-02-18 20:32:49 UTC (rev 2019)
+++ trunk/vhffs-api/src/Vhffs/Group.pm 2012-02-18 23:40:13 UTC (rev 2020)
@@ -424,13 +424,8 @@
=cut
sub delete {
- my $self;
- my $request;
- my $request2;
- my $request3;
+ my $self = shift;
- $self = shift;
-
use Vhffs::Services::MailGroup;
my $mg = init Vhffs::Services::MailGroup( $self->{'main'} , $self );
if( defined $mg ) {
@@ -438,12 +433,10 @@
$mg->delforward;
}
- $request = $self->{'db'}->prepare('DELETE FROM vhffs_groups WHERE gid=?');
- $request->execute($self->{'gid'}) or return -1;
-
- $self->SUPER::delete;
-
- return 1;
+ # User references corresponding object with an ON DELETE cascade foreign key
+ # so we don't even need to delete group
+ # rows that reference this group will be deleted by foreign keys constraints
+ return $self->SUPER::delete;
}
=pod
Modified: trunk/vhffs-api/src/Vhffs/Object.pm
===================================================================
--- trunk/vhffs-api/src/Vhffs/Object.pm 2012-02-18 20:32:49 UTC (rev 2019)
+++ trunk/vhffs-api/src/Vhffs/Object.pm 2012-02-18 23:40:13 UTC (rev 2020)
@@ -318,13 +318,10 @@
sub delete {
my $self = shift;
- my $query;
- my $request;
-
# Foreign key constraints are in 'ON DELETE CASCADE' mode
# we don't have to bother with foreign tables deletion.
- $query = 'DELETE FROM vhffs_object WHERE object_id=?';
- $request = $self->{'db'}->prepare($query);
+ my $query = 'DELETE FROM vhffs_object WHERE object_id=?';
+ my $request = $self->{'db'}->prepare($query);
$request->execute( $self->{'object_id'} ) or return -1;
return 1;
Modified: trunk/vhffs-api/src/Vhffs/Services/Bazaar.pm
===================================================================
--- trunk/vhffs-api/src/Vhffs/Services/Bazaar.pm 2012-02-18 20:32:49 UTC (rev 2019)
+++ trunk/vhffs-api/src/Vhffs/Services/Bazaar.pm 2012-02-18 23:40:13 UTC (rev 2020)
@@ -158,16 +158,6 @@
return _new Vhffs::Services::Bazaar($main, @params);
}
-sub delete {
- my $self = shift;
-
- my $query = 'DELETE FROM vhffs_bazaar WHERE bazaar_id=?';
- my $request = $self->{'db'}->prepare($query);
- $request->execute( $self->{bazaar_id} ) or return -1;
-
- return $self->SUPER::delete;
-}
-
sub commit {
my $self = shift;
Modified: trunk/vhffs-api/src/Vhffs/Services/Cron.pm
===================================================================
--- trunk/vhffs-api/src/Vhffs/Services/Cron.pm 2012-02-18 20:32:49 UTC (rev 2019)
+++ trunk/vhffs-api/src/Vhffs/Services/Cron.pm 2012-02-18 23:40:13 UTC (rev 2020)
@@ -193,16 +193,6 @@
return _new Vhffs::Services::Cron($main, @params);
}
-sub delete {
- my $self = shift;
- return unless defined $self;
-
- my $dbh = $self->get_db_object();
- $dbh->do(q{DELETE FROM vhffs_cron WHERE object_id=?}, undef, $self->get_oid()) or return -1;
-
- return $self->SUPER::delete;
-}
-
sub commit {
my $self = shift;
Modified: trunk/vhffs-api/src/Vhffs/Services/Cvs.pm
===================================================================
--- trunk/vhffs-api/src/Vhffs/Services/Cvs.pm 2012-02-18 20:32:49 UTC (rev 2019)
+++ trunk/vhffs-api/src/Vhffs/Services/Cvs.pm 2012-02-18 23:40:13 UTC (rev 2020)
@@ -180,16 +180,6 @@
return _new Vhffs::Services::Cvs($main, @params);
}
-sub delete {
- my $self = shift;
-
- my $query = 'DELETE FROM vhffs_cvs WHERE cvs_id=?';
- my $request = $self->{'db'}->prepare($query);
- $request->execute( $self->{cvs_id} ) or return -1;
-
- return $self->SUPER::delete;
-}
-
sub commit {
my $self = shift;
Modified: trunk/vhffs-api/src/Vhffs/Services/DNS.pm
===================================================================
--- trunk/vhffs-api/src/Vhffs/Services/DNS.pm 2012-02-18 20:32:49 UTC (rev 2019)
+++ trunk/vhffs-api/src/Vhffs/Services/DNS.pm 2012-02-18 23:40:13 UTC (rev 2020)
@@ -2,31 +2,31 @@
# Copyright (c) vhffs project and its contributors
# All rights reserved.
#
-# Redistribution and use in source and binary forms, with or without
-# modification, are permitted provided that the following conditions
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
# are met:
#
-# 1. Redistributions of source code must retain the above copyright
+# 1. Redistributions of source code must retain the above copyright
# notice, this list of conditions and the following disclaimer.
#2. Redistributions in binary form must reproduce the above copyright
-# notice, this list of conditions and the following disclaimer in
-# the documentation and/or other materials provided with the
+# notice, this list of conditions and the following disclaimer in
+# the documentation and/or other materials provided with the
# distribution.
-#3. Neither the name of vhffs nor the names of its contributors
-# may be used to endorse or promote products derived from this
+#3. Neither the name of vhffs nor the names of its contributors
+# may be used to endorse or promote products derived from this
# software without specific prior written permission.
#
-#THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-#"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
-#LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
-#FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
-#COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
-#INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
-#BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
-#LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-#CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
-# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
-# ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+#THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+#"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+#LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+#FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+#COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+#INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+#BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+#LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+#CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+# ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
=pod
@@ -51,147 +51,154 @@
use base qw(Vhffs::Object);
use DBI;
-# Returns an array with ALL the DNS
-# If ionly a ref of a Vhffs::Main instance if given, it returns ALL DNS objects
-# If a state (of Vhffs::Constants) is given more, it returns all DNS objects which have this state
-sub getall
-{
- my ($vhffs, $state, $name, $group) = @_;
+sub check_rr_name {
+ my $name = shift;
+ return ($name =~ /^(?:(?:[a-z0-9\-\_\*]{1,63}(?:\.[a-z0-9\-\_]{1,63})*)|@)$/ );
+}
- my $domains = [];
- my @params;
- my $sql = 'SELECT d.domain FROM vhffs_dns d, vhffs_object o WHERE o.object_id = d.object_id';
- if(defined $state) {
- $sql .= ' AND o.state = ?';
- push @params, $state;
- }
- if(defined $name) {
- $sql .= ' AND d.domain LIKE ?';
- push @params, '%'.$name.'%';
- }
- if(defined $group) {
- $sql .= ' AND o.owner_gid = ?';
- push @params, $group->get_gid;
- }
- $sql .= ' ORDER BY d.domain';
+sub _new {
+ my ($class, $main, $dns_id, $domain, $owner_gid, $ns, $mbox, $serial, $refresh, $retry, $expire, $minimum, $ttl, $oid, $owner_uid, $date_creation, $state, $description, $a, $nsr, $cname, $mx, $srv, $aaaa, $txt) = @_;
- my $dbh = $vhffs->get_db_object();
- my $sth = $dbh->prepare($sql);
- $sth->execute(@params);
- while(my @d = $sth->fetchrow_array) {
- push @$domains, get_by_domainname($vhffs, $d[0]);
- }
+ my $self = $class->SUPER::_new($main, $oid, $owner_uid, $owner_gid, $date_creation, $description, '', $state, Vhffs::Constants::TYPE_DNS);
- return $domains;
+ $self->{dns_id} = $dns_id;
+ $self->{domain} = $domain;
+ $self->{ns} = $ns;
+ $self->{mbox} = $mbox;
+ $self->{serial} = $serial;
+ $self->{refresh} = $refresh;
+ $self->{retry} = $retry;
+ $self->{expire} = $expire;
+ $self->{minimum} = $minimum;
+ $self->{ttl} = $ttl;
+ $self->{A} = $a;
+ $self->{NS} = $nsr;
+ $self->{CNAME} = $cname;
+ $self->{MX} = $mx;
+ $self->{SRV} = $srv;
+ $self->{AAAA} = $aaaa;
+ $self->{TXT} = $txt;
+
+ return $self;
}
=pod
=head2 create
- my $dns = Vhffs::Services::DNS::create($main, $domain, $description, $user, $group);
- die('Unable to create DNS') unless(defined $dns);
+ my $dns = Vhffs::Services::DNS::create($main, $domain, $description, $user, $group);
+ die('Unable to create DNS') unless(defined $dns);
Create a new DNS in database and returns the corresponding object.
If the init section of the VHFFS config is filled, use it to add initial A, MX and NS records.
=cut
+sub create {
+ my($main, $domain, $description, $user, $group) = @_;
-sub create
-{
- my($main, $domain, $description, $user, $group) = @_;
+ my $conf = $main->get_config->get_service('dns');
+ return undef unless defined $conf;
- my $conf = $main->get_config->get_service("dns");
- return undef if ( ! defined $conf );
+ return undef unless(defined($user) && defined($group));
+ return undef unless(Vhffs::Functions::check_domain_name($domain));
- return undef unless(defined($user) && defined($group));
- return undef unless(Vhffs::Functions::check_domain_name($domain));
+ my $dbh = $main->get_db_object();
+ local $dbh->{RaiseError} = 1;
+ local $dbh->{PrintError} = 0;
+ $dbh->begin_work;
+ my $self;
- my $dbh = $main->get_db_object();
- local $dbh->{RaiseError} = 1;
- local $dbh->{PrintError} = 0;
- $dbh->begin_work;
- my $self;
+ eval {
- eval {
+ my $parent = Vhffs::Object::create($main, $user->get_uid, $group->get_gid, $description, undef, Vhffs::Constants::TYPE_DNS);
- my $parent = Vhffs::Object::create($main, $user->get_uid, $group->get_gid, $description, undef, Vhffs::Constants::TYPE_DNS);
+ die('Unable to create parent object') unless(defined $parent);
- die('Unable to create parent object') unless(defined $parent);
+ my $sql = 'INSERT INTO vhffs_dns (domain, object_id, ns, mbox, serial, refresh, retry, expire, minimum, ttl) VALUES(?, ?, ?, ?, ?, ?, ?, ?, ?, ?)';
+ my ($day, $month, $year);
+ (undef,undef,undef,$day,$month,$year) = localtime(time);
+ my $serial = sprintf('%.4u%.2u%.2u01',$year+1900,$month+1,$day);
- my $sql = 'INSERT INTO vhffs_dns (domain, object_id, ns, mbox, serial, refresh, retry, expire, minimum, ttl) VALUES(?, ?, ?, ?, ?, ?, ?, ?, ?, ?)';
- my ($day, $month, $year);
- (undef,undef,undef,$day,$month,$year) = localtime(time);
- my $serial = sprintf('%.4u%.2u%.2u01',$year+1900,$month+1,$day);
+ my $sth = $dbh->prepare($sql);
- my $sth = $dbh->prepare($sql);
+ $sth->execute($domain, $parent->get_oid, $conf->{init}->{soa}->{ns}, $conf->{init}->{soa}->{mbox}, $serial,
+ $conf->{init}->{soa}->{refresh}, $conf->{init}->{soa}->{retry}, $conf->{init}->{soa}->{expire}, $conf->{init}->{soa}->{minimum}, $conf->{init}->{soa}->{ttl} );
- $sth->execute($domain, $parent->get_oid, $conf->{init}->{soa}->{ns}, $conf->{init}->{soa}->{mbox}, $serial,
- $conf->{init}->{soa}->{refresh}, $conf->{init}->{soa}->{retry}, $conf->{init}->{soa}->{expire}, $conf->{init}->{soa}->{minimum}, $conf->{init}->{soa}->{ttl} );
+ $dbh->commit;
+ $self = get_by_domainname($main, $domain);
+ };
- $dbh->commit;
- $self = get_by_domainname($main, $domain);
- };
+ # Something went wrong, let's cancel everything
+ if($@) {
+ warn 'Error creating domain '.$domain.': '.$@."\n";
+ $dbh->rollback;
+ return undef;
+ }
- # Something went wrong, let's cancel everything
- if($@) {
- warn "Error creating domain $domain: $@\n";
- $dbh->rollback;
- return undef;
- }
+ # Fill in default information defined in configuration.
+ if( defined $conf->{init} ) {
+ my ($ip, $name, $prio);
+ my $init = $conf->{init};
- # Fill in default information defined in configuration.
- if( defined $conf->{init} ) {
- my ($ip, $name, $prio);
- my $init = $conf->{init};
+ if( defined $init->{a} ) {
+ foreach( keys %{$init->{a}} ) {
+ $name = $_;
+ $ip = $init->{a}{$_};
+ $self->add_a( $name , $ip );
+ }
+ }
+ if( defined $init->{mx} ) {
+ foreach( keys %{$init->{mx}} ) {
+ $prio = $_;
+ $ip = $init->{mx}{$_};
+ $self->add_mx( '@', $ip , $prio );
+ }
+ }
+ if( defined $init->{ns} ) {
+ foreach( keys %{$init->{ns}} ) {
+ $name = $_;
+ $self->add_ns( '@', $name );
+ }
+ }
+ }
- if( defined $init->{a} ) {
- foreach( keys %{$init->{a}} ) {
- $name = $_;
- $ip = $init->{a}{$_};
- $self->add_a( $name , $ip );
- }
- }
- if( defined $init->{mx} ) {
- foreach( keys %{$init->{mx}} ) {
- $prio = $_;
- $ip = $init->{mx}{$_};
- $self->add_mx( '@', $ip , $prio );
- }
- }
- if( defined $init->{ns} ) {
- foreach( keys %{$init->{ns}} ) {
- $name = $_;
- $self->add_ns( '@', $name );
- }
- }
- }
-
- return $self;
+ return $self;
}
-# Delete this object from VHFFS database
-sub delete
-{
- my $self = shift;
- my $query;
- my $request;
-
- # Destroy the RR part (A, NS, PTR, ...)
- $query = "DELETE FROM vhffs_dns_rr WHERE zone='".$self->{'dns_id'}."'";
- $request = $self->{'db'}->prepare($query);
- $request->execute or return -1;
+# Returns an array with ALL the DNS
+# If ionly a ref of a Vhffs::Main instance if given, it returns ALL DNS objects
+# If a state (of Vhffs::Constants) is given more, it returns all DNS objects which have this state
+sub getall {
+ my ($vhffs, $state, $name, $group) = @_;
- # Destroy the main part of the DNS
- $query = "DELETE FROM vhffs_dns WHERE dns_id='".$self->{'dns_id'}."'";
- $request = $self->{'db'}->prepare($query);
- $request->execute or return -1;
-
- #Destroy the generic object
- return -2 if( $self->SUPER::delete < 0 );
-
- return 1;
+ my $domains = [];
+ my @params;
+ my $sql = 'SELECT d.domain
+ FROM vhffs_dns d INNER JOIN vhffs_object o ON d.object_id = o.object_id WHERE 1=1';
+
+ if(defined $state) {
+ $sql .= ' AND o.state = ?';
+ push @params, $state;
+ }
+ if(defined $name) {
+ $sql .= ' AND d.domain LIKE ?';
+ push @params, '%'.$name.'%';
+ }
+ if(defined $group) {
+ $sql .= ' AND o.owner_gid = ?';
+ push @params, $group->get_gid;
+ }
+ $sql .= ' ORDER BY d.domain';
+
+ my $dbh = $vhffs->get_db_object();
+ my $sth = $dbh->prepare($sql);
+ $sth->execute(@params);
+ while(my @d = $sth->fetchrow_array) {
+ push @$domains, get_by_domainname($vhffs, $d[0]);
+ }
+
+ return $domains;
}
=head2 fill_object
@@ -199,30 +206,29 @@
See C<Vhffs::Object::fill_object>.
=cut
-
sub fill_object {
- my ($class, $obj) = @_;
- my $sql = q{SELECT dns_id, domain, ns, mbox, serial, refresh, retry,
- expire, minimum, ttl FROM vhffs_dns WHERE object_id = ?};
- $obj = $class->SUPER::_fill_object($obj, $sql);
-
- if($obj->isa('Vhffs::Services::DNS')) {
- my @records = fetch_records($obj->get_db_object, $obj->{dns_id});
- $obj->{A} = $records[0];
- $obj->{NS} = $records[1];
- $obj->{CNAME} = $records[2];
- $obj->{MX} = $records[3];
- $obj->{SRV} = $records[4];
- $obj->{AAAA} = $records[5];
- $obj->{TXT} = $records[6];
- }
-
- return $obj;
+ my ($class, $obj) = @_;
+ my $sql = q{SELECT dns_id, domain, ns, mbox, serial, refresh, retry,
+ expire, minimum, ttl FROM vhffs_dns WHERE object_id = ?};
+ $obj = $class->SUPER::_fill_object($obj, $sql);
+
+ if($obj->isa('Vhffs::Services::DNS')) {
+ my @records = fetch_records($obj->get_db_object, $obj->{dns_id});
+ $obj->{A} = $records[0];
+ $obj->{NS} = $records[1];
+ $obj->{CNAME} = $records[2];
+ $obj->{MX} = $records[3];
+ $obj->{SRV} = $records[4];
+ $obj->{AAAA} = $records[5];
+ $obj->{TXT} = $records[6];
+ }
+
+ return $obj;
}
=head2 fetch_records
- my @records = fetch_records($dbh, $dns_id);
+ my @records = fetch_records($dbh, $dns_id);
Returns an array of hashrefs containing all records for a given zone. The
records are pushed in the following order: A, NS, CNAME, MX, SRV, AAAA, TXT.
@@ -230,448 +236,397 @@
Internal module use only.
=cut
-
-
sub fetch_records {
- my ($dbh, $dns_id) = @_;
- my @records;
- # Fetches A records
- my $sql = 'SELECT id, zone, (CASE WHEN name = \'\' THEN \'@\' ELSE name END) AS name, type, data, aux, ttl FROM vhffs_dns_rr WHERE zone = ? AND type = \'A\'';
- my $sth = $dbh->prepare($sql);
- $sth->execute($dns_id);
- my $a = $sth->fetchall_hashref('id');
- push @records, $a;
+ my ($dbh, $dns_id) = @_;
+ my @records;
+ # Fetches A records
+ my $sql = 'SELECT id, zone, (CASE WHEN name = \'\' THEN \'@\' ELSE name END) AS name, type, data, aux, ttl FROM vhffs_dns_rr WHERE zone = ? AND type = \'A\'';
+ my $sth = $dbh->prepare($sql);
+ $sth->execute($dns_id);
+ my $a = $sth->fetchall_hashref('id');
+ push @records, $a;
- # Fetches NS records
- $sql = 'SELECT id, zone, (CASE WHEN name = \'\' THEN \'@\' ELSE name END) AS name, type, data, aux, ttl FROM vhffs_dns_rr WHERE zone = ? AND type = ?';
- $sth = $dbh->prepare($sql);
- $sth->execute($dns_id, 'NS');
- my $ns = $sth->fetchall_hashref('id');
- push @records, $ns;
+ # Fetches NS records
+ $sql = 'SELECT id, zone, (CASE WHEN name = \'\' THEN \'@\' ELSE name END) AS name, type, data, aux, ttl FROM vhffs_dns_rr WHERE zone = ? AND type = ?';
+ $sth = $dbh->prepare($sql);
+ $sth->execute($dns_id, 'NS');
+ my $ns = $sth->fetchall_hashref('id');
+ push @records, $ns;
- # Fetches CNAME records
- $sql = 'SELECT id, zone, (CASE WHEN name = \'\' THEN \'@\' ELSE name END) AS name, type, data, aux, ttl FROM vhffs_dns_rr WHERE zone = ? AND type = ?';
- $sth = $dbh->prepare($sql);
- $sth->execute($dns_id, 'CNAME');
- my $cname = $sth->fetchall_hashref('id');
- push @records, $cname;
+ # Fetches CNAME records
+ $sql = 'SELECT id, zone, (CASE WHEN name = \'\' THEN \'@\' ELSE name END) AS name, type, data, aux, ttl FROM vhffs_dns_rr WHERE zone = ? AND type = ?';
+ $sth = $dbh->prepare($sql);
+ $sth->execute($dns_id, 'CNAME');
+ my $cname = $sth->fetchall_hashref('id');
+ push @records, $cname;
- # Fetches MX records
- $sql = 'SELECT id, zone, (CASE WHEN name = \'\' THEN \'@\' ELSE name END) AS name, type, data, aux, ttl FROM vhffs_dns_rr WHERE zone = ? AND type = ?';
- $sth = $dbh->prepare($sql);
- $sth->execute($dns_id, 'MX');
- my $mx = $sth->fetchall_hashref('id');
- push @records, $mx;
+ # Fetches MX records
+ $sql = 'SELECT id, zone, (CASE WHEN name = \'\' THEN \'@\' ELSE name END) AS name, type, data, aux, ttl FROM vhffs_dns_rr WHERE zone = ? AND type = ?';
+ $sth = $dbh->prepare($sql);
+ $sth->execute($dns_id, 'MX');
+ my $mx = $sth->fetchall_hashref('id');
+ push @records, $mx;
- # Fetches SRV records
- $sql = 'SELECT id, zone, name, type, data, aux, ttl FROM vhffs_dns_rr WHERE zone = ? AND type = ?';
- $sth = $dbh->prepare($sql);
- $sth->execute($dns_id, 'SRV');
- my $srv = {};
- while(my $rr = $sth->fetchrow_hashref('NAME_lc')) {
- my @fields = split(/ /, $rr->{data});
- $rr->{weight} = shift(@fields);
- $rr->{port} = shift(@fields);
- $rr->{host} = join(' ', @fields);
- delete $rr->{data};
- $srv->{$rr->{id}} = $rr;
- }
- push @records, $srv;
+ # Fetches SRV records
+ $sql = 'SELECT id, zone, name, type, data, aux, ttl FROM vhffs_dns_rr WHERE zone = ? AND type = ?';
+ $sth = $dbh->prepare($sql);
+ $sth->execute($dns_id, 'SRV');
+ my $srv = {};
+ while(my $rr = $sth->fetchrow_hashref('NAME_lc')) {
+ my @fields = split(/ /, $rr->{data});
+ $rr->{weight} = shift(@fields);
+ $rr->{port} = shift(@fields);
+ $rr->{host} = join(' ', @fields);
+ delete $rr->{data};
+ $srv->{$rr->{id}} = $rr;
+ }
+ push @records, $srv;
- # Fetches AAAA records
- $sql = 'SELECT id, zone, (CASE WHEN name = \'\' THEN \'@\' ELSE name END) AS name, type, data, aux, ttl FROM vhffs_dns_rr WHERE zone = ? AND type = ?';
- $sth = $dbh->prepare($sql);
- $sth->execute($dns_id, 'AAAA');
- my $aaaa = $sth->fetchall_hashref('id');
- push @records, $aaaa;
+ # Fetches AAAA records
+ $sql = 'SELECT id, zone, (CASE WHEN name = \'\' THEN \'@\' ELSE name END) AS name, type, data, aux, ttl FROM vhffs_dns_rr WHERE zone = ? AND type = ?';
+ $sth = $dbh->prepare($sql);
+ $sth->execute($dns_id, 'AAAA');
+ my $aaaa = $sth->fetchall_hashref('id');
+ push @records, $aaaa;
- # Fetches TXT records
- $sql = 'SELECT id, zone, (CASE WHEN name = \'\' THEN \'@\' ELSE name END) AS name, type, data, aux, ttl FROM vhffs_dns_rr WHERE zone = ? AND type = ?';
- $sth = $dbh->prepare($sql);
- $sth->execute($dns_id, 'TXT');
- my $txt = $sth->fetchall_hashref('id');
- push @records, $txt;
+ # Fetches TXT records
+ $sql = 'SELECT id, zone, (CASE WHEN name = \'\' THEN \'@\' ELSE name END) AS name, type, data, aux, ttl FROM vhffs_dns_rr WHERE zone = ? AND type = ?';
+ $sth = $dbh->prepare($sql);
+ $sth->execute($dns_id, 'TXT');
+ my $txt = $sth->fetchall_hashref('id');
+ push @records, $txt;
- return @records;
+ return @records;
}
=head2 get_by_domainname
- my $dns = Vhffs::Services::DNS::get_by_domainname($main, $domainname);
- die('Domain not found') unless(defined $dns);
+ my $dns = Vhffs::Services::DNS::get_by_domainname($main, $domainname);
+ die('Domain not found') unless(defined $dns);
Fetches the DNS object whose domainname is $domainname. Returned object is fully
functionnal. A, NS, CNAME, I<etc.> records are filled and accessible using
C<$dns->get_xxx_type>.
=cut
+sub get_by_domainname($$) {
+ my ($main, $name) = @_;
-sub get_by_domainname($$)
-{
- my ($main, $name) = @_;
-
- my $sql = 'SELECT d.dns_id, d.domain, o.owner_gid, d.ns, d.mbox, d.serial, d.refresh, d.retry, d.expire, d.minimum, d.ttl, o.object_id, o.owner_uid, o.date_creation, o.state, o.description FROM vhffs_dns d INNER JOIN vhffs_object o ON o.object_id = d.object_id WHERE d.domain = ?';
+ my $sql = 'SELECT d.dns_id, d.domain, o.owner_gid, d.ns, d.mbox, d.serial, d.refresh, d.retry, d.expire, d.minimum, d.ttl, o.object_id, o.owner_uid, o.date_creation, o.state, o.description FROM vhffs_dns d INNER JOIN vhffs_object o ON o.object_id = d.object_id WHERE d.domain = ?';
- my $dbh = $main->get_db_object();
- my @params;
- return undef unless(@params = $dbh->selectrow_array($sql, undef, $name));
- my $dns_id = $params[0];
+ my $dbh = $main->get_db_object();
+ my @params;
+ return undef unless(@params = $dbh->selectrow_array($sql, undef, $name));
+ my $dns_id = $params[0];
- push @params, fetch_records($dbh, $dns_id);
+ push @params, fetch_records($dbh, $dns_id);
- return _new Vhffs::Services::DNS($main, @params);
+ return _new Vhffs::Services::DNS($main, @params);
}
-sub _new
-{
- my ($class, $main, $dns_id, $domain, $owner_gid, $ns, $mbox, $serial, $refresh, $retry, $expire, $minimum, $ttl, $oid, $owner_uid, $date_creation, $state, $description, $a, $nsr, $cname, $mx, $srv, $aaaa, $txt) = @_;
-
- my $self = $class->SUPER::_new($main, $oid, $owner_uid, $owner_gid, $date_creation, $description, '', $state, Vhffs::Constants::TYPE_DNS);
-
- $self->{dns_id} = $dns_id;
- $self->{domain} = $domain;
- $self->{ns} = $ns;
- $self->{mbox} = $mbox;
- $self->{serial} = $serial;
- $self->{refresh} = $refresh;
- $self->{retry} = $retry;
- $self->{expire} = $expire;
- $self->{minimum} = $minimum;
- $self->{ttl} = $ttl;
- $self->{A} = $a;
- $self->{NS} = $nsr;
- $self->{CNAME} = $cname;
- $self->{MX} = $mx;
- $self->{SRV} = $srv;
- $self->{AAAA} = $aaaa;
- $self->{TXT} = $txt;
-
- return $self;
-}
-
=pod
=head2 name_exists
- print 'A rr with the same name already exists in type A or CNAME' if($dns->name_exists($name, 'A', 'CNAME'));
+ print 'A rr with the same name already exists in type A or CNAME' if($dns->name_exists($name, 'A', 'CNAME'));
Tests if a name already exists in given record types. Returns true if the name already exists
false otherwise.
=cut
-
sub name_exists {
- my $self = shift;
- my $name = shift;
- my @types = @_;
- my $dbh = $self->get_main->get_db_object();
- my $in = '?'.(', ?' x (scalar(@types) - 1));
- my $sql = 'SELECT id FROM vhffs_dns_rr WHERE name = ? AND zone = ? AND type IN('.$in.') LIMIT 1';
- return ($dbh->do($sql, undef, $name, $self->{dns_id}, @types) != 0);
+ my $self = shift;
+ my $name = shift;
+ my @types = @_;
+ my $dbh = $self->get_main->get_db_object();
+ my $in = '?'.(', ?' x (scalar(@types) - 1));
+ my $sql = 'SELECT id FROM vhffs_dns_rr WHERE name = ? AND zone = ? AND type IN('.$in.') LIMIT 1';
+ return ($dbh->do($sql, undef, $name, $self->{dns_id}, @types) != 0);
}
=pod
=head2 delete_record
- die("Unable to delete $type record #$id") unless($dns->delete_record($id, $type) > 0);
+ die("Unable to delete $type record #$id") unless($dns->delete_record($id, $type) > 0);
Delete record of type C<$type> whose id is C<$id>.
=cut
+sub delete_record {
+ my ($self, $id, $type) = @_;
-sub delete_record
-{
- my ($self, $id, $type) = @_;
+ return -1 unless($id =~ /^\d+$/ );
+ return -2 unless(exists $self->{$type});
+ my $rr = $self->{$type}{$id};
+ return -3 unless(defined $rr);
- return -1 unless($id =~ /^\d+$/ );
- return -2 unless(exists $self->{$type});
- my $rr = $self->{$type}{$id};
- return -3 unless(defined $rr);
+ my $dbh = $self->get_main()->get_db_object();
+ my $sql = 'DELETE FROM vhffs_dns_rr WHERE id = ? AND type = ? AND zone = ?';
+ $dbh->do($sql, undef, $id, $type, $self->{dns_id}) or return -3;
- my $dbh = $self->get_main()->get_db_object();
- my $sql = 'DELETE FROM vhffs_dns_rr WHERE id = ? AND type = ? AND zone = ?';
- $dbh->do($sql, undef, $id, $type, $self->{dns_id}) or return -3;
+ $self->add_history('Deleted '.$type.' record '.$rr->{name});
+ delete $self->{$type}{$id};
- $self->add_history("Deleted $type record ".$rr->{name});
- delete $self->{$type}{$id};
-
- #Update SOA
- $self->update_serial();
- return 1;
+ #Update SOA
+ $self->update_serial();
+ return 1;
}
-sub update_a
-{
- my ( $self , $id, $ip, $ttl ) = @_;
-
- return -1 unless($id =~ /^\d+$/ );
- my $rr = $self->{A}{$id};
- return -2 unless(defined $rr);
- return -3 unless( Vhffs::Functions::check_ip($ip) );
- $ttl = $rr->{ttl} unless(defined $ttl and $ttl =~ /^\d+$/);
+sub update_a {
+ my ( $self , $id, $ip, $ttl ) = @_;
- my $dbh = $self->get_main()->get_db_object();
- my $sql = 'UPDATE vhffs_dns_rr SET data = ?, ttl = ? WHERE id = ? AND zone = ? AND type = \'A\'';
- $dbh->do($sql, undef, $ip, $ttl, $id, $self->{dns_id}) or return -4;
+ return -1 unless($id =~ /^\d+$/ );
+ my $rr = $self->{A}{$id};
+ return -2 unless(defined $rr);
+ return -3 unless( Vhffs::Functions::check_ip($ip) );
+ $ttl = $rr->{ttl} unless(defined $ttl and $ttl =~ /^\d+$/);
- $rr->{data} = $ip;
+ my $dbh = $self->get_main()->get_db_object();
+ my $sql = 'UPDATE vhffs_dns_rr SET data = ?, ttl = ? WHERE id = ? AND zone = ? AND type = \'A\'';
+ $dbh->do($sql, undef, $ip, $ttl, $id, $self->{dns_id}) or return -4;
- $self->add_history('Updated A record '.$rr->{name}." pointing now on $ip (TTL $ttl)");
-
- $self->update_serial();
- return 1;
+ $rr->{data} = $ip;
+
+ $self->add_history('Updated A record '.$rr->{name}.' pointing now on '.$ip.' (TTL '.$ttl.')');
+
+ $self->update_serial();
+ return 1;
}
+sub add_ns {
+ my ($self, $name, $host, $ttl) = @_;
-sub add_ns
-{
- my ($self, $name, $host, $ttl) = @_;
-
- $ttl = 900 unless defined $ttl;
- return -5 unless check_rr_name($name);
- $name = '' if $name eq '@';
+ $ttl = 900 unless defined $ttl;
+ return -5 unless check_rr_name($name);
+ $name = '' if $name eq '@';
- return -1 unless( Vhffs::Functions::check_domain_name($host) || ( $host =~ /[a-z0-9\-]{1,63}/ ) );
+ return -1 unless( Vhffs::Functions::check_domain_name($host) || ( $host =~ /[a-z0-9\-]{1,63}/ ) );
- my $sql = 'SELECT * FROM vhffs_dns_rr WHERE zone=? AND type=\'NS\' AND name=? AND data=?';
- my $dbh = $self->get_main->get_db_object();
- return -2 if($dbh->do($sql, undef, $self->{dns_id}, $name, $host) != 0);
+ my $sql = 'SELECT * FROM vhffs_dns_rr WHERE zone=? AND type=\'NS\' AND name=? AND data=?';
+ my $dbh = $self->get_main->get_db_object();
+ return -2 if($dbh->do($sql, undef, $self->{dns_id}, $name, $host) != 0);
- $sql = 'INSERT INTO vhffs_dns_rr(zone, name, type, data, aux, ttl) VALUES(?, ?, \'NS\', ?, 0, ?)';
- $dbh->do($sql, undef, $self->{dns_id}, $name, $host, $ttl) or return -3;
+ $sql = 'INSERT INTO vhffs_dns_rr(zone, name, type, data, aux, ttl) VALUES(?, ?, \'NS\', ?, 0, ?)';
+ $dbh->do($sql, undef, $self->{dns_id}, $name, $host, $ttl) or return -3;
- my $id = $dbh->last_insert_id(undef, undef, 'vhffs_dns_rr', undef);
+ my $id = $dbh->last_insert_id(undef, undef, 'vhffs_dns_rr', undef);
- my $ns = {id => $id,
- zone => $self->{dns_id},
- name => $name,
- type => 'NS',
- data => $host,
- aux => 0,
- ttl => $ttl
- };
- $self->{NS}{$id} = $ns;
+ my $ns = {id => $id,
+ zone => $self->{dns_id},
+ name => $name,
+ type => 'NS',
+ data => $host,
+ aux => 0,
+ ttl => $ttl
+ };
+ $self->{NS}{$id} = $ns;
- $self->update_serial;
+ $self->update_serial;
- $self->add_history('Added a NS record with name '.($name or '@').' pointing to '.$host);
- return $id;
+ $self->add_history('Added a NS record with name '.($name or '@').' pointing to '.$host);
+ return $id;
}
-sub check_rr_name {
- my $name = shift;
- return ($name =~ /^(?:(?:[a-z0-9\-\_\*]{1,63}(?:\.[a-z0-9\-\_]{1,63})*)|@)$/ );
-}
+sub add_a {
+ my ( $self , $name , $ip , $ttl ) = @_;
+ $ttl = 900 unless defined $ttl;
+ return -1 unless check_rr_name($name);
+ $name = '' if $name eq '@';
+ return -2 if ( $self->name_exists( $name, 'A', 'CNAME' ) != 0 );
-sub add_a
-{
- my ( $self , $name , $ip , $ttl ) = @_;
-
- $ttl = 900 unless defined $ttl;
- return -1 unless check_rr_name($name);
- $name = '' if $name eq '@';
- return -2 if ( $self->name_exists( $name, 'A', 'CNAME' ) != 0 );
+ unless( defined $ip ) {
+ my $dnsconfig = $self->{'main'}->get_config->get_service('dns');
+ if( defined $dnsconfig->{'default_a'} ) {
+ $ip = $dnsconfig->{'default_a'};
+ } else {
+ return -3;
+ }
+ }
- if( ! defined $ip ) {
- my $dnsconfig = $self->{'main'}->get_config->get_service('dns');
- if( defined $dnsconfig->{'default_a'} ) {
- $ip = $dnsconfig->{'default_a'};
- } else {
- return -3;
- }
- }
-
- return -4 unless( Vhffs::Functions::check_ip($ip) );
+ return -4 unless( Vhffs::Functions::check_ip($ip) );
- my $dbh = $self->get_main()->get_db_object();
- my $sql = 'INSERT INTO vhffs_dns_rr (zone, name, type, data, aux, ttl) VALUES(?, ?, \'A\', ?, 0, ?)';
- $dbh->do($sql, undef, $self->{dns_id}, $name, $ip, $ttl) or return -5;
+ my $dbh = $self->get_main()->get_db_object();
+ my $sql = 'INSERT INTO vhffs_dns_rr (zone, name, type, data, aux, ttl) VALUES(?, ?, \'A\', ?, 0, ?)';
+ $dbh->do($sql, undef, $self->{dns_id}, $name, $ip, $ttl) or return -5;
- my $id = $dbh->last_insert_id(undef, undef, 'vhffs_dns_rr', undef);
- $name = '@' if($name eq '');
- my $a = {id => $id,
- zone => $self->{dns_id},
- name => $name,
- type => 'A',
- data => $ip,
- aux => 0,
- ttl => $ttl
- };
- $self->{A}{$id} = $a;
+ my $id = $dbh->last_insert_id(undef, undef, 'vhffs_dns_rr', undef);
+ $name = '@' if($name eq '');
+ my $a = {id => $id,
+ zone => $self->{dns_id},
+ name => $name,
+ type => 'A',
+ data => $ip,
+ aux => 0,
+ ttl => $ttl
+ };
+ $self->{A}{$id} = $a;
- $self->update_serial();
+ $self->update_serial();
- $self->add_history("Added a A TYPE with name $name pointing on $ip");
- return $id;
+ $self->add_history('Added a A TYPE with name '.$name.' pointing on '.$ip);
+ return $id;
}
=pod
=head2 update_mx
- $dns->update_mx($rr_id, $host[, $priority, $ttl]);
+ $dns->update_mx($rr_id, $host[, $priority, $ttl]);
Replace address for MX record C<$rr_id>.
=cut
+sub update_mx {
+ my ($self, $id, $host, $priority, $ttl) = @_;
-sub update_mx
-{
- my ($self, $id, $host, $priority, $ttl) = @_;
-
- return -1 unless($id =~ /^\d+$/);
- my $rr = $self->{MX}{$id};
- $priority = $rr->{aux} unless(defined $priority and $priority =~ /^\d+$/);
- $ttl = $rr->{ttl} unless(defined $ttl and $ttl =~ /^\d+$/);
- return -2 unless(defined $rr);
- return -3 unless( Vhffs::Functions::check_domain_name($host, 1) || check_rr_name($host) );
+ return -1 unless($id =~ /^\d+$/);
+ my $rr = $self->{MX}{$id};
+ $priority = $rr->{aux} unless(defined $priority and $priority =~ /^\d+$/);
+ $ttl = $rr->{ttl} unless(defined $ttl and $ttl =~ /^\d+$/);
+ return -2 unless(defined $rr);
+ return -3 unless( Vhffs::Functions::check_domain_name($host, 1) || check_rr_name($host) );
- my $sql = 'UPDATE vhffs_dns_rr SET data = ?, aux = ?, ttl = ? WHERE id = ? AND zone = ? AND type=\'MX\'';
- my $dbh = $self->get_main()->get_db_object();
+ my $sql = 'UPDATE vhffs_dns_rr SET data = ?, aux = ?, ttl = ? WHERE id = ? AND zone = ? AND type=\'MX\'';
+ my $dbh = $self->get_main()->get_db_object();
- $dbh->do($sql, undef, $host, $priority, $ttl, $id, $self->{dns_id}) or return -4;
+ $dbh->do($sql, undef, $host, $priority, $ttl, $id, $self->{dns_id}) or return -4;
- $rr->{data} = $host;
+ $rr->{data} = $host;
- $self->add_history('Changed the MX for priority '.$rr->{aux}.": $host");
+ $self->add_history('Changed the MX for priority '.$rr->{aux}.': '.$host);
- $self->update_serial();
+ $self->update_serial();
}
+sub add_mx {
+ my ($self, $name, $host, $priority, $ttl) = @_;
-sub add_mx
-{
- my ($self, $name, $host, $priority, $ttl) = @_;
+ $ttl = 900 unless defined $ttl;
+ $priority = 10 unless defined $priority;
+ return -5 unless check_rr_name($name);
+ $name = '' if $name eq '@';
- $ttl = 900 unless defined $ttl;
- $priority = 10 unless defined $priority;
- return -5 unless check_rr_name($name);
- $name = '' if $name eq '@';
+ return -1 unless( Vhffs::Functions::check_domain_name($host, 1) || check_rr_name($host) );
+ return -2 unless( $priority =~ /^\d+$/ );
- return -1 unless( Vhffs::Functions::check_domain_name($host, 1) || check_rr_name($host) );
- return -2 unless( $priority =~ /^\d+$/ );
+ my $sql = 'SELECT id FROM vhffs_dns_rr WHERE zone=? AND type=\'MX\' AND name=? AND data=?';
+ my $dbh = $self->get_main()->get_db_object();
+ return -3 if($dbh->do($sql, undef, $self->{dns_id}, $name, $host) != 0);
- my $sql = 'SELECT id FROM vhffs_dns_rr WHERE zone=? AND type=\'MX\' AND name=? AND data=?';
- my $dbh = $self->get_main()->get_db_object();
- return -3 if($dbh->do($sql, undef, $self->{dns_id}, $name, $host) != 0);
+ $sql = 'INSERT INTO vhffs_dns_rr(zone, name, type, data, aux, ttl) VALUES(?, ?, \'MX\', ?, ?, ?)';
+ $dbh->do($sql, undef, $self->{dns_id}, $name, $host, $priority, $ttl) or return -4;
- $sql = 'INSERT INTO vhffs_dns_rr(zone, name, type, data, aux, ttl) VALUES(?, ?, \'MX\', ?, ?, ?)';
- $dbh->do($sql, undef, $self->{dns_id}, $name, $host, $priority, $ttl) or return -4;
-
- my $id = $dbh->last_insert_id(undef, undef, 'vhffs_dns_rr', undef);
- my $mx = {id => $id,
- zone => $self->{dns_id},
- name => $name,
- type => 'MX',
- data => $host,
- aux => $priority,
- ttl => $ttl
- };
- $self->{MX}->{$id} = $mx;
+ my $id = $dbh->last_insert_id(undef, undef, 'vhffs_dns_rr', undef);
+ my $mx = {id => $id,
+ zone => $self->{dns_id},
+ name => $name,
+ type => 'MX',
+ data => $host,
+ aux => $priority,
+ ttl => $ttl
+ };
+ $self->{MX}->{$id} = $mx;
- $self->add_history('Added an MX record, name: '.($name or '@').' - exchanger: '.$host.' - priority: '.$priority);
-
- $self->update_serial();
- return $id;
+ $self->add_history('Added an MX record, name: '.($name or '@').' - exchanger: '.$host.' - priority: '.$priority);
+
+ $self->update_serial();
+ return $id;
}
=pod
=head2 add_srv
- die('Unable to add SRV record') unless($dns->add_srv($protocol, $service, $host, $port, $priority, $weight);
+ die('Unable to add SRV record') unless($dns->add_srv($protocol, $service, $host, $port, $priority, $weight);
Add a SRV record to the $dns object. C<$protocol> and $service may start with an underscore or not.
See IETF RFC 2782 for more details.
=cut
+sub add_srv {
+ my ($self, $name, $proto, $svc, $host, $port, $priority, $weight) = @_;
+ return -1 unless($proto =~ /^(?:_\w+)|(?:[^_]\w*)$/);
+ return -2 unless($svc =~ /^(?:_\w+)|(?:[^_]\w*)$/);
+ return -3 unless( Vhffs::Functions::check_domain_name($host, 1) || ( check_rr_name($host) ) );
+ return -4 unless($port =~ /^\d+$/ && $port <= 65535 && $port > 0);
+ return -5 unless($priority =~ /^\d+$/ && $priority <= 65535 && $priority >= 0);
+ return -6 unless($weight =~ /^\d+$/ && $weight <= 65535 && $weight >= 0);
+ return -7 unless check_rr_name($name);
-sub add_srv
-{
- my ($self, $name, $proto, $svc, $host, $port, $priority, $weight) = @_;
- return -1 unless($proto =~ /^(?:_\w+)|(?:[^_]\w*)$/);
- return -2 unless($svc =~ /^(?:_\w+)|(?:[^_]\w*)$/);
- return -3 unless( Vhffs::Functions::check_domain_name($host, 1) || ( check_rr_name($host) ) );
- return -4 unless($port =~ /^\d+$/ && $port <= 65535 && $port > 0);
- return -5 unless($priority =~ /^\d+$/ && $priority <= 65535 && $priority >= 0);
- return -6 unless($weight =~ /^\d+$/ && $weight <= 65535 && $weight >= 0);
- return -7 unless check_rr_name($name);
+ $proto = '_'.$proto unless($proto =~ /^_/);
+ $proto = lc($proto);
+ $svc = '_'.$svc unless($svc =~ /^_/);
+ $svc = lc($svc);
+ $name = '' if $name eq '@';
+ $name = $svc.'.'.$proto.'.'.$name;
+ $name =~ s/\.$//;
+ my $data = $weight.' '.$port.' '.$host;
- $proto = "_$proto" unless($proto =~ /^_/);
- $proto = lc($proto);
- $svc = "_$svc" unless($svc =~ /^_/);
- $svc = lc($svc);
- $name = '' if $name eq '@';
- $name = $svc.'.'.$proto.'.'.$name;
- $name =~ s/\.$//;
- my $data = "$weight $port $host";
+ # Looks if this host is already registered for the same service
+ # and the same protocol.
+ my $sql = 'SELECT id FROM vhffs_dns_rr WHERE type=\'SRV\' AND name=? AND data LIKE ? AND zone=?';
+ my $dbh = $self->get_main()->get_db_object();
+ return -8 if($dbh->do($sql, undef, $name, '%'.$host, $self->{dns_id}) != 0);
- # Looks if this host is already registered for the same service
- # and the same protocol.
- my $sql = 'SELECT id FROM vhffs_dns_rr WHERE type=\'SRV\' AND name=? AND data LIKE ? AND zone=?';
- my $dbh = $self->get_main()->get_db_object();
- return -8 if($dbh->do($sql, undef, $name, "\%$host", $self->{dns_id}) != 0);
+ $sql = 'INSERT INTO vhffs_dns_rr(zone, name, type, data, aux, ttl) VALUES(?, ?, \'SRV\', ?, ?, 900)';
+ $dbh->do($sql, undef, $self->{dns_id}, $name, $data, $priority) or return -9;
- $sql = 'INSERT INTO vhffs_dns_rr(zone, name, type, data, aux, ttl) VALUES(?, ?, \'SRV\', ?, ?, 900)';
- $dbh->do($sql, undef, $self->{dns_id}, $name, $data, $priority) or return -9;
+ my $id = $dbh->last_insert_id(undef, undef, 'vhffs_dns_rr', undef);
+ my $srv = {id => $id,
+ zone => $self->{dns_id},
+ name => $name,
+ type => 'SRV',
+ host => $host,
+ port => $port,
+ weight => $weight,
+ aux => $priority,
+ ttl => 900
+ };
+ $self->{SRV}->{$id} = $srv;
- my $id = $dbh->last_insert_id(undef, undef, 'vhffs_dns_rr', undef);
- my $srv = {id => $id,
- zone => $self->{dns_id},
- name => $name,
- type => 'SRV',
- host => $host,
- port => $port,
- weight => $weight,
- aux => $priority,
- ttl => 900
- };
- $self->{SRV}->{$id} = $srv;
+ $self->add_history('Added an SRV record, '.$name.' -> '.$data.' - priority : '.$priority);
- $self->add_history("Added an SRV record, $name -> $data - priority : $priority");
+ $self->update_serial();
+ return $id;
- $self->update_serial();
- return $id;
-
}
=pod
=head2 update_srv
- die("Unable to update SRV record #$id\n") unless($dns->update_srv($id, $newhost, $newport, $newpriority, $newweight) > 0);
+ die("Unable to update SRV record #$id\n") unless($dns->update_srv($id, $newhost, $newport, $newpriority, $newweight) > 0);
Updates data about SRV resource record which id is C<$id>.
=cut
-
sub update_srv {
- my ($self, $id, $host, $port, $priority, $weight) = @_;
- return -1 unless($id =~ /^\d+$/);
- my $rr = $self->{SRV}{$id};
- return -2 unless(defined $rr);
- return -3 unless( Vhffs::Functions::check_domain_name($host, 1) || check_rr_name($host) );
- return -4 unless($port =~ /^\d+$/ && $port <= 65535 && $port > 0);
- return -5 unless($priority =~ /^\d+$/ && $priority <= 65535 && $priority >= 0);
- return -6 unless($weight =~ /^\d+$/ && $weight <= 65535 && $weight >= 0);
+ my ($self, $id, $host, $port, $priority, $weight) = @_;
+ return -1 unless($id =~ /^\d+$/);
+ my $rr = $self->{SRV}{$id};
+ return -2 unless(defined $rr);
+ return -3 unless( Vhffs::Functions::check_domain_name($host, 1) || check_rr_name($host) );
+ return -4 unless($port =~ /^\d+$/ && $port <= 65535 && $port > 0);
+ return -5 unless($priority =~ /^\d+$/ && $priority <= 65535 && $priority >= 0);
+ return -6 unless($weight =~ /^\d+$/ && $weight <= 65535 && $weight >= 0);
- my $data = "$weight $port $host";
+ my $data = $weight.' '.$port.' '.$host;
- my $sql = 'UPDATE vhffs_dns_rr SET data = ?, aux = ? WHERE id = ? AND zone = ? AND type = \'SRV\'';
- my $dbh = $self->get_main()->get_db_object();
- $dbh->do($sql, undef, $data, $priority, $id, $self->{dns_id}) or return -7;
+ my $sql = 'UPDATE vhffs_dns_rr SET data = ?, aux = ? WHERE id = ? AND zone = ? AND type = \'SRV\'';
+ my $dbh = $self->get_main()->get_db_object();
+ $dbh->do($sql, undef, $data, $priority, $id, $self->{dns_id}) or return -7;
- $rr->{aux} = $priority;
- $rr->{weight} = $weight;
- $rr->{host} = $host;
- $rr->{port} = $port;
+ $rr->{aux} = $priority;
+ $rr->{weight} = $weight;
+ $rr->{host} = $host;
+ $rr->{port} = $port;
- $self->add_history('Updated an SRV record, '.$rr->{name}." -> $data - priority : $priority");
+ $self->add_history('Updated an SRV record, '.$rr->{name}.' -> '.$data.' - priority : '.$priority);
- $self->update_serial();
+ $self->update_serial();
}
@@ -680,223 +635,211 @@
=head2 add_aaaa
- die('Unable to add A Record\n') unless($dns->($name, $ip) > 0)
+ die('Unable to add A Record\n') unless($dns->($name, $ip) > 0)
Add an IPv6 AAAA record.
=cut
+sub add_aaaa {
+ my ( $self , $name , $ip , $ttl ) = @_;
-sub add_aaaa
-{
- my ( $self , $name , $ip , $ttl ) = @_;
-
- $ttl = 900 unless defined $ttl;
- return -1 unless check_rr_name($name);
- $name = '' if $name eq '@';
- return -2 if ( $self->name_exists( $name, 'CNAME', 'AAAA' ) != 0 );
+ $ttl = 900 unless defined $ttl;
+ return -1 unless check_rr_name($name);
+ $name = '' if $name eq '@';
+ return -2 if ( $self->name_exists( $name, 'CNAME', 'AAAA' ) != 0 );
- if( ! defined $ip ) {
- my $dnsconfig = $self->{'main'}->get_config->get_service('dns');
- if( defined $dnsconfig->{'default_aaaa'} ) {
- $ip = $dnsconfig->{'default_aaaa'};
- } else {
- return -3;
- }
- }
-
- return -4 unless( Vhffs::Functions::check_ipv6($ip) );
+ unless( defined $ip ) {
+ my $dnsconfig = $self->{'main'}->get_config->get_service('dns');
+ if( defined $dnsconfig->{'default_aaaa'} ) {
+ $ip = $dnsconfig->{'default_aaaa'};
+ } else {
+ return -3;
+ }
+ }
- my $dbh = $self->get_main()->get_db_object();
- my $sql = 'INSERT INTO vhffs_dns_rr (zone, name, type, data, aux, ttl) VALUES(?, ?, \'AAAA\', ?, 0, ?)';
- $dbh->do($sql, undef, $self->{dns_id}, $name, $ip, $ttl) or return -5;
+ return -4 unless( Vhffs::Functions::check_ipv6($ip) );
- my $id = $dbh->last_insert_id(undef, undef, 'vhffs_dns_rr', undef);
- $name = '@' if($name eq '');
- my $aaaa = {id => $id,
- zone => $self->{dns_id},
- name => $name,
- type => 'AAAA',
- data => $ip,
- aux => 0,
- ttl => $ttl
- };
- $self->{AAAA}{$id} = $aaaa;
+ my $dbh = $self->get_main()->get_db_object();
+ my $sql = 'INSERT INTO vhffs_dns_rr (zone, name, type, data, aux, ttl) VALUES(?, ?, \'AAAA\', ?, 0, ?)';
+ $dbh->do($sql, undef, $self->{dns_id}, $name, $ip, $ttl) or return -5;
- $self->update_serial();
+ my $id = $dbh->last_insert_id(undef, undef, 'vhffs_dns_rr', undef);
+ $name = '@' if($name eq '');
+ my $aaaa = {id => $id,
+ zone => $self->{dns_id},
+ name => $name,
+ type => 'AAAA',
+ data => $ip,
+ aux => 0,
+ ttl => $ttl
+ };
+ $self->{AAAA}{$id} = $aaaa;
- $self->add_history("Added a AAAA TYPE with name $name pointing on $ip");
- return $id;
+ $self->update_serial();
+
+ $self->add_history('Added a AAAA TYPE with name '.$name.' pointing on '.$ip);
+ return $id;
}
=pod
=head2 update_aaaa
- die("Unable to update AAAA record #$id\n") unless($dns->update_aaaa($id, $newip);
+ die("Unable to update AAAA record #$id\n") unless($dns->update_aaaa($id, $newip);
Updates IPv6 address for an AAAA record
=cut
+sub update_aaaa {
+ my ( $self , $id, $ip, $ttl ) = @_;
-sub update_aaaa
-{
- my ( $self , $id, $ip, $ttl ) = @_;
-
- return -1 unless($id =~ /^\d+$/ );
- my $rr = $self->{AAAA}{$id};
- return -2 unless(defined $rr);
- return -3 unless( Vhffs::Functions::check_ipv6($ip) );
- $ttl = $rr->{ttl} unless(defined $ttl);
+ return -1 unless($id =~ /^\d+$/ );
+ my $rr = $self->{AAAA}{$id};
+ return -2 unless(defined $rr);
+ return -3 unless( Vhffs::Functions::check_ipv6($ip) );
+ $ttl = $rr->{ttl} unless(defined $ttl);
- my $dbh = $self->get_main()->get_db_object();
- my $sql = 'UPDATE vhffs_dns_rr SET data = ?, ttl = ? WHERE id = ? AND zone = ? AND type = \'AAAA\'';
- $dbh->do($sql, undef, $ip, $ttl, $id, $self->{dns_id}) or return -4;
+ my $dbh = $self->get_main()->get_db_object();
+ my $sql = 'UPDATE vhffs_dns_rr SET data = ?, ttl = ? WHERE id = ? AND zone = ? AND type = \'AAAA\'';
+ $dbh->do($sql, undef, $ip, $ttl, $id, $self->{dns_id}) or return -4;
- $rr->{data} = $ip;
+ $rr->{data} = $ip;
- $self->add_history('Updated AAAA record '.$rr->{name}." pointing now on $ip");
-
- $self->update_serial();
- return 1;
+ $self->add_history('Updated AAAA record '.$rr->{name}.' pointing now on '.$ip);
+
+ $self->update_serial();
+ return 1;
}
=pod
=head2 add_txt
- die('Unable to add TXT record') unless($dns->add_txt($prefix, $txt));
+ die('Unable to add TXT record') unless($dns->add_txt($prefix, $txt));
Associate text $txt to hostname $prefix.
=cut
+sub add_txt {
+ my ($self, $name, $data, $ttl) = @_;
-sub add_txt
-{
- my ($self, $name, $data, $ttl) = @_;
+ $ttl = 900 unless defined $ttl;
+ return -1 unless( check_rr_name($name) );
+ $name = '' if( $name eq '@' );
+ return -2 if($data =~ /^\s*$/);
+ return -3 if ( $self->name_exists( $name, 'TXT', 'CNAME' ) != 0 );
- $ttl = 900 if ( ! defined $ttl );
- return -1 unless( check_rr_name($name) );
- $name = '' if( $name eq '@' );
- return -2 if($data =~ /^\s*$/);
- return -3 if ( $self->name_exists( $name, 'TXT', 'CNAME' ) != 0 );
+ my $dbh = $self->get_main()->get_db_object();
+ my $sql = 'INSERT INTO vhffs_dns_rr (zone, name, type, data, aux, ttl) VALUES(?, ?, \'TXT\', ?, 0, ?)';
+ $dbh->do($sql, undef, $self->{dns_id}, $name, $data, $ttl) or return -4;
- my $dbh = $self->get_main()->get_db_object();
- my $sql = 'INSERT INTO vhffs_dns_rr (zone, name, type, data, aux, ttl) VALUES(?, ?, \'TXT\', ?, 0, ?)';
- $dbh->do($sql, undef, $self->{dns_id}, $name, $data, $ttl) or return -4;
+ my $id = $dbh->last_insert_id(undef, undef, 'vhffs_dns_rr', undef);
+ $name = '@' if($name eq '');
+ my $txt = {id => $id,
+ zone => $self->{dns_id},
+ name => $name,
+ type => 'TXT',
+ data => $data,
+ aux => 0,
+ ttl => $ttl
+ };
+ $self->{TXT}{$id} = $txt;
- my $id = $dbh->last_insert_id(undef, undef, 'vhffs_dns_rr', undef);
- $name = '@' if($name eq '');
- my $txt = {id => $id,
- zone => $self->{dns_id},
- name => $name,
- type => 'TXT',
- data => $data,
- aux => 0,
- ttl => $ttl
- };
- $self->{TXT}{$id} = $txt;
+ $self->update_serial();
- $self->update_serial();
+ $self->add_history('Added a TXT record for prefix '.$name.' ('.$txt.')');
+ return $id;
- $self->add_history("Added a TXT record for prefix $name ($txt)");
- return $id;
-
}
=pod
=head2 update_txt
- die("Unable to set new value $newtxt for TXT record #$id\n") unless($dns->update_txt($id, $newtxt));
+ die("Unable to set new value $newtxt for TXT record #$id\n") unless($dns->update_txt($id, $newtxt));
Update data for a TXT record.
=cut
-
-sub update_txt
-{
- my ($self, $id, $data, $ttl) = @_;
-
- return -1 unless($id =~ /^\d+$/);
- my $rr = $self->{TXT}{$id};
- return -2 unless(defined $rr);
- return -3 if($data =~ /^\s*$/);
- $ttl = $rr->{ttl} unless(defined $ttl and $ttl =~ /^\d+$/);
+sub update_txt {
+ my ($self, $id, $data, $ttl) = @_;
- my $sql = 'UPDATE vhffs_dns_rr SET data = ?, ttl = ? WHERE id = ? AND zone = ? AND type=\'TXT\'';
- my $dbh = $self->get_main()->get_db_object();
+ return -1 unless($id =~ /^\d+$/);
+ my $rr = $self->{TXT}{$id};
+ return -2 unless(defined $rr);
+ return -3 if($data =~ /^\s*$/);
+ $ttl = $rr->{ttl} unless(defined $ttl and $ttl =~ /^\d+$/);
- $dbh->do($sql, undef, $data, $ttl, $id, $self->{dns_id}) or return -4;
+ my $sql = 'UPDATE vhffs_dns_rr SET data = ?, ttl = ? WHERE id = ? AND zone = ? AND type=\'TXT\'';
+ my $dbh = $self->get_main()->get_db_object();
- $rr->{data} = $data;
+ $dbh->do($sql, undef, $data, $ttl, $id, $self->{dns_id}) or return -4;
- $self->add_history('Changed the TXT data for '.$rr->{name}.": $data");
+ $rr->{data} = $data;
- $self->update_serial();
+ $self->add_history('Changed the TXT data for '.$rr->{name}.': '.$data);
+
+ $self->update_serial();
}
-sub update_cname
-{
- my ($self, $id, $dest, $ttl) = @_;
-
- return -1 unless($id =~ /^\d+$/ );
- my $rr = $self->{CNAME}{$id};
- return -2 unless(defined $rr);
- return -3 unless( Vhffs::Functions::check_domain_name($dest, 1) || check_rr_name($dest) );
- $ttl = $rr->{ttl} unless(defined $ttl and $ttl =~ /^\d+$/);
-
- my $dbh = $self->get_main()->get_db_object();
- my $sql = 'UPDATE vhffs_dns_rr SET data = ?, ttl = ? WHERE id = ? AND type = \'CNAME\' AND zone = ?';
- $dbh->do($sql, undef, $dest, $ttl, $id, $self->{dns_id})or return -4;
+sub update_cname {
+ my ($self, $id, $dest, $ttl) = @_;
- $rr->{data} = $dest;
+ return -1 unless($id =~ /^\d+$/ );
+ my $rr = $self->{CNAME}{$id};
+ return -2 unless(defined $rr);
+ return -3 unless( Vhffs::Functions::check_domain_name($dest, 1) || check_rr_name($dest) );
+ $ttl = $rr->{ttl} unless(defined $ttl and $ttl =~ /^\d+$/);
- $self->add_history('Updated CNAME '.$rr->{data}." pointing now on $dest");
- $self->update_serial();
+ my $dbh = $self->get_main()->get_db_object();
+ my $sql = 'UPDATE vhffs_dns_rr SET data = ?, ttl = ? WHERE id = ? AND type = \'CNAME\' AND zone = ?';
+ $dbh->do($sql, undef, $dest, $ttl, $id, $self->{dns_id})or return -4;
+
+ $rr->{data} = $dest;
+
+ $self->add_history('Updated CNAME '.$rr->{data}.' pointing now on '.$dest);
+ $self->update_serial();
}
-sub add_cname
-{
- my ($self, $name, $dest, $ttl) = @_;
+sub add_cname {
+ my ($self, $name, $dest, $ttl) = @_;
- $ttl = 900 if ( ! defined $ttl );
- return -1 unless( check_rr_name($name) );
- return -2 unless( Vhffs::Functions::check_domain_name($dest, 1) || check_rr_name( $dest ) );
- $name = '' if( $name eq '@' );
- return -3 if ( $self->name_exists( $name, 'A', 'AAAA', 'CNAME' ) != 0 );
+ $ttl = 900 unless defined $ttl;
+ return -1 unless( check_rr_name($name) );
+ return -2 unless( Vhffs::Functions::check_domain_name($dest, 1) || check_rr_name( $dest ) );
+ $name = '' if( $name eq '@' );
+ return -3 if ( $self->name_exists( $name, 'A', 'AAAA', 'CNAME' ) != 0 );
- my $dbh = $self->get_main()->get_db_object();
+ my $dbh = $self->get_main()->get_db_object();
- my $sql = 'INSERT INTO vhffs_dns_rr(zone, name, type, data, aux, ttl) VALUES(?, ?, \'CNAME\', ?, 0, ?)';
- $dbh->do($sql, undef, $self->{dns_id}, $name, $dest, $ttl) or return -4;
- my $id = $dbh->last_insert_id(undef, undef, 'vhffs_dns_rr', undef);
+ my $sql = 'INSERT INTO vhffs_dns_rr(zone, name, type, data, aux, ttl) VALUES(?, ?, \'CNAME\', ?, 0, ?)';
+ $dbh->do($sql, undef, $self->{dns_id}, $name, $dest, $ttl) or return -4;
+ my $id = $dbh->last_insert_id(undef, undef, 'vhffs_dns_rr', undef);
- $name = '@' if($name eq '');
- my $cname = {id => $id,
- zone => $self->{dns_id},
- name => $name,
- type => 'CNAME',
- data => $dest,
- aux => 0,
- ttl => $ttl};
+ $name = '@' if($name eq '');
+ my $cname = {id => $id,
+ zone => $self->{dns_id},
+ name => $name,
+ type => 'CNAME',
+ data => $dest,
+ aux => 0,
+ ttl => $ttl};
- $self->{CNAME}{$id} = $cname;
+ $self->{CNAME}{$id} = $cname;
- $self->add_history("Added a CNAME record ($name -> $dest)");
+ $self->add_history('Added a CNAME record ('.$name.' -> '.$dest.')');
- $self->update_serial();
- return $id;
+ $self->update_serial();
+ return $id;
}
-
# Submit changes to the backend
-sub commit
-{
- my $self = shift;
+sub commit {
+ my $self = shift;
return -1 unless ( defined $self && defined $self->{'dns_id'} );
-
- my $conf = $self->{'main'}->get_config->get_service("dns");
+
+ my $conf = $self->{'main'}->get_config->get_service('dns');
return -1 unless defined $conf;
#Update the serial to refresh the domain
@@ -910,8 +853,7 @@
$self->SUPER::commit;
}
-sub get_next_serial
-{
+sub get_next_serial {
my $self = shift;
my ($second,$minutes,$hours,$day,$month,$year) = localtime(time);
my $newserial = sprintf('%.4u%.2u%.2u',$year+1900,$month+1,$day);
@@ -939,178 +881,152 @@
See C<Vhffs::Object::get_label>.
=cut
-
sub get_label {
- my $self = shift;
- return $self->{domain};
+ my $self = shift;
+ return $self->{domain};
}
-sub get_dns_id
-{
- my $self = shift;
- return $self->{dns_id};
+sub get_dns_id {
+ my $self = shift;
+ return $self->{dns_id};
}
-sub get_mx_type
-{
- my $self = shift;
- return $self->{MX};
+sub get_mx_type {
+ my $self = shift;
+ return $self->{MX};
}
-sub get_a_type
-{
- my $self = shift;
- return $self->{A};
+sub get_a_type {
+ my $self = shift;
+ return $self->{A};
}
sub get_aaaa_type {
- my $self = shift;
- return $self->{AAAA};
+ my $self = shift;
+ return $self->{AAAA};
}
-sub get_cname_type
-{
- my $self = shift;
- return $self->{CNAME};
+sub get_cname_type {
+ my $self = shift;
+ return $self->{CNAME};
}
-sub get_ns_type
-{
- my $self = shift;
- return $self->{NS};
+sub get_ns_type {
+ my $self = shift;
+ return $self->{NS};
}
sub get_srv_type {
- my $self = shift;
- return $self->{SRV};
+ my $self = shift;
+ return $self->{SRV};
}
sub get_txt_type {
- my $self = shift;
- return $self->{TXT};
+ my $self = shift;
+ return $self->{TXT};
}
-sub get_soa_ns
-{
- my $self = shift;
- return $self->{'ns'};
+sub get_soa_ns {
+ my $self = shift;
+ return $self->{'ns'};
}
-sub get_soa_mbox
-{
- my $self = shift;
- return $self->{'mbox'};
+sub get_soa_mbox {
+ my $self = shift;
+ return $self->{'mbox'};
}
-sub get_soa_serial
-{
- my $self = shift;
- return $self->{'serial'};
+sub get_soa_serial {
+ my $self = shift;
+ return $self->{'serial'};
}
-sub get_soa_refresh
-{
- my $self = shift;
- return $self->{'refresh'};
+sub get_soa_refresh {
+ my $self = shift;
+ return $self->{'refresh'};
}
-sub get_soa_retry
-{
- my $self = shift;
- return $self->{'retry'};
+sub get_soa_retry {
+ my $self = shift;
+ return $self->{'retry'};
}
-sub get_soa_expire
-{
- my $self = shift;
- return $self->{'expire'};
+sub get_soa_expire {
+ my $self = shift;
+ return $self->{'expire'};
}
-sub get_soa_minimum
-{
- my $self = shift;
- return $self->{'minimum'};
+sub get_soa_minimum {
+ my $self = shift;
+ return $self->{'minimum'};
}
-sub get_soa_ttl
-{
- my $self = shift;
- return $self->{'ttl'};
+sub get_soa_ttl {
+ my $self = shift;
+ return $self->{'ttl'};
}
-sub set_soa_ns
-{
- my $self = shift;
- my $value = shift;
+sub set_soa_ns {
+ my $self = shift;
+ my $value = shift;
- $self->{'ns'} = $value;
+ $self->{'ns'} = $value;
}
-sub set_soa_mbox
-{
- my $self = shift;
- my $value = shift;
+sub set_soa_mbox {
+ my $self = shift;
+ my $value = shift;
- $self->{'mbox'} = $value;
+ $self->{'mbox'} = $value;
}
-sub set_soa_serial
-{
- my $self = shift;
- my $value = shift;
+sub set_soa_serial {
+ my $self = shift;
+ my $value = shift;
- $self->{'serial'} = $value;
+ $self->{'serial'} = $value;
}
-sub set_soa_refresh
-{
- my $self = shift;
- my $value = shift;
+sub set_soa_refresh {
+ my $self = shift;
+ my $value = shift;
- $self->{'refresh'} = $value;
+ $self->{'refresh'} = $value;
}
-sub set_soa_retry
-{
- my $self = shift;
- my $value = shift;
+sub set_soa_retry {
+ my $self = shift;
+ my $value = shift;
- $self->{'retry'} = $value;
+ $self->{'retry'} = $value;
}
+sub set_soa_expire {
+ my $self = shift;
+ my $value = shift;
-sub set_soa_expire
-{
- my $self = shift;
- my $value = shift;
-
- $self->{'expire'} = $value;
+ $self->{'expire'} = $value;
}
-sub set_soa_minimum
-{
- my $self = shift;
- my $value = shift;
+sub set_soa_minimum {
+ my $self = shift;
+ my $value = shift;
- $self->{'minimum'} = $value;
+ $self->{'minimum'} = $value;
}
-sub set_soa_ttl
-{
- my $self = shift;
- my $value = shift;
+sub set_soa_ttl {
+ my $self = shift;
+ my $value = shift;
- $self->{'ttl'} = $value;
+ $self->{'ttl'} = $value;
}
-sub get_domain
-{
- my $self = shift;
- return $self->{domain};
+sub get_domain {
+ my $self = shift;
+ return $self->{domain};
}
-
-
1;
__END__
Modified: trunk/vhffs-api/src/Vhffs/Services/Git.pm
===================================================================
--- trunk/vhffs-api/src/Vhffs/Services/Git.pm 2012-02-18 20:32:49 UTC (rev 2019)
+++ trunk/vhffs-api/src/Vhffs/Services/Git.pm 2012-02-18 23:40:13 UTC (rev 2020)
@@ -159,18 +159,6 @@
return _new Vhffs::Services::Git($main, @params);
}
-sub delete {
- my $self = shift;
- my $query;
- my $request;
-
- $query = 'DELETE FROM vhffs_git WHERE git_id=?';
- $request = $self->{'db'}->prepare($query);
- $request->execute( $self->{git_id} ) or return -1;
-
- return $self->SUPER::delete;
-}
-
sub commit {
my $self = shift;
Modified: trunk/vhffs-api/src/Vhffs/Services/Mail.pm
===================================================================
--- trunk/vhffs-api/src/Vhffs/Services/Mail.pm 2012-02-18 20:32:49 UTC (rev 2019)
+++ trunk/vhffs-api/src/Vhffs/Services/Mail.pm 2012-02-18 23:40:13 UTC (rev 2020)
@@ -54,34 +54,6 @@
use DBI;
use Vhffs::Services::MailingList;
-sub delete
-{
- my $self = shift;
- my $query;
- my $request;
-
-
- $query = "DELETE FROM vhffs_mxdomain WHERE object_id='".$self->{'object_id'}."'";
- $request = $self->{'db'}->prepare($query);
- $request->execute or return -1;
-
- $query = "DELETE FROM vhffs_boxes WHERE domain='".$self->{'domain'}."'";
- $request = $self->{'db'}->prepare($query);
- $request->execute or return -1;
-
- $query = "DELETE FROM vhffs_forward WHERE domain='".$self->{'domain'}."'";
- $request = $self->{'db'}->prepare($query);
- $request->execute or return -1;
-
-
-
-
-
- return -2 if( $self->SUPER::delete < 0 );
-
- return 1;
-}
-
=pod
=head2 create
Modified: trunk/vhffs-api/src/Vhffs/Services/Mercurial.pm
===================================================================
--- trunk/vhffs-api/src/Vhffs/Services/Mercurial.pm 2012-02-18 20:32:49 UTC (rev 2019)
+++ trunk/vhffs-api/src/Vhffs/Services/Mercurial.pm 2012-02-18 23:40:13 UTC (rev 2020)
@@ -158,18 +158,6 @@
return _new Vhffs::Services::Mercurial($main, @params);
}
-sub delete {
- my $self = shift;
- my $query;
- my $request;
-
- $query = 'DELETE FROM vhffs_mercurial WHERE mercurial_id=?';
- $request = $self->{'db'}->prepare($query);
- $request->execute( $self->{mercurial_id} ) or return -1;
-
- return $self->SUPER::delete;
-}
-
sub commit {
my $self = shift;
Modified: trunk/vhffs-api/src/Vhffs/Services/Mysql.pm
===================================================================
--- trunk/vhffs-api/src/Vhffs/Services/Mysql.pm 2012-02-18 20:32:49 UTC (rev 2019)
+++ trunk/vhffs-api/src/Vhffs/Services/Mysql.pm 2012-02-18 23:40:13 UTC (rev 2020)
@@ -87,16 +87,6 @@
return ($dbpass =~ /^.{3,}$/ );
}
-sub delete
-{
- my $self = shift;
- my $request = $self->{'db'}->prepare( 'DELETE FROM vhffs_mysql WHERE object_id=?' );
- $request->execute( $self->{'object_id'} ) or return -1;
-
- return -2 if( $self->SUPER::delete < 0 );
- return 1;
-}
-
=pod
=head2 create
Modified: trunk/vhffs-api/src/Vhffs/Services/Pgsql.pm
===================================================================
--- trunk/vhffs-api/src/Vhffs/Services/Pgsql.pm 2012-02-18 20:32:49 UTC (rev 2019)
+++ trunk/vhffs-api/src/Vhffs/Services/Pgsql.pm 2012-02-18 23:40:13 UTC (rev 2020)
@@ -102,17 +102,7 @@
return ( $dbpass =~ /^.{3,}$/);
}
-sub delete
-{
- my $self = shift;
- my $request = $self->{'db'}->prepare( 'DELETE FROM vhffs_pgsql WHERE object_id=?' );
- $request->execute( $self->{'object_id'} ) or return -1;
-
- return -2 if( $self->SUPER::delete < 0 );
- return 1;
-}
-
=pod
=head2 create
Modified: trunk/vhffs-api/src/Vhffs/Services/Repository.pm
===================================================================
--- trunk/vhffs-api/src/Vhffs/Services/Repository.pm 2012-02-18 20:32:49 UTC (rev 2019)
+++ trunk/vhffs-api/src/Vhffs/Services/Repository.pm 2012-02-18 23:40:13 UTC (rev 2020)
@@ -62,19 +62,6 @@
return ($name =~ /^[a-z0-9]+$/);
}
-sub delete
-{
- my $self = shift;
- return unless(defined $self);
-
- my $query = "DELETE FROM vhffs_repository WHERE object_id='".$self->{'object_id'}."'";
- my $request = $self->{'db'}->prepare($query);
- $request->execute or return -1;
-
- return -1 if( $self->SUPER::delete < 0 );
- return 1;
-}
-
=pod
=head2 create
Modified: trunk/vhffs-api/src/Vhffs/Services/Svn.pm
===================================================================
--- trunk/vhffs-api/src/Vhffs/Services/Svn.pm 2012-02-18 20:32:49 UTC (rev 2019)
+++ trunk/vhffs-api/src/Vhffs/Services/Svn.pm 2012-02-18 23:40:13 UTC (rev 2020)
@@ -160,18 +160,6 @@
return _new Vhffs::Services::Svn($main, @params);
}
-sub delete {
- my $self = shift;
- my $query;
- my $request;
-
- $query = 'DELETE FROM vhffs_svn WHERE svn_id=?';
- $request = $self->{'db'}->prepare($query);
- $request->execute( $self->{svn_id} ) or return -1;
-
- return $self->SUPER::delete;
-}
-
sub commit {
my $self = shift;
Modified: trunk/vhffs-panel/templates/dns/prefs.tt
===================================================================
--- trunk/vhffs-panel/templates/dns/prefs.tt 2012-02-18 20:32:49 UTC (rev 2019)
+++ trunk/vhffs-panel/templates/dns/prefs.tt 2012-02-18 23:40:13 UTC (rev 2020)
@@ -10,7 +10,7 @@
[% FOREACH a IN sorted_a %]
<form class="table-like" method="post" action="#" accept-charset="utf-8">
<p>
- <label for="data_[% a.id %]">[% (a.name == '@' ? dns.get_domain : a.name) | html %]-></label>
+ <label for="data_[% a.id %]">[% a.name | html %]-></label>
<input type="text" name="data" id="data_[% a.id %]" value="[% a.data | html %]" />
<input type="hidden" name="name" value="[% dns.get_domain | html %]" />
<input type="hidden" name="rr_id" value="[% a.id %]" />
@@ -59,7 +59,7 @@
[% FOREACH aaaa IN sorted_aaaa %]
<form class="table-like" method="post" action="#" accept-charset="utf-8">
<p>
- <label for="data_[% aaaa.id %]">[% (aaaa.name == '@' ? dns.get_domain : aaaa.name) | html %]-></label>
+ <label for="data_[% aaaa.id %]">[% aaaa.name | html %]-></label>
<input type="text" name="data" id="data_[% aaaa.id %]" value="[% aaaa.data | html %]" />
<input type="hidden" name="name" value="[% dns.get_domain | html %]"/>
<input type="hidden" name="rr_id" value="[% aaaa.id %]"/>
@@ -107,7 +107,7 @@
[% FOREACH mx IN sorted_mx %]
<form class="table-like" method="post" action="#" accept-charset="utf-8">
<p><label for="data_[% mx.id %]">
- [% (mx.name == '@' ? dns.get_domain : mx.name) | html %] ([% 'Priority:' | i18n | html %] [% mx.aux | html %])->
+ [% mx.name | html %] ([% 'Priority:' | i18n | html %] [% mx.aux | html %])->
</label>
<input type="text" name="data" id="data_[% mx.id %]" value="[% mx.data | html %]" />
<input type="hidden" name="name" value="[% dns.get_domain | html %]" />
@@ -152,7 +152,7 @@
[% FOREACH cname IN sorted_cname %]
<form class="table-like" method="post" action="#" accept-charset="utf-8">
<p>
- <label for="data_[% cname.id %]">[% (cname.name == '@' ? dns.get_domain : cname.name) | html %]-></label>
+ <label for="data_[% cname.id %]">[% cname.name | html %]-></label>
<input type="text" name="data" id="data_[% cname.id %]" value="[% cname.data | html %]" />
<input type="hidden" name="action" value="manage_cname" />
<input type="hidden" name="rr_id" value="[% cname.id %]"/>
@@ -192,7 +192,7 @@
[% FOREACH ns IN sorted_ns %]
<form class="table-like" method="post" action="#" accept-charset="utf-8">
<p>
- <label>[% (ns.name == '@' ? dns.get_domain : ns.name) | html %] -> [% ns.data | html %]</label>
+ <label>[% ns.name | html %] -> [% ns.data | html %]</label>
<input type="hidden" name="action" value="manage_ns" />
<input type="hidden" name="rr_id" value="[% ns.id %]" />
<input type="hidden" name="name" value="[% dns.domain | html %]" />
@@ -269,7 +269,7 @@
[% FOREACH txt IN sorted_txt %]
<form class="table-like" method="post" action="#" accept-charset="utf-8">
<p>
- <label for="data_[% txt.id %]">[% (txt.name == '@' ? dns.get_domain : txt.name) | html %]</label>
+ <label for="data_[% txt.id %]">[% txt.name | html %]</label>
<input type="text" name="data" id="data_[% txt.id %]" value="[% txt.data | html %]" />
<input type="hidden" name="name" value="[% dns.get_domain | html %]" />
<input type="hidden" name="rr_id" value="[% txt.id %]" />