1 | #!/usr/bin/perl -w -T
|
---|
2 | # Plaintext record list for DeepNet DNS Administrator
|
---|
3 | ##
|
---|
4 | # $Id: textrecs.cgi 422 2012-10-10 17:41:00Z 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->{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 | }
|
---|