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;