Changeset 725 for branches/stable/DNSDB.pm
- Timestamp:
- 06/20/16 13:18:07 (8 years ago)
- Location:
- branches/stable
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/stable
-
branches/stable/DNSDB.pm
r696 r725 222 222 template_skip_0 => 0, # publish .0 by default 223 223 template_skip_255 => 0, # publish .255 by default 224 # allow TXT records to be dealt with mostly automatically by DNS server? 225 autotxt => 1, 224 226 ); 225 227 … … 252 254 # Several settings are booleans. Handle multiple possible ways of setting them. 253 255 for my $boolopt ('log_failures', 'force_refresh', 'lowercase', 'usecache', 254 'template_skip_0', 'template_skip_255' ) {256 'template_skip_0', 'template_skip_255', 'autotxt') { 255 257 if ($self->{$boolopt} ne '1' && $self->{$boolopt} ne '0') { 256 258 # true/false, on/off, yes/no all valid. … … 990 992 # Not strictly true, but SRV records not following this convention won't be found. 991 993 return ('FAIL',"SRV records must begin with _service._protocol [${$args{host}}]") 992 unless ${$args{host}} =~ /^_[A-Za-z ]+\._[A-Za-z]+\.[a-zA-Z0-9-]+/;994 unless ${$args{host}} =~ /^_[A-Za-z-]+\._[A-Za-z]+\.[a-zA-Z0-9-]+/; 993 995 994 996 # SRV target check - IP addresses not allowed. Must be a more or less well-formed hostname. … … 1852 1854 $cfg->{template_skip_0} = $1 if /^template_skip_0\s*=\s*([a-z01]+)/i; 1853 1855 $cfg->{template_skip_255} = $1 if /^template_skip_255\s*=\s*([a-z01]+)/i; 1856 $cfg->{autotxt} = $1 if /^autotxt\s*=\s*([a-z01]+)/i; 1854 1857 # not supported in dns.cgi yet 1855 1858 # $cfg->{templatedir} = $1 if m{^templatedir\s*=\s*([a-z0-9/_.-]+)}i; … … 2316 2319 # Add a domain 2317 2320 # Takes a database handle, domain name, numeric group, boolean(ish) state (active/inactive), 2318 # and user info hash (for logging).2321 # and a default location indicator 2319 2322 # Returns a status code and message 2320 2323 sub addDomain { … … 2341 2344 return ('FAIL', "Invalid characters in domain") if $domain !~ /^[a-zA-Z0-9_.-]+$/; 2342 2345 2343 my $sth = $dbh->prepare("SELECT domain_id FROM domains WHERE lower(domain) = lower(?) ");2346 my $sth = $dbh->prepare("SELECT domain_id FROM domains WHERE lower(domain) = lower(?) AND default_location = ?"); 2344 2347 my $dom_id; 2345 2348 2346 2349 # quick check to start to see if we've already got one 2347 $sth->execute($domain );2350 $sth->execute($domain, $defloc); 2348 2351 ($dom_id) = $sth->fetchrow_array; 2349 2352 … … 2362 2365 2363 2366 # get the ID... 2364 ($dom_id) = $dbh->selectrow_array("SELECT domain_id FROM domains WHERE lower(domain) = lower(?) ",2365 undef, ($domain ));2367 ($dom_id) = $dbh->selectrow_array("SELECT domain_id FROM domains WHERE lower(domain) = lower(?) AND default_location = ?", 2368 undef, ($domain, $defloc)); 2366 2369 2367 2370 $self->_log(domain_id => $dom_id, group_id => $group, … … 2537 2540 my $dbh = $self->{dbh}; 2538 2541 my $domain = shift; 2539 my ($domid) = $dbh->selectrow_array("SELECT domain_id FROM domains WHERE lower(domain) = lower(?)", 2540 undef, ($domain) ); 2542 my $location = shift; 2543 2544 # Note that location may be *empty*, but it may not be *undefined* 2545 if (!defined($location)) { 2546 $errstr = "Missing location"; 2547 return; 2548 } 2549 2550 my ($domid) = $dbh->selectrow_array( 2551 "SELECT domain_id FROM domains WHERE lower(domain) = lower(?) AND default_location = ?", 2552 undef, ($domain, $location) ); 2541 2553 if (!$domid) { 2542 2554 if ($dbh->err) { … … 2558 2570 my $dbh = $self->{dbh}; 2559 2571 my $revzone = shift; 2560 my ($revid) = $dbh->selectrow_array("SELECT rdns_id FROM revzones WHERE revnet=?", undef, ($revzone) ); 2572 my $location = shift; 2573 2574 # Note that location may be *empty*, but it may not be *undefined* 2575 if (!defined($location)) { 2576 $errstr = "Missing location"; 2577 return; 2578 } 2579 2580 my ($revid) = $dbh->selectrow_array( 2581 "SELECT rdns_id FROM revzones WHERE revnet = ? AND default_location = ?", 2582 undef, ($revzone, $location) ); 2561 2583 if (!$revid) { 2562 2584 if ($dbh->err) { … … 2602 2624 2603 2625 # quick check to start to see if we've already got one 2604 my ($rdns_id) = $dbh->selectrow_array("SELECT rdns_id FROM revzones WHERE revnet=?", undef, ("$zone")); 2626 my ($rdns_id) = $dbh->selectrow_array("SELECT rdns_id FROM revzones WHERE revnet = ? AND default_location = ?", 2627 undef, ("$zone", $defloc)); 2605 2628 2606 2629 return ('FAIL', "Zone already exists") if $rdns_id; … … 2843 2866 if ($args{revrec} eq 'n') { 2844 2867 $args{sortby} = 'domain' if !$args{sortby} || !grep /^$args{sortby}$/, ('domain','group','status'); 2845 $sql = "SELECT domain_id AS zoneid,domain AS zone,status,groups.group_name AS group FROM domains". 2846 " INNER JOIN groups ON domains.group_id=groups.group_id". 2847 " WHERE domains.group_id IN ($args{curgroup}".($args{childlist} ? ",$args{childlist}" : '').")". 2868 $sql = q(SELECT 2869 domain_id AS zoneid, 2870 domain AS zone, 2871 status, 2872 groups.group_name AS group, 2873 l.description AS location 2874 FROM domains 2875 LEFT JOIN locations l ON domains.default_location=l.location 2876 INNER JOIN groups ON domains.group_id=groups.group_id ). 2877 "WHERE domains.group_id IN ($args{curgroup}".($args{childlist} ? ",$args{childlist}" : '').")". 2848 2878 ($args{startwith} ? " AND domain ~* ?" : ''). 2849 2879 ($args{filter} ? " AND domain ~* ?" : ''); … … 2851 2881 ##fixme: arguably startwith here is irrelevant. depends on the UI though. 2852 2882 $args{sortby} = 'revnet' if !$args{sortby} || !grep /^$args{sortby}$/, ('revnet','group','status'); 2853 $sql = "SELECT rdns_id AS zoneid,revnet AS zone,status,groups.group_name AS group FROM revzones". 2854 " INNER JOIN groups ON revzones.group_id=groups.group_id". 2883 $sql = q(SELECT 2884 rdns_id AS zoneid, 2885 revnet AS zone, 2886 status, 2887 groups.group_name AS group, 2888 l.description AS location 2889 FROM revzones 2890 LEFT JOIN locations l ON revzones.default_location=l.location 2891 INNER JOIN groups ON revzones.group_id=groups.group_id ). 2855 2892 " WHERE revzones.group_id IN ($args{curgroup}".($args{childlist} ? ",$args{childlist}" : '').")". 2856 2893 ($args{startwith} ? " AND CAST(revnet AS VARCHAR) ~* ?" : ''); … … 3472 3509 my $sel = shift || 0; 3473 3510 3474 my $sth = $dbh->prepare("SELECT username,user_id FROM users WHERE group_id=? ");3511 my $sth = $dbh->prepare("SELECT username,user_id FROM users WHERE group_id=? AND password <> 'RPC'"); 3475 3512 $sth->execute($grp); 3476 3513 … … 3689 3726 my $self = shift; 3690 3727 my $dbh = $self->{dbh}; 3691 my $grp = shift; 3692 my $shdesc = shift; 3693 my $comments = shift; 3694 my $iplist = shift; 3728 my %args = @_; 3729 3730 my $grp = $args{group}; 3731 my $shdesc = $args{desc}; 3732 my $comments = $args{comments}; 3733 my $iplist = $args{iplist}; 3695 3734 3696 3735 # $shdesc gets set to the generated location ID if possible, but these can be de-undefined here. … … 3698 3737 $iplist = '' if !$iplist; 3699 3738 3700 my $loc; 3739 # allow requesting a specific location entry. 3740 my $loc = $args{loc}; 3701 3741 3702 3742 # Generate a location ID. This is, by spec, a two-character widget. We'll use [a-z][a-z] 3703 3743 # for now; 676 locations should satisfy all but the largest of the huge networks. 3704 # Not sure whether these are case-sensitive, or what other rules might apply - in any case 3705 # the absolute maximum is 16K (256*256) since it's parsed by tinydns as a two-character field. 3744 3745 # just to be as clear as possible; as per http://cr.yp.to/djbdns/tinydns-data.html: 3746 3747 #For versions 1.04 and above: You may include a client location on each line. The line is ignored for clients 3748 #outside that location. Client locations are specified by % lines: 3749 # 3750 # %lo:ipprefix 3751 # 3752 #means that IP addresses starting with ipprefix are in location lo. lo is a sequence of one or two ASCII letters. 3753 3754 # this has been confirmed by experiment; locations "lo", "Lo", and "lO" are all distinct. 3706 3755 3707 3756 # add just after "my $origloc = $loc;": … … 3725 3774 eval { 3726 3775 # Get the "last" location. Note this is the only use for loc_id, because selecting on location Does Funky Things 3727 ($loc) = $dbh->selectrow_array("SELECT location FROM locations ORDER BY loc_id DESC LIMIT 1"); 3728 ($loc) = ($loc =~ /^(..)/) if $loc; 3729 my $origloc = $loc; 3730 $loc = 'aa' if !$loc; 3776 my ($newloc) = $dbh->selectrow_array("SELECT location FROM locations ORDER BY loc_id DESC LIMIT 1"); 3777 3778 no warnings qw(uninitialized); 3779 3780 my $ecnt = $dbh->prepare("SELECT count(*) FROM locations WHERE location LIKE ?"); 3781 3782 if ($loc) { 3783 $ecnt->execute($loc); 3784 if (($ecnt->fetchrow_array())[0]) { 3785 # too bad, so sad, requested location is unavailable. 3786 ##fixme: known failure case: caller requests a location ID that is not two characters. 3787 die "Requested location is already defined\n" if $args{reqonly}; 3788 # fall back to autoincrement 3789 } 3790 $newloc = $loc; 3791 } 3792 3793 # Either the requested location ID is unavailable and the caller isn't too attached 3794 # to it, OR, the caller hasn't specified a location ID. (The second case should be 3795 # far more common.) Find the "next available" location identifier. 3796 3797 ($newloc) = ($newloc =~ /^(..)/) if $newloc; 3798 my $origloc = $newloc; 3799 $newloc = 'aa' if !$newloc; 3731 3800 # Make a change... 3732 $loc++;3733 3801 # ... and keep changing if it exists 3734 while ($dbh->selectrow_array("SELECT count(*) FROM locations WHERE location LIKE ?", undef, ($ loc.'%'))) {3735 $ loc++;3736 ($ loc) = ($loc =~ /^(..)/);3737 die "too many locations in use, can't add another one\n" if $ loc eq $origloc;3802 while ($dbh->selectrow_array("SELECT count(*) FROM locations WHERE location LIKE ?", undef, ($newloc.'%'))) { 3803 $newloc++; 3804 ($newloc) = ($newloc =~ /^(..)/); 3805 die "too many locations in use, can't add another one\n" if $newloc eq $origloc; 3738 3806 ##fixme: really need to handle this case faster somehow 3739 3807 #if $loc eq $origloc die "<thwap> bad admin: all locations used, your network is too fragmented"; 3740 3808 } 3741 # And now we should have a unique location. tinydns fundamentally limits the 3742 # number of these but there's no doc on what characters are valid. 3743 $shdesc = $loc if !$shdesc; 3809 # And now we should have a unique location. 3810 $shdesc = $newloc if !$shdesc; 3744 3811 $dbh->do("INSERT INTO locations (location, group_id, iplist, description, comments) VALUES (?,?,?,?,?)", 3745 undef, ($ loc, $grp, $iplist, $shdesc, $comments) );3812 undef, ($newloc, $grp, $iplist, $shdesc, $comments) ); 3746 3813 $self->_log(entry => "Added location ($shdesc, '$iplist')"); 3814 $loc = $newloc; 3747 3815 $dbh->commit; 3748 3816 }; … … 4140 4208 $args{defrec} = 'n' if !$args{defrec}; 4141 4209 4210 # RPC callers generally want the "true" IP. Flag argument for those to bypass showrev_arpa 4211 ##fixme: this will still blow up if some idiot has actually stored .arpa names in the DB. 4212 # ... do we care? 4213 $args{rpc} = 0 if !$args{rpc}; 4214 4142 4215 # protection against bad or missing arguments 4143 4216 $args{sortorder} = 'ASC' if !$args{sortorder} || !grep /^$args{sortorder}$/, ('ASC','DESC'); … … 4150 4223 $args{offset} = 0 if !$args{offset} || $args{offset} !~ /^(?:all|\d+)$/; 4151 4224 my $perpage = ($args{nrecs} ? $args{nrecs} : $self->{perpage}); 4152 4153 4225 4154 4226 ##fixme: do we need a knob to twist to switch from unix epoch to postgres time string? … … 4181 4253 4182 4254 # Filtering on other fields 4183 foreach (qw(type distance weight port ttl description )) {4255 foreach (qw(type distance weight port ttl description location)) { 4184 4256 if ($args{$_}) { 4185 $sql .= " AND $_ ~* ?";4257 $sql .= " AND r.$_ ~* ?"; 4186 4258 push @bindvars, $args{$_}; 4187 4259 } … … 4212 4284 $recsth->execute(@bindvars); 4213 4285 while (my $rec = $recsth->fetchrow_hashref) { 4214 if ( $args{revrec} eq 'y' && $args{defrec} eq 'n' &&4286 if (!$args{rpc} && $args{revrec} eq 'y' && $args{defrec} eq 'n' && 4215 4287 ($self->{showrev_arpa} eq 'record' || $self->{showrev_arpa} eq 'all') && 4216 4288 $rec->{val} !~ /\.arpa$/ ) { … … 4818 4890 my $dbh = $self->{dbh}; 4819 4891 my $cidr = shift; 4820 my $group = shift || 1; # just in case 4892 my %args = @_; 4893 $args{group} = 1 if !$args{group}; # just in case 4894 $args{location} = '' if !$args{location}; 4821 4895 4822 4896 # for speed! Casting and comparing even ~7K records takes ~2.5s, so narrow it down to one revzone first. … … 4826 4900 ##fixme? may need to narrow things down more by octet-chopping and doing text comparisons before casting. 4827 4901 my ($revpatt) = $dbh->selectrow_array("SELECT host FROM records ". 4828 "WHERE (type in (12,65280,65281,65282,65283,65284)) AND rdns_id = ? AND inetlazy(val) >>= ? ". 4829 "ORDER BY inetlazy(val) DESC LIMIT 1", undef, ($revid, $cidr) ); 4902 "WHERE (type in (12,65280,65281,65282,65283,65284)) AND rdns_id = ? ". 4903 "AND location = ? AND inetlazy(val) >>= ? ". 4904 "ORDER BY inetlazy(val) DESC LIMIT 1", 4905 undef, ($revid, $args{location}, $cidr) ); 4906 4830 4907 return $revpatt; 4831 4908 } # end getRevPattern() … … 4839 4916 my $dbh = $self->{dbh}; 4840 4917 my $cidr = shift; 4841 my $group = shift || 1; # just in case 4918 my %args = @_; 4919 $args{group} = 1 if !$args{group}; # just in case 4920 $args{location} = '' if !$args{location}; 4842 4921 4843 4922 # for speed! Casting and comparing even ~7K records takes ~2.5s, so narrow it down to one revzone first. … … 4855 4934 4856 4935 my $sth = $dbh->prepare("SELECT val, host FROM records ". 4857 "WHERE (type in (12,65280,65281,65282,65283,65284)) AND rdns_id = ? AND inetlazy(val) = ?");4936 "WHERE (type in (12,65280,65281,65282,65283,65284)) AND rdns_id = ? AND location = ? AND inetlazy(val) = ?"); 4858 4937 4859 4938 my @ret; 4860 4939 foreach my $ip (@{$cidr->splitref()}) { 4861 $sth->execute($revid, $ ip);4940 $sth->execute($revid, $args{location}, $ip); 4862 4941 my @data = $sth->fetchrow_array(); 4863 4942 my %row; … … 5127 5206 ## DNSDB::getZonesByCIDR() 5128 5207 # Get a list of zone names and IDs that records for a passed CIDR block are within. 5208 # Optionally restrict to a specific location/view 5209 # Optionally leave off the default_location field 5129 5210 sub getZonesByCIDR { 5130 5211 my $self = shift; 5131 5212 my $dbh = $self->{dbh}; 5132 5213 my %args = @_; 5133 5134 my $result = $dbh->selectall_arrayref("SELECT rdns_id,revnet FROM revzones WHERE revnet >>= ? OR revnet <<= ?", 5135 { Slice => {} }, ($args{cidr}, $args{cidr}) ); 5214 $args{return_location} = 1 if !defined($args{return_location}); 5215 5216 my $sql = "SELECT rdns_id,revnet".($args{return_location} ? ',default_location' : ''). 5217 " FROM revzones WHERE (revnet >>= ? OR revnet <<= ?)". 5218 (defined($args{location}) ? " AND default_location = ?" : ''); 5219 my @svals = ($args{cidr}, $args{cidr}); 5220 push @svals, $args{location} if defined $args{location}; 5221 5222 my $result = $dbh->selectall_arrayref($sql, { Slice => {} }, @svals ); 5136 5223 return $result; 5137 5224 } # end getZonesByCIDR() … … 5295 5382 ##fixme: serial 5296 5383 $dbh->do("INSERT INTO domains (domain,group_id,status) VALUES (?,?,?)", undef, 5297 ($zone, $group, $args{status}) ) ;5384 ($zone, $group, $args{status}) ) or die $dbh->errstr; 5298 5385 # get domain id so we can do the records 5299 5386 ($zone_id) = $dbh->selectrow_array("SELECT currval('domains_domain_id_seq')"); … … 6222 6309 6223 6310 ($host,$val) = __revswap($host,$val) if $revrec eq 'y'; 6224 ##fixme: split v-e-r-y long TXT strings? will need to do so for BIND export, at least 6225 $val =~ s/:/\\072/g; # may need to replace other symbols 6226 print $datafile "'$host:$val:$ttl:$stamp:$loc\n" or die $!; 6311 # le sigh. Some idiot DNS implementations don't seem to like tinydns autosplitting 6312 # long TXT records at 127 characters instead of 255. Hand-crafting a record seems 6313 # to paper over the remote stupid. We will NOT try to split on whitespace; the 6314 # contents of a TXT record are opaque and clients who can't deal are even more broken 6315 # than the ones that don't like them split at 127 characters... because BIND tries 6316 # to "intelligently" split TXT data, and abso-by-damn-lutely generates chunks <255 6317 # characters, and anything that can't interpret BIND's DNS responses has no business 6318 # trying to interpret DNS data at all. 6319 6320 if ($self->{autotxt}) { 6321 # let tinydns deal with splitting the record. note tinydns autosplits at 127 6322 # characters, not 255. Because Reasons. 6323 $val =~ s/:/\\072/g; # may need to replace other symbols 6324 print $datafile "'$host:$val:$ttl:$stamp:$loc\n" or die $!; 6325 } else { 6326 print $datafile ":$host:16:"; 6327 my @txtsegs = $val =~ /.{1,255}/g; 6328 foreach (@txtsegs) { 6329 my $len = length($_); 6330 s/:/\\072/g; 6331 printf $datafile "\\%0.3o%s", $len, $_; 6332 } 6333 print $datafile ":$ttl:$stamp:$loc\n"; 6334 } 6227 6335 6228 6336 # by-hand TXT
Note:
See TracChangeset
for help on using the changeset viewer.