Summerschool Aachen 2004/Project Day I

HTTP Tunnelling

I was planning to implement in my project first a simple program and then extend it to a more "advanced" program: Assume we have a host H1 behind a firewall F who wants to communicate with a host H2 who is outside the firewall. Let us further assume that the firewall F only lets HTTP packets through, i.e. packets with destination port 80, and assume that host H1 wants to build up an SSH connection with host H2. I want first to write a (static) C program run on a host X between host H1 and H2, such that H1 can contact build up an SSH connection with X at port 80 (meaning that the traffic will be let through by F) and X forwards the traffic to H2 at port 22. F should also forward the traffic from H2 to H1. Later I want to extend this program to a more dynamic program in a way that H1 can tell X with whom he wants to build up an SSH connection and X does this. If there is still some time left (which I hope there will be :)) I would like to extend that program to a more generic program which cannot only forward SSH traffic but also SMTP and other kinds of traffic. I know that there are probably already many tunnelling programs doing such kinds of things. However, as I don't have that much experience of network programming (except a small webserver I have once set up in Java) I think that such a project will help me to improve my skills in network programming.

--Samad Nasserian

Fingerprinting Tool in perl

This is the current version of the fingerprinting tool, I'm working on.

#!/usr/bin/perl -w

use strict;

# ---------------------------------------------------------------------------------
package Net::DNS::PacketExt;

   use strict;
   use vars qw(@ISA);

   @ISA = qw(Net::DNS::Packet);

   sub new
   {
      my $proto = shift;
      my $class = ref $proto || $proto;
      my $data  = shift;

      my $self = Net::DNS::Packet->new($data);
      $self->{"header"} = Net::DNS::HeaderExt->new($data);

      bless $self, $class;
      return $self;
   }

1;

# ---------------------------------------------------------------------------------

package Net::DNS::HeaderExt;

   use strict;
   use vars qw(@ISA);

   @ISA = qw(Net::DNS::Header);

   sub new
   {
      my $proto = shift;
      my $class = ref $proto || $proto;
      my $data  = shift;

      my $self = Net::DNS::Header->new($data);

      my @a = unpack("n C2 n4", $$data);

      $self->{"z0"} = ($a[2] >> 6) & 0x1;
      $self->{"z1"} = ($a[2] >> 5) & 0x1;
      $self->{"z2"} = ($a[2] >> 4) & 0x1;

      bless $self, $class;
      return $self;
   }

1;

# ---------------------------------------------------------------------------------

package MapTool;

   use strict;
   use Carp;

   sub new
   {
      my $proto = shift;
      my $class = ref $proto || $proto;
      my $targethost = $_[0] or croak "need target host";

      my %self;
      $self{targethost} = $targethost;

      $self{smtp} = MapTool::Smtp->new();
      $self{ftp}  = MapTool::Ftp->new();
      $self{dns}  = MapTool::Dns->new();

      bless \%self, $class;
      return \%self;
   }

   sub probe
   {
      my $self = shift;

      $self->{dns}->probe($self->{targethost});
   }

   sub results
   {
      my $self = shift;

      $self->{dns}->results();
   }

1;

# ---------------------------------------------------------------------------------

