Ignore lockmem executable.
[bluesky.git] / TBBT / trace_init / key.pl
1 #\r
2 # Copyright (c) 2002-2003\r
3 #      The President and Fellows of Harvard College.\r
4 #\r
5 # Redistribution and use in source and binary forms, with or without\r
6 # modification, are permitted provided that the following conditions\r
7 # are met:\r
8 # 1. Redistributions of source code must retain the above copyright\r
9 #    notice, this list of conditions and the following disclaimer.\r
10 # 2. Redistributions in binary form must reproduce the above copyright\r
11 #    notice, this list of conditions and the following disclaimer in the\r
12 #    documentation and/or other materials provided with the distribution.\r
13 # 3. Neither the name of the University nor the names of its contributors\r
14 #    may be used to endorse or promote products derived from this software\r
15 #    without specific prior written permission.\r
16 #\r
17 # THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY AND CONTRIBUTORS ``AS IS'' AND\r
18 # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE\r
19 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE\r
20 # ARE DISCLAIMED.  IN NO EVENT SHALL THE UNIVERSITY OR CONTRIBUTORS BE LIABLE\r
21 # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL\r
22 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS\r
23 # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)\r
24 # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT\r
25 # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY\r
26 # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF\r
27 # SUCH DAMAGE.\r
28 #\r
29 # $Id: key.pl,v 1.11 2003/07/26 20:52:04 ellard Exp $\r
30 \r
31 package key;\r
32 \r
33 sub makeKey {\r
34         my ($line, $proto, $op, $xid, $client, $now) = @_;\r
35         my ($client_id, $fh, $euid, $egid) = ('u', 'u', 'u', 'u');\r
36         my ($uxid) = "$client-$xid";\r
37 \r
38         if ($proto eq 'R3' || $proto eq 'R2') {\r
39                 if (exists $PendingKeyStr{$uxid}) {\r
40                         return ($PendingKeyStr{$uxid});\r
41                 }\r
42                 else {\r
43                         return 'u,u,u,u';\r
44                 }\r
45         }\r
46 \r
47         if ($main::UseClient) {\r
48                 $client_id = $client;\r
49                 $client_id =~ s/\..*//g\r
50         }\r
51         if ($main::UseFH && $op ne 'null') {\r
52                 my $tag = ($op eq 'commit') ? 'file' : 'fh';\r
53 \r
54                 $fh = nfsd::nfsDumpParseLineField ($line, $tag);\r
55                 if (! defined $fh) {\r
56                         print STDERR "undefined fh ($line)\n";\r
57                 }\r
58 \r
59                 $fh = nfsd::nfsDumpCompressFH ($main::FH_TYPE, $fh);\r
60 \r
61         }\r
62         if ($main::UseUID && $op ne 'null') {\r
63                 $euid = nfsd::nfsDumpParseLineField ($line, 'euid');\r
64         }\r
65         if ($main::UseGID && $op ne 'null') {\r
66                 $egid = nfsd::nfsDumpParseLineField ($line, 'egid');\r
67         }\r
68 \r
69         my $key = "$client_id,$fh,$euid,$egid";\r
70         $KeysSeen{$key} = 1;\r
71 \r
72         $PendingKeyStr{$uxid} = $key;\r
73         $PendingKeyTime{$uxid} = $now;\r
74 \r
75         return ($key);\r
76 }\r
77 \r
78 sub key2str {\r
79         my ($key) = @_;\r
80 \r
81         my ($client_id, $fh, $euid, $egid) = split (/,/, $key);\r
82 \r
83         if ($client_id ne 'u') {\r
84 \r
85                 # just for aesthetics:\r
86                 $client_id = sprintf ("%.8x", hex ($client_id));\r
87                 $client_id =~ /^(..)(..)(..)(..)/;\r
88                 $client_id = sprintf ("%d.%d.%d.%d",\r
89                                 hex ($1), hex ($2), \r
90                                 hex ($3), hex ($4)); \r
91                 $client_id = sprintf ("%-15s", $client_id);\r
92         }\r
93 \r
94         if ($euid ne 'u') {\r
95                 $euid = hex ($euid);\r
96         }\r
97         if ($egid ne 'u') {\r
98                 $egid = hex ($egid);\r
99         }\r
100 \r
101         return ("$client_id $fh $euid $egid");\r
102 }\r
103 \r
104 # Purge all the pending XID records dated earlier than $when (which is\r
105 # typically at least $PRUNE_INTERVAL seconds ago).  This is important\r
106 # because otherwise missing XID records can pile up, eating a lot of\r
107 # memory. \r
108   \r
109 sub prunePending {\r
110         my ($when) = @_;\r
111 \r
112         foreach my $uxid ( keys %PendingKeyTime ) {\r
113                 if ($PendingKeyTime{$uxid} < $when) {\r
114                         delete $PendingKeyTime{$uxid};\r
115                         delete $PendingKeyStr{$uxid};\r
116                 }\r
117         }\r
118 \r
119         return ;\r
120 }\r
121 \r
122 1;\r