|
|
| (11 intermediate revisions by 5 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)
| |
