| [420] | 1 | #!/usr/bin/perl -w -T
 | 
|---|
 | 2 | # Plaintext record list for DeepNet DNS Administrator
 | 
|---|
 | 3 | ##
 | 
|---|
 | 4 | # $Id: textrecs.cgi 841 2022-04-28 20:47:20Z kdeugau $
 | 
|---|
| [841] | 5 | # Copyright 2012-2014,2020,2022 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 | 
 | 
|---|
| [841] | 30 | # Taint-safe (ish) voodoo to push "the directory the script is in" into @INC.
 | 
|---|
 | 31 | use File::Spec ();
 | 
|---|
 | 32 | use File::Basename ();
 | 
|---|
 | 33 | my $path;
 | 
|---|
 | 34 | BEGIN {
 | 
|---|
 | 35 |     $path = File::Basename::dirname(File::Spec->rel2abs($0));
 | 
|---|
 | 36 |     if ($path =~ /(.*)/) {
 | 
|---|
 | 37 |         $path = $1;
 | 
|---|
 | 38 |     }
 | 
|---|
 | 39 | }
 | 
|---|
 | 40 | use lib $path;
 | 
|---|
| [420] | 41 | 
 | 
|---|
| [468] | 42 | use DNSDB;
 | 
|---|
| [420] | 43 | 
 | 
|---|
 | 44 | # Let's do these templates right...
 | 
|---|
 | 45 | my $templatedir = "templates";
 | 
|---|
 | 46 | 
 | 
|---|
 | 47 | # Set up the CGI object...
 | 
|---|
 | 48 | my $q = new CGI::Simple;
 | 
|---|
 | 49 | # ... and get query-string params as well as POST params if necessary
 | 
|---|
 | 50 | $q->parse_query_string;
 | 
|---|
 | 51 | 
 | 
|---|
 | 52 | # This is probably excessive fiddling, but it puts the parameters somewhere my fingers know about...
 | 
|---|
 | 53 | my %webvar = $q->Vars;
 | 
|---|
 | 54 | 
 | 
|---|
 | 55 | # shut up some warnings, in case we arrive somewhere we forgot to set this
 | 
|---|
 | 56 | $webvar{defrec} = 'n' if !$webvar{defrec};      # non-default records
 | 
|---|
 | 57 | $webvar{revrec} = 'n' if !$webvar{revrec};      # non-reverse (domain) records
 | 
|---|
 | 58 | 
 | 
|---|
| [468] | 59 | my $dnsdb = new DNSDB;
 | 
|---|
| [420] | 60 | 
 | 
|---|
 | 61 | # Check the session and if we have a zone ID to retrieve.  Call a failure sub if not.
 | 
|---|
| [494] | 62 | my $sid = $q->cookie('dnsadmin_session');
 | 
|---|
| [468] | 63 | my $session = new CGI::Session("driver:File", $sid, {Directory => $dnsdb->{sessiondir}})
 | 
|---|
| [420] | 64 |         or die CGI::Session->errstr();
 | 
|---|
 | 65 | do_not_pass_go() if !$sid;
 | 
|---|
 | 66 | do_not_pass_go() if !$webvar{id};
 | 
|---|
 | 67 | 
 | 
|---|
 | 68 | my $zone;
 | 
|---|
| [473] | 69 | $zone = ($webvar{revrec} eq 'n' ? $dnsdb->domainName($webvar{id}) : $dnsdb->revName($webvar{id}))
 | 
|---|
| [420] | 70 |         if $webvar{defrec} eq 'n';
 | 
|---|
| [473] | 71 | $zone = "group ".$dnsdb->groupName($webvar{id}) if $webvar{defrec} eq 'y';
 | 
|---|
| [420] | 72 | 
 | 
|---|
 | 73 | ##fixme:  do we support both HTML-plain and true plaintext?  could be done, with another $webvar{}
 | 
|---|
| [495] | 74 | # Don't die on bad parameters.  Saves munging the return from getRecList.
 | 
