Changeset 103 for trunk/DNSDB.pm

Timestamp:

07/15/11 14:52:30 (13 years ago)

Author:

Kris Deugau

Message:

/trunk

Add public export() and private export_tiny() subs to handle

export of most common records for tinyDNS

File:

• trunk/DNSDB.pm (modified) (3 diffs)

trunk/DNSDB.pm

@@ -34 +34 @@
         &addRec &updateRec &delRec
         &domStatus &importAXFR
+        &export
         %typemap %reverse_typemap
         %permissions @permtypes $permlist
@@ -49 +50 @@
                 &addRec &updateRec &delRec
                 &domStatus &importAXFR
+                &export
                 %typemap %reverse_typemap
                 %permissions @permtypes $permlist
@@ -1510 +1512 @@
 
 
+## DNSDB::export()
+# Export the DNS database, or a part of it
+# Takes database handle, export type, optional arguments depending on type
+# Writes zone data to targets as appropriate for type
+sub export {
+  my $dbh = shift;
+  my $target = shift;
+
+  if ($target eq 'tiny') {
+    __export_tiny($dbh,@_);
+  }
+# elsif ($target eq 'foo') {
+#   __export_foo($dbh,@_);
+#}
+# etc
+
+} # end export()
+
+
+## DNSDB::__export_tiny
+# Internal sub to implement tinyDNS (compatible) export
+# Takes database handle, filehandle to write export to, optional argument(s)
+# to determine which data gets exported
+sub __export_tiny {
+  my $dbh = shift;
+  my $datafile = shift;
+
+##fixme: slurp up further options to specify particular zone(s) to export
+
+  ## Convert a bare number into an octal-coded pair of octets.
+  # Take optional arg to indicate a decimal or hex input.  Defaults to hex.
+  sub octalize {
+    my $tmp = shift;
+    my $srctype = shift || 'h'; # default assumes hex string
+    $tmp = sprintf "%0.4x", hex($tmp) if $srctype eq 'h';       # 0-pad hex to 4 digits
+    $tmp = sprintf "%0.4x", $tmp if $srctype eq 'd';    # 0-pad decimal to 4 hex digits
+    my @o = ($tmp =~ /^(..)(..)$/);     # split into octets
+    return sprintf "\\%0.3o\\%0.3o", hex($o[0]), hex($o[1]);;
+  }
+
+##fixme: fail if $datafile isn't an open, writable file
+
+  # easy case - export all evarything
+  # not-so-easy case - export item(s) specified
+  # todo:  figure out what kind of list we use to export items
+
+  my $domsth = $dbh->prepare("SELECT domain_id,domain,status FROM domains WHERE status=1");
+  my $recsth = $dbh->prepare("SELECT r.host,r.type,r.val,r.distance,r.weight,r.port,r.ttl,l.recdata ".
+        "FROM records r LEFT OUTER JOIN longrecs l ON r.longrec_id=l.longrec_id WHERE domain_id=?");
+  $domsth->execute();
+  while (my ($domid,$dom,$domstat) = $domsth->fetchrow_array) {
+    $recsth->execute($domid);
+    while (my ($host,$type,$val,$dist,$weight,$port,$ttl,$lval) = $recsth->fetchrow_array) {
+      $val = $lval if $lval;
+
+# raw packet in unknown format:  first byte indicates length
+# of remaining data, allows up to 255 raw bytes
+
+##fixme?  append . to all host/val hostnames
+      if ($typemap{$type} eq 'SOA') {
+
+        # host contains pri-ns:responsible
+        # val is abused to contain refresh:retry:expire:minttl
+##fixme:  "manual" serial vs tinydns-autoserial
+        print $datafile "Z$host"."::$val:$ttl\n";
+
+      } elsif ($typemap{$type} eq 'A') {
+
+        print $datafile "+$host:$val:$ttl\n";
+
+      } elsif ($typemap{$type} eq 'NS') {
+
+        print $datafile "\&$host"."::$val:$ttl\n";
+
+      } elsif ($typemap{$type} eq 'AAAA') {
+
+        print $datafile ":$host:28:";
+        my $altgrp = 0;
+        my @altconv;
+        # Split in to up to 8 groups of hex digits (allows for :: 0-collapsing)
+        foreach (split /:/, $val) {
+          if (/^$/) {
+            # flag blank entry;  this is a series of 0's of (currently) unknown length
+            $altconv[$altgrp++] = 's';
+          } else {
+            # call sub to convert 1-4 hex digits to 2 string-rep octal bytes
+            $altconv[$altgrp++] = octalize($_)
+          }
+        }
+        foreach my $octet (@altconv) {
+          # if not 's', output
+          print $datafile $octet unless $octet =~ /^s$/;
+          # if 's', output (9-array length)x literal '\000\000'
+          print $datafile '\000\000'x(9-$altgrp) if $octet =~ /^s$/;
+        }
+        print $datafile ":$ttl\n";
+
+      } elsif ($typemap{$type} eq 'MX') {
+
+        print $datafile "\@$host"."::$val:$dist:$ttl\n";
+
+      } elsif ($typemap{$type} eq 'TXT') {
+
+##fixme:  split v-e-r-y long TXT strings?  will need to do so for BIND export, at least
+        $val =~ s/:/\\072/g;    # may need to replace other symbols
+        print $datafile "'$host:$val:$ttl\n";
+
+# by-hand TXT
+#:deepnet.cx:16:2v\075spf1\040a\040a\072bacon.deepnet.cx\040a\072home.deepnet.cx\040-all:3600
+#@       IN      TXT     "v=spf1 a a:bacon.deepnet.cx a:home.deepnet.cx -all"
+#'deepnet.cx:v=spf1 a a\072bacon.deepnet.cx a\072home.deepnet.cx -all:3600
+
+#txttest IN      TXT     "v=foo bar:bob kn;ob' \" !@#$%^&*()-=_+[]{}<>?"
+#:txttest.deepnet.cx:16:\054v\075foo\040bar\072bob\040kn\073ob\047\040\042\040\041\100\043\044\045\136\046\052\050\051-\075\137\053\133\135\173\175\074\076\077:3600
+
+# very long TXT record as brought in by axfr-get
+# note tinydns does not support >512-byte RR data, need axfr-dns (for TCP support) for that
+# also note, tinydns does not seem to support <512, >256-byte RRdata from axfr-get either.  :/
+#:longtxt.deepnet.cx:16:
+#\170this is a very long txt record.  it is really long.  long. very long.  really very long. this is a very long txt record.
+#\263  it is really long.  long. very long.  really very long. this is a very long txt record.  it is really long.  long. very long.  really very long. this is a very long txt record. 
+#\351 it is really long.  long. very long.  really very long.this is a very long txt record.  it is really long.  long. very long.  really very long. this is a very long txt record.  it is really long.  long. very long.  really very long.
+#:3600
+
+      } elsif ($typemap{$type} eq 'CNAME') {
+
+        print $datafile "C$host:$val:$ttl\n";
+
+      } elsif ($typemap{$type} eq 'SRV') {
+
+        # data is two-byte values for priority, weight, port, in that order,
+        # followed by length/string data
+
+        print $datafile ":$host:33:".octalize($dist,'d').octalize($weight,'d').octalize($port,'d');
+
+        $val .= '.' if $val !~ /\.$/;
+        foreach (split /\./, $val) {
+          printf $datafile "\\%0.3o%s", length($_), $_;
+        }
+        print $datafile "\\000:$ttl\n";
+
+      } elsif ($typemap{$type} eq 'RP') {
+
+        # RP consists of two mostly free-form strings.
+        # The first is supposed to be an email address with @ replaced by . (as with the SOA contact)
+        # The second is the "hostname" of a TXT record with more info.
+        print $datafile ":$host:17:";
+        my ($who,$what) = split /\s/, $val;
+        foreach (split /\./, $who) {
+          printf $datafile "\\%0.3o%s", length($_), $_;
+        }
+        print $datafile '\000';
+        foreach (split /\./, $what) {
+          printf $datafile "\\%0.3o%s", length($_), $_;
+        }
+        print $datafile "\\000:$ttl\n";
+
+      } elsif ($typemap{$type} eq 'PTR') {
+
+        # must handle both IPv4 and IPv6
+##work
+
+      } # record type if-else
+
+    } # while ($recsth)
+  } # while ($domsth)
+} # end __export_tiny()
+
+
 # shut Perl up
 1;