Changeset 35
Legend:
- Unmodified
- Added
- Removed
-
trunk/DNSDB.pm
r34 r35 816 816 sub importAXFR { 817 817 my $dbh = shift; 818 my $ifrom = shift;818 my $ifrom_in = shift; 819 819 my $domain = shift; 820 820 my $group = shift; … … 824 824 ##fixme: add mode to delete&replace, merge+overwrite, merge new? 825 825 826 827 826 my $nrecs = 0; 828 my $flags = 0; 829 my $warnmsg; 827 my $soaflag = 0; 828 my $nsflag = 0; 829 my $warnmsg = ''; 830 my $ifrom; 831 832 # choke on possible bad setting in ifrom 833 # IPv4 and v6! 834 ($ifrom) = ($ifrom_in =~ /^([0-9a-f\:.]+|[0-9a-z_.-]+)$/i); 835 return ('FAIL', "Bad AXFR source host $ifrom") 836 unless ($ifrom) = ($ifrom_in =~ /^([0-9a-f\:.]+|[0-9a-z_.-]+)$/i); 830 837 831 838 # Allow transactions, and raise an exception on errors so we can catch it later. … … 834 841 local $dbh->{RaiseError} = 1; 835 842 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=?"); 836 845 my $dom_id; 846 847 # quick check to start to see if we've already got one 848 $sth_getid->execute($domain); 849 ($dom_id) = $sth_getid->fetchrow_array; 850 851 return ('FAIL', "Domain already exists") if $dom_id; 837 852 838 853 eval { 839 854 # can't do this, can't nest transactions. sigh. 840 #my ($dcode, $dmsg) = addDomain( $dbh, $domain, $group, $status);855 #my ($dcode, $dmsg) = addDomain(dbh, domain, group, status); 841 856 842 857 ##fixme: serial 843 my $sth = $dbh->prepare("INSERT INTO domains (domain,group_id,status) VALUES (?,?,?)"); 844 $warnmsg = "trying lokido... (".$dbh->{AutoCommit}."), (".$dbh->{RaiseError}.")" if $domain eq 'waslokido.com'; 845 $sth->execute($domain,$group,$status); 858 $sth_domin->execute($domain,$group,$status); 859 860 ## bizarre DBI<->Net::DNS interaction bug: 861 ## sometimes a zone will cause an immediate commit-and-exit (sort of) of the while() 846 862 847 863 # get domain id so we can do the records 848 $sth = $dbh->prepare("select domain_id from domains where domain='$domain'"); 849 $sth->execute; 850 ($dom_id) = $sth->fetchrow_array(); 851 $warnmsg .= " [domid $dom_id]"; 864 $sth_getid->execute($domain); 865 ($dom_id) = $sth_getid->fetchrow_array(); 852 866 853 867 my $res = Net::DNS::Resolver->new; 854 unless ($res->axfr_start($domain)) { 855 $dbh->rollback; 856 die "Couldn't begin AXFR\n"; 857 } 858 859 #die "just started AXFR\n"; 860 861 while (my $rr = $res->axfr_next) { 862 $warnmsg = $rr->string; 868 $res->nameservers($ifrom); 869 $res->axfr_start($domain) 870 or die "Couldn't begin AXFR\n"; 871 872 #my $foobar = $res->axfr_next() if $domain =~ /loki/; 873 #die "outside the loop with ".$foobar->type."\n" if $domain =~ /loki/; 874 875 while (my $rr = $res->axfr_next()) { 863 876 my $type = $rr->type; 864 # nasty big ugly case-like thing here, since we have to do *some* different 865 # processing depending on the record. le sigh. 877 878 #die "first record! $type\n" if $domain =~ /lok/; 879 866 880 my $sql = "INSERT INTO records (domain_id,host,type,ttl,val"; 867 881 my $vallen = "?,?,?,?,?"; … … 870 884 # my $val; 871 885 886 $soaflag = 1 if $type eq 'SOA'; 887 $nsflag = 1 if $type eq 'NS'; 888 872 889 ##work 873 # gnnnnnh. going to need to (rr->string) -> split -> <localvars> ? 874 my @vallist = ($dom_id, $rr->name, $reverse_typemap{$type}, $rr->ttl); 890 my @vallist = ($dom_id, $rr->name, $reverse_typemap{$type}, $rr->ttl); 875 891 876 892 # "Primary" types: 877 893 # A, NS, CNAME, SOA, PTR(warn in forward), MX, TXT, AAAA, SRV, A6(ob), SPF 878 894 # maybe KEY 895 896 # nasty big ugly case-like thing here, since we have to do *some* different 897 # processing depending on the record. le sigh. 879 898 880 899 if ($type eq 'A') { … … 882 901 } elsif ($type eq 'NS') { 883 902 push @vallist, $rr->nsdname; 903 $nsflag = 1; 884 904 } elsif ($type eq 'CNAME') { 885 905 push @vallist, $rr->cname; … … 887 907 $vallist[1] = $rr->mname.":".$rr->rname; 888 908 push @vallist, ($rr->refresh.":".$rr->retry.":".$rr->expire.":".$rr->minimum); 909 $soaflag = 1; 889 910 } elsif ($type eq 'PTR') { 890 911 # hmm. PTR records should not be in forward zones. … … 910 931 push @vallist, $rr->port; 911 932 } elsif ($type eq 'KEY') { 933 # we don't actually know what to do with these... 912 934 push @vallist, ($rr->flags.":".$rr->protocol.":".$rr->algorithm.":".$rr->key.":".$rr->keytag.":".$rr->privatekeyname); 935 } else { 936 # Finding a different record type is not fatal.... just problematic. 937 $warnmsg .= "Unusual record ".$rr->name." ($type) found\n"; 913 938 } 914 915 $warnmsg = $rr->string;916 $dbh->rollback if $domain eq 'waslokido.com';917 die "first record: ".$rr->string."\n" if $domain eq 'waslokido.com';918 939 919 940 # BIND supports: … … 934 955 } 935 956 936 $sth= $dbh->prepare($sql.") VALUES (".$vallen.")");937 $sth ->execute(@vallist) or die "failed to insert ".$rr->string.": ".$sth->errstr."\n" if $sth->err;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; 938 959 939 960 if ($type eq 'SOA') { 940 961 } 941 962 963 #die "die.die.die!\n"; 964 965 $nrecs++; 966 967 } # while axfr_next 968 969 die "No records found; either $ifrom is not authoritative or doesn't allow transfers\n" if !$nrecs; 970 die "Bad zone: No SOA record!\n" if !$soaflag; 971 die "Bad zone: No NS records!\n" if !$nsflag; 972 942 973 $dbh->rollback; 943 # die "die.die.die!\n";944 945 #print $rr->rdata."\n";946 } 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"; 947 978 }; 948 979 … … 950 981 my $msg = $@; 951 982 eval { $dbh->rollback; }; 983 # $dbh->do("delete from domains where domain='$domain'"); 952 984 return ('FAIL',$msg." $warnmsg"); 953 985 } else { 954 return ('WARN', "OOOK! Ooooook. Ook. ($warnmsg)") if $domain eq 'deepnet.cx';955 return ('WARN', "Funky Things Happened: $warnmsg") if $domain eq 'waslokido.com';986 # $dbh->do("delete from domains where domain='$domain'"); 987 return ('WARN', $warnmsg) if $warnmsg; 956 988 return ('OK',"ook"); 957 989 } -
trunk/dns.cgi
r34 r35 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) unless$webvar{domactive};603 $page->param(dominactive => 1) if !$webvar{domactive}; 604 604 $page->param(importdoms => $webvar{importdoms}) if $webvar{importdoms}; 605 605 ##work … … 618 618 my ($code,$msg) = importAXFR($dbh, $webvar{ifrom}, $domain, $webvar{group}, 619 619 $webvar{domstatus}, $webvar{rwsoa}, $webvar{rwns}); 620 $row{domok} = 1 if $code eq 'OK'; 621 $row{domwarn} = $msg if $code eq 'WARN'; 622 $row{domerr} = $msg if $code eq 'FAIL'; 623 push @debugbits, "$domain: $code<br>\n"; 620 $row{domok} = $msg if $code eq 'OK'; 621 if ($code eq 'WARN') { 622 $msg =~ s|\n|<br />|g; 623 $row{domwarn} = $msg; 624 } 625 $row{domerr} = $msg if $code eq 'FAIL'; 624 626 # do stuff! DNSDB::importAXFR($webvar{ifrom}, $webvar{rwsoa}, $webvar{rwns}, $domain, <flags>) 625 627 $row{domain} = $domain; … … 630 632 } 631 633 632 push @debugbits, "<pre>$webvar{importdoms}</pre>";633 634 } 634 635 -
trunk/templates/axfr.tmpl
r34 r35 3 3 <TMPL_INCLUDE NAME="menu.tmpl"> 4 4 5 <td align="center" >5 <td align="center" valign="top"> 6 6 7 7 <form action="dns.cgi" method="POST"> … … 56 56 <td><TMPL_VAR NAME=domain></td> 57 57 <TMPL_IF domok> <td>Imported OK</td> 58 <TMPL_ELSE><TMPL_IF domwarn> <td class="warn">Warning: <TMPL_VAR NAME=domwarn></td> 58 <TMPL_ELSE><TMPL_IF domwarn> <td class="warn">Import OK but:<br /> 59 <TMPL_VAR NAME=domwarn></td> 59 60 <TMPL_ELSE> <td class="err">Failed: <TMPL_VAR NAME=domerr></td> 60 61 </TMPL_IF></TMPL_IF>
Note:
See TracChangeset
for help on using the changeset viewer.