|---|
| [420] | 75 | #my $page = HTML::Template->new(filename => "$templatedir/textrecs.tmpl",
 | 
|---|
 | 76 | #       loop_context_vars => 1, global_vars => 1, die_on_bad_params => 0);
 | 
|---|
 | 77 | #print "Content-type: text/html\n\n";
 | 
|---|
 | 78 | 
 | 
|---|
 | 79 | print "Content-type: text/plain\n\n";
 | 
|---|
 | 80 | print "Plaintext version of records for $zone.\n" if $webvar{defrec} eq 'n';
 | 
|---|
 | 81 | print "Plaintext version of default ".($webvar{revrec} eq 'y' ? 'reverse ' : '')."records for $zone.\n"
 | 
|---|
 | 82 |         if $webvar{defrec} eq 'y';
 | 
|---|
 | 83 | print qq(Press the "Back" button to return to the standard record list.\n\n);
 | 
|---|
 | 84 | 
 | 
|---|
| [495] | 85 | my $reclist = $dnsdb->getRecList(defrec => $webvar{defrec}, revrec => $webvar{revrec}, id => $webvar{id},
 | 
|---|
| [580] | 86 |         sortby => ($webvar{revrec} eq 'n' ? 'type,host' : 'type,val'), sortorder => 'ASC', offset => 'all');
 | 
|---|
| [420] | 87 | foreach my $rec (@$reclist) {
 | 
|---|
 | 88 |   $rec->{type} = $typemap{$rec->{type}};
 | 
|---|
| [440] | 89 |   $rec->{val} .= '.' if $rec->{type} ne 'A' && $rec->{type} ne 'TXT' && $webvar{revrec} eq 'n' && $rec->{val} !~ /\.$/;
 | 
|---|
| [420] | 90 |   $rec->{host} .= '.' if $webvar{revrec} eq 'y' && $rec->{val} !~ /\.$/;
 | 
|---|
 | 91 |   $rec->{val} = "$rec->{distance}  $rec->{val}" if $rec->{type} eq 'MX';
 | 
|---|
 | 92 |   $rec->{val} = "$rec->{distance}  $rec->{weight}  $rec->{port}  $rec->{val}" if $rec->{type} eq 'SRV';
 | 
|---|
| [536] | 93 |   if ($webvar{revrec} eq 'y') {
 | 
|---|
 | 94 |     printf "%-16s\t%d\t%s\t%s\n", $rec->{val}, $rec->{ttl}, $rec->{type}, $rec->{host};
 | 
|---|
 | 95 |   } else {
 | 
|---|
 | 96 |     printf "%-45s\t%d\t%s\t%s\n", $rec->{host}, $rec->{ttl}, $rec->{type}, $rec->{val};
 | 
|---|
 | 97 |   }
 | 
|---|
| [420] | 98 | }
 | 
|---|
 | 99 | #$page->param(defrec => ($webvar{defrec} eq 'y'));
 | 
|---|
 | 100 | #$page->param(revrec => ($webvar{revrec} eq 'y'));
 | 
|---|
 | 101 | #$page->param(zone => $zone);
 | 
|---|
 | 102 | #$page->param(reclist => $reclist);
 | 
|---|
 | 103 | #$page->param(fwdzone => ($webvar{revrec} eq 'n'));
 | 
|---|
 | 104 | #print $page->output;
 | 
|---|
 | 105 | 
 | 
|---|
 | 106 | exit;
 | 
|---|
 | 107 | 
 | 
|---|
 | 108 | sub do_not_pass_go {
 | 
|---|
 | 109 |   my $webpath = $ENV{SCRIPT_NAME};
 | 
|---|
 | 110 |   $webpath =~ s|/[^/]+$|/|;
 | 
|---|
 | 111 |   print "Status: 302\nLocation: http://$ENV{HTTP_HOST}$webpath\n\n";
 | 
|---|
 | 112 |   exit;
 | 
|---|
 | 113 | }
 | 
|---|