Legend:
- Unmodified
- Added
- Removed
-
trunk/DNSDB.pm
r35 r37 200 200 while (my ($host,$type,$val,$dist,$weight,$port,$ttl) = $sth->fetchrow_array()) { 201 201 $host =~ s/DOMAIN/$domain/g; 202 $val =~ s/DOMAIN/$domain/g; 202 203 $sth_in->execute($host,$type,$val,$dist,$weight,$port,$ttl); 203 204 } … … 814 815 ## DNSDB::importAXFR 815 816 # Import a domain via AXFR 817 # Takes AXFR host, domain to transfer, group to put the domain in, 818 # and optionally: 819 # - active/inactive state flag (defaults to active) 820 # - overwrite-SOA flag (defaults to off) 821 # - overwrite-NS flag (defaults to off, doesn't affect subdomain NS records) 822 # Returns a status code (OK, WARN, or FAIL) and message - message should be blank 823 # if status is OK, but WARN includes conditions that are not fatal but should 824 # really be reported. 816 825 sub importAXFR { 817 826 my $dbh = shift; … … 822 831 my $rwsoa = shift || 0; 823 832 my $rwns = shift || 0; 833 824 834 ##fixme: add mode to delete&replace, merge+overwrite, merge new? 825 835 826 my $nrecs = 0;827 my $soaflag = 0;828 my $nsflag = 0;829 my $warnmsg = '';830 my $ifrom;836 my $nrecs = 0; 837 my $soaflag = 0; 838 my $nsflag = 0; 839 my $warnmsg = ''; 840 my $ifrom; 831 841 832 842 # choke on possible bad setting in ifrom 833 # IPv4 and v6 !843 # IPv4 and v6, and valid hostnames! 834 844 ($ifrom) = ($ifrom_in =~ /^([0-9a-f\:.]+|[0-9a-z_.-]+)$/i); 835 845 return ('FAIL', "Bad AXFR source host $ifrom") … … 841 851 local $dbh->{RaiseError} = 1; 842 852 843 my $sth_domin = $dbh->prepare("INSERT INTO domains (domain,group_id,status) VALUES (?,?,?)"); 844 my $sth_getid = $dbh->prepare("SELECT domain_id FROM domains WHERE domain=?"); 853 my $sth = $dbh->prepare("SELECT domain_id FROM domains WHERE domain=?"); 845 854 my $dom_id; 846 855 847 856 # quick check to start to see if we've already got one 848 $sth _getid->execute($domain);849 ($dom_id) = $sth _getid->fetchrow_array;857 $sth->execute($domain); 858 ($dom_id) = $sth->fetchrow_array; 850 859 851 860 return ('FAIL', "Domain already exists") if $dom_id; … … 856 865 857 866 ##fixme: serial 858 $sth_domin->execute($domain,$group,$status); 867 my $sth = $dbh->prepare("INSERT INTO domains (domain,group_id,status) VALUES (?,?,?)"); 868 $sth->execute($domain,$group,$status); 859 869 860 870 ## bizarre DBI<->Net::DNS interaction bug: 861 871 ## sometimes a zone will cause an immediate commit-and-exit (sort of) of the while() 872 ## fixed, apparently I was doing *something* odd, but not certain what it was that 873 ## caused a commit instead of barfing 862 874 863 875 # get domain id so we can do the records 864 $sth_getid->execute($domain); 865 ($dom_id) = $sth_getid->fetchrow_array(); 876 $sth = $dbh->prepare("SELECT domain_id FROM domains WHERE domain=?"); 877 $sth->execute($domain); 878 ($dom_id) = $sth->fetchrow_array(); 866 879 867 880 my $res = Net::DNS::Resolver->new; … … 870 883 or die "Couldn't begin AXFR\n"; 871 884 872 #my $foobar = $res->axfr_next() if $domain =~ /loki/;873 #die "outside the loop with ".$foobar->type."\n" if $domain =~ /loki/;874 875 885 while (my $rr = $res->axfr_next()) { 876 886 my $type = $rr->type; 877 887 878 #die "first record! $type\n" if $domain =~ /lok/;879 880 888 my $sql = "INSERT INTO records (domain_id,host,type,ttl,val"; 881 889 my $vallen = "?,?,?,?,?"; 882 # my $host = $rr->name; 883 # my $ttl = $rr->ttl; 884 # my $val; 885 886 $soaflag = 1 if $type eq 'SOA'; 887 $nsflag = 1 if $type eq 'NS'; 888 889 ##work 890 891 $soaflag = 1 if $type eq 'SOA'; 892 $nsflag = 1 if $type eq 'NS'; 893 890 894 my @vallist = ($dom_id, $rr->name, $reverse_typemap{$type}, $rr->ttl); 891 895 … … 900 904 push @vallist, $rr->address; 901 905 } elsif ($type eq 'NS') { 906 # hmm. should we warn here if subdomain NS'es are left alone? 907 next if ($rwns && ($rr->name eq $domain)); 902 908 push @vallist, $rr->nsdname; 903 909 $nsflag = 1; … … 905 911 push @vallist, $rr->cname; 906 912 } elsif ($type eq 'SOA') { 913 next if $rwsoa; 907 914 $vallist[1] = $rr->mname.":".$rr->rname; 908 915 push @vallist, ($rr->refresh.":".$rr->retry.":".$rr->expire.":".$rr->minimum); … … 927 934 $sql .= ",distance,weight,port" if $type eq 'SRV'; 928 935 $vallen .= ",?,?,?" if $type eq 'SRV'; 936 push @vallist, $rr->target; 929 937 push @vallist, $rr->priority; 930 938 push @vallist, $rr->weight; … … 934 942 push @vallist, ($rr->flags.":".$rr->protocol.":".$rr->algorithm.":".$rr->key.":".$rr->keytag.":".$rr->privatekeyname); 935 943 } else { 944 push @vallist, $rr->rdatastr; 936 945 # Finding a different record type is not fatal.... just problematic. 946 # We may not be able to export it correctly. 937 947 $warnmsg .= "Unusual record ".$rr->name." ($type) found\n"; 938 948 } … … 948 958 # DNSKEY DLV X25 TXT TSIG TKEY SSHFP SRV SPF SOA RT RP PX PTR NULL APL::AplItem 949 959 950 # MX and SRV have known extras to stuff in. 951 if ($type eq 'MX') { 952 push @vallist, $rr->preference; 960 $sth = $dbh->prepare($sql.") VALUES (".$vallen.")") or die "problem preparing record insert SQL\n"; 961 $sth->execute(@vallist) or die "failed to insert ".$rr->string.": ".$sth->errstr."\n"; 962 963 $nrecs++; 964 965 } # while axfr_next 966 967 # Overwrite SOA record 968 if ($rwsoa) { 969 $soaflag = 1; 970 my $sthgetsoa = $dbh->prepare("SELECT host,val,ttl FROM default_records WHERE group_id=? AND type=?"); 971 my $sthputsoa = $dbh->prepare("INSERT INTO records (domain_id,host,type,val,ttl) VALUES (?,?,?,?,?)"); 972 $sthgetsoa->execute($group,$reverse_typemap{SOA}); 973 while (my ($host,$val,$ttl) = $sthgetsoa->fetchrow_array()) { 974 $host =~ s/DOMAIN/$domain/g; 975 $val =~ s/DOMAIN/$domain/g; 976 $sthputsoa->execute($dom_id,$host,$reverse_typemap{SOA},$val,$ttl); 953 977 } 954 if ($type eq 'SRV') { 978 } 979 980 # Overwrite NS records 981 if ($rwns) { 982 $nsflag = 1; 983 my $sthgetns = $dbh->prepare("SELECT host,val,ttl FROM default_records WHERE group_id=? AND type=?"); 984 my $sthputns = $dbh->prepare("INSERT INTO records (domain_id,host,type,val,ttl) VALUES (?,?,?,?,?)"); 985 $sthgetns->execute($group,$reverse_typemap{NS}); 986 while (my ($host,$val,$ttl) = $sthgetns->fetchrow_array()) { 987 $host =~ s/DOMAIN/$domain/g; 988 $val =~ s/DOMAIN/$domain/g; 989 $sthputns->execute($dom_id,$host,$reverse_typemap{NS},$val,$ttl); 955 990 } 956 957 my $sth_rr = $dbh->prepare($sql.") VALUES (".$vallen.")"); 958 $sth_rr->execute(@vallist) or die "failed to insert ".$rr->string.": ".$sth_rr->errstr."\n" if $sth_rr->err; 959 960 if ($type eq 'SOA') { 961 } 962 963 #die "die.die.die!\n"; 964 965 $nrecs++; 966 967 } # while axfr_next 991 } 968 992 969 993 die "No records found; either $ifrom is not authoritative or doesn't allow transfers\n" if !$nrecs; … … 971 995 die "Bad zone: No NS records!\n" if !$nsflag; 972 996 973 $dbh->rollback; 974 # $dbh->commit; 975 976 # die "Bad zone. BAD zone! No cookie!\n"; 977 #die "don't insert me! I'm nasty, I am!\n"; 997 $dbh->commit; 998 978 999 }; 979 1000 … … 981 1002 my $msg = $@; 982 1003 eval { $dbh->rollback; }; 983 # $dbh->do("delete from domains where domain='$domain'");984 1004 return ('FAIL',$msg." $warnmsg"); 985 1005 } else { 986 # $dbh->do("delete from domains where domain='$domain'");987 1006 return ('WARN', $warnmsg) if $warnmsg; 988 1007 return ('OK',"ook"); 989 1008 } 990 1009 1010 # it should be impossible to get here. 991 1011 return ('WARN',"OOOK!"); 992 1012 } # end importAXFR() -
trunk/dns.cgi
r35 r37 68 68 69 69 # default 70 #my $perpage = 15;71 my $perpage = 3;70 my $perpage = 15; 71 #my $perpage = 3; 72 72 my $offset = ($webvar{offset} ? $webvar{offset} : 0); 73 73 … … 601 601 $page->param(rwsoa => $webvar{rwsoa}) if $webvar{rwsoa}; 602 602 $page->param(rwns => $webvar{rwns}) if $webvar{rwns}; 603 $page->param(dominactive => 1) if !$webvar{domactive};603 $page->param(dominactive => 1) if (!$webvar{domactive} && $webvar{doit}); # eww. 604 604 $page->param(importdoms => $webvar{importdoms}) if $webvar{importdoms}; 605 605 ##work … … 623 623 $row{domwarn} = $msg; 624 624 } 625 $row{domerr} = $msg if $code eq 'FAIL'; 625 if ($code eq 'FAIL') { 626 $msg =~ s|\n|<br />|g; 627 $row{domerr} = $msg; 628 } 626 629 # do stuff! DNSDB::importAXFR($webvar{ifrom}, $webvar{rwsoa}, $webvar{rwns}, $domain, <flags>) 627 630 $row{domain} = $domain;
Note:
See TracChangeset
for help on using the changeset viewer.