package MapTool::Smtp;

   use strict;
   use vars qw/@ISA/;
   use Carp;
   use Net::DNS::Resolver;

   @ISA = ("MapTool");

   my $mydomain   = 'ccc.de';
   my $validsrc   = 'cpunkt@ccc.de';

   sub new
   {
      my $proto = shift;
      my $class = ref($proto) || $proto;

      my $fpres   = "smtp_fingerprints";
      my $fpcmd   = "smtp_tests";


      my $self = {};

      bless $self, $class;
      $self->mkdb($fpcmd, $fpres);

      return $self;
   }

   sub mkdb
   {
      my $self = shift;

      $self->{commands} = [];
      $self->{fingerprints}  = {};

      open TESTS,   "$_[0]" or croak "can't open $_[0]";
      open RESULTS, "$_[1]" or croak "can't open $_[1]";

      while (my $tline = <TESTS>) {
         next if ($tline =~ /^#/);
         chomp $tline;

         my $invalidsrc = $self->generate_source_address();

         $tline =~ s/\$MY_DOMAIN/${mydomain}/g;
         $tline =~ s/\$VALID_SOURCE/${validsrc}/g;
         $tline =~ s/\$INVALID_SOURCE/${invalidsrc}/g;

         my @cmd_sequence = split /->/, $tline;

         push @{$self->{commands}}, \@cmd_sequence;
      }

      close TESTS;

      while (my $rline = <RESULTS>) {
         next if ($rline =~ /^#/);
         chomp $rline;

         my @res_sequence = split /:/, $rline;
         my $software_version = shift @res_sequence;

         $self->{fingerprints}->{$software_version} = \@res_sequence;
      }

      close RESULTS;
   }

   sub generate_source_address
   {
      my ($i, $ok, $query);
      my ($fake_domain, $fake_user) = ('', '');
      my $res = Net::DNS::Resolver->new;
      my @VALID_CHARS = ( 'A' .. 'Z', 'a' .. 'z', '0' .. '9', '_');

      while (not $ok) {
         for $i (1 .. 25) {
            $fake_domain .= $VALID_CHARS[int rand(@VALID_CHARS)];
         }

         $fake_domain .= '.com';
         $ok = 1;

         $query = $res->query($fake_domain, 'SOA');

         $ok = 1 if (not $query);
      }

      for $i (1 .. 10) {
         $fake_user .= $VALID_CHARS[int rand(@VALID_CHARS)];
      }

      return "$fake_user\@$fake_domain";
   }

1;

# ---------------------------------------------------------------------------------

package MapTool::Ftp;

   use strict;
   use vars qw/@ISA/;
   use Carp;

   @ISA = ("MapTool");

   sub new
   {
      my $proto = shift;
      my $class = ref($proto) || $proto;

      my $fpres   = "ftp_fingerprints";
      my $fpcmd   = "ftp_tests";

      my $self = {};

      bless $self, $class;
      $self->mkdb($fpcmd, $fpres);

      return $self;
   }

   sub mkdb
   {
      my $self = shift;

      $self->{commands} = [];
      $self->{fingerprints}  = {};

      open TESTS,   "$_[0]" or croak "can't open $_[0]";
      open RESULTS, "$_[1]" or croak "can't open $_[1]";

      my $isnulled = 0;

      while (my $tline = <TESTS>) {
         next if ($tline =~ /^#/);
         chomp $tline;

         if ($tline =~ /^#if 0/) {
            $isnulled = 1;
         } elsif ($isnulled && $tline =~ /^#endif/) {
            $isnulled = 0;
         }

         next if ($isnulled || $tline !~ /^\s*"([^"]+)"/);

         push @{$self->{commands}}, $1;
      }

      close TESTS;

      my $inblock = 0;
      my $softwareversion;

      while (my $rline = <RESULTS>) {
         chomp $rline;

         if ($inblock && $rline =~ /^\s*\}/) {
            $inblock = 0;
            $softwareversion = '';
            next;
         } elsif ($inblock) {
            my @checksums = split /,/, $rline;
            push @{$self->{fingerprints}->{$softwareversion}}, \@checksums;
            next;
         }

         if ($rline =~ /^\s*0UL,\s*"([^"]+)"/) {
            $softwareversion = $1;
            $inblock = 1
         }
      }

      close RESULTS;
   }

1;

# ---------------------------------------------------------------------------------

