]>
Commit | Line | Data |
---|---|---|
064af421 BP |
1 | #! /usr/bin/perl |
2 | ||
053df7bd | 3 | # Copyright (c) 2009, 2010, 2011, 2012, 2015 Nicira, Inc. |
a14bc59f BP |
4 | # |
5 | # Licensed under the Apache License, Version 2.0 (the "License"); | |
6 | # you may not use this file except in compliance with the License. | |
7 | # You may obtain a copy of the License at: | |
8 | # | |
9 | # http://www.apache.org/licenses/LICENSE-2.0 | |
10 | # | |
11 | # Unless required by applicable law or agreed to in writing, software | |
12 | # distributed under the License is distributed on an "AS IS" BASIS, | |
13 | # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. | |
14 | # See the License for the specific language governing permissions and | |
15 | # limitations under the License. | |
16 | ||
064af421 BP |
17 | use strict; |
18 | use warnings; | |
19 | ||
20 | open(FLOWS, ">&=3");# or die "failed to open fd 3 for writing: $!\n"; | |
21 | open(PACKETS, ">&=4");# or die "failed to open fd 4 for writing: $!\n"; | |
22 | ||
23 | # Print pcap file header. | |
24 | print PACKETS pack('NnnNNNN', | |
25 | 0xa1b2c3d4, # magic number | |
26 | 2, # major version | |
27 | 4, # minor version | |
28 | 0, # time zone offset | |
29 | 0, # time stamp accuracy | |
30 | 1518, # snaplen | |
31 | 1); # Ethernet | |
32 | ||
33 | output(DL_HEADER => '802.2'); | |
34 | ||
b9ec4ff7 | 35 | for my $dl_header (qw(802.2+SNAP Ethernet)) { |
064af421 | 36 | my %a = (DL_HEADER => $dl_header); |
b9ec4ff7 | 37 | for my $dl_vlan (qw(none zero nonzero)) { |
064af421 BP |
38 | my %b = (%a, DL_VLAN => $dl_vlan); |
39 | ||
40 | # Non-IP case. | |
41 | output(%b, DL_TYPE => 'non-ip'); | |
42 | ||
b9ec4ff7 | 43 | for my $ip_options (qw(no yes)) { |
064af421 | 44 | my %c = (%b, DL_TYPE => 'ip', IP_OPTIONS => $ip_options); |
b9ec4ff7 | 45 | for my $ip_fragment (qw(no first middle last)) { |
064af421 | 46 | my %d = (%c, IP_FRAGMENT => $ip_fragment); |
b9ec4ff7 | 47 | for my $tp_proto (qw(TCP TCP+options UDP ICMP other)) { |
064af421 BP |
48 | output(%d, TP_PROTO => $tp_proto); |
49 | } | |
50 | } | |
51 | } | |
52 | } | |
53 | } | |
54 | ||
55 | sub output { | |
56 | my (%attrs) = @_; | |
57 | ||
58 | # Compose flow. | |
59 | my (%flow); | |
60 | $flow{DL_SRC} = "00:02:e3:0f:80:a4"; | |
61 | $flow{DL_DST} = "00:1a:92:40:ac:05"; | |
62 | $flow{NW_PROTO} = 0; | |
834377ea | 63 | $flow{NW_TOS} = 0; |
064af421 BP |
64 | $flow{NW_SRC} = '0.0.0.0'; |
65 | $flow{NW_DST} = '0.0.0.0'; | |
66 | $flow{TP_SRC} = 0; | |
67 | $flow{TP_DST} = 0; | |
68 | if (defined($attrs{DL_VLAN})) { | |
69 | my (%vlan_map) = ('none' => 0xffff, | |
70 | 'zero' => 0, | |
71 | 'nonzero' => 0x0123); | |
72 | $flow{DL_VLAN} = $vlan_map{$attrs{DL_VLAN}}; | |
73 | } else { | |
74 | $flow{DL_VLAN} = 0xffff; # OFP_VLAN_NONE | |
75 | } | |
76 | if ($attrs{DL_HEADER} eq '802.2') { | |
77 | $flow{DL_TYPE} = 0x5ff; # OFP_DL_TYPE_NOT_ETH_TYPE | |
78 | } elsif ($attrs{DL_TYPE} eq 'ip') { | |
79 | $flow{DL_TYPE} = 0x0800; # ETH_TYPE_IP | |
80 | $flow{NW_SRC} = '10.0.2.15'; | |
81 | $flow{NW_DST} = '192.168.1.20'; | |
834377ea | 82 | $flow{NW_TOS} = 44; |
064af421 BP |
83 | if ($attrs{TP_PROTO} eq 'other') { |
84 | $flow{NW_PROTO} = 42; | |
85 | } elsif ($attrs{TP_PROTO} eq 'TCP' || | |
86 | $attrs{TP_PROTO} eq 'TCP+options') { | |
6767a2cc | 87 | $flow{NW_PROTO} = 6; # IPPROTO_TCP |
064af421 BP |
88 | $flow{TP_SRC} = 6667; |
89 | $flow{TP_DST} = 9998; | |
90 | } elsif ($attrs{TP_PROTO} eq 'UDP') { | |
6767a2cc | 91 | $flow{NW_PROTO} = 17; # IPPROTO_UDP |
064af421 BP |
92 | $flow{TP_SRC} = 1112; |
93 | $flow{TP_DST} = 2223; | |
94 | } elsif ($attrs{TP_PROTO} eq 'ICMP') { | |
6767a2cc | 95 | $flow{NW_PROTO} = 1; # IPPROTO_ICMP |
064af421 BP |
96 | $flow{TP_SRC} = 8; # echo request |
97 | $flow{TP_DST} = 0; # code | |
98 | } else { | |
99 | die; | |
100 | } | |
7257b535 | 101 | if ($attrs{IP_FRAGMENT} ne 'no' && $attrs{IP_FRAGMENT} ne 'first') { |
064af421 BP |
102 | $flow{TP_SRC} = $flow{TP_DST} = 0; |
103 | } | |
104 | } elsif ($attrs{DL_TYPE} eq 'non-ip') { | |
105 | $flow{DL_TYPE} = 0x5678; | |
106 | } else { | |
107 | die; | |
108 | } | |
109 | ||
110 | # Compose packet. | |
111 | my $packet = ''; | |
94639963 JR |
112 | my $wildcards = 1 << 5 | 1 << 6 | 1 << 7 | 32 << 8 | 32 << 14 | 1 << 21; |
113 | ||
064af421 BP |
114 | $packet .= pack_ethaddr($flow{DL_DST}); |
115 | $packet .= pack_ethaddr($flow{DL_SRC}); | |
50f06e16 BP |
116 | if ($flow{DL_VLAN} != 0xffff) { |
117 | $packet .= pack('nn', 0x8100, $flow{DL_VLAN}); | |
118 | } | |
119 | my $len_ofs = length($packet); | |
064af421 BP |
120 | $packet .= pack('n', 0) if $attrs{DL_HEADER} =~ /^802.2/; |
121 | if ($attrs{DL_HEADER} eq '802.2') { | |
122 | $packet .= pack('CCC', 0x42, 0x42, 0x03); # LLC for 802.1D STP. | |
123 | } else { | |
124 | if ($attrs{DL_HEADER} eq '802.2+SNAP') { | |
125 | $packet .= pack('CCC', 0xaa, 0xaa, 0x03); # LLC for SNAP. | |
126 | $packet .= pack('CCC', 0, 0, 0); # SNAP OUI. | |
127 | } | |
064af421 BP |
128 | $packet .= pack('n', $flow{DL_TYPE}); |
129 | if ($attrs{DL_TYPE} eq 'ip') { | |
130 | my $ip = pack('CCnnnCCnNN', | |
131 | (4 << 4) | 5, # version, hdrlen | |
834377ea | 132 | $flow{NW_TOS}, # type of service |
064af421 BP |
133 | 0, # total length (filled in later) |
134 | 65432, # id | |
135 | 0, # frag offset | |
136 | 64, # ttl | |
137 | $flow{NW_PROTO}, # protocol | |
138 | 0, # checksum | |
139 | 0x0a00020f, # source | |
140 | 0xc0a80114); # dest | |
94639963 | 141 | $wildcards &= ~( 1 << 5 | 63 << 8 | 63 << 14 | 1 << 21); |
064af421 BP |
142 | if ($attrs{IP_OPTIONS} eq 'yes') { |
143 | substr($ip, 0, 1) = pack('C', (4 << 4) | 8); | |
144 | $ip .= pack('CCnnnCCCx', | |
145 | 130, # type | |
146 | 11, # length | |
147 | 0x6bc5, # top secret | |
148 | 0xabcd, | |
149 | 0x1234, | |
150 | 1, | |
151 | 2, | |
152 | 3); | |
153 | } | |
94639963 | 154 | |
064af421 BP |
155 | if ($attrs{IP_FRAGMENT} ne 'no') { |
156 | my (%frag_map) = ('first' => 0x2000, # more frags, ofs 0 | |
157 | 'middle' => 0x2111, # more frags, ofs 0x888 | |
158 | 'last' => 0x0222); # last frag, ofs 0x1110 | |
159 | substr($ip, 6, 2) | |
160 | = pack('n', $frag_map{$attrs{IP_FRAGMENT}}); | |
161 | } | |
94639963 JR |
162 | if ($attrs{IP_FRAGMENT} eq 'no' || $attrs{IP_FRAGMENT} eq 'first') { |
163 | if ($attrs{TP_PROTO} =~ '^TCP') { | |
164 | my $tcp = pack('nnNNnnnn', | |
165 | $flow{TP_SRC}, # source port | |
166 | $flow{TP_DST}, # dest port | |
167 | 87123455, # seqno | |
168 | 712378912, # ackno | |
169 | (5 << 12) | 0x02 | 0x10, # hdrlen, SYN, ACK | |
170 | 5823, # window size | |
171 | 18923, # checksum | |
172 | 12893); # urgent pointer | |
173 | if ($attrs{TP_PROTO} eq 'TCP+options') { | |
174 | substr($tcp, 12, 2) = pack('n', (6 << 12) | 0x02 | 0x10); | |
175 | $tcp .= pack('CCn', 2, 4, 1975); # MSS option | |
176 | } | |
177 | $tcp .= 'payload'; | |
178 | $ip .= $tcp; | |
179 | $wildcards &= ~(1 << 6 | 1 << 7); | |
180 | } elsif ($attrs{TP_PROTO} eq 'UDP') { | |
181 | my $len = 15; | |
182 | my $udp = pack('nnnn', $flow{TP_SRC}, $flow{TP_DST}, $len, 0); | |
183 | $udp .= chr($len) while length($udp) < $len; | |
184 | $ip .= $udp; | |
185 | $wildcards &= ~(1 << 6 | 1 << 7); | |
186 | } elsif ($attrs{TP_PROTO} eq 'ICMP') { | |
187 | $ip .= pack('CCnnn', | |
188 | 8, # echo request | |
189 | 0, # code | |
190 | 0, # checksum | |
191 | 736, # identifier | |
192 | 931); # sequence number | |
193 | $wildcards &= ~(1 << 6 | 1 << 7); | |
194 | } elsif ($attrs{TP_PROTO} eq 'other') { | |
195 | $ip .= 'other header'; | |
196 | } else { | |
197 | die; | |
064af421 | 198 | } |
064af421 | 199 | } |
064af421 BP |
200 | substr($ip, 2, 2) = pack('n', length($ip)); |
201 | $packet .= $ip; | |
202 | } | |
203 | } | |
50f06e16 BP |
204 | if ($attrs{DL_HEADER} =~ /^802.2/) { |
205 | my $len = length ($packet); | |
206 | $len -= 4 if $flow{DL_VLAN} != 0xffff; | |
207 | substr($packet, $len_ofs, 2) = pack('n', $len); | |
208 | } | |
064af421 BP |
209 | |
210 | print join(' ', map("$_=$attrs{$_}", keys(%attrs))), "\n"; | |
211 | print join(' ', map("$_=$flow{$_}", keys(%flow))), "\n"; | |
212 | print "\n"; | |
213 | ||
214 | print FLOWS pack('Nn', | |
41ca9a1e BP |
215 | $wildcards, # wildcards |
216 | 1); # in_port | |
064af421 BP |
217 | print FLOWS pack_ethaddr($flow{DL_SRC}); |
218 | print FLOWS pack_ethaddr($flow{DL_DST}); | |
834377ea | 219 | print FLOWS pack('nCxnCCxxNNnn', |
064af421 | 220 | $flow{DL_VLAN}, |
959a2ecd | 221 | 0, # DL_VLAN_PCP |
064af421 | 222 | $flow{DL_TYPE}, |
834377ea | 223 | $flow{NW_TOS}, |
064af421 BP |
224 | $flow{NW_PROTO}, |
225 | inet_aton($flow{NW_SRC}), | |
226 | inet_aton($flow{NW_DST}), | |
227 | $flow{TP_SRC}, | |
228 | $flow{TP_DST}); | |
229 | ||
230 | print PACKETS pack('NNNN', | |
231 | 0, # timestamp seconds | |
232 | 0, # timestamp microseconds | |
233 | length($packet), # bytes saved | |
234 | length($packet)), # total length | |
235 | $packet; | |
236 | } | |
237 | ||
238 | sub pack_ethaddr { | |
239 | local ($_) = @_; | |
240 | my $xx = '([0-9a-fA-F][0-9a-fA-F])'; | |
241 | my (@octets) = /$xx:$xx:$xx:$xx:$xx:$xx/; | |
242 | @octets == 6 or die $_; | |
243 | my ($out) = ''; | |
244 | $out .= pack('C', hex($_)) foreach @octets; | |
245 | return $out; | |
246 | } | |
247 | ||
248 | sub inet_aton { | |
249 | local ($_) = @_; | |
250 | my ($a, $b, $c, $d) = /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/; | |
251 | defined $d or die $_; | |
252 | return ($a << 24) | ($b << 16) | ($c << 8) | $d; | |
253 | } |