Difference between revisions of "Summerschool Aachen 2004/Project Day I"

From C4 Wiki
Jump to: navigation, search
(Fingerprinting Tool in perl)
(cleanup)
 
(8 intermediate revisions by 4 users not shown)
Line 1: Line 1:
== HTTP Tunnelling ==
+
#REDIRECT[[Summerschool Aachen 2004/Project Days]]
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.
 
 
 
<pre>
 
#!/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();
 
 
 
</pre>
 
 
 
--[[User:Cpunkt|Cpunkt]] 18:52, 30 Sep 2004 (CEST)
 
 
 
[[Category:Summerschools]] [[Category:Code]]
 
 
 
=== Wardriving evaluation software ===
 

Latest revision as of 17:45, 5 October 2004