package MapTool::Dns;

   use strict;
   use vars qw/@ISA/;
   use Carp;
   use LWP::UserAgent;
   use Sys::Hostname;
   use Socket;

   @ISA = ("MapTool");

   sub new
   {
      my $proto = shift;
      my $class = ref($proto) || $proto;

      my $self = {};

      my $ua = LWP::UserAgent->new;
      $ua->timeout(23);

      my $djb_response = $ua->get('http://cr.yp.to/surveys/dns1.html');

      if ($djb_response->is_success) {
         bless $self, $class;
         $self->mkdb($djb_response->content);
         return $self;
      }

      croak $djb_response->status_line;
   }

   sub mkdb
   {
      my $self = shift;

      $self->{commands} = [];
      $self->{fingerprints}  = {};

      my $html_response = $_[0];
      my @html_lines = split /\n/, $html_response;

      my $tables = 0;
      my $table_open = 0;

      $self->{commands} = [
         "\0\0\10\0\0\1\0\0\0\0\0\0\4test\17network-surveys\2cr\2yp\2to\0\0\20\0\1",
         "\0\0\0\0\0\1\0\0\0\0\0\0\4test\17network-surveys\2cr\2yp\2to\0\0\20\0\3",
         "\0\0\0\0\0\1\0\0\0\0\0\0\4test\17network-surveys\2cr\2yp\2to\0\0\20\0\77",
         "\0\0\0\0\0\2\0\0\0\0\0\0\4test\17network-surveys\2cr\2yp\2to\0\0\20\0\1\0\0\20\0\1",
         "\0\0\40\0\0\1\0\0\0\0\0\0\4test\17network-surveys\2cr\2yp\2to\0\0\20\0\1",
         "\0\0\50\0\0\1\0\0\0\0\0\0\4test\17network-surveys\2cr\2yp\2to\0\0\20\0\1",
         "\0\0\0\0\0\0\0\0\0\0\0\0",
         "\0\0\0\0\0\1\0\0\0\0\0\0\6",
         "\0\0\0\0\0\1\0\0\0\0\0\0\4test\17network-surveys\2cr\2yp\2to\0",
         "\0\0\2\0\0\1\0\0\0\0\0\0\4test\17network-surveys\2cr\2yp\2to\0\0\20\0\1",
         "\0\0\0\0\0\1\0\0\0\0\0\0\7Authors\4BIND\0\0\20\0\3",
         "\0\0\4\0\0\1\0\0\0\0\0\0\4test\17network-surveys\2cr\2yp\2to\0\0\20\0\1",
         "\0\0\0\17\0\1\0\0\0\0\0\0\4test\17network-surveys\2cr\2yp\2to\0\0\20\0\1",
         "\0\0\0\20\0\1\0\0\0\0\0\0\4test\17network-surveys\2cr\2yp\2to\0\0\20\0\1",
         "\0\0\0\40\0\1\0\0\0\0\0\0\4test\17network-surveys\2cr\2yp\2to\0\0\20\0\1",
         "\0\0\0\100\0\1\0\0\0\0\0\0\4test\17network-surveys\2cr\2yp\2to\0\0\20\0\1",
         "\0\0\20\0\0\1\0\0\0\0\0\0\4test\17network-surveys\2cr\2yp\2to\0\0\20\0\1",
         "\0\0\30\0\0\1\0\0\0\0\0\0\4test\17network-surveys\2cr\2yp\2to\0\0\20\0\1",
         "\0\0\60\0\0\1\0\0\0\0\0\0\4test\17network-surveys\2cr\2yp\2to\0\0\20\0\1",
         "\0\0\0\0\0\1\0\0\0\0\0\0\4test\17network-surveys\2cr\2yp\2to\0\0\20\0\1",
         "\0\0\0\0\0\1\0\0\0\0\0\0\25erre-con-erre-cigarro\7maradns\3org\0\0\20\0\1",
         "\0\0\0\0\0\1\0\0\0\0\0\0\7version\6server\0\0\20\0\3",
         "\0\0\0\0\0\1\0\0\0\0\0\0\7version\4bind\0\0\20\0\3"
      ];

      foreach my $hline (@html_lines) {
         if ($hline =~ /<table/) {
            $tables++;
            $table_open = 1;
            next;
         } elsif ($hline =~ /<\/table/) {
            $table_open = 0;
            next;
         }

         if ($tables > 3 && $tables < 10 && $table_open) {
            if ($hline =~ /<tr><td>Software/ || $hline !~ s/<tr><td>([^<]+)<\/td>//) {
               next;
            }

            my $softwareversion = $1;
            my @results;

            while ($hline =~ s/<td>([^<]+)<\/td>//) {
               push @results, $1;
            }

            push @{$self->{fingerprints}->{$softwareversion}}, \@results;
         }
      }
   }

   sub probe
   {
      my $self = shift;
      my $targethost = $_[0];

      my $iaddr = inet_aton("0.0.0.0");
      my $proto = getprotobyname('udp');
      my $port  = getservbyname('domain', 'udp');
      my $paddr = sockaddr_in(0, $iaddr);

      socket(SOCK, PF_INET, SOCK_DGRAM, $proto)  || croak "socket: $!";
      bind(SOCK, $paddr) || croak "bind: $!";

      $| = 1;

      my $hisiaddr = inet_aton($targethost) || croak "unknown host";
      my $hispaddr = sockaddr_in($port, $hisiaddr);

      my $count = 0;

      foreach my $request (@{$self->{commands}}) {
         $count++;

         defined(send(SOCK, $request, 0, $hispaddr)) || croak "send ".$targethost.": $!";

         my $rin = '';
         vec($rin, fileno(SOCK), 1) = 1;

         my $rout;

         if (!select($rout = $rin, undef, undef, 3.0)) {
            $count > 0 && do { $count = 0; $self->pushresult("timeout"); next; };
            redo;
         }

         my $response;

         ($hispaddr = recv(SOCK, $response, 1000, 0)) || croak "recv: $!";

         $self->pushresult($response);

         $count = 0;
      }
   }

   sub pushresult
   {
      my $self = shift;
      my $result = $_[0];

      push @{$self->{answers}}, $result;
   }

   sub results
   {
      my $self = shift;

      if (scalar @{$self->{answers}} != scalar @{$self->{commands}}) {
         croak "number of answers doesn't match number of commands";
      }

      $self->{results} = {};

      foreach my $swversion (keys %{$self->{fingerprints}}) {
         for (my $j = 0; $j < scalar @{$self->{fingerprints}->{$swversion}}; $j++) {
            my $matchcount;

            for (my $i = 0; $i < scalar @{$self->{answers}}; $i++) {
               $matchcount += $self->compare($self->{answers}->[$i],
                                             $self->{fingerprints}->{$swversion}->[$j]->[$i]);
            }

            push @{$self->{results}->{$matchcount}}, $swversion;
         }
      }

      for (my $score = scalar @{$self->{answers}}; $score >= 0; $score--) {
         next unless (defined $self->{results}->{$score});

         print "matched with score ".int ($score/(scalar @{$self->{answers}})*100).":\n";
         map { print "\t$_\n"; } @{$self->{results}->{$score}};
      }
   }

   sub compare
   {
      my $self = shift;
      my ($response, $fingerprint) = @_;

      $fingerprint =~ s/\s+//g;

      if ($fingerprint =~ /t/) {
         return($response eq 'timeout');
      } elsif ($response eq 'timeout') {
         return 0;
      }

      my @alternatives = split /,/, $fingerprint;
      my $packet = Net::DNS::PacketExt->new(\$response);

      $packet || croak("DNS::Packet refuses the response...");

      my $header  = $packet->header;
      my @queries = $packet->question;
      my @answers = $packet->answer;

      my $match = 0;

      foreach my $alternative (@alternatives) {
         if ($alternative =~ s/0//) {
            $match = ($header->rcode eq 'NOERROR');
            next unless ($match);
         }
         if ($alternative =~ s/1//) {
            $match = ($header->rcode eq 'FORMERR');
            next unless ($match);
         }
         if ($alternative =~ s/2//) {
            $match = ($header->rcode eq 'SERVFAIL');
            next unless ($match);
         }
         if ($alternative =~ s/3//) {
            $match = ($header->rcode eq 'NXDOMAIN');
            next unless ($match);
         }
         if ($alternative =~ s/4//) {
            $match = ($header->rcode eq 'NOTIMP');
            next unless ($match);
         }
         if ($alternative =~ s/5//) {
            $match = ($header->rcode eq 'REFUSED');
            next unless ($match);
         }
         if ($alternative =~ s/TC//) {
            $match = $header->tc;
            next unless ($match);
         }
         if ($alternative =~ s/RD//) {
            $match = $header->rd;
            next unless ($match);
         }
         if ($alternative =~ s/AA//) {
            $match = $header->aa;
            next unless ($match);
         }
         if ($alternative =~ s/Z0//) {
            $match = $header->z0;
            next unless ($match);
         }
         if ($alternative =~ s/Z1//) {
            $match = $header->z1;
            next unless ($match);
         }
         if ($alternative =~ s/Z2//) {
            $match = $header->z2;
            next unless ($match);
         }
         if ($alternative =~ s/q//) {
            $match = ($#queries == -1);
            next unless ($match);
         }
         if ($alternative =~ s/Q2//) {
            $match = ($#queries == 1);
            next unless ($match);
         }
         if ($alternative =~ s/X//) {
            $match = 1;
            next unless ($match);
         }
         if ($alternative =~ s/D//) {
            $match = ($#answers > -1);
            next unless ($match);
         }
      }

      return $match;
   }

1;

# ---------------------------------------------------------------------------------

use strict;

if ($#ARGV != 0) {
   print "usage: $0 <hostname>\n\n";
   exit 1;
}

my $targethost = $ARGV[0];

my $map = MapTool->new($targethost);

$map->probe();
$map->results();

--Cpunkt 18:52, 30 Sep 2004 (CEST)

Wardriving evaluation software

---

Christian (Dietrich), Jan, Sammy and I try to develop a wardriving evaluation software called warpaint. The tool should be able to read kismet XML files and present the information on a map. We think that gpsdrive and gpsmap do not show much information of WLAN hotspots, so warpaint should make the difference in that. For the project days we hope top finish at least a basic part that can draw GPS guided paths and the WLAM hotspots on a local map. We will develop Warpaint in Java. Yesterday, I finished the XML parser, so this should already work.

Some features of warpaint:

...

--217.82.205.47 08:00, 1 Oct 2004 (CEST)