fireartist has asked for the wisdom of the Perl Monks concerning the following question:

Below is a CGI program used to perform network queries such as gethostbyaddr, ping, whois etc.

I'm running under taint. Can anyone see any security issues with it? Does anyone have practical suggestions of how to deal with DOS attacks. (I'm assuming anyone that might want to do that would be able to spoof their IP address.

The main program logic can be seen between the "parse_input();" and "exit;" lines.

update: edited non-standard sh-bang line + force wrapped long lines. 
#!/usr/bin/perl -T
use strict;
use warnings;
delete $ENV{PATH};
use CGI;
$CGI::DISABLE_UPLOADS = 1;

#use CGI::Carp 'fatalsToBrowser';
#use Data::Dumper;

use Data::FormValidator;
use File::Basename;
use HTML::Template;
use HTML::TokeParser::Simple;
use Socket;
#requires...
# Net::DNS
# URI

# ping - include 'count' flag if needed!
my $ping_exec = '/usr/sbin/ping';

# traceroute
# -m maxhop, default 30
# -Q maxtimeout, default 5
# -q nqueries, default 3
# -w waittime, default 5
my $traceroute_exec = '/usr/sbin/traceroute -Q 3 -w 3';

my $whois_exec = '/bin/whois';


my $cgi = CGI->new;

my %valid;    # valid input from Data::FormValidator
my @invalid;  # these will be flagged with css, class="alert"
my %tmpl;     # to be used by HTML::Template->param
my %form;     # form <input name="" value=""> pairs


# used for automated form filling and Data::FormValidator 
# profile generation
my @ip_parts = qw/ ip iphost ipping iptraceroute /;
my @hosts = qw/ host nameserver hostmx hostping 
    hosttraceroute whois /;


parse_input();

pre_fill_form();

process() unless @invalid;

my $html = fill_template();

my $output = fill_form( \$html );

print $cgi->header;
print $output;
exit;


sub parse_input {
  my %param = $cgi->Vars;
  
  my $results = Data::FormValidator->check( \%param, input_profile() )
+;
  
  my $ok = $results->valid;
  
  for (keys %$ok) {
    $valid{$_} = $ok->{$_};
  }
  
  for ($results->missing, $results->invalid) {
    push @invalid, $_;
  }
  
  return;
}


sub pre_fill_form {
  my @id = keys %{ input_profile()->{constraints} };
  
  for (@id) {
    $form{$_} = $valid{$_} if exists $valid{$_};
  }
  
  return;
}


sub process {
  if ($valid{ipsubmit}) {
    ip_to_hex();
  }
  elsif ($valid{hexsubmit}) {
    hex_to_ip();
  }
  elsif ($valid{iphostsubmit}) {
    ip_to_hostname();
  }
  elsif ($valid{hostsubmit}) {
    hostname_to_ip();
  }
  elsif ($valid{nameserversubmit}) {
    nameservers();
  }
  elsif ($valid{hostmxsubmit}) {
    mxrecords();
  }
  elsif ($valid{ippingsubmit}) {
    $valid{run} 
    ? ping(join('.', map {$form{"ipping$_"}} (1..4))) 
    : ping_ip();
  }
  elsif ($valid{hostpingsubmit}) {
    $valid{run} 
    ? ping($valid{hostping}) 
    : ping_host();
  }
  elsif ($valid{iptraceroutesubmit}) {
    $valid{run} 
    ? traceroute(
      join('.', map {$form{"iptraceroute$_"}} (1..4))) 
    : traceroute_ip();
  }
  elsif ($valid{hosttraceroutesubmit}) {
    $valid{run} 
    ? traceroute($valid{hosttraceroute}) 
    : traceroute_host();
  }
  elsif ($valid{whois}) {
    $valid{run} 
    ? whois($valid{whois}) 
    : whois_host();
  }
  
  return;
}


sub fill_template {
  my $tmpl = HTML::Template->new(filehandle => *DATA);
  
  $tmpl->param( 
    %tmpl,
  );
  
  return $tmpl->output;
}


sub fill_form {
  my ($html) = @_;
  
  my $parser = HTML::TokeParser::Simple->new($html);
  my $new;
  
  while (my $t = $parser->get_token) {
    if ($t->is_start_tag('form')) {
      $t->set_attr('action', basename($0));
      
      $new .= $t->as_is;
    }
    elsif ($t->is_start_tag('input')) {
      
      for my $key (keys %form) {
        $t->set_attr('value', $form{$key})
          if $t->get_attr('name') eq $key;
      }
      
      for (@invalid) {
        $t->set_attr('class', 'alert')
          if $t->get_attr('name') eq $_;
      }
      
      $new .= $t->as_is;
    }
    else {
      $new .= $t->as_is;
    }
  }
  
  return $new;
}


