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