Allow updating of zones, next we get an interface!

Readme.md

@@ -1,7 +1,8 @@
 tCMS
 =====
 
-A flexible perl CMS which supports multiple data models and content types
+A flexible perl CMS which supports multiple data models and content types.
+Should be readily portable/hostable between any other system that runs tCMS due to being largely self-contained.
 
 tCMS is built fully around ubuntu hosts at the moment.
 
@@ -21,6 +22,8 @@ It is strongly suggested that you chmod everything but the run/ directory to be
 
 It also sets up the mailserver and DNS for you.
 
+You should add the pdns group to the user you use to run tCMS, so that the zone management features will work.
+
 A Dockerfile and deployment scripts are provided for your convenience in building/running containers based on this:
 ```
 # Build and run the server

bin/build_zone

@@ -86,7 +86,7 @@ sub main(@args) {
         nameservers => ["ns1.$domain"],
         subdomains  => [map { { name => $_, ip => domain2ips("$_.$domain", "A"), "ip6" => domain2ips("$_.$domain", "AAAA"), nameservers => ["ns1.$_.$domain"] } } @{$options{subdomains}}],
         cnames      => [(qw{www mail chat},@{$options{cnames}})],
-        gsv_string  => $options{gsv},
+        gsv_string  => $options{gsv} // '',
         version    => 0,
         dkim_pkey => extract_pkey($domain),
         acme_challenge => get_dns_dcv_string( $domain ),
@@ -103,9 +103,6 @@ sub main(@args) {
         user       => $user,
     };
 
-    my $processor = Text::Xslate->new( path => 'www/templates/text' );
-    $data->{data} = $processor->render('zone.tx', $data);
-
     my $zone = Trog::Zone::addzone($data);
     print $data->{data};
 

lib/Trog/SQLite.pm

@@ -47,12 +47,16 @@ sub dbh {
     $dbh //= {};
     return $dbh->{$dbname} if $dbh->{$dbname};
     File::Touch::touch($dbname) unless -f $dbname;
-    die "No such schema file '$schema' !" unless -f $schema;
-    my $qq = File::Slurper::read_text($schema);
     my $db = DBI->connect( "dbi:SQLite:dbname=$dbname", "", "" );
-    $db->{sqlite_allow_multiple_statements} = 1;
-    $db->do($qq) or die "Could not ensure database consistency: " . $db->errstr;
-    $db->{sqlite_allow_multiple_statements} = 0;
+
+    if ($schema) {
+        die "No such schema file '$schema' !" unless -f $schema;
+        my $qq = File::Slurper::read_text($schema);
+        $db->{sqlite_allow_multiple_statements} = 1;
+        $db->do($qq) or die "Could not ensure database consistency: " . $db->errstr;
+        $db->{sqlite_allow_multiple_statements} = 0;
+    }
+
     $dbh->{$dbname} = $db;
 
     # Turn on fkeys

lib/Trog/Zone.pm

@@ -17,6 +17,7 @@ no warnings qw{experimental};
 use Trog::Config;
 use Trog::Data;
 use Trog::Vars;
+use Trog::SQLite;
 
 use Net::IP;
 use Ref::Util;
@@ -77,6 +78,10 @@ sub addzone($query) {
     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),
@@ -84,7 +89,43 @@ sub addzone($query) {
 
     $data->add($latest);
 
-    #TODO render and import into pdns
+    #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;
 }
@@ -95,7 +136,17 @@ sub delzone($domain) {
 
     my ($latest) = zone($domain);
     return unless $latest;
-    return $data->delete($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;

www/templates/text/zone.tx

@@ -38,18 +38,18 @@ $TTL    300
 
 ; MX & SRV records
 <: $title :>.    IN MX  0 mail.<: $title :>.
-_smtps._tcp.mail. IN SRV 10 5 587 .
-_imaps._tcp.mail. IN SRV 10 5 993 .
-_pop3s._tcp.mail. IN SRV 10 5 995 .
+_smtps._tcp.mail.<: $title :>. IN SRV 10 5 587 .
+_imaps._tcp.mail.<: $title :>. IN SRV 10 5 993 .
+_pop3s._tcp.mail.<: $title :>. IN SRV 10 5 995 .
 
 ; SPF, DKIM, DMARC
 _dmarc.<: $title :>.          IN TXT "v=DMARC1; p=reject; rua=mailto:postmaster@<: $title :>; ruf=mailto:postmaster@<: $title :>"
 mail._domainkey.<: $title :>. IN TXT "v=DKIM1; h=sha256; k=rsa; t=y; p=<: $dkim_pkey :>"
-<: $title :>.                 IN TXT "v=spf1 +mx +a +ip4:<: $ip :> +ip6:<: $ip :> ~all"
+<: $title :>.                 IN TXT "v=spf1 +mx +a +ip4:<: $ip :> +ip6:<: $ip6 :> ~all"
 
 ; Indexer verification
 <: $title :>.                 IN TXT "google-site-verification=<: $gsv_string :>"
 
 ; LetsEncyst
 _acme-challenge.<: $title :>. IN TXT  "<: $acme_challenge :>"
-<: $title :>                  IN CAA 0 issue letsencrypt.org
+<: $title :>.                 IN CAA 0 issue "letsencrypt.org"