#!/usr/bin/perl

# Caezar's Challenge 5b - by h1kari and CommPort5.
# Shouts to BasharTeg for his help with the bug list and question answers.
# 
# 5bhack.pl v0.01 - discovers common bugs within ascii based tcp protocols
# using captured sessions and generic protocol information.
#
# this is an extremely generalized proof-of-concept, so manual checking of the
# results must be done for accurate detection. possible future features should
# include more intelligent protocol support and intuitive scripting for
# protocol-specific symantics.
#
# NOTE: capture file must be in a format compatible to the sample capture file
# included

# config vars
my $maxread    = 4096;
my $recvtout   = 0.1;
my $vulnchkstr = '../../../../../.../..../...../*?+[]^$(){}\'";<>|%s%d%p%n';
my $_5ba_incr  = 4096;
my $_5ba_tries = 3;
my $_5bg_tries = 10;
my $_5bg_tout  = 0.1;

# parse input and initialize
use Net::Telnet;

($ARGV[2]) or
 die "5bhack.pl - for caezar's challenge's question 5b - by h1kari and CommPort5.\n".
 "usage: $0 <capture file> <host> <port> <tests a-i> [verbose level]\n".
 "  verbose:\n".
 "    0/undef - only print necessary information\n".
 "    1       - print high verbose for necessary information\n".
 "    2       - print lower-risk information\n".
 "    3       - print high verbose for lower-risk information\n";

require $ARGV[0];
my $host    = $ARGV[1];
my $ip      = &host2ip($host);
my $port    = $ARGV[2];
my @tests   = split //, $ARGV[3];
my $verbose = $ARGV[4];

# run tests
for(@tests)
{
  if($_ =~ /^[a-i]$/)
  {
    print "----------------[ running test 5b$_....\n";
    eval "&try_5b$_";
  }
}

# 5ba functions
sub try_5ba
{
  for(1..$_5ba_tries)
  {
    my @sessions = &get_5ba_sessions(($_ * $_5ba_incr) + 1);
    &send_std_session(1, \@sessions);
  }
}

