| 1 | #!/usr/bin/perl -w -T
 | 
|---|
| 2 | # Plaintext record list for DeepNet DNS Administrator
 | 
|---|
| 3 | ##
 | 
|---|
| 4 | # $Id: textrecs.cgi 535 2013-11-21 20:07:43Z kdeugau $
 | 
|---|
| 5 | # Copyright 2012 Kris Deugau <kdeugau@deepnet.cx>
 | 
|---|
| 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 | 
 | 
|---|
| 33 | use DNSDB qw(:ALL);
 | 
|---|
| 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 | 
 | 
|---|
| 50 | # load some local system defaults (mainly DB connect info)
 | 
|---|
| 51 | # note this is not *absolutely* fatal, since there's a default dbname/user/pass in DNSDB.pm
 | 
|---|
| 52 | # we'll catch a bad DB connect string once we get to trying that
 | 
|---|
| 53 | ##fixme:  pass params to loadConfig, and use them there, to allow one codebase to support multiple sites
 | 
|---|
| 54 | if (!loadConfig()) {
 | 
|---|
| 55 |   warn "Using default configuration;  unable to load custom settings: $DNSDB::errstr";
 | 
|---|
| 56 | }
 | 
|---|
| 57 | 
 | 
|---|
| 58 | # Check the session and if we have a zone ID to retrieve.  Call a failure sub if not.
 | 
|---|
| 59 | my $sid = ($webvar{sid} ? $webvar{sid} : undef);
 | 
|---|
| 60 | my $session = new CGI::Session("driver:File", $sid, {Directory => $config{sessiondir}})
 | 
|---|
| 61 |         or die CGI::Session->errstr();
 | 
|---|
| 62 | do_not_pass_go() if !$sid;
 | 
|---|
| 63 | do_not_pass_go() if !$webvar{id};
 | 
|---|
| 64 | 
 | 
|---|
| 65 | ##fixme: quit throwing the database handle around, and put all the SQL and direct DB fiddling into DNSDB.pm
 | 
|---|
| 66 | # dbname, user, pass, host (optional)
 | 
|---|
| 67 | my ($dbh,$msg) = connectDB($config{dbname}, $config{dbuser}, $config{dbpass}, $config{dbhost});
 | 
|---|
| 68 | # Load config pieces from the database.  Ideally all but the DB user/pass/etc should be loaded here.
 | 
|---|
| 69 | initGlobals($dbh);
 | 
|---|
| 70 | 
 | 
|---|
| 71 | my $zone;
 | 
|---|
| 72 | $zone = domainName($dbh, $webvar{id}) if $webvar{defrec} eq 'n';
 | 
|---|
| 73 | $zone = "group ".groupName($dbh, $webvar{id}) if $webvar{defrec} eq 'y';
 | 
|---|
| 74 | 
 | 
|---|
| 75 | ##fixme:  do we support both HTML-plain and true plaintext?  could be done, with another $webvar{}
 | 
|---|
| 76 | # Don't die on bad parameters.  Saves munging the return from getDomRecs.
 | 
|---|
| 77 | #my $page = HTML::Template->new(filename => "$templatedir/textrecs.tmpl",
 | 
|---|
| 78 | #       loop_context_vars => 1, global_vars => 1, die_on_bad_params => 0);
 | 
|---|
| 79 | #print "Content-type: text/html\n\n";
 | 
|---|
| 80 | 
 | 
|---|
| 81 | print "Content-type: text/plain\n\n";
 | 
|---|
| 82 | print "Plaintext version of records for $zone.\n" if $webvar{defrec} eq 'n';
 | 
|---|
| 83 | print "Plaintext version of default records for $zone.\n" if $webvar{defrec} eq 'y';
 | 
|---|
| 84 | print qq(Press the "Back" button to return to the standard record list.\n\n);
 | 
|---|
| 85 | 
 | 
|---|
| 86 | my $reclist = getDomRecs($dbh, $webvar{defrec}, $webvar{id}, 0, 'all', 'type,host', 'ASC');
 | 
|---|
| 87 | 
 | 
|---|
| 88 | foreach my $rec (@$reclist) {
 | 
|---|
| 89 |   $rec->{type} = $typemap{$rec->{type}};
 | 
|---|
| 90 |   $rec->{val} .= '.' if $rec->{type} ne 'A' && $rec->{type} ne 'TXT' && $rec->{val} !~ /\.$/;
 | 
|---|
| 91 |   $rec->{host} .= '.' if $rec->{val} !~ /\.$/;
 | 
|---|
| 92 |   $rec->{val} = "$rec->{distance}  $rec->{val}" if $rec->{type} eq 'MX';
 | 
|---|
| 93 |   $rec->{val} = "$rec->{distance}  $rec->{weight}  $rec->{port}  $rec->{val}" if $rec->{type} eq 'SRV';
 | 
|---|
| 94 |   printf "%-45s\t%d\t%s\t%s\n", $rec->{host}, $rec->{ttl}, $rec->{type}, $rec->{val};
 | 
|---|
| 95 | }
 | 
|---|
| 96 | #$page->param(defrec => ($webvar{defrec} eq 'y'));
 | 
|---|
| 97 | #$page->param(revrec => ($webvar{revrec} eq 'y'));
 | 
|---|
| 98 | #$page->param(zone => $zone);
 | 
|---|
| 99 | #$page->param(reclist => $reclist);
 | 
|---|
| 100 | #$page->param(fwdzone => ($webvar{revrec} eq 'n'));
 | 
|---|
| 101 | #print $page->output;
 | 
|---|
| 102 | 
 | 
|---|
| 103 | exit;
 | 
|---|
| 104 | 
 | 
|---|
| 105 | sub do_not_pass_go {
 | 
|---|
| 106 |   my $webpath = $ENV{SCRIPT_NAME};
 | 
|---|
| 107 |   $webpath =~ s|/[^/]+$|/|;
 | 
|---|
| 108 |   print "Status: 302\nLocation: http://$ENV{HTTP_HOST}$webpath\n\n";
 | 
|---|
| 109 |   exit;
 | 
|---|
| 110 | }
 | 
|---|