check.cgi

   1 #!/usr/bin/perl
   2 #
   3 #  A Simple WWW interface for Sleuth domain checker
   4 #  (c) 1999--2001 Martin Mares <mj@ucw.cz>
   5 #
   6
   7 # Load configuration file and all modules we need
   8
   9 BEGIN { require "check.conf"; }
  10
  11 use CGI;
  12 use IO::Handle;
  13
  14 $query = new CGI;
  15 print $query->header;
  16
  17 $domain = $query->param('domain');
  18 $server = $query->param('server');
  19 $serverip = $query->param('serverip');
  20 $verbose = $query->param('verbose');
  21 $secondary = $query->param('secondary');
  22 $submitter = $query->param('submitter');
  23 $submit = "Submit";
  24
  25 $stylesheet = <<EOF
  26 #headbar {
  27    background-color: #4c3bff; color: #fffa45; margin: 0 15%; padding: 1ex;
  28    text-align: center;
  29    border: solid white;
  30    border-width: 1px;
  31 }
  32 #headbox1 {
  33    position: absolute;
  34    width: 15%;
  35    top: 0; bottom: auto; left: 0; right: auto;
  36    text-align: center;
  37 }
  38 #headbox2 {
  39    position: absolute;
  40    width: 15%;
  41    top: 0; bottom: auto; left: auto; right: 0;
  42    text-align: center;
  43 }
  44 #querybox {
  45    background-color: #ffffb0;
  46    color: black;
  47    margins: 0 15%;
  48    padding: 1ex 2ex;
  49    border: solid black;
  50    border-width: 1px;
  51 }
  52 #querybox TD {
  53    padding: 0.5ex 1ex;
  54 }
  55 TD#qbhead {
  56    font-size: 150%;
  57    font-weight: bold;
  58    text-align: center;
  59    padding-bottom: 1ex;
  60 }
  61 .singline { display: block }
  62 .collapse { margin: 0 0 }
  63 .msgW { color: #9e6500; font-style: normal; }
  64 .msgE, .msgF { color: #d73a05; font-style: normal; }
  65 EOF
  66 ;
  67
  68 print $query->start_html(       -title=>"DNS Sleuth",
  69                                 -author=>"$admin_email",
  70                                 -dtd=>'-//W3C//DTD HTML 4.01//EN',
  71                                 -style=>{-code=>$stylesheet}
  72                         );
  73
  74 print <<EOF
  75 <div id=headbar align=center>
  76 <h2 class=collapse>The DNS Sleuth</h2>
  77 <p class=collapse style="margin-top: 1ex">An online tool for checking of DNS zones
  78 </div>
  79 <div id=headbox1 align=center>
  80 <p><A HREF="ftp://atrey.karlin.mff.cuni.cz/pub/local/mj/net/sleuth-$version.tar.gz">Sleuth</A> version $version ($rev_date)
  81 </div>
  82 <div id=headbox2 align=center>
  83 <p>
  84 <span class=singline>Written by</span>
  85 <span class=singline>$author_ref</span>
  86 <span class=singline><a href="mailto:$author_email">&lt;$author_email&gt;</a></span>
  87 </div>
  88 EOF
  89 ;
  90
  91 if ($secondary_ns eq "") {
  92         $secondary = '';
  93 }
  94 $msg = "New query";
  95 if ($domain eq "") {
  96         print <<EOF
  97 <P>This is an online version of Sleuth -- a detector
  98 of common errors in DNS zones.
  99
 100 <P>To check a zone, just enter its name in the form below. You can explictly
 101 specify a name server to be asked for zone data and if its name isn't available
 102 from the public DNS, then also its IP address. If you select the verbose mode,
 103 you will also get a full dump of the zone at no extra cost.
 104 EOF
 105 ;
 106         if ($secondary_ns ne "") {
 107                 print <<EOF
 108 <P>If you want to submit a request for secondary DNS service, fill in all
 109 form fields and check the "request secondary" box. The secondary server will
 110 run on <CODE>$secondary_ns</CODE>, so don't forget to list it as an
 111 authoritative server in your zone file.
 112 EOF
 113 ;
 114         }
 115         print <<EOF
 116 <P>If you want to run Sleuth on your own machine, just <a href="ftp://atrey.karlin.mff.cuni.cz/pub/local/mj/net/">download</a>
 117 the latest version from our FTP server. Sleuth is free software, you can freely use and distribute it according
 118 to the <a href="http://www.gnu.org/copyleft/">GNU General Public License</a>.
 119 <P>If this page looks a bit fruitless, but otherwise displayed correctly,
 120 it's probably because your browser doesn't support the <a href="http://www.w3.org/Style/CSS/">Cascading
 121 Style Sheets</a> which are The Right Way to define presentation of HTML documents.
 122 In case this page looks a bit weird, your browser probably tries
 123 to support the style sheets, but does it wrongly (hello, Netscape 4).
 124 EOF
 125 ;
 126 } elsif ($secondary ne "" && $server eq "") {
 127         $msg = "Missing server name";
 128 } elsif ($secondary ne "" && $serverip eq "") {
 129         $msg = "Missing server IP";
 130 } elsif ($secondary ne "" && $submitter eq "" && $need_submitter) {
 131         $msg = "Please fill in who is submitting the zone";
 132 } elsif ($server !~ /^[0-9A-Za-z.-]*$/ ||
 133          $serverip !~ /^(\d+\.\d+\.\d+\.\d+)?$/ ||
 134          $domain !~ /^[0-9A-Za-z.-]*$/ ||
 135          $submitter !~ /^[0-9A-Za-z.\240-\376 -]*$/) {
 136         $msg = "Incorrect parameter syntax";
 137 } elsif ($secondary ne "" && defined $sec_ns_addr_space &&
 138         unpack("H8",pack("c4",split(/\./,$serverip))) !~ $sec_ns_addr_space) {
 139         $msg = "Name server address out of permitted range";
 140 } else {
 141         print "<H2>Check results for $domain</H2>\n";
 142         @c = "./sleuth";
 143         if ($verbose ne "") { push @c, "-v"; }
 144         push @c, "-h", $domain, $server;
 145         if ($serverip ne "") { push @c, $serverip; }
 146         if ($secondary ne "") { push @c, $secondary_ns, $secondary_ns_ip; }
 147         STDOUT->flush();
 148         $rc = system @c;
 149         if ($secondary ne "") {
 150                 if ($rc / 256) {
 151                         print "<P>Request for secondary DNS service rejected because of errors in the zone.\n";
 152                         print "<P>If you have any questions, please ask $admin_ref.\n";
 153                 } else {
 154                         print "<P>Forwarding your secondary DNS service request to $admin_ref\n";
 155                         print "who will notify you by e-mail sent to the hostmaster address given in the\n";
 156                         print "SOA record when the secondary server will be configured.\n";
 157                         shift @c;
 158                         while ($c[0] =~ /^-[vh]$/) { shift @c; }
 159                         $ru = $query->remote_user;
 160                         ($rh = $query->remote_host) =~ s/[^A-Za-z0-9. \240-\376-]/?/g;
 161
 162                         # "@c" might look insecure, but we know all the names have been correctly
 163                         # validated by the first sleuth run.
 164                         &{sub {
 165                                 local *HMSLEUTH;
 166                                 open(HMSLEUTH,"./sleuth -m @c|") or return;
 167                                 my $hostmaster = "";    # default
 168                                 /^\. Hostmaster e-mail address is (.*)$/m and $hostmaster=$1  while <HMSLEUTH>;
 169                                 close HMSLEUTH;
 170
 171                                 local *MAILCMD;
 172                                 open(MAILCMD,"|(cat;./sleuth @c)|/usr/sbin/sendmail -oi -oee -t") or return;
 173                                 print MAILCMD (!$hostmaster ? "" : "Reply-To: \"Hostmaster for $domain\" <$hostmaster>\n"),
 174                                                 <<"EOF";
 175 Subject: New zone
 176 To: $secondaries_to
 177
 178 Domain: $domain
 179 Server: $server [$serverip]
 180 Hostmaster: $hostmaster
 181 User: $ru
 182 From: $submitter ($rh)
 183
 184 EOF
 185                                 close MAILCMD;
 186                                 1;
 187                         }} or print "<P><EM>Forwarding failed (rc=$?)</EM>\n";
 188                 }
 189         }
 190         print "<hr>\n";
 191 }
 192
 193 print $query->startform(-method=>'GET');
 194 print "\
 195 <p><table align=center border=0 id=querybox>\n\
 196 <tr><td colspan=4 align=center id=qbhead>$msg</td></tr>\n";
 197 print "<tr><td><em>Domain:</em></td><td>", $query->textfield('domain'), "</td>\n";
 198 print "<td><em>Verbose output:</em></td><td>", $query->checkbox(-name=>'verbose',value=>'ON',-label=>''), "</td></tr>\n";
 199 print "<tr><td><em>Server name:</em></td><td>", $query->textfield('server'), "</td>\n";
 200 print "<td><em>Server IP:</em></td><td>", $query->textfield('serverip'), "</td></tr>\n";
 201 if ($secondary_ns ne "") {
 202         print "<tr><td><em>Request secondary:</em></td><td>", $query->checkbox(-name=>'secondary',value=>'ON',-label=>''), "</td>\n";
 203         print "<td><em>Your name:</em></td><td>", $query->textfield('submitter'), "</td></tr>\n";
 204 }
 205 print "<tr><td colspan=4 align=center>", $query->submit('action', 'Submit'), "</td></tr>\n";
 206 print "</table>\n";
 207 print $query->endform;
 208
 209 print "<div align=center><p>Please <a href=\"mailto:$author_email\">send</a> your bug reports and suggestions to $author_ref.</div>\n";
 210 print $query->end_html;
 211 print "\n";