### Calculation subs


sub ip_to_hex {
  for (1..4) {
    $form{"hex$_"} = sprintf("%02x", $valid{"ip$_"});
  }
  
  fill_form_ip_parts( 'ip' );
  
  $tmpl{result} = join('', map {$form{"hex$_"}} (1..4));
  
  return;
}


sub hex_to_ip {
  for (1..4) {
    $form{"ip$_"} = hex($valid{"hex$_"});
    
    $form{"hex$_"} = $valid{"hex$_"};
  }
  
  fill_form_ip_parts( 'ip' );
  
  $tmpl{result} = join('.', map {$form{"ip$_"}} (1..4));
  
  return;
}


sub ip_to_hostname {
  my $ip = join('.', map {$valid{"iphost$_"}} (1..4));
  
  $ip = inet_aton($ip);
  
  my ($host) = gethostbyaddr($ip, AF_INET);
  
  if ($host) {
    $form{host} = $host;
    
    fill_form_hosts( 'host' );
  }
  else {
    $host = 'unknown';
  }
  
  fill_form_ip_parts( 'iphost' );
  
  $tmpl{result} = $host;
  
  return;
}


sub hostname_to_ip {
  require Net::DNS;
  my $res   = Net::DNS::Resolver->new;
  my $query = $res->search($valid{host});
  
  if ($query) {
    my @valid_ip;
    
    for my $rr (grep { $_->type eq 'A' } $query->answer) {
      push @valid_ip, $rr->address;
    }
    
    $tmpl{result} = join "\n", @valid_ip;
    
    @form{qw/ iphost1 iphost2 iphost3 iphost4 /} = 
      split /\./, $valid_ip[0];
    
    fill_form_ip_parts( 'iphost' );
    
    fill_form_hosts( 'host' );
  }
  else {
    push @invalid, 'host';
  }
  
  return;
}


sub nameservers {
  require Net::DNS;
  my $res   = Net::DNS::Resolver->new;
  my $query = $res->query($valid{nameserver}, "NS");
  
  if ($query) {
    my @valid_ns;
    
    for my $rr (grep { $_->type eq 'NS' } $query->answer) {
      push @valid_ns, $rr->nsdname;
    }
    
    $tmpl{result} = join "\n", @valid_ns;
  }
  else {
    push @invalid, 'nameserver';
  }
  
  fill_form_hosts( 'nameserver' );
  
  return;
}


sub mxrecords {
  require Net::DNS;
  my $res = Net::DNS::Resolver->new;
  my @mx  = mx($res, $valid{hostmx});
  my @valid;
  
  if (@mx) {
    for (@mx) {
      push @valid, [$_->preference, $_->exchange];
    }
    
    $tmpl{result} = 
      join "\n", 
        map {$_->[1]} 
          sort {$a->[0]<=>$b->[0]} @valid;
  }
  else {
    push @invalid, 'hostmx';
  }
  
  fill_form_hosts( 'hostmx' );
  
  return;
}


sub ping_ip {
  require URI;
  my $url = URI->new (basename($0));
  
  $url->query_form(
    ipping1      => $valid{ipping1},
    ipping2      => $valid{ipping2},
    ipping3      => $valid{ipping3},
    ipping4      => $valid{ipping4},
    ippingsubmit => 1,
    run          => 1,
    );
  
  $tmpl{dynamic} = $url;
  
  fill_form_ip_parts( 'ipping' );
}


sub ping_host {
  require URI;
  my $url = URI->new (basename($0));
  
  $url->query_form(
    hostping       => $valid{hostping},
    hostpingsubmit => 1,
    run            => 1,
    );
  
  $tmpl{dynamic} = $url;
  
  fill_form_hosts( 'hostping' );
}


sub ping {
  my ($target) = @_;
  $| = 1;
  
  print $cgi->header;
  print "<pre>";
  print "$ping_exec $target\n\n";
  
  print `$ping_exec $target`;
  
  print "</pre>";
  exit;
}


