|
|
@@ -1,157 +0,0 @@
|
|
|
-#!/usr/bin/env perl
|
|
|
-
|
|
|
-=head1 build_zone
|
|
|
-
|
|
|
-Build the basic zone for a tCMS site and import it into powerdns.
|
|
|
-Otherwise, make it a post so you can edit it in the config backend.
|
|
|
-
|
|
|
-In general this should not be called outside of Installer.mk.
|
|
|
-
|
|
|
-=head2 OPTIONS
|
|
|
-
|
|
|
-=head3 subdomain
|
|
|
-
|
|
|
-Specify a subdomain, such as 'foo' to add to the domain.
|
|
|
-
|
|
|
-May be passed multiple times.
|
|
|
-
|
|
|
-=head3 gsv
|
|
|
-
|
|
|
-Google site verification string goes into TXT record
|
|
|
-
|
|
|
-=head3 cname
|
|
|
-
|
|
|
-Specify a cname, such as 'bar' to add to the domain.
|
|
|
-
|
|
|
-By default, the cnames 'www', 'mail' and 'chat' are set up, as these are essential tCMS services setup by the makefile before this.
|
|
|
-
|
|
|
-May be passed multiple times.
|
|
|
-
|
|
|
-=cut
|
|
|
-
|
|
|
-use strict;
|
|
|
-use warnings;
|
|
|
-
|
|
|
-no warnings qw{experimental};
|
|
|
-use feature qw{signatures state};
|
|
|
-
|
|
|
-use FindBin::libs;
|
|
|
-use Trog::Config();
|
|
|
-use Trog::Zone();
|
|
|
-use Trog::Auth;
|
|
|
-
|
|
|
-use DNS::Unbound;
|
|
|
-use Net::DNS::Packet;
|
|
|
-
|
|
|
-use Text::Xslate;
|
|
|
-use Net::IP;
|
|
|
-
|
|
|
-use Getopt::Long qw{GetOptionsFromArray};
|
|
|
-
|
|
|
-$ENV{NOHUP} = 1;
|
|
|
-
|
|
|
-exit main(@ARGV) unless caller;
|
|
|
-
|
|
|
-sub main(@args) {
|
|
|
-
|
|
|
- my %options;
|
|
|
- GetOptionsFromArray(\@args,
|
|
|
- 'subdomain=s@' => \$options{subdomains},
|
|
|
- 'gsv=s' => \$options{gsv},
|
|
|
- 'cname=s@' => \$options{cnames},
|
|
|
- );
|
|
|
-
|
|
|
- # Paranoia, some versions of getopt don't do this
|
|
|
- $options{cnames} //= [];
|
|
|
- $options{subdomains} //=[];
|
|
|
-
|
|
|
- my $domain = Trog::Config->get()->param('general.hostname');
|
|
|
- die "Hostname not set in tCMS configuration. Please set this first." unless $domain;
|
|
|
-
|
|
|
- my $user = Trog::Auth::primary_user;
|
|
|
- die "Primary tCMS user not yet set up" unless $user;
|
|
|
-
|
|
|
- # Get a flesh start
|
|
|
- Trog::Zone::delzone($domain);
|
|
|
-
|
|
|
- my ($ip) = domain2ips($domain, 'A');
|
|
|
- my ($ip6) = domain2ips($domain, 'AAAA');
|
|
|
-
|
|
|
- my $data = {
|
|
|
- ip => $ip,
|
|
|
- ip6 => $ip6,
|
|
|
- ip_reversed => Net::IP->new($ip)->reverse_ip(),
|
|
|
- ip6_reversed => Net::IP->new($ip6)->reverse_ip(),
|
|
|
- title => $domain,
|
|
|
- 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} // '',
|
|
|
- version => 0,
|
|
|
- dkim_pkey => extract_pkey($domain),
|
|
|
- acme_challenge => get_dns_dcv_string( $domain ),
|
|
|
- visibility => 'private',
|
|
|
- acls => [qw{admin}],
|
|
|
- aliases => [],
|
|
|
- tags => ['zone'],
|
|
|
- form => 'dns.tx',
|
|
|
- callback => "Trog::Routes::TXT::zone",
|
|
|
- id => undef,
|
|
|
- created => undef,
|
|
|
- local_href => "/text/zone/$domain",
|
|
|
- href => "/text/zone/$domain",
|
|
|
- user => $user,
|
|
|
- };
|
|
|
-
|
|
|
- my $zone = Trog::Zone::addzone($data);
|
|
|
- print $data->{data};
|
|
|
-
|
|
|
- return 0;
|
|
|
-}
|
|
|
-
|
|
|
-sub extract_pkey ( $domain ) {
|
|
|
- open(my $fh, '<', "/etc/opendkim/keys/$domain/mail.public");
|
|
|
- my @lines = map { chomp $_; $_ } readline $fh;
|
|
|
- close $fh;
|
|
|
- shift @lines;
|
|
|
- pop @lines;
|
|
|
- return join('', @lines);
|
|
|
-}
|
|
|
-
|
|
|
-sub get_dns_dcv_string( $domain ) {
|
|
|
- return "TODO";
|
|
|
-}
|
|
|
-
|
|
|
-sub domain2ips( $domain, $type ) {
|
|
|
- # XXX would be great to use state here, but felipe
|
|
|
- my $resolver = DNS::Unbound->new();
|
|
|
-
|
|
|
- my $p = $resolver->resolve( $domain, $type )->answer_packet();
|
|
|
- my @rrs = Net::DNS::Packet->new( \$p )->answer;
|
|
|
-
|
|
|
- my @addr = map { $_->address } @rrs;
|
|
|
- @addr=(get_local_ip($type)) unless @addr;
|
|
|
- return @addr;
|
|
|
-}
|
|
|
-
|
|
|
-my $addrout='';
|
|
|
-sub get_local_ip( $type ) {
|
|
|
- $addrout //=qx{ip addr};
|
|
|
- return $type eq 'A' ? _ipv4() : _ipv6();
|
|
|
-}
|
|
|
-
|
|
|
-sub _ipv4 {
|
|
|
- state $ip;
|
|
|
- return $ip if $ip;
|
|
|
- ($ip) = $addrout =~ m{inet\s+([\d|\.|/]+)\s+scope\s+global}gmx;
|
|
|
- return $ip;
|
|
|
-}
|
|
|
-
|
|
|
-sub _ipv6 {
|
|
|
- state $ip6;
|
|
|
- return $ip6 if $ip6;
|
|
|
- ($ip6) = $addrout =~ m{inet6\s+([a-f|\d|:|/]+)\s+scope\s+global\s+dynamic\s+mngtmpaddr}gmx;
|
|
|
- # We have to strip the CIDR off of it, or it breaks Net::IP's brain.
|
|
|
- $ip6 =~ s|/\d+$||;
|
|
|
- return $ip6;
|
|
|
-}
|
