123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152 |
- package Trog::Zone;
- =head1 Trog::Zone
- =head2 DESCRIPTION
- Zonefile CRUD
- =cut
- use strict;
- use warnings;
- use feature qw{signatures};
- no warnings qw{experimental};
- use Trog::Config;
- use Trog::Data;
- use Trog::Vars;
- use Trog::SQLite;
- use Net::IP;
- use Ref::Util;
- =head2 zone($domain) = @zonedata
- Returns the zone data for the requested zone.
- Like any other post in TCMS it's versioned.
- =cut
- sub zone($domain, $version=undef) {
- my $conf = Trog::Config::get();
- my $data = Trog::Data->new($conf);
- my @zonedata = $data->get( tags => ['zone'], acls => [qw{admin}], title => $domain );
- @zonedata = grep { $_->{version} == $version } @zonedata if defined $version;
- return @zonedata;
- }
- =head2 addzone($domain, %options)
- Add a post of 'zone' type.
- =cut
- my $valid_ip = sub {
- return Net::IP->new(shift);
- };
- my $valid_rev_ip = sub {
- return shift =~ m/\.in-addr\.arpa\.$/;
- };
- my $valid_rev_ip6 = sub {
- return shift =~ m/\.ip6\.arpa\.$/;
- };
- my $spec = {
- ip => $valid_ip,
- ip6 => $valid_ip,
- ip_reversed => $valid_rev_ip,
- ip6_reversed => $valid_rev_ip6,
- nameservers => \&Ref::Util::is_arrayref,
- subdomains => \&Ref::Util::is_arrayref,
- cnames => \&Ref::Util::is_arrayref,
- gsv_string => $Trog::Vars::not_ref,
- dkim_pkey => $Trog::Vars::not_ref,
- acme_challenge => $Trog::Vars::not_ref,
- };
- sub addzone($query) {
- my $domain = $query->{title};
- return unless $domain;
- my ($latest) = zone($domain);
- $latest //= {};
- my $conf = Trog::Config::get();
- my $data = Trog::Data->new($conf);
- #XXX TODO make this instead use @records2add, complexity demon BAD
- my $processor = Text::Xslate->new( path => 'www/templates/text' );
- $query->{data} = $processor->render('zone.tx', $query);
- %$latest = (
- %$latest,
- Trog::Vars::filter($query, $spec),
- );
- $data->add($latest);
- #import into pdns
- my ($ttl, $prio, $disabled) = (300, 0, 0);
- my $insert_sql = q{insert into records (domain_id, name, type,content,ttl,prio,disabled) select id , ?, ?, ?, ?, ?, ? from domains where name=?};
- my @records2add = (
- [$query->{title}, 'SOA', "$query->{title} soa.$query->{title} $query->{version} 10800 3600 604800 10800"],
- [$query->{title}, 'A', $query->{ip} ],
- [$query->{title}, 'AAAA', $query->{ip6} ],
- [$query->{ip_reversed}, 'PTR', $query->{title}],
- [$query->{ip6_reversed}, 'PTR', $query->{title}],
- [$query->{title}, 'MX', "mail.$query->{title}"],
- ["_smtps._tcp.mail.$query->{title}", 'SRV', "5 587 ." ],
- ["_imaps._tcp.mail.$query->{title}", 'SRV', "5 993 ." ],
- ["_pop3s._tcp.mail.$query->{title}", 'SRV', "5 995 ." ],
- ["_dmarc.$query->{title}", 'TXT', "v=DMARC1; p=reject; rua=mailto:postmaster\@$query->{title}; ruf=mailto:postmaster\@$query->{title}"],
- ["mail._domainkey.$query->{title}", 'TXT', "v=DKIM1; h=sha256; k=rsa; t=y; p=$query->{dkim_pkey}"],
- [$query->{title}, 'TXT', "v=spf1 +mx +a +ip4:$query->{ip} +ip6:$query->{ip6} -all"],
- [$query->{title}, 'TXT', "google-site-verification=$query->{gsv_string}"],
- ["_acme-challenge.$query->{title}", 'TXT', $query->{acme_challenge}],
- [$query->{title}, 'CAA', '0 issue "letsencrypt.org"'],
- );
- push(@records2add, (map { ["$_.$query->{title}", "CNAME", $query->{title}] } @{$query->{cnames}}));
- push(@records2add, (map { [$query->{title}, 'NS', $_] } @{$query->{nameservers}}));
- foreach my $subdomain (@{$query->{subdomains}}) {
- push(@records2add, ["$subdomain->{name}.$query->{title}", 'A', $subdomain->{ip}]);
- push(@records2add, ["$subdomain->{name}.$query->{title}", 'AAAA', $subdomain->{ip6}]);
- push(@records2add, (map { ["$subdomain->{name}.$query->{title}", 'NS', $_] } @{$subdomain->{nameservers}}));
- }
- my $dbh = _dbh();
- $dbh->begin_work();
- $dbh->do("DELETE FROM records") or _roll_and_die($dbh);
- foreach my $record (@records2add) {
- $dbh->do($insert_sql, undef, @$record, $ttl, $prio, $disabled, $query->{title}) or _roll_and_die($dbh);
- }
- $dbh->commit() or _roll_and_die($dbh);
- return $latest;
- }
- sub delzone($domain) {
- my $conf = Trog::Config::get();
- my $data = Trog::Data->new($conf);
- my ($latest) = zone($domain);
- return unless $latest;
- return $data->delete($latest);
- }
- sub _dbh {
- return Trog::SQLite::dbh( undef, "dns/zones.db" );
- }
- sub _roll_and_die($dbh) {
- my $err = $dbh->errstr;
- $dbh->rollback();
- die $err;
- }
- 1;
|