sub traceroute_ip {
  require URI;
  my $url = URI->new (basename($0));
  
  $url->query_form(
    iptraceroute1      => $valid{iptraceroute1},
    iptraceroute2      => $valid{iptraceroute2},
    iptraceroute3      => $valid{iptraceroute3},
    iptraceroute4      => $valid{iptraceroute4},
    iptraceroutesubmit => 1,
    run                => 1,
    );
  
  $tmpl{dynamic} = $url;
  
  fill_form_ip_parts( 'iptraceroute' );
}


sub traceroute_host {
  require URI;
  my $url = URI->new (basename($0));
  
  $url->query_form(
    hosttraceroute       => $valid{hosttraceroute},
    hosttraceroutesubmit => 1,
    run                  => 1,
    );
  
  $tmpl{dynamic} = $url;
  
  fill_form_hosts( 'hosttraceroute' );
}


sub traceroute {
  my ($target) = @_;
  $| = 1;
  
  print $cgi->header;
  print "<pre>";
  print "$traceroute_exec $target\n\n";
  
  print `$traceroute_exec $target`;
  
  print "</pre>";
  exit;
}


sub whois_host {
  require URI;
  my $url = URI->new (basename($0));
  
  $url->query_form(
    whois       => $valid{whois},
    whoissubmit => 1,
    run         => 1,
    );
  
  $tmpl{dynamic} = $url;
  
  fill_form_hosts( 'whois' );
}


sub whois {
  my ($target) = @_;
  $| = 1;
  
  print $cgi->header;
  print "<pre>";
  print "$whois_exec $target\n";
  
  print `$whois_exec $target`;
  
  print "</pre>";
  exit;
}


###


sub fill_form_ip_parts {
  my ($name) = @_;
  
  for my $part (@ip_parts) {
    for my $num (1..4) {
      $form{"$part$num"} = $form{"$name$num"};
    }
  }
}


sub fill_form_hosts {
  my ($name) = @_;
  
  for my $host (@hosts) {
    $form{$host} = $form{"$name"};
  }
}


### DATA::FormValidator subs


sub input_profile {
  my %ip;
  for my $part (@ip_parts) {
    for my $num (1..4) {
      $ip{"$part$num"} = \&valid_ip_part;
    }
  }
  
  my %host;
  for my $host (@hosts) {
    $host{$host} = \&valid_hostname;
  }
  
  return {
    optional => [qw/
      ip1 ip2 ip3 ip4 ipsubmit 
      hex1 hex2 hex3 hex4 hexsubmit 
      iphost1 iphost2 iphost3 iphost4 iphostsubmit 
      host hostsubmit 
      nameserver nameserversubmit 
      hostmx hostmxsubmit 
      ipping1 ipping2 ipping3 ipping4 ippingsubmit 
      hostping hostpingsubmit 
      iptraceroute1 iptraceroute2 iptraceroute3 
        iptraceroute4 
      iptraceroutesubmit
      hosttraceroute hosttraceroutesubmit 
      whois whoissubmit 
      run 
      /],
    
    dependencies => {
      ipsubmit => [qw/ ip1 ip2 ip3 ip4 /],
      
      hexsubmit => [qw/ hex1 hex2 hex3 hex4 /],
      
      iphostsubmit => 
        [qw/ iphost1 iphost2 iphost3 iphost4 /],
      
      hostsubmit => 'host',
      
      nameserversubmit => 'nameserver',
      
      hostmxsubmit => 'hostmx',
      
      ippingsubmit => 
        [qw/ ipping1 ipping2 ipping3 ipping4 /],
      
      hostpingsubmit => 'hostping',
      
      iptraceroutesubmit => 
        [qw/ iptraceroute1 iptraceroute2 iptraceroute3 
             iptraceroute4 /],
      
      hosttraceroutesubmit => 'hosttraceroute',
      
      whoissubmit => 'whois',
    },
    
    constraints => {
      %ip,
      %host,
      
      hex1 => \&valid_hex_part,
      hex2 => \&valid_hex_part,
      hex3 => \&valid_hex_part,
      hex4 => \&valid_hex_part,
    },
    
    untaint_all_constraints => 1,
  };
}


sub valid_ip_part {
  my $test = shift;
  
  if ($test =~ /^([0-9]{1,3})$/ && $test <= 255) {
    return $1;
  }
}


sub valid_hex_part {
  my $test = shift;
  
  if ($test eq '0') {
    return '0 but true';
  }
  
  if ($test =~ /^([0-9a-f]{1,2})$/) {
    return $1;
  }
}


