Ignore lockmem executable.
[bluesky.git] / TBBT / trace_init / nfsdump.pl
1 #!/usr/bin/perl -w\r
2 #\r
3 # Copyright (c) 2002-2003\r
4 #      The President and Fellows of Harvard College.\r
5 #\r
6 # Redistribution and use in source and binary forms, with or without\r
7 # modification, are permitted provided that the following conditions\r
8 # are met:\r
9 # 1. Redistributions of source code must retain the above copyright\r
10 #    notice, this list of conditions and the following disclaimer.\r
11 # 2. Redistributions in binary form must reproduce the above copyright\r
12 #    notice, this list of conditions and the following disclaimer in the\r
13 #    documentation and/or other materials provided with the distribution.\r
14 # 3. Neither the name of the University nor the names of its contributors\r
15 #    may be used to endorse or promote products derived from this software\r
16 #    without specific prior written permission.\r
17 #\r
18 # THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY AND CONTRIBUTORS ``AS IS'' AND\r
19 # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE\r
20 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE\r
21 # ARE DISCLAIMED.  IN NO EVENT SHALL THE UNIVERSITY OR CONTRIBUTORS BE LIABLE\r
22 # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL\r
23 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS\r
24 # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)\r
25 # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT\r
26 # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY\r
27 # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF\r
28 # SUCH DAMAGE.\r
29 #\r
30 # $Id: nfsdump.pl,v 1.5 2003/07/26 20:52:04 ellard Exp $\r
31 #\r
32 # Utility for dealing with raw nfsdump records.\r
33 \r
34 package nfsd;\r
35 \r
36 # If $AllowRisky is set, then allow some optimizations that might be\r
37 # "risky" in bizarre situations (but have never been observed to\r
38 # actually break anything).  By default, no riskiness is permitted.\r
39 \r
40 $AllowRisky     = 0;\r
41 \r
42 # nfsDumpParseLine -- initializes the global associative array\r
43 # %nfsd'nfsDumpLine with information about a record from nfsdump. \r
44 # Returns an empty list if anything goes wrong.  Otherwise, returns a\r
45 # list of the protocol (eg R2, C2, R3, C3), the name of the operation,\r
46 # and the xid, the client host ID, the time, and for responses, the\r
47 # status (via nfsDumpParseLineHeader).  The reason for this particular\r
48 # return list is that these are very frequently-accessed values, so it\r
49 # can save time to avoid going through the associative array to access\r
50 # them.\r
51 #\r
52 # All records begin with several fixed fields, and then are followed\r
53 # by some number of name/value pairs, and finally some diagnostic\r
54 # fields (which are mostly ignored by this routine-- the only\r
55 # diagnostic this routine cares about is whether the packet as part of\r
56 # a jumbo packet or not.  If so, then 'truncated' is set.)\r
57 \r
58 sub nfsDumpParseLine {\r
59         my ($line, $total) = @_;\r
60 \r
61         my (@rl) = &nfsDumpParseLineHeader ($line);\r
62 \r
63         if (@rl && $total) {\r
64                 &nfsDumpParseLineBody ($line);\r
65         }\r
66 \r
67         return @rl;\r
68 }\r
69 \r
70 sub nfsDumpParseLineBody {\r
71         my ($line) = @_;\r
72         my $i;\r
73         my $client_id;\r
74         my $reseen;\r
75 \r
76         undef %nfsDumpLine;\r
77 \r
78         # If the line doesn't start with a digit, then it's certainly\r
79         # not properly formed, so bail out immediately.\r
80 \r
81         if (! ($line =~ /^[0-9]/)) {\r
82                 return undef;\r
83         }\r
84 \r
85         my @l = split (' ', $line);\r
86         my $lineLen = @l;\r
87         if ($l[$lineLen - 1] eq 'LONGPKT') {\r
88                 splice (@l, $lineLen - 1);\r
89                 $nfsDumpLine{'truncated'} = 1;\r
90                 $lineLen--;\r
91         }\r
92 \r
93         $nfsDumpLine{'time'}    = $l[0];\r
94         $nfsDumpLine{'srchost'} = $l[1];\r
95         $nfsDumpLine{'deshost'} = $l[2];\r
96         $nfsDumpLine{'proto'}   = $l[4];\r
97         $nfsDumpLine{'xid'}     = $l[5];\r
98         $nfsDumpLine{'opcode'}  = $l[6];\r
99         $nfsDumpLine{'opname'}  = $l[7];\r
100 \r
101         if (($l[4] eq 'R3') || ($l[4] eq 'R2')) {\r
102                 $nfsDumpLine{'status'}  = $l[8];\r
103 \r
104                 $client_id = $l[2];\r
105                 $reseen = 0;\r
106                 for ($i = 9; $i < $lineLen - 10; $i += 2) {\r
107                         if (defined $nfsDumpLine{$l[$i]}) {\r
108                                 $reseen = 1;\r
109                                 $nfsDumpLine{"$l[$i]-2"} = $l[$i + 1];\r
110                         }\r
111                         else {\r
112                                 $nfsDumpLine{$l[$i]} = $l[$i + 1];\r
113                         }\r
114                 }\r
115         }\r
116         else {\r
117                 $client_id = $l[1];\r
118                 $reseen = 0;\r
119                 for ($i = 8; $i < $lineLen - 6; $i += 2) {\r
120                         if (defined $nfsDumpLine{$l[$i]}) {\r
121                                 $nfsDumpLine{"$l[$i]-2"} = $l[$i + 1];\r
122                                 $reseen = 1;\r
123                         }\r
124                         else {\r
125                                 $nfsDumpLine{$l[$i]} = $l[$i + 1];\r
126                         }\r
127                 }\r
128         }\r
129 }\r
130 \r
131 # Returns an empty list if anything goes wrong.  Otherwise, returns a\r
132 # list of the protocol (eg R2, C2, R3, C3), the name of the operation,\r
133 # and the xid, the client host ID, and time, and the response status. \r
134 # (For call messages, the status is 'na'.)\r
135 \r
136 sub nfsDumpParseLineHeader {\r
137         my ($line) = @_;\r
138 \r
139         # If the line doesn't start with a digit, then it's certainly\r
140         # not properly formed, so bail out immediately.\r
141 \r
142         if (! ($line =~ /^[0-9]/)) {\r
143                 return ();\r
144         }\r
145         else {\r
146                 my $client_id;\r
147                 my $status;\r
148 \r
149                 my @l = split (' ', $line, 10);\r
150 \r
151 \r
152                 if (($l[4] eq 'R3') || ($l[4] eq 'R2')) {\r
153                         $client_id = $l[2];\r
154                         $status = $l[8];\r
155                 }\r
156                 else {\r
157                         $client_id = $l[1];\r
158                         $status = 'na';\r
159                 }\r
160 \r
161                 return ($l[4], $l[7], $l[5], $client_id, $l[0], $status);\r
162         }\r
163 }\r
164 \r
165 # nfsDumpParseLineFields -- Just return a subset of the fields,\r
166 # without parsing the entire line.\r
167 \r
168 sub nfsDumpParseLineFields {\r
169         my ($line, @fields) = @_;\r
170         my $i;\r
171 \r
172         # If the line doesn't start with a digit, then\r
173         # it's certainly not properly formed, so bail out\r
174         # immediately.\r
175 \r
176         if (! ($line =~ /^[0-9]/)) {\r
177                 return ();\r
178         }\r
179 \r
180         my $rest;\r
181         if ($AllowRisky) {\r
182                 $rest = $line;\r
183         }\r
184         else {\r
185                 my @foo = split (' ', $line, 9);\r
186                 $rest = ' ' . $foo[8];\r
187         }\r
188 \r
189         my $fl = @fields;\r
190         my @l = ();\r
191         for ($i = 0; $i < $fl; $i++) {\r
192                 my $field = $fields[$i];\r
193 \r
194                 $rest =~ /\ $field\ +([^\ ]+)/;\r
195                 $l[$i] = $1;\r
196         }\r
197 \r
198         return (@l);\r
199 }\r
200 \r
201 # nfsDumpParseLineField -- Just return ONE of the fields,\r
202 # without parsing the entire line.\r
203 \r
204 sub nfsDumpParseLineField {\r
205         my ($line, $field) = @_;\r
206 \r
207         # If the line doesn't start with a digit, then\r
208         # it's certainly not properly formed, so bail out\r
209         # immediately.\r
210 \r
211         if (! ($line =~ /^[0-9]/)) {\r
212                 return undef;\r
213         }\r
214 \r
215         my $rest;\r
216         if ($AllowRisky) {\r
217                 $rest = $line;\r
218         }\r
219         else {\r
220                 my @foo = split (' ', $line, 9);\r
221                 $rest = ' ' . $foo[8];\r
222         }\r
223 \r
224         $rest =~ /\ $field\ +([^\ ]+)/;\r
225         return $1;\r
226 }\r
227 \r
228 # Returns a new file handle that has all the "useful" information as\r
229 # the original, but requires less storage space.  File handles\r
230 # typically contain quite a bit of redundancy or unused bytes.\r
231 #\r
232 # This routine only knows about the advfs and netapp formats.  If\r
233 # you're using anything else, just use anything else as the mode, and\r
234 # the original file handle will be returned.\r
235 #\r
236 # If you extend this to handle more file handles, please send the new\r
237 # code to me (ellard@eecs.harvard.edu) so I can add it to the\r
238 # distribution.\r
239 \r
240 sub nfsDumpCompressFH {\r
241         my ($mode, $fh) = @_;\r
242 \r
243         if ($mode eq 'advfs') {\r
244 \r
245                 # The fh is a long hex string:\r
246                 # 8 chars: file system ID\r
247                 # 8 chars: apparently unused.\r
248                 # 8 chars: unused.\r
249                 # 8 chars: inode\r
250                 # 8 chars: generation\r
251                 # rest of string: mount point (not interesting).\r
252                 # So all we do is pluck out the fsid, inode,\r
253                 # and generation number, and throw the rest away.\r
254 \r
255                 $fh =~ /^(........)(........)(........)(........)(........)/;\r
256 \r
257                 return ("$1-$4-$5");\r
258         }\r
259         elsif ($mode eq 'netapp') {\r
260 \r
261                 # Here's the netapp format (from Shane Owara):\r
262                 #\r
263                 # 4 bytes     mount point file inode number\r
264                 # 4 bytes     mount point file generation number\r
265                 # \r
266                 # 2 bytes     flags\r
267                 # 1 byte      snapshot id\r
268                 # 1 byte      unused\r
269                 #\r
270                 # 4 bytes     file inode number\r
271                 # 4 bytes     file generation number\r
272                 # 4 bytes     volume identifier\r
273                 #\r
274                 # 4 bytes     export point fileid\r
275                 # 1 byte      export point snapshot id\r
276                 # 3 bytes     export point snapshot generation number\r
277                 #\r
278                 # The only parts of this that are interesting are\r
279                 # inode, generation, and volume identifier (and probably\r
280                 # a lot of the bits of the volume identifier could be\r
281                 # tossed, since we don't have many volumes...).\r
282 \r
283                 $fh =~ /^(........)(........)(........)(........)(........)(........)(........)/;\r
284 \r
285                 return ("$4-$5-$6-$1");\r
286         }\r
287         elsif ($mode eq 'RFSNN') {\r
288 \r
289                 # Here's the netapp format (from Shane Owara):\r
290                 #\r
291                 # 4 bytes     mount point file inode number\r
292                 # 4 bytes     mount point file generation number\r
293                 # \r
294                 # 2 bytes     flags\r
295                 # 1 byte      snapshot id\r
296                 # 1 byte      unused\r
297                 #\r
298                 # 4 bytes     file inode number\r
299                 # 4 bytes     file generation number\r
300                 # 4 bytes     volume identifier\r
301                 #\r
302                 # 4 bytes     export point fileid\r
303                 # 1 byte      export point snapshot id\r
304                 # 3 bytes     export point snapshot generation number\r
305                 #\r
306                 # The only parts of this that are interesting are\r
307                 # inode, generation, and volume identifier (and probably\r
308                 # a lot of the bits of the volume identifier could be\r
309                 # tossed, since we don't have many volumes...).\r
310                 \r
311                 # 61890100575701002000000  0009ac710e9ea381  0d24400006189010057570100\r
312                 # 61890100575701002000000  0009ac70ed2ea381  0d24400006189010057570100\r
313                 # 61890100575701002000000  000479a1e008d782  0d24400006189010057570100\r
314                 # Ningning need only 24-39 (or 12-19 bytes)\r
315 \r
316                 $fh =~ /^(........)(........)(........)(........)(........)(........)/;\r
317 \r
318                 return ("$4$5");\r
319         }else {\r
320 \r
321                 return ($fh);\r
322         }\r
323 }\r
324 \r
325 sub testMain {\r
326         $lineNum = 0;\r
327 \r
328         while (<STDIN>) {\r
329                 $line = $_;\r
330                 $lineNum++;\r
331 \r
332                 &nfsDumpParseLine ($line);\r
333         }\r
334 }\r
335 \r
336 1;\r
337 \r
338 # end of nfsdump.pl\r