sub get_5ba_sessions
{
  my $size = @_[0];
  my(@sessions, $i, $j, $k);
  $i = 0;

  foreach $j (0..$#send)
  {
    my @words = split /$sepregex+/, $send[$j];
    foreach $k (0..$#words)
    {
      my @words_temp = @words;
      $words_temp[$k] = $words_temp[$k] ."A"x($size - length($words_temp[$k]));
      @{$sessions[$i]} = @send;
      $sessions[$i++][$j] = join $seperator, @words_temp;
    }
  }

  return @sessions;
}

# 5bb functions
sub try_5bb
{
  my @sessions = &get_5bb_sessions;
  &send_std_session(2, \@sessions);
}

sub get_5bb_sessions
{
  my(@sessions, $i, $j, $k, $l, %nums);
  $i = 0;

  foreach $j (0..$#send)
  {
    my @words = split /$sepregex+/, $send[$j];
    foreach $k (0..$#words)
    {
      if($words[$k] =~ /^\-?[0-9]+$/)
      {
        $nums{$words[$k]} = 1;
      }
    }
  }

  foreach $j (0..$#send)
  {
    my @words = split /$sepregex+/, $send[$j];
    foreach $k (0..$#words)
    {
      if($words[$k] =~ /^\-?[0-9]+$/)
      {
        my @words_temp = @words;
        foreach $l (keys(%nums))
        {
          if($words_temp[$k] == $l) { next }
          $words_temp[$k] = $l;
          @{$sessions[$i]} = @send;
          $sessions[$i++][$j] = join $seperator, @words_temp;
        }
      }
    }
  }

  return @sessions;
}

# 5bc functions
sub try_5bc
{
  my @sessions = &get_5bc_sessions;
  &send_std_session(1, \@sessions);
}

sub get_5bc_sessions
{
  my(@sessions, $i, $j, $k);
  $i = 0;

  foreach $j (0..$#send)
  {
    my @words = split/$sepregex+/, $send[$j];
    foreach $k (0..$#words)
    {
      if($words[$k] =~ /^\-?[0-9]+$/)
      {
        my @words_temp = @words;
        # first replace with 0
        if($words[$k] != 0)
        {
          $words_temp[$k] = 0;
          @{$sessions[$i]} = @send;
          $sessions[$i++][$j] = join $seperator, @words_temp;
        }
        # then with the inverse of the number or -1 if it's 0.
        ($words_temp[$k] ? ($words_temp[$k] *= -1) : ($words_temp[$k] = -1));
        @{$sessions[$i]} = @send;
        $sessions[$i++][$j] = join $seperator, @words_temp;
      }
    }
  }

  return @sessions;
}

# 5bd functions
sub try_5bd
{
  my $i;
  my @sessions = &get_5bd_sessions;

  # implementation isn't the best, but it outlines what needs to be done.
  foreach $i (0..$#sessions)
  {
    my(@temp_send, @temp_sessions);
    @{$temp_send[0]} = @send;
    @{$temp_sessions[0]} = @{$sessions[$i]};
    if(!fork)
    {
      &send_std_session(0, \@temp_sessions);
      exit;
    }
    &send_std_session(1, \@temp_send);
    # wait until child process is reaped
    while(wait != -1) { wait }
  }
}

sub get_5bd_sessions
{
  my(@sessions, $i, $l, $combos);
  $i = 0;

  $l = newcombo main(@send);
  while(@{$sessions[$i++]} = $l->nextcombo) { }

  return @sessions;
}

# 5be functions
sub try_5be
{
  my $i;
  my @sessions = &get_5be_sessions;
  &send_std_session(1, \@sessions);
}

sub get_5be_sessions
{
  my(@sessions, $i, $l, $combos);
  $i = 0;

  $l = newcombo main(@send);
  while(@{$sessions[$i++]} = $l->nextcombo) { }

  return @sessions;
}

# 5bf functions
sub try_5bf
{
  my @sessions = &get_5bf_sessions;
  &send_std_session(2, \@sessions);
}

sub get_5bf_sessions
{
  my(@sessions, $i, $j, $k);
  $i = 0;
    
  foreach $j (0..$#send)
  {
    my @words = split /$sepregex+/, $send[$j];
    foreach $k (0..$#words)
    {
      my @words_temp = @words;
      # lets try adding the vuln checking string to both the front and end
      $words_temp[$k] = $words[$k] .$vulnchkstr;
      @{$sessions[$i]} = @send;
      $sessions[$i++][$j] = join $seperator, @words_temp;
      $words_temp[$k] = $vulnchkstr. $words[$k];
      @{$sessions[$i]} = @send;
      $sessions[$i++][$j] = join $seperator, @words_temp;
    }
  }

  return @sessions;
}

# 5bg functions
sub try_5bg
{
  my $temp_tout = $recvtout;
  my($sessions, $recvs) = &get_5bg_sessions;

  &send_std_session(1, $sessions, $recvs);
}

sub get_5bg_sessions
{
  my(@sessions, @recvs, $i, $j, $k);
  $i = 0;

  foreach $j (0..$#send)
  {
    if(!$send[$j]) { next }

    $k = 0;
    for(0..$#send)
    {
      if($_ == $j)
      {
        for(0..$_5bg_tries)
        {
          $sessions[$i][$k] = $send[$j];
          $recvs[$i][$k++] = $recv[$j];
        }
      }
      else
      {
        $sessions[$i][$k] = $send[$_];
        $recvs[$i][$k++] = $recv[$_];
      }
    }
    $i++;
  }

  return(\@sessions, \@recvs);
}

# 5bh functions
sub try_5bh
{
  my @sessions = &get_5bh_sessions;
  &send_std_session(2, \@sessions);
}

sub get_5bh_sessions
{
  my(@sessions, $i, $j, $k);
  $i = 0;

  foreach $j (0..$#send)
  {
    my @words = split/$sepregex+/, $send[$j];
    foreach $k (0..$#words)
    {
      if($words[$k] =~ /^\-?[0-9]+$/ && $words[$k] != 0)
      {
        my @words_temp = @words;
        # then with the inverse of the number or -1 if it's 0.
        $words_temp[$k] *= -1;
        @{$sessions[$i]} = @send;
        $sessions[$i++][$j] = join $seperator, @words_temp;
      }
    }
  }

  return @sessions;
}

# 5bi functions
sub try_5bi
{
  my @sessions = &get_5bi_sessions;
  &send_std_session(2, \@sessions);
}

sub get_5bi_sessions
{
  my(@sessions, $i, $j, $k);
  $i = 0;

  foreach $j (0..$#send)
  {
    my @words = split /$sepregex+/, $send[$j];
    foreach $k (0..$#words)
    {
      my @words_temp = @words;
      $words_temp[$k] = &urlescape($words[$k]);
      @{$sessions[$i]} = @send;
      $sessions[$i++][$j] = join $seperator, @words_temp;
      # lets try adding the vuln checking string to both the front and end
      $words_temp[$k] = &urlescape($words[$k] .$vulnchkstr);
      @{$sessions[$i]} = @send;
      $sessions[$i++][$j] = join $seperator, @words_temp;
      $words_temp[$k] = &urlescape($vulnchkstr. $words[$k]);
      @{$sessions[$i]} = @send;
      $sessions[$i++][$j] = join $seperator, @words_temp;
    }
  }

  return @sessions;
}

# general functionality
sub connectto
{
  my $t = new Net::Telnet(
   Host => $host,
   Port => $port,
   Telnetmode => 0,
   Timeout => $recvtout);
  $t->errmode('return');
  $t->open();
  return $t;
}

# 5b sending functions
# errlevel == 1, check for disconnect
# errlevel == 2, check for different responses
# search == 1, check only the first word in the string
# search == -1, search the full recv string
sub send_std_session
{
  my $errlevel = $_[0];
  my @sessions = @{$_[1]};
  my @recvs    = @{$_[2]};
  my($i, $j, @responses);

  foreach $i (0..$#sessions)
  {
    my $err = 0;
    my $t = &connectto;
    my @temp_recvs = defined($_[2]) ? @{$recvs[$i]} : @recv;
  

    foreach $j (0..$#temp_recvs)
    {
      if($err == 1) { next }
      # wait for receive before flushing input.
      ($sessions[$i][$j]) and $t->print($sessions[$i][$j]);
      my $line = $t->getline;
      while($t->getline) { }
      $line =~ s/[\r\n]+$//g; $line =~ s/[\r\n]+/\\n/g;

      if($temp_recvs[$j] =~ /^([^$sepregex]+)/)
      {
        my $search = &escaperegex($1);
        $search =~ s/[\r\n]+/\\n/g;

        if(!defined($line) && ($errlevel == 1 || $verbose > 1))
        {
          print "------[ ! connection closed, sent: $sessions[$i][$j], ".
           "expect: $1, recv: $line\n";
          &printsessverbose(\@{$sessions[$i]}, \@{$responses[$i]})
           if(($errlevel == 1 && $verbose > 0) ||
           ($errlevel == 2 && $verbose > 2));
          $err = 1;
        }
        if(defined($line) &&
         ($line !~ /$search/ && ($errlevel == 2 || $verbose > 1)))
        {
          print "------[ ! sent: $sessions[$i][$j], expect: $1, recv: $line\n";
          &printsessverbose(\@{$sessions[$i]}, \@{$responses[$i]})
           if(($errlevel == 2 && $verbose > 0) ||
           ($errlevel == 1 && $verbose > 2));
        } 
        $responses[$i][$j] = $line;
      }
    }
    $t->close();
  }
}

# misc functions
sub host2ip
{
  return join(".", unpack("C4", (gethostbyname($_[0]))[4]));
}

sub escaperegex
{
  my $search = $_[0];
  $search =~ s/([^0-9a-zA-Z])/\\$1/g;
  return $search;
}

sub urlescape
{
  my $url = $_[0];
  $url =~ s/(.)/sprintf("%%%x", ord($1))/eg;
  return $url;
}

sub printsessverbose
{
  my @sessions = @{$_[0]};
  my @responses = @{$_[1]};
  my $k;

  foreach $k (0..$#responses)
  {
    ($sessions[$k]) and print "--[ send $k: $sessions[$k]\n";
    ($responses[$k]) and print "--[ recv $k: $responses[$k]\n";
  }
}

# combinations oop functions
sub newcombo
{
  $class = shift;
  $list = [ @_ ];
  bless [$list, [0 .. $#$list]], $class;
}

sub nextcombo
{
  $self = shift;
  $list = $self->[0];
  $tot = $self->[1];
  return unless @$tot;
  @next = @$tot;
  @end = pop @next;
  while (@next && $next[-1] > $end[-1])
  {
    push(@end, pop(@next));
  }
  if (defined($extra = pop(@next)))
  {
    ($place) = grep $extra < $end[$_], 0 .. $#end;
    ($extra, $end[$place]) = ($end[$place], $extra);
    $self->[1] = [@next, $extra, @end];
  }
  else
  {
    $self->[1] = [];
  }
  return @$list[@$tot];
}