sub valid_hostname {
  my $test = shift;
  
  my $end = qr'[a-zA-Z0-9]';
  
  my $any = qr'[-a-zA-Z0-9]';
  
  if ($test =~ 
    /^(
      $end        # word must be 1 char long
      (?:
        $any*     # any number of chars
        $end      # must end with valid
      )?          # longer than 1 char is optional
      (?:
        \.        # any further words must start with dot .
        $end
        (?:
          $any*
          $end
        )?
      )*          # further words are optional
      )
    $/x)
  {
    return $1;
  }
}


__DATA__
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<title>Network Utilities</title>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
<script language="JavaScript" type="text/JavaScript">
<!--
function ip_defaults (idname) {
  for (i=1; i<=4; i++) {
    if (! document.getElementById(idname+i).value)
      document.getElementById(idname+i).setAttribute('value', 0);
  }
}
function hex_defaults (idname) {
  for (i=1; i<=4; i++) {
    if (! document.getElementById(idname+i).value)
      document.getElementById(idname+i).setAttribute('value', '00');
  }
}
-->
</script>
<style type="text/css">
<!--
h1 {
  font-family: Verdana, Arial, Helvetica, sans-serif;
  font-size: 1em;
  text-align: center;
}
pre {
  float: left;
  border: 1px solid #000;
  margin: 1em;
  padding: 1em;
}
.function {
  float: left;
  border: 1px solid #000;
  margin: 1em;
  padding: 0em 1em 0em 1em;
}
iframe {
  width: 80%;
  height: 150px;
  overflow: auto;
  border: 1px solid #000;
  margin: 1em;
  padding: 1em;
}
.alert {
  background: #f00;
}
</style>
</head>
<body>
<TMPL_IF result>
  <pre><TMPL_VAR result></pre>
  <br clear="all">
</TMPL_IF>
<TMPL_IF dynamic>
  <iframe src="<TMPL_VAR dynamic>">
    Sorry, your browser doesn't support IFRAME's.
  </iframe>
</TMPL_IF>
<div class="function">
  <h1>IP address to hostname converter</h1>
  <form method="post" action="<TMPL_VAR action>" 
onSubmit="ip_defaults('iphost');">
    <input name="iphost1" type="text" value="" 
id="iphost1" size="3" maxlength="3">
    <input name="iphost2" type="text" value="" 
id="iphost2" size="3" maxlength="3">
    <input name="iphost3" type="text" value="" 
id="iphost3" size="3" maxlength="3">
    <input name="iphost4" type="text" value="" 
id="iphost4" size="3" maxlength="3">
    <input name="iphostsubmit" type="hidden" value="1">
    <input type="submit" name="Submit" value="Convert IP address to ho
+stname">
  </form>
  <form method="post" action="<TMPL_VAR action>">
    <input name="host" type="text" value="" 
id="host" size="30">
    <input name="hostsubmit" type="hidden" value="1">
    <input type="submit" name="Submit" 
value="Convert to hostname to IP address">
  </form>
</div>
<div class="function">
  <h1>IP address to HEX IP adress converter</h1>
  <form method="post" action="<TMPL_VAR action>" 
onSubmit="ip_defaults('ip');">
    <input name="ip1" type="text" value="" 
id="ip1" size="3" maxlength="3">
    <input name="ip2" type="text" value="" 
id="ip2" size="3" maxlength="3">
    <input name="ip3" type="text" value="" 
id="ip3" size="3" maxlength="3">
    <input name="ip4" type="text" value="" 
id="ip4" size="3" maxlength="3">
    <input name="ipsubmit" type="hidden" value="1">
    <input type="submit" name="Submit" 
value="Convert to hex">
  </form>
  <form method="post" action="<TMPL_VAR action>" 
onSubmit="hex_defaults('hex');">
    <input name="hex1" type="text" value="" 
id="hex1" size="2" maxlength="2">
    <input name="hex2" type="text" value="" 
id="hex2" size="2" maxlength="2">
    <input name="hex3" type="text" value="" 
id="hex3" size="2" maxlength="2">
    <input name="hex4" type="text" value="" 
id="hex4" size="2" maxlength="2">
    <input name="hexsubmit" type="hidden" value="1">
    <input type="submit" name="Submit" 
value="Convert to numeric">
  </form>
</div>
<br clear="all">
<div class="function">
  <h1>Ping</h1>
  <form method="post" action="<TMPL_VAR action>" 
onSubmit="ip_defaults('ipping');">
    <input name="ipping1" type="text" value="" 
