#! /usr/bin/perl -w
# Copyright (C) 2020-2022 Arne Wichmann <aw@saar.de>
#
# This little thing is distributed under the GNU General Public License,
# version 2. If you need the license, ask your distributor for it.

use strict;

use TOML::Parser;

# todo - wenn ich die subdomain in systems.toml vergessen hab ist die
# fehlermeldung wirklich scheiße - sie zeigt weder einen sinnvollen ort noch
# ist sie inhaltlich hilfreich. (duplicate key IP)


sub processitem($$);

my $parser = TOML::Parser->new();

my $data = $parser->parse(join("",<>));

# my(@t)=localtime(time);
# my($serial)=sprintf("%04d%02d%02d%02d",$t[5]+1900,$t[4]+1,$t[3],$t[2]);
my($serial)=time()+4*10**8;


open(L,'leadin') or die "Could not open file 'leadin': $!\n";
my($leadin)=join('',<L>);
close(L);
$leadin=~s/\$serial/$serial/g;
print($leadin);

our($defaultttl,$domain)=(86400,".");

# for now this is quite specific to kaesesalat so this is ok as a default
processitem($data,"kaesesalat"); 

sub processitem($$) { # argument is a reference to a hash
  my($item)=shift;
  my($name)=shift;
  ref($item) eq "HASH" or die "no hash?";

  # this value will be overwritten by each recursion (dynamic scope)
  # so, this is slightly magic, and magic needs explanation
  # local gives a variable a new value which will last _dynamically_ until
  # the end of the current block - that means among others including
  # functions we call - in effect the variable stays the default for all
  # further recursions unless overridden
  local($defaultttl)=$defaultttl;
  local($domain)="$domain";

  if (exists($item->{"isdomain"}) and $item->{"isdomain"}) {
    if (exists($item->{"name"})) {$name=$item->{"name"}}
    $domain="$name.$domain";
    if (exists($item->{"ttl"})) {$defaultttl=$item->{"ttl"}}
    if (exists($item->{"domain"})) {$domain=$item->{"domain"}}
    print '$ORIGIN '.$domain."\n";

  } else {
    my($ttl)=$defaultttl;
    if (exists($item->{"name"})) {$name=$item->{"name"}}
    if (exists($item->{"ttl"})) {$ttl=$item->{"ttl"}}
    if (exists($item->{"domain"})) { # should this be supported?
      warn "domain only supported in domain definitions. skipping $name";
      return;
    }
    if (exists($item->{"ippattern"})) {
      if (exists($item->{"ip"})) {
        warn "ip and ippattern cannot go together. skipping $name";
	return;
      }
      print "$name $ttl A ".$item->{"ippattern"}."\n";
    }
    if (exists($item->{"ip"})) {
      my(@ip);
      if (ref($item->{"ip"}) eq "ARRAY") {
        @ip=@{$item->{"ip"}};
      } else {
        ref($item->{"ip"}) eq "" or warn "ip not scalar but "
	  .ref($item->{"ip"}).", things might break - please report this!";
        @ip=($item->{"ip"});
      }

      for (@ip) {
        if (/[0-9]+(\.[0-9]+){3}/) {
	  print "$name $ttl A $_\n";
	} elsif (/[0-9a-fA-F]*:[0-9a-fA-F:]*:[0-9a-fA-F]*/) {
	  print "$name $ttl AAAA $_\n";
	} else {
	  print "$name $ttl CNAME $_\n";
	}
      }
    }
    if (exists($item->{"mx"})) {
      my(@mx);
      if (ref($item->{"mx"}) eq "ARRAY") { @mx=@{$item->{"mx"}} }
      else {
        ref($item->{"mx"}) eq "" or warn "mx not scalar but "
          .ref($item->{"mx"}).", things might break - please report this!";
        @mx=($item->{"mx"});
      }

      for (@mx) { print "$name $ttl MX $_\n"; }
    }
    # ignored: eip, ettl, emx, smart
  }

  for (sort(keys(%$item))) {
    if (ref($item->{$_}) eq "HASH") { # name
      next if $item->{$_}->{"isdomain"};
      processitem($item->{$_},$_);
    }
  }

  for (sort(keys(%$item))) {
    if (ref($item->{$_}) eq "HASH") { # subdomain
      next unless $item->{$_}->{"isdomain"};
      processitem($item->{$_},$_);
    }
  }

}