- Timestamp:
- 04/08/16 16:36:06 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/cgi-bin/IPDB.pm
r831 r832 21 21 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); 22 22 23 $VERSION = 2; ##VERSION##23 $VERSION = 3; ##VERSION## 24 24 @ISA = qw(Exporter); 25 25 @EXPORT_OK = qw( … … 33 33 &ipParent &subParent &blockParent &getBreadCrumbs &getRoutedCity 34 34 &allocateBlock &updateBlock &splitBlock &shrinkBlock &mergeBlocks &deleteBlock &getBlockData 35 &getBlockRDNS &getRDNSbyIP 35 &getBlockRDNS &getRDNSbyIP &getRevID 36 36 &getNodeList &getNodeName &getNodeInfo 37 37 &mailNotify … … 49 49 &ipParent &subParent &blockParent &getBreadCrumbs &getRoutedCity 50 50 &allocateBlock &updateBlock &splitBlock &shrinkBlock &mergeBlocks &deleteBlock &getBlockData 51 &getBlockRDNS &getRDNSbyIP 51 &getBlockRDNS &getRDNSbyIP &getRevID 52 52 &getNodeList &getNodeName &getNodeInfo 53 53 &mailNotify … … 115 115 116 116 our $rpc_url = ''; 117 our $dnsadmin_url; # needs to be modified later 117 118 our $revgroup = 1; # should probably be configurable somewhere 118 119 our $rpccount = 0; … … 566 567 # $ENV{HTML_TEMPLATE_ROOT} = 'foo/bar'; 567 568 569 # fix up DNSAdmin remote link based on RPC URL 570 if ($rpc_url) { 571 ($dnsadmin_url = $rpc_url) =~ s{/dns-rpc\.f?cgi}{}; 572 } 573 568 574 return (1,"OK"); 569 575 } # end initIPDBGlobals … … 1008 1014 my %row = ( 1009 1015 block => $cidr, 1010 subcontainers => $cont,1011 suballocs => $alloc,1012 1016 subfree => $free, 1013 1017 lfree => $lfree, … … 1015 1019 type => $disp_alloctypes{$type}, 1016 1020 custid => $custid, 1017 swip => ($swip eq 'y' ? 'Yes' : 'No'),1018 partswip => ($swip eq 'y' && $ncust == 0 ? 1 : 0),1019 1021 desc => $desc, 1020 1022 hassubs => ($type eq 'rm' || $type =~ /.c/ ? 1 : 0), … … 1260 1262 my $sql = "SELECT type,listname,type=? AS sel FROM alloctypes WHERE listorder <= 500"; 1261 1263 if ($tgroup eq 'n') { 1262 # grouping ' p' - all netblock types. These include routed blocks, containers (_c)1264 # grouping 'n' - all netblock types. These include routed blocks, containers (_c) 1263 1265 # and contained (_r) types, dynamic-allocation ranges (_e), static IP pools (_d and _p), 1264 1266 # and the "miscellaneous" cn, in, and en types. 1267 # Or in other words, everything but master and static IP types. 1265 1268 $sql .= " AND type NOT LIKE '_i'"; 1266 1269 } elsif ($tgroup eq 'p') { … … 1513 1516 } 1514 1517 1518 $args{desc} = $args{description} if $args{description}; 1515 1519 $args{desc} = '' if !$args{desc}; 1516 1520 $args{notes} = '' if !$args{notes}; 1517 1521 $args{circid} = '' if !$args{circid}; 1518 1522 $args{privdata} = '' if !$args{privdata}; 1523 ##fixme: VRF should trickle down like master_id 1519 1524 $args{vrf} = '' if !$args{vrf}; 1520 1525 $args{vlan} = '' if !$args{vlan}; … … 1549 1554 $msg = "Unable to assign static IP $args{cidr} to $args{custid}"; 1550 1555 eval { 1556 ##fixme: IP pools across VRFs, need to use the IP ID instead of the CIDR 1557 # ... or the VRF itself? 1551 1558 if ($args{cidr}) { # IP specified 1552 my ($isavail) = $dbh->selectrow_array("SELECT available FROM poolips WHERE ip=?", undef, ($args{cidr}) ); 1559 my ($isavail) = $dbh->selectrow_array( 1560 "SELECT available FROM poolips WHERE ip=?".($args{vrf} ? " AND vrf=?" : ''), 1561 undef, ($args{vrf} ? ($args{cidr},$args{vrf}) : $args{cidr}) ); 1553 1562 die "IP is not in an IP pool.\n" 1554 1563 if !$isavail; … … 1579 1588 # finally assign the IP 1580 1589 $dbh->do("UPDATE poolips SET custid = ?, city = ?, available='n', description = ?, notes = ?, ". 1581 "circuitid = ?, privdata = ?, vrf = ?,rdns = ?, backup_id = ? ".1590 "circuitid = ?, privdata = ?, rdns = ?, backup_id = ? ". 1582 1591 "WHERE ip = ? AND parent_id = ?", undef, 1583 1592 ($args{custid}, $args{city}, $args{desc}, $args{notes}, 1584 $args{circid}, $args{privdata}, $args{ vrf}, $args{rdns}, $backupid,1593 $args{circid}, $args{privdata}, $args{rdns}, $backupid, 1585 1594 $args{cidr}, $args{parent}) ); 1586 1595 … … 1640 1649 $dbh->do("INSERT INTO allocations ". 1641 1650 "(cidr,parent_id,master_id,vrf,vlan,custid,type,city,description,notes,circuitid,privdata,rdns,backup_id)". 1642 " VALUES (?,?,?, ?,?,?,?,?,?,?,?,?,?,?)", undef,1643 ($args{cidr}, $fbparent, $fbmaster, $ args{vrf}, $args{vlan}, $args{custid}, $args{type}, $args{city},1651 " VALUES (?,?,?,(SELECT vrf FROM allocations WHERE id=?),?,?,?,?,?,?,?,?,?,?)", undef, 1652 ($args{cidr}, $fbparent, $fbmaster, $fbmaster, $args{vlan}, $args{custid}, $args{type}, $args{city}, 1644 1653 $args{desc}, $args{notes}, $args{circid}, $args{privdata}, $args{rdns}, $backupid) ); 1645 1654 my ($bid) = $dbh->selectrow_array("SELECT currval('allocations_id_seq')"); … … 1716 1725 $dbh->do("INSERT INTO allocations ". 1717 1726 "(cidr,parent_id,master_id,vrf,vlan,custid,type,city,description,notes,circuitid,privdata,rdns)". 1718 " VALUES (?,?,?, ?,?,?,?,?,?,?,?,?,?)", undef,1719 ($args{cidr}, $fbparent, $fbmaster, $ args{vrf}, $args{vlan}, $args{custid}, $args{type}, $args{city},1727 " VALUES (?,?,?,(SELECT vrf FROM allocations WHERE id=?),?,?,?,?,?,?,?,?,?)", undef, 1728 ($args{cidr}, $fbparent, $fbmaster, $fbmaster, $args{vlan}, $args{custid}, $args{type}, $args{city}, 1720 1729 $args{desc}, $args{notes}, $args{circid}, $args{privdata}, $args{rdns}) ); 1721 1730 my ($bid) = $dbh->selectrow_array("SELECT currval('allocations_id_seq')"); … … 1767 1776 # Snag the parent info 1768 1777 my $pinfo = getBlockData($dbh, $fbparent); 1769 # Only try to update rDNS when the pool is flagged as "rDNS available" 1770 if ($pinfo->{revavail} || $pinfo->{revpartial}) { 1771 # now we do the DNS dance for netblocks, if we have an RPC server to do it with and a pattern to use. 1772 _rpc('addOrUpdateRevRec', cidr => "$args{cidr}", name => $args{rdns}, rpcuser => $args{user}) 1773 if $args{rdns}; 1774 1775 # and the per-IP set, if there is one. 1776 _rpc('updateRevSet', %{$args{iprev}}, rpcuser => $args{user}); 1778 # Only try to update rDNS when the block is flagged as "rDNS available" 1779 if (($pinfo->{revavail} || $pinfo->{revpartial}) && $args{rdns}) { 1780 # the netblock/allocation... 1781 _rpc('addOrUpdateRevRec', cidr => "$args{cidr}", name => $args{rdns}, rpcuser => $args{user}); 1782 # ...and the per-IP set, if there is one. 1783 _rpc('updateRevSet', %{$args{iprev}}, rpcuser => $args{user}) 1784 if keys (%{$args{iprev}}); 1777 1785 } 1778 1786 … … 1913 1921 $updtable = 'poolips'; 1914 1922 $binfo = getBlockData($dbh, $args{block}, 'i'); 1923 # allow allocating an IP by update. mainly for RPC, may simplify matters for caller 1924 if ($args{assignIP_on_update}) { 1925 push @fieldlist, 'available'; 1926 push @vallist, 'n'; 1927 } 1915 1928 } else { 1916 1929 ## fixme: there's got to be a better way... … … 2033 2046 $sql .= " = ? WHERE $keyfield = ?"; 2034 2047 2048 ##fixme: don't do the update on pool IPs if the IP is available and assignIP_on_update is not set 2035 2049 # do the update 2036 2050 $dbh->do($sql, undef, @vallist); … … 2081 2095 2082 2096 } else { 2083 $binfo->{block} =~ s|/32$||; 2084 _rpc('addOrUpdateRevRec', cidr => $binfo->{block}, name => $args{rdns}, rpcuser => $args{user}); 2097 $binfo->{block} =~ s{/(?:32|128)$}{}; 2098 # Only insert a record for IPv4, or actual single v6 IPs 2099 _rpc('addOrUpdateRevRec', cidr => $binfo->{block}, name => $args{rdns}, rpcuser => $args{user}) 2100 if !$cidr->{isv6} || ($cidr->{isv6} && $cidr->masklen == 128); 2085 2101 2086 2102 # and the per-IP set, if there is one. 2087 _rpc('updateRevSet', %{$args{iprev}}, rpcuser => $args{user}) if keys (%{$args{iprev}}); 2103 _rpc('updateRevSet', cidr => $binfo->{block}, %{$args{iprev}}, rpcuser => $args{user}, location => $pinfo->{location}) 2104 if keys (%{$args{iprev}}); 2088 2105 2089 2106 # and fix up the template's CIDR if required … … 2883 2900 my ($dbh,$id,$basetype,$delfwd,$user) = @_; 2884 2901 2902 # reset $basetype so caller can just pass the complete allocation type 2903 if ($basetype =~ /.i/) { 2904 $basetype = 'i'; 2905 } else { 2906 $basetype = 'b'; 2907 } 2908 2885 2909 # Collect info about the block we're going to delete 2886 2910 my $binfo = getBlockData($dbh, $id, $basetype); … … 3196 3220 my $type = shift || 'b'; # default to netblock for lazy callers 3197 3221 3222 # catch some errors, someday 3223 # if (!$id || $id !~ /^\d+$/) { 3224 # $errstr = "Allocation ID must be numeric 3225 # } 3226 3198 3227 # netblocks are in the allocations table; pool IPs are in the poolips table. 3199 3228 # If we try to look up a CIDR in an integer field we should just get back nothing. … … 3209 3238 my $binfo = $dbh->selectrow_hashref(qq( 3210 3239 SELECT a.id, a.ip AS block, a.city, a.vrf, a.parent_id, a.master_id, $commonfields, 3211 d.zone >> a.ip AS revavail, 3240 d.zone >> a.ip AS revavail, d.location, 3212 3241 $bkfields, 3213 v.location 3242 v.location AS vrfloc 3214 3243 FROM poolips a 3215 3244 LEFT JOIN dnsavail d ON a.master_id = d.parent_alloc AND a.ip << d.zone … … 3223 3252 SELECT a.id, a.cidr AS block, a.city, a.vrf, a.parent_id, a.master_id, a.swip, $commonfields, 3224 3253 f.cidr AS reserve, f.id as reserve_id, 3225 d.zone >>= a.cidr AS revavail, d.zone << a.cidr AS revpartial, 3254 d.zone >>= a.cidr AS revavail, d.zone << a.cidr AS revpartial, d.location, 3226 3255 $bkfields, 3227 v.location 3256 v.location AS vrfloc 3228 3257 FROM allocations a 3229 3258 LEFT JOIN freeblocks f ON a.id=f.reserve_for … … 3252 3281 3253 3282 # snag entry from database 3254 my ($rdns,$rfrom,$pid );3283 my ($rdns,$rfrom,$pid,$mid); 3255 3284 if ($args{type} =~ /.i/) { 3256 ($rdns, $rfrom, $pid ) = $dbh->selectrow_array("SELECT rdns,ip,parent_id FROM poolips WHERE id = ?",3285 ($rdns, $rfrom, $pid, $mid) = $dbh->selectrow_array("SELECT rdns,ip,parent_id,master_id FROM poolips WHERE id = ?", 3257 3286 undef, ($args{id}) ); 3258 3287 } else { 3259 ($rdns, $rfrom, $pid ) = $dbh->selectrow_array("SELECT rdns,cidr,parent_id FROM allocations WHERE id = ?",3288 ($rdns, $rfrom, $pid, $mid) = $dbh->selectrow_array("SELECT rdns,cidr,parent_id,master_id FROM allocations WHERE id = ?", 3260 3289 undef, ($args{id}) ); 3261 3290 } … … 3288 3317 cidr => "$rpcblock", 3289 3318 ); 3319 3320 # # Retrieve the VRF's location by way of the master block 3321 # ($rpcargs{location}) = $dbh->selectrow_array("SELECT v.location FROM vrfs v". 3322 # " JOIN allocations a ON a.vrf = v.vrf". 3323 # " WHERE a.id = ?", undef, $mid); 3324 3325 ## ... is there something more needed here? 3326 # order by so that we get the narrowest entry 3327 ($rpcargs{location}) = $dbh->selectrow_array("SELECT d.location FROM dnsavail d". 3328 " WHERE d.parent_alloc = ? ORDER BY zone DESC", undef, $mid) or print "foo? ".$dbh->errstr; 3290 3329 3291 3330 $errstr = ''; … … 3320 3359 } 3321 3360 3361 my $binfo = getBlockData($dbh, $args{id}, $args{type}); 3362 3322 3363 my @ret = (); 3323 3364 # special case: single IP. Check if it's an allocation or in a pool, then do the RPC call for fresh data. … … 3325 3366 my ($ip, $localrev) = $dbh->selectrow_array("SELECT ip, rdns FROM poolips WHERE id = ?", undef, ($args{id}) ); 3326 3367 push @ret, { 'r_ip' => $ip, 'iphost' => $localrev }; 3368 ##fixme: rpc call? 3327 3369 } else { 3328 3370 if ($rpc_url) { … … 3333 3375 ); 3334 3376 3377 # # Retrieve the VRF's DNS location by way of the master block 3378 # ($rpcargs{location}) = $dbh->selectrow_array("SELECT v.location FROM vrfs v". 3379 # " JOIN allocations a ON a.vrf = v.vrf JOIN allocations b ON a.id = b.master_id". 3380 # " WHERE b.id = ?", undef, $args{id}); 3381 3382 ## ... is there something more needed here? 3383 # order by so that we get the narrowest entry 3384 ($rpcargs{location}) = $dbh->selectrow_array("SELECT d.location FROM dnsavail d". 3385 " WHERE d.parent_alloc = ? ORDER BY zone DESC", undef, $binfo->{master_id}); 3386 3335 3387 my $remote_rdns = _rpc('getRevSet', %rpcargs); 3336 3388 return $remote_rdns; … … 3341 3393 return \@ret; 3342 3394 } # end getRDNSbyIP() 3395 3396 3397 ## IPDB::getRevID() 3398 # Get the reverse zone ID(s) for an allocation 3399 # Takes a hash with cidr, location and user elements 3400 # Returns a hashref to a list of zones and zone IDs (in case of large 3401 # allocations effectively split across multiple DNS zones) 3402 ##fixme: arguably should be integrated in some other related sub that 3403 # does RPC to minimize the number of RPC calls somehow 3404 sub getRevID { 3405 my $dbh = shift; 3406 my %args = @_; 3407 3408 ##fixme: build a local cache for mapping allocations to DNS zone IDs 3409 # my ($revlocal) = $dbh->selectrow_array("SELECT revzones[0] AS zone,revzones[1] AS revid FROM dnsavail WHERE 3410 #zone >>= ? AND location = ?", undef, $args{cidr}, $args{location}); 3411 #use Data::Dumper; 3412 #print "rezone array?<pre>".Dumper($revlocal)."</pre>\n"; 3413 3414 my $revzones = _rpc('getZonesByCIDR', rpcuser => $args{user}, 3415 cidr => $args{cidr}, 3416 return_location => 0, 3417 location => $args{location}, 3418 ); 3419 return $revzones; 3420 } # end getRevID() 3343 3421 3344 3422
Note:
See TracChangeset
for help on using the changeset viewer.