File Coverage

blib/lib/Net/SinFP3/Ext/TCP.pm
Criterion Covered Total %
statement 15 87 17.2
branch 0 42 0.0
condition 0 6 0.0
subroutine 5 16 31.2
pod 1 1 100.0
total 21 152 13.8


line stmt bran cond sub pod time code
1             #
2             # $Id: TCP.pm,v 451c3602d7b2 2015/11/25 06:13:53 gomor $
3             #
4             package Net::SinFP3::Ext::TCP;
5 1     1   1080 use strict;
  1         3  
  1         28  
6 1     1   5 use warnings;
  1         2  
  1         27  
7              
8 1     1   6 use base qw(Class::Gomor::Array);
  1         2  
  1         113  
9             our @AS = qw(
10             global
11             next
12             _src
13             _seq
14             _ack
15             );
16             __PACKAGE__->cgBuildIndices;
17             __PACKAGE__->cgBuildAccessorsScalar(\@AS);
18              
19 1     1   6 use Net::Frame::Layer qw(:subs);
  1         2  
  1         339  
20 1     1   6 use Net::Frame::Layer::TCP qw(:consts);
  1         2  
  1         1735  
21              
22             sub new {
23 0     0 1   my $self = shift->SUPER::new(
24             @_,
25             );
26              
27 0           my $src = $self->_getInitial16bits;
28 0           my $seq = $self->_getInitial32bits;
29 0           my $ack = $self->_getInitial32bits;
30              
31 0           $self->_src($src);
32 0           $self->_seq($seq);
33 0           $self->_ack($ack);
34              
35 0           return $self;
36             }
37              
38             sub _getInitial16bits {
39 0     0     my $self = shift;
40 0           my $i16 = getRandom16bitsInt() - 3;
41 0 0         $i16 += 1025 unless $i16 > 1024;
42 0           return $i16;
43             }
44              
45             sub _getInitial32bits {
46 0     0     my $self = shift;
47 0           my $i32 = getRandom32bitsInt() - 3;
48 0 0         $i32 += 666 unless $i32 > 0;
49 0           return $i32;
50             }
51              
52             sub _getP1Tcp {
53 0     0     my $self = shift;
54 0           return Net::Frame::Layer::TCP->new(
55             src => $self->_src,
56             seq => $self->_seq,
57             ack => $self->_ack,
58             dst => $self->next->port,
59             x2 => 0,
60             flags => NF_TCP_FLAGS_SYN,
61             win => 5840,
62             options =>
63             "\x02\x04\x05\xb4".
64             "",
65             );
66             }
67              
68             sub _getP2Tcp {
69 0     0     my $self = shift;
70 0           return Net::Frame::Layer::TCP->new(
71             src => $self->_src + 1,
72             seq => $self->_seq + 1,
73             ack => $self->_ack + 1,
74             dst => $self->next->port,
75             x2 => 0,
76             flags => NF_TCP_FLAGS_SYN,
77             win => 5840,
78             options =>
79             "\x02\x04\x05\xb4".
80             "\x08\x0a\x44\x45".
81             "\x41\x44\x00\x00".
82             "\x00\x00\x03\x03".
83             "\x01\x04\x02\x00".
84             "",
85             );
86             }
87              
88             sub _getP3Tcp {
89 0     0     my $self = shift;
90 0           return Net::Frame::Layer::TCP->new(
91             src => $self->_src + 2,
92             seq => $self->_seq + 2,
93             ack => $self->_ack + 2,
94             dst => $self->next->port,
95             x2 => 0,
96             flags => NF_TCP_FLAGS_SYN | NF_TCP_FLAGS_ACK,
97             win => 5840,
98             );
99             }
100              
101             sub __analyzeTcpSeq {
102 0     0     my $self = shift;
103 0           my ($p) = @_;
104 0           my $reqAck = $p->ref->{TCP}->ack;
105 0           my $repSeq = $p->reply->ref->{TCP}->seq;
106 0           my $flag = 1;
107 0 0         if ($repSeq == 0 ) { $flag = 0 }
  0 0          
    0          
108 0           elsif ($repSeq == $reqAck ) { $flag = 2 }
109 0           elsif ($repSeq == ++$reqAck) { $flag = 3 }
110 0           return $flag;
111             }
112              
113             sub __analyzeTcpAck {
114 0     0     my $self = shift;
115 0           my ($p) = @_;
116 0           my $reqSeq = $p->ref->{TCP}->seq;
117 0           my $repAck = $p->reply->ref->{TCP}->ack;
118 0           my $flag = 1;
119 0 0         if ($repAck == 0 ) { $flag = 0 }
  0 0          
    0          
120 0           elsif ($repAck == $reqSeq ) { $flag = 2 }
121 0           elsif ($repAck == ++$reqSeq) { $flag = 3 }
122 0           return $flag;
123             }
124              
125             sub _analyzeTcpFlags {
126 0     0     my $self = shift;
127 0           my ($p) = @_;
128 0           return sprintf("F0x%02x", $p->reply->ref->{TCP}->flags);
129             }
130              
131             sub _analyzeTcpWindow {
132 0     0     my $self = shift;
133 0           my ($p) = @_;
134 0           return 'W'.$p->reply->ref->{TCP}->win;
135             }
136              
137             sub _analyzeTcpOptions {
138 0     0     my $self = shift;
139 0           my ($p) = @_;
140             # Rewrite timestamp values, if > 0 overwrite with ffff,
141             # for each timestamp. Same with WScale value
142 0           my $mss;
143             my $wscale;
144 0           my $opts;
145 0 0         if ($opts = unpack('H*', $p->reply->ref->{TCP}->options)) {
146 0 0         if ($opts =~ /080a(........)(........)/) {
147 0 0 0       if ($1 && $1 !~ /44454144|00000000/) {
148 0           $opts =~ s/(080a)........(........)/$1ffffffff$2/;
149             }
150 0 0 0       if ($2 && $2 !~ /44454144|00000000/) {
151 0           $opts =~ s/(080a........)......../$1ffffffff/;
152             }
153             }
154             # Move MSS value in its own field
155 0 0         if ($opts =~ /0204(....)/) {
156 0 0         if ($1) {
157 0           $mss = sprintf("%d", hex($1));
158 0           $opts =~ s/0204..../0204ffff/;
159             }
160             }
161             # Move WScale value in its own field
162 0 0         if ($opts =~ /0303(..)/) {
163 0 0         if ($1) {
164 0           $wscale = sprintf("%d", hex($1));
165 0           $opts =~ s/0303../0303ff/;
166             }
167             }
168             }
169             $opts .= unpack('H*', $p->reply->ref->{TCP}->payload)
170 0 0         if $p->reply->ref->{TCP}->payload;
171              
172 0 0         $opts = '0' unless $opts;
173 0 0         $mss = '0' unless $mss;
174 0 0         $wscale = '0' unless $wscale;
175 0 0         my $optLen = $opts ? length($opts) / 2 : 0;
176 0           return [ 'O'.$opts, 'M'.$mss, 'S'.$wscale, 'L'.$optLen ];
177             }
178              
179             1;
180              
181             __END__