source: trunk/textrecs.cgi@ 858

Last change on this file since 858 was 841, checked in by Kris Deugau, 3 years ago

/trunk

Update textrecs.cgi include path finder - see #80

  • Property svn:executable set to *
  • Property svn:keywords set to Date Rev Author Id
File size: 4.2 KB
Line 
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 $
5# Copyright 2012-2014,2020,2022 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
21use strict;
22use warnings;
23
24use CGI::Carp qw (fatalsToBrowser);
25use CGI::Simple;
26use HTML::Template;
27use CGI::Session;
28use DBI;
29
30# Taint-safe (ish) voodoo to push "the directory the script is in" into @INC.
31use File::Spec ();
32use File::Basename ();
33my $path;
34BEGIN {
35 $path = File::Basename::dirname(File::Spec->rel2abs($0));
36 if ($path =~ /(.*)/) {
37 $path = $1;
38 }
39}
40use lib $path;
41
42use DNSDB;
43
44# Let's do these templates right...
45my $templatedir = "templates";
46
47# Set up the CGI object...
48my $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...
53my %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
59my $dnsdb = new DNSDB;
60
61# Check the session and if we have a zone ID to retrieve. Call a failure sub if not.
62my $sid = $q->cookie('dnsadmin_session');
63my $session = new CGI::Session("driver:File", $sid, {Directory => $dnsdb->{sessiondir}})
64 or die CGI::Session->errstr();
65do_not_pass_go() if !$sid;
66do_not_pass_go() if !$webvar{id};
67
68my $zone;
69$zone = ($webvar{revrec} eq 'n' ? $dnsdb->domainName($webvar{id}) : $dnsdb->revName($webvar{id}))
70 if $webvar{defrec} eq 'n';
71$zone = "group ".$dnsdb->groupName($webvar{id}) if $webvar{defrec} eq 'y';
72
73##fixme: do we support both HTML-plain and true plaintext? could be done, with another $webvar{}
74# Don't die on bad parameters. Saves munging the return from getRecList.
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
79print "Content-type: text/plain\n\n";
80print "Plaintext version of records for $zone.\n" if $webvar{defrec} eq 'n';
81print "Plaintext version of default ".($webvar{revrec} eq 'y' ? 'reverse ' : '')."records for $zone.\n"
82 if $webvar{defrec} eq 'y';
83print qq(Press the "Back" button to return to the standard record list.\n\n);
84
85my $reclist = $dnsdb->getRecList(defrec => $webvar{defrec}, revrec => $webvar{revrec}, id => $webvar{id},
86 sortby => ($webvar{revrec} eq 'n' ? 'type,host' : 'type,val'), sortorder => 'ASC', offset => 'all');
87foreach my $rec (@$reclist) {
88 $rec->{type} = $typemap{$rec->{type}};
89 $rec->{val} .= '.' if $rec->{type} ne 'A' && $rec->{type} ne 'TXT' && $webvar{revrec} eq 'n' && $rec->{val} !~ /\.$/;
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';
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 }
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
106exit;
107
108sub 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}
Note: See TracBrowser for help on using the repository browser.