[420] | 1 | #!/usr/bin/perl -w -T
|
---|
| 2 | # Plaintext record list for DeepNet DNS Administrator
|
---|
| 3 | ##
|
---|
| 4 | # $Id: textrecs.cgi 581 2014-01-02 18:22:11Z kdeugau $
|
---|
[496] | 5 | # Copyright 2012,2013 Kris Deugau <kdeugau@deepnet.cx>
|
---|
[420] | 6 | #
|
---|
| 7 | # This program is free software: you can redistribute it and/or modify
|
---|
| 8 | # it under the terms of the GNU General Public License as published by
|
---|
| 9 | # the Free Software Foundation, either version 3 of the License, or
|
---|
| 10 | # (at your option) any later version.
|
---|
| 11 | #
|
---|
| 12 | # This program is distributed in the hope that it will be useful,
|
---|
| 13 | # but WITHOUT ANY WARRANTY; without even the implied warranty of
|
---|
| 14 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
---|
| 15 | # GNU General Public License for more details.
|
---|
| 16 | #
|
---|
| 17 | # You should have received a copy of the GNU General Public License
|
---|
| 18 | # along with this program. If not, see <http://www.gnu.org/licenses/>.
|
---|
| 19 | ##
|
---|
| 20 |
|
---|
| 21 | use strict;
|
---|
| 22 | use warnings;
|
---|
| 23 |
|
---|
| 24 | use CGI::Carp qw (fatalsToBrowser);
|
---|
| 25 | use CGI::Simple;
|
---|
| 26 | use HTML::Template;
|
---|
| 27 | use CGI::Session;
|
---|
| 28 | use DBI;
|
---|
| 29 |
|
---|
| 30 | # don't remove! required for GNU/FHS-ish install from tarball
|
---|
| 31 | use lib '.'; ##uselib##
|
---|
| 32 |
|
---|
[468] | 33 | use DNSDB;
|
---|
[420] | 34 |
|
---|
| 35 | # Let's do these templates right...
|
---|
| 36 | my $templatedir = "templates";
|
---|
| 37 |
|
---|
| 38 | # Set up the CGI object...
|
---|
| 39 | my $q = new CGI::Simple;
|
---|
| 40 | # ... and get query-string params as well as POST params if necessary
|
---|
| 41 | $q->parse_query_string;
|
---|
| 42 |
|
---|
| 43 | # This is probably excessive fiddling, but it puts the parameters somewhere my fingers know about...
|
---|
| 44 | my %webvar = $q->Vars;
|
---|
| 45 |
|
---|
| 46 | # shut up some warnings, in case we arrive somewhere we forgot to set this
|
---|
| 47 | $webvar{defrec} = 'n' if !$webvar{defrec}; # non-default records
|
---|
| 48 | $webvar{revrec} = 'n' if !$webvar{revrec}; # non-reverse (domain) records
|
---|
| 49 |
|
---|
[468] | 50 | my $dnsdb = new DNSDB;
|
---|
[420] | 51 |
|
---|
| 52 | # Check the session and if we have a zone ID to retrieve. Call a failure sub if not.
|
---|
[494] | 53 | my $sid = $q->cookie('dnsadmin_session');
|
---|
[468] | 54 | my $session = new CGI::Session("driver:File", $sid, {Directory => $dnsdb->{sessiondir}})
|
---|
[420] | 55 | or die CGI::Session->errstr();
|
---|
| 56 | do_not_pass_go() if !$sid;
|
---|
| 57 | do_not_pass_go() if !$webvar{id};
|
---|
| 58 |
|
---|
| 59 | my $zone;
|
---|
[473] | 60 | $zone = ($webvar{revrec} eq 'n' ? $dnsdb->domainName($webvar{id}) : $dnsdb->revName($webvar{id}))
|
---|
[420] | 61 | if $webvar{defrec} eq 'n';
|
---|
[473] | 62 | $zone = "group ".$dnsdb->groupName($webvar{id}) if $webvar{defrec} eq 'y';
|
---|
[420] | 63 |
|
---|
| 64 | ##fixme: do we support both HTML-plain and true plaintext? could be done, with another $webvar{}
|
---|
[495] | 65 | # Don't die on bad parameters. Saves munging the return from getRecList.
|
---|
[420] | 66 | #my $page = HTML::Template->new(filename => "$templatedir/textrecs.tmpl",
|
---|
| 67 | # loop_context_vars => 1, global_vars => 1, die_on_bad_params => 0);
|
---|
| 68 | #print "Content-type: text/html\n\n";
|
---|
| 69 |
|
---|
| 70 | print "Content-type: text/plain\n\n";
|
---|
| 71 | print "Plaintext version of records for $zone.\n" if $webvar{defrec} eq 'n';
|
---|
| 72 | print "Plaintext version of default ".($webvar{revrec} eq 'y' ? 'reverse ' : '')."records for $zone.\n"
|
---|
| 73 | if $webvar{defrec} eq 'y';
|
---|
| 74 | print qq(Press the "Back" button to return to the standard record list.\n\n);
|
---|
| 75 |
|
---|
[495] | 76 | my $reclist = $dnsdb->getRecList(defrec => $webvar{defrec}, revrec => $webvar{revrec}, id => $webvar{id},
|
---|
[580] | 77 | sortby => ($webvar{revrec} eq 'n' ? 'type,host' : 'type,val'), sortorder => 'ASC', offset => 'all');
|
---|
[420] | 78 | foreach my $rec (@$reclist) {
|
---|
| 79 | $rec->{type} = $typemap{$rec->{type}};
|
---|
[440] | 80 | $rec->{val} .= '.' if $rec->{type} ne 'A' && $rec->{type} ne 'TXT' && $webvar{revrec} eq 'n' && $rec->{val} !~ /\.$/;
|
---|
[420] | 81 | $rec->{host} .= '.' if $webvar{revrec} eq 'y' && $rec->{val} !~ /\.$/;
|
---|
| 82 | $rec->{val} = "$rec->{distance} $rec->{val}" if $rec->{type} eq 'MX';
|
---|
| 83 | $rec->{val} = "$rec->{distance} $rec->{weight} $rec->{port} $rec->{val}" if $rec->{type} eq 'SRV';
|
---|
[536] | 84 | if ($webvar{revrec} eq 'y') {
|
---|
[581] | 85 | if ($dnsdb->{showrec_arpa_ns} && $rec->{type} eq 'NS') {
|
---|
| 86 | my $tmp = new NetAddr::IP $rec->{val};
|
---|
| 87 | $rec->{val} = DNSDB::_ZONE($tmp, 'ZONE', 'r', '.').($tmp->{isv6} ? '.ip6.arpa' : '.in-addr.arpa');
|
---|
| 88 | }
|
---|
[536] | 89 | printf "%-16s\t%d\t%s\t%s\n", $rec->{val}, $rec->{ttl}, $rec->{type}, $rec->{host};
|
---|
| 90 | } else {
|
---|
| 91 | printf "%-45s\t%d\t%s\t%s\n", $rec->{host}, $rec->{ttl}, $rec->{type}, $rec->{val};
|
---|
| 92 | }
|
---|
[420] | 93 | }
|
---|
| 94 | #$page->param(defrec => ($webvar{defrec} eq 'y'));
|
---|
| 95 | #$page->param(revrec => ($webvar{revrec} eq 'y'));
|
---|
| 96 | #$page->param(zone => $zone);
|
---|
| 97 | #$page->param(reclist => $reclist);
|
---|
| 98 | #$page->param(fwdzone => ($webvar{revrec} eq 'n'));
|
---|
| 99 | #print $page->output;
|
---|
| 100 |
|
---|
| 101 | exit;
|
---|
| 102 |
|
---|
| 103 | sub do_not_pass_go {
|
---|
| 104 | my $webpath = $ENV{SCRIPT_NAME};
|
---|
| 105 | $webpath =~ s|/[^/]+$|/|;
|
---|
| 106 | print "Status: 302\nLocation: http://$ENV{HTTP_HOST}$webpath\n\n";
|
---|
| 107 | exit;
|
---|
| 108 | }
|
---|