123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160 |
- #!/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 $processor = Text::Xslate->new( path => 'www/templates/text' );
- $data->{data} = $processor->render('zone.tx', $data);
- 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;
- }
|