Changeset 103 for trunk


Ignore:
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:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/DNSDB.pm

    r101 r103  
    3434        &addRec &updateRec &delRec
    3535        &domStatus &importAXFR
     36        &export
    3637        %typemap %reverse_typemap
    3738        %permissions @permtypes $permlist
     
    4950                &addRec &updateRec &delRec
    5051                &domStatus &importAXFR
     52                &export
    5153                %typemap %reverse_typemap
    5254                %permissions @permtypes $permlist
     
    15101512
    15111513
     1514## DNSDB::export()
     1515# Export the DNS database, or a part of it
     1516# Takes database handle, export type, optional arguments depending on type
     1517# Writes zone data to targets as appropriate for type
     1518sub export {
     1519  my $dbh = shift;
     1520  my $target = shift;
     1521
     1522  if ($target eq 'tiny') {
     1523    __export_tiny($dbh,@_);
     1524  }
     1525# elsif ($target eq 'foo') {
     1526#   __export_foo($dbh,@_);
     1527#}
     1528# etc
     1529
     1530} # end export()
     1531
     1532
     1533## DNSDB::__export_tiny
     1534# Internal sub to implement tinyDNS (compatible) export
     1535# Takes database handle, filehandle to write export to, optional argument(s)
     1536# to determine which data gets exported
     1537sub __export_tiny {
     1538  my $dbh = shift;
     1539  my $datafile = shift;
     1540
     1541##fixme: slurp up further options to specify particular zone(s) to export
     1542
     1543  ## Convert a bare number into an octal-coded pair of octets.
     1544  # Take optional arg to indicate a decimal or hex input.  Defaults to hex.
     1545  sub octalize {
     1546    my $tmp = shift;
     1547    my $srctype = shift || 'h'; # default assumes hex string
     1548    $tmp = sprintf "%0.4x", hex($tmp) if $srctype eq 'h';       # 0-pad hex to 4 digits
     1549    $tmp = sprintf "%0.4x", $tmp if $srctype eq 'd';    # 0-pad decimal to 4 hex digits
     1550    my @o = ($tmp =~ /^(..)(..)$/);     # split into octets
     1551    return sprintf "\\%0.3o\\%0.3o", hex($o[0]), hex($o[1]);;
     1552  }
     1553
     1554##fixme: fail if $datafile isn't an open, writable file
     1555
     1556  # easy case - export all evarything
     1557  # not-so-easy case - export item(s) specified
     1558  # todo:  figure out what kind of list we use to export items
     1559
     1560  my $domsth = $dbh->prepare("SELECT domain_id,domain,status FROM domains WHERE status=1");
     1561  my $recsth = $dbh->prepare("SELECT r.host,r.type,r.val,r.distance,r.weight,r.port,r.ttl,l.recdata ".
     1562        "FROM records r LEFT OUTER JOIN longrecs l ON r.longrec_id=l.longrec_id WHERE domain_id=?");
     1563  $domsth->execute();
     1564  while (my ($domid,$dom,$domstat) = $domsth->fetchrow_array) {
     1565    $recsth->execute($domid);
     1566    while (my ($host,$type,$val,$dist,$weight,$port,$ttl,$lval) = $recsth->fetchrow_array) {
     1567      $val = $lval if $lval;
     1568
     1569# raw packet in unknown format:  first byte indicates length
     1570# of remaining data, allows up to 255 raw bytes
     1571
     1572##fixme?  append . to all host/val hostnames
     1573      if ($typemap{$type} eq 'SOA') {
     1574
     1575        # host contains pri-ns:responsible
     1576        # val is abused to contain refresh:retry:expire:minttl
     1577##fixme:  "manual" serial vs tinydns-autoserial
     1578        print $datafile "Z$host"."::$val:$ttl\n";
     1579
     1580      } elsif ($typemap{$type} eq 'A') {
     1581
     1582        print $datafile "+$host:$val:$ttl\n";
     1583
     1584      } elsif ($typemap{$type} eq 'NS') {
     1585
     1586        print $datafile "\&$host"."::$val:$ttl\n";
     1587
     1588      } elsif ($typemap{$type} eq 'AAAA') {
     1589
     1590        print $datafile ":$host:28:";
     1591        my $altgrp = 0;
     1592        my @altconv;
     1593        # Split in to up to 8 groups of hex digits (allows for :: 0-collapsing)
     1594        foreach (split /:/, $val) {
     1595          if (/^$/) {
     1596            # flag blank entry;  this is a series of 0's of (currently) unknown length
     1597            $altconv[$altgrp++] = 's';
     1598          } else {
     1599            # call sub to convert 1-4 hex digits to 2 string-rep octal bytes
     1600            $altconv[$altgrp++] = octalize($_)
     1601          }
     1602        }
     1603        foreach my $octet (@altconv) {
     1604          # if not 's', output
     1605          print $datafile $octet unless $octet =~ /^s$/;
     1606          # if 's', output (9-array length)x literal '\000\000'
     1607          print $datafile '\000\000'x(9-$altgrp) if $octet =~ /^s$/;
     1608        }
     1609        print $datafile ":$ttl\n";
     1610
     1611      } elsif ($typemap{$type} eq 'MX') {
     1612
     1613        print $datafile "\@$host"."::$val:$dist:$ttl\n";
     1614
     1615      } elsif ($typemap{$type} eq 'TXT') {
     1616
     1617##fixme:  split v-e-r-y long TXT strings?  will need to do so for BIND export, at least
     1618        $val =~ s/:/\\072/g;    # may need to replace other symbols
     1619        print $datafile "'$host:$val:$ttl\n";
     1620
     1621# by-hand TXT
     1622#:deepnet.cx:16:2v\075spf1\040a\040a\072bacon.deepnet.cx\040a\072home.deepnet.cx\040-all:3600
     1623#@       IN      TXT     "v=spf1 a a:bacon.deepnet.cx a:home.deepnet.cx -all"
     1624#'deepnet.cx:v=spf1 a a\072bacon.deepnet.cx a\072home.deepnet.cx -all:3600
     1625
     1626#txttest IN      TXT     "v=foo bar:bob kn;ob' \" !@#$%^&*()-=_+[]{}<>?"
     1627#: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
     1628
     1629# very long TXT record as brought in by axfr-get
     1630# note tinydns does not support >512-byte RR data, need axfr-dns (for TCP support) for that
     1631# also note, tinydns does not seem to support <512, >256-byte RRdata from axfr-get either.  :/
     1632#:longtxt.deepnet.cx:16:
     1633#\170this is a very long txt record.  it is really long.  long. very long.  really very long. this is a very long txt record.
     1634#\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.
     1635#\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.
     1636#:3600
     1637
     1638      } elsif ($typemap{$type} eq 'CNAME') {
     1639
     1640        print $datafile "C$host:$val:$ttl\n";
     1641
     1642      } elsif ($typemap{$type} eq 'SRV') {
     1643
     1644        # data is two-byte values for priority, weight, port, in that order,
     1645        # followed by length/string data
     1646
     1647        print $datafile ":$host:33:".octalize($dist,'d').octalize($weight,'d').octalize($port,'d');
     1648
     1649        $val .= '.' if $val !~ /\.$/;
     1650        foreach (split /\./, $val) {
     1651          printf $datafile "\\%0.3o%s", length($_), $_;
     1652        }
     1653        print $datafile "\\000:$ttl\n";
     1654
     1655      } elsif ($typemap{$type} eq 'RP') {
     1656
     1657        # RP consists of two mostly free-form strings.
     1658        # The first is supposed to be an email address with @ replaced by . (as with the SOA contact)
     1659        # The second is the "hostname" of a TXT record with more info.
     1660        print $datafile ":$host:17:";
     1661        my ($who,$what) = split /\s/, $val;
     1662        foreach (split /\./, $who) {
     1663          printf $datafile "\\%0.3o%s", length($_), $_;
     1664        }
     1665        print $datafile '\000';
     1666        foreach (split /\./, $what) {
     1667          printf $datafile "\\%0.3o%s", length($_), $_;
     1668        }
     1669        print $datafile "\\000:$ttl\n";
     1670
     1671      } elsif ($typemap{$type} eq 'PTR') {
     1672
     1673        # must handle both IPv4 and IPv6
     1674##work
     1675
     1676      } # record type if-else
     1677
     1678    } # while ($recsth)
     1679  } # while ($domsth)
     1680} # end __export_tiny()
     1681
     1682
    15121683# shut Perl up
    151316841;
Note: See TracChangeset for help on using the changeset viewer.