id="ipping1" size="3" maxlength="3">
    <input name="ipping2" type="text" value="" 
id="ipping2" size="3" maxlength="3">
    <input name="ipping3" type="text" value="" 
id="ipping3" size="3" maxlength="3">
    <input name="ipping4" type="text" value="" 
id="ipping4" size="3" maxlength="3">
    <input name="ippingsubmit" type="hidden" value="1">
    <input type="submit" name="Submit" 
value="Ping IP address">
  </form>
  <form method="post" action="<TMPL_VAR action>">
    <input name="hostping" type="text" value="" id="hostping" size="30
+">
    <input name="hostpingsubmit" type="hidden" value="1">
    <input type="submit" name="Submit" value="Ping hostname">
  </form>
</div>
<div class="function">
  <h1>Traceroute</h1>
  <form method="post" action="<TMPL_VAR action>" 
onSubmit="ip_defaults('iptraceroute');">
    <input name="iptraceroute1" type="text" 
value="" id="iptraceroute1" size="3" maxlength="3">
    <input name="iptraceroute2" type="text" 
value="" id="iptraceroute2" size="3" maxlength="3">
    <input name="iptraceroute3" type="text" 
value="" id="iptraceroute3" size="3" maxlength="3">
    <input name="iptraceroute4" type="text" 
value="" id="iptraceroute4" size="3" maxlength="3">
    <input name="iptraceroutesubmit" type="hidden" 
value="1">
    <input type="submit" name="Submit" 
value="Traceroute to IP address">
  </form>
  <form method="post" action="<TMPL_VAR action>">
    <input name="hosttraceroute" type="text" 
value="" id="hosttraceroute" size="30">
    <input name="hosttraceroutesubmit" 
type="hidden" value="1">
    <input type="submit" name="Submit" 
value="Traceroute to hostname">
  </form>
</div>
<br clear="all">
<div class="function">
  <h1>List hostname's nameservers</h1>
  <form method="post" action="<TMPL_VAR action>">
    <input name="nameserver" type="text" 
value="" id="nameserver" size="30">
    <input name="nameserversubmit" type="hidden" 
value="1">
    <input type="submit" name="Submit" 
value="List nameservers">
  </form>
</div>
<div class="function">
  <h1>List hostname's MX records</h1>
  <form method="post" action="<TMPL_VAR action>">
    <input name="hostmx" type="text" 
value="" id="hostmx" size="30">
    <input name="hostmxsubmit" type="hidden" value="1">
    <input type="submit" name="Submit" 
value="List MX records">
  </form>
</div>
<div class="function">
  <h1>WHOIS query</h1>
  <form method="post" action="<TMPL_VAR action>">
    <input name="whois" type="text" value="" 
id="whois" size="30">
    <input name="whoissubmit" type="hidden" value="1">
    <input type="submit" name="Submit" 
value="WHOIS query">
  </form>
</div>
</body>
</html>

[download]

Replies are listed 'Best First'.
Re: RFC: CGI program - any security holes?
by PodMaster (Abbot) on Mar 19, 2005 at 10:41 UTC
    Does anyone have practical suggestions of how to deal with DOS attacks.
    Why are you worried about DOS attacks? The least you can do is adjust $CGI::POST_MAX and $CGI::DISABLE_UPLOADS, but the general public shouldn't have access to this program, so you shouldn't have to worry about DOS, but you should read merlyn's Watching long processes through CGI.

    MJD says "you can't just make shit up and expect the computer to know what you mean, retardo!"
    I run a Win32 PPM repository for perl 5.6.x and 5.8.x -- I take requests (README).
    ** The third rule of perl club is a statement of fact: pod is sexy.

[reply]
Re: RFC: CGI program - any security holes?
by tlm (Prior) on Mar 19, 2005 at 14:56 UTC

    I feel your pain and all, but that's a lot of code for a busy monk to read, especially if the monk is in search of possible security holes. You need to figure out which are "the naughty bits" and discuss those. (Provide the rest of the code for context, maybe as a <readmore> addendum, if you wish.)

    Good luck.

    the lowliest monk

[reply]
[d/l]
      Definitely! Looking for security problem is an long an involved process. I don't think you'll find many of us (if any) to take a look at a long program like that for fun. At best, we might glance at it and spot glaring mistakes.
[reply]
A reply falls below the community's threshold of quality. You may see it by logging in.

Back to Seekers of Perl Wisdom