#! /usr/bin/perl -w
# Copyright (C) 2021-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;

sub processitem($$);

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

# this is quite specific - we should rethink this if we have other use
# cases
our $ptr = shift;
if ($ptr=~/([1-9][0-9]*|0)\.([1-9][0-9]*|0)\.([1-9][0-9]*|0)/) {
  $1<256 and $2<256 and $3<256
    or die "Syntax: $0 x.y.z\nx,y,z must be integers between 0-255\n"
} else { die "Syntax: $0 x.y.z\n(x,y,z must be integers between 0-255)\n"}


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


# for now this is quite specific to kaesesalat so this is ok as a default
our($domain)=("kaesesalat.de.");
our(%ip);

processitem($data,$domain); 

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->{"ptrprefix"})) { 
    return unless $item->{"ptrprefix"} eq $ptr; 
  } 
  if (exists($item->{"isdomain"}) and $item->{"isdomain"}) {
    if (exists($item->{"name"})) {$name=$item->{"name"}}
    $domain="$name.$domain";
    if (exists($item->{"domain"})) {$domain=$item->{"domain"}}

  } else {
    if (exists($item->{"name"})) {$name=$item->{"name"}}
    if (exists($item->{"ptrname"})) {$name=$item->{"ptrname"}}
    if (exists($item->{"domain"})) { # should this be supported?
      warn "domain only supported in domain definitions. skipping $name";
      return;
    }
    my(@ip);
    if (exists($item->{"ptrpattern"})) {
      @ip=($item->{"ptrpattern"});
      print $ip[0]." IN PTR $name\n";
    }
    if (exists($item->{"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]+\.){3})([0-9]+)/) {
	  if ($1 eq "$ptr.") {
	    print "$3 IN PTR $name.$domain\n";
	    if (defined($ip{$3})) {
	      die "duplicate IP $3 in PTR pointing to $name.$domain and $ip{$3}"
	    } else { $ip{$3}= $name.$domain }
	  }
	}
      }
    }
  }

  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->{$_},$_);
    }
  }
}