src/TraceFS/checktrace.pl

   1 #! /usr/bin/perl
   2 #
   3 # $Id$
   4 # Checks assumptions on Cc* (Cache Manager) behaviour by reading TraceFS log
   5 # Copyright (C) 2003 Jan Kratochvil <project-captive@jankratochvil.net>
   6 #
   7 # This program is free software; you can redistribute it and/or modify
   8 # it under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; exactly version 2 of June 1991 is required
  10 #
  11 # This program is distributed in the hope that it will be useful,
  12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 # GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License
  17 # along with this program; if not, write to the Free Software
  18 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  19
  20
  21 use strict;
  22 use warnings;
  23 use Data::Dumper;
  24 use Carp qw(cluck confess);
  25
  26
  27 my $filter=0;
  28 $Data::Dumper::Sortkeys=1;
  29 my $ntfs_blocksize=0x200;
  30
  31 # $Object->{"by"}="CcSomeFunction";
  32 # $Object->{"line_enter"}=123;
  33 # $Object->{"line_leave"}=124;
  34 # $Object->{"ProcessThread"}="0x12345678/0x12345678";
  35 # $Object->{"data"}[dataline]{"FileObject"}="0x12345678";
  36 # $Object->{"data"}[dataline]{"FileName"}="\filename" or undef() if NULL;
  37 # $Object->{"data"}[dataline]{"Flags"}="0x40100";
  38 # $Object->{"data"}[dataline]{"SectionObjectPointer"}="0x12345678";
  39 # $Object->{"data"}[dataline]{"SharedCacheMap"}="0x12345678";
  40 # $FileObject{$FileObject}{"FileObject"}="0x12345678";
  41 # $FileObject{$FileObject}{"SectionObjectPointer"}="0x12345678";
  42 # $SectionObjectPointer{$SectionObjectPointer}{"SectionObjectPointer"}="0x12345678";
  43 # $SectionObjectPointer{$SectionObjectPointer}{"SharedCacheMap"}="0x12345678";
  44 # $SharedCacheMap{$SharedCacheMap}{"SharedCacheMap"}="0x12345678";
  45 # $SharedCacheMap{$SharedCacheMap}{"SectionObjectPointer"}="0x12345678";
  46 # $SharedCacheMap{$SharedCacheMap}{"Allocation"}="0x12345";
  47 # $SharedCacheMap{$SharedCacheMap}{"FileSize"}="0x12345";
  48 # $SharedCacheMap{$SharedCacheMap}{"ref_count"}=1;
  49 # $SharedCacheMap{$SharedCacheMap}{"map"}="0x12345678" (Bcb);
  50 # $SharedCacheMap{$SharedCacheMap}{"pin"}{"0x1000"}="0x12345678" (Bcb) if !Bcb->{"OwnerPointer"};
  51 # $SharedCacheMap{$SharedCacheMap}{"PinAccess"}=0 or 1;
  52 # $SharedCacheMap{$SharedCacheMap}{"LogHandle"}="0x12345678" optional;
  53 # $SharedCacheMap{$SharedCacheMap}{"AcquireForLazyWrite"}=0;    # count
  54 # $LogHandle{$LogHandle}{"LogHandle"}="0x12345678";
  55 # $Bcb{$Bcb}{"Bcb"}="0x12345678";
  56 # $Bcb{$Bcb}{"SharedCacheMap"}="0x12345678";
  57 # $Bcb{$Bcb}{"type"}="pin" or "map";
  58 # $Bcb{$Bcb}{"ref_count"}=1;
  59 # $Bcb{$Bcb}{"FileOffset"}="0x1000" if {"type"} eq "pin";
  60 # $Bcb{$Bcb}{"Buffer"}="0x12345678";    # PAGE_SIZE-aligned for "pin", FileOffset_0-aligned for "map"
  61 # $Bcb{$Bcb}{"OwnerPointer"}="0x12345678" optional;
  62 # $Bcb{$Bcb}{"Lsn"}="0x12345678" optional;
  63 # $Bcb{$Bcb}{"dirty"}=1 optional;
  64 # $MdlChain{$MdlChain}{"MdlChain"}="0x12345678";
  65 # $MdlChain{$MdlChain}{"FileObject"}="0x12345678";
  66 # $MdlChain{$MdlChain}{"FileOffset"}="0x5000";
  67 # $MdlChain{$MdlChain}{"Length"}="0x9000";
  68
  69 my %FileObject;
  70 my %LogHandle;
  71 my %SectionObjectPointer;
  72 my %SharedCacheMap;
  73 my %Bcb;
  74 my %MdlChain;
  75 my %LastLeave;  # $ProcessThread=>[$Object,$Object,...]
  76 my $LastLeave;  # ref copy for the current $ProcessThread
  77 my $ProcessThread;
  78 my %EnterLeave;
  79
  80 END {
  81         print Data::Dumper->Dump([\%FileObject,\%SectionObjectPointer,\%SharedCacheMap,\%Bcb],
  82                                [qw(%FileObject  %SectionObjectPointer  %SharedCacheMap  %Bcb)]) if !$filter;
  83         }
  84
  85 my $Object;
  86
  87 sub tohex($)
  88 {
  89 my($num)=@_;
  90
  91         return sprintf("0x%X",$num);
  92 }
  93
  94 sub FObject($)
  95 {
  96 my($FileObject)=@_;
  97
  98         my $FObject=$FileObject{$FileObject};
  99         if (!$FObject) {
 100                 my($package,$filename,$line,$subroutine)=caller 0;
 101                 warn "Non-existent FileObject $FileObject by line $line";
 102                 }
 103         return $FObject;
 104 }
 105
 106 sub delete_FObject($)
 107 {
 108 my($FObject)=@_;
 109
 110         my $FileObject=$FObject->{"FileObject"};
 111         delete $FileObject{$FileObject};
 112 }
 113
 114 sub SObject($)
 115 {
 116 my($SectionObjectPointer)=@_;
 117
 118         my $SObject=$SectionObjectPointer{$SectionObjectPointer};
 119         if (!$SObject) {
 120                 my($package,$filename,$line,$subroutine)=caller 0;
 121                 warn "Non-existent SectionObjectPointer $SectionObjectPointer by line $line"
 122                 }
 123         return $SObject;
 124 }
 125
 126 sub SObject_from_FileObject($)
 127 {
 128 my($FileObject)=@_;
 129
 130         return if !(my $FObject=FObject $FileObject);
 131         my $SObject=SObject $FObject->{"SectionObjectPointer"};
 132         if (!$SObject) {
 133                 my($package,$filename,$line,$subroutine)=caller 0;
 134                 warn "by line $line";
 135                 }
 136         return $SObject;
 137 }
 138
 139 sub delete_CObject($)
 140 {
 141 my($CObject)=@_;
 142
 143         my $SharedCacheMap=$CObject->{"SharedCacheMap"};
 144         do { warn "Trailing map $_ of SharedCacheMap $SharedCacheMap during its deletion" if $_; } for ($CObject->{"map"});
 145         do { warn "Trailing pin $_ of SharedCacheMap $SharedCacheMap during its deletion" if $_; } for (values(%{$CObject->{"pin"}}));
 146         if (my $LogHandle=$CObject->{"LogHandle"}) {
 147                 do { warn "INTERNAL: Missing LogHandle $LogHandle for SharedCacheMap $SharedCacheMap"; return; }
 148                         if !(my $LObject=$LogHandle{$LogHandle});
 149                 # Do not delete $LogHandle as it may be used by many SharedCacheMap-s
 150                 }
 151         delete $SharedCacheMap{$SharedCacheMap};
 152 }
 153
 154 sub CObject($)
 155 {
 156 my($SharedCacheMap)=@_;
 157
 158         my $CObject=$SharedCacheMap{$SharedCacheMap};
 159         if (!$CObject) {
 160                 my($package,$filename,$line,$subroutine)=caller 0;
 161                 warn "Non-existent SharedCacheMap $SharedCacheMap by line $line";
 162                 }
 163         return $CObject;
 164 }
 165
 166 sub CObject_from_FileObject($)
 167 {
 168 my($FileObject)=@_;
 169
 170         return if !(my $SObject=SObject_from_FileObject $FileObject);
 171         return if !(my $CObject=CObject $SObject->{"SharedCacheMap"});
 172         return $CObject;
 173 }
 174
 175 sub SharedCacheMap_valid($)
 176 {
 177 my($SharedCacheMap)=@_;
 178
 179         cluck if !defined $SharedCacheMap;
 180         return 0 if "0x".("F"x8) eq $SharedCacheMap;
 181         return 0 if !eval $SharedCacheMap;
 182         return 1;
 183 }
 184
 185 sub check_data($)
 186 {
 187 my($data)=@_;
 188
 189         if (!eval $data->{"SectionObjectPointer"}) {
 190                 return if $Object->{"by"} eq "IRP_MJ_CREATE";   # SectionObjectPointer is not yet initialized
 191                 warn "Existing FileObject ".$data->{"FileObject"}." but no SectionObjectPointer found"
 192                                 if $FileObject{$data->{"FileObject"}} && eval($FileObject{$data->{"FileObject"}}{"SectionObjectPointer"});
 193                 return;
 194                 }
 195         my $SectionObjectPointer=$data->{"SectionObjectPointer"};
 196         if (!SharedCacheMap_valid $data->{"SharedCacheMap"} && $SectionObjectPointer{$SectionObjectPointer}) {
 197                 return if !(my $SObject=SObject $SectionObjectPointer);
 198                 my $SharedCacheMap=$SObject->{"SharedCacheMap"};
 199                 return if !eval $SharedCacheMap;
 200                 my $CObject=CObject $SharedCacheMap;
 201                 warn "Existing SectionObjectPointer ".$data->{"SectionObjectPointer"}." but no SharedCacheMap found,"
 202                                                 ." ref_count of SharedCacheMap is ".$CObject->{"ref_count"}
 203                                 if $CObject->{"ref_count"};
 204 #                               if $SectionObjectPointer{$data->{"SectionObjectPointer"}};
 205                 # SharedCacheMap was droppped by async task as it had ref_count==0.
 206                 delete_CObject $CObject;
 207                 $SObject->{"SharedCacheMap"}=tohex(0);
 208                 # FileObject is still valid!
 209                 return;
 210                 }
 211         return if !$FileObject{$data->{"FileObject"}};
 212         return if !(my $FObject=FObject $data->{"FileObject"});
 213         return if !(my $SObject=SObject $FObject->{"SectionObjectPointer"});
 214         my $SharedCacheMap=$SObject->{"SharedCacheMap"};
 215         warn "FileObject ".$FObject->{"FileObject"}." SectionObjectPointer ".$SObject->{"SectionObjectPointer"}
 216                                         ." expected SharedCacheMap $SharedCacheMap"
 217                                         ." but found SharedCacheMap ".$data->{"SharedCacheMap"}
 218                         if $SharedCacheMap ne $data->{"SharedCacheMap"};
 219         warn "INTERNAL: SharedCacheMap $SharedCacheMap of FileObject ".$FObject->{"FileObject"}." got destroyed"
 220                         if !$SharedCacheMap{$SharedCacheMap};
 221 }
 222
 223 sub CcInitializeCacheMap($$$$$)
 224 {
 225 my($FileObject,$AllocationSize,$FileSize,$ValidDataLength,$PinAccess)=@_;
 226
 227         $ValidDataLength=$FileSize if $ValidDataLength==eval("0x".("F"x8));
 228         $Object->{"ref_count"}=1;
 229         $Object->{"AllocationSize"}=tohex($AllocationSize);
 230         $Object->{"FileSize"}=tohex($FileSize);
 231         $Object->{"ValidDataLength"}=tohex($ValidDataLength);
 232         $Object->{"map"}=undef();
 233         $Object->{"pin"}={};
 234         $Object->{"PinAccess"}=$PinAccess;
 235         $Object->{"FileObject"}=$FileObject;
 236 }
 237
 238 sub CcInitializeCacheMap_leave()
 239 {
 240         my $SharedCacheMap=$Object->{"data"}[1]{"SharedCacheMap"};
 241         $Object->{"SharedCacheMap"}=$SharedCacheMap;
 242         my $old=$SharedCacheMap{$SharedCacheMap};
 243         if (!SharedCacheMap_valid $Object->{"data"}[0]{"SharedCacheMap"} && $old) {
 244                 # SharedCacheMap got deleted in the meantime
 245                 delete_CObject CObject $SharedCacheMap;
 246                 my $SObject=SObject $Object->{"data"}[0]{"SectionObjectPointer"};
 247                 $SObject->{"SharedCacheMap"}=tohex(0);
 248                 $old=undef();
 249                 }
 250         if (!$old != !SharedCacheMap_valid $Object->{"data"}[0]{"SharedCacheMap"}) {
 251                 warn "Expecting old SharedCacheMap validity ".(!!$old)
 252                                 ." but found old SharedCacheMap ".$Object->{"data"}[0]{"SharedCacheMap"};
 253                 }
 254         warn "New SharedCacheMap ".$Object->{"data"}[1]{"SharedCacheMap"}." is not valid"
 255                         if !SharedCacheMap_valid $Object->{"data"}[1]{"SharedCacheMap"};
 256         if (SharedCacheMap_valid $Object->{"data"}[0]{"SharedCacheMap"}) {
 257                 warn "Existing SharedCacheMap changed"
 258                                                 ." from ".$Object->{"data"}[0]{"SharedCacheMap"}." to ".$Object->{"data"}[1]{"SharedCacheMap"}
 259                                 if $Object->{"data"}[0]{"SharedCacheMap"} ne $Object->{"data"}[1]{"SharedCacheMap"};
 260                 }
 261         if ($old) {
 262                 for my $field (qw(AllocationSize FileSize PinAccess)) {
 263                         warn "SharedCacheMap $SharedCacheMap old instance $field ".$old->{$field}
 264                                                         ." != new instance $field ".$Object->{$field}
 265                                         if $old->{$field} ne $Object->{$field};
 266                         }
 267                 do { warn "Existing map Bcb $_ during CcInitializeCacheMap()" if $_; } for ($old->{"map"});
 268                 do { warn "Existing pin Bcb $_ during CcInitializeCacheMap()" if $_; } for (values(%{$old->{"pin"}}));
 269                 $Object->{"ref_count"}+=$old->{"ref_count"};
 270                 }
 271         $SharedCacheMap{$SharedCacheMap}=$Object;
 272
 273         warn "Changed SectionObjectPointer inside CcInitializeCacheMap()"
 274                                         ." from ".$Object->{"data"}[0]{"SectionObjectPointer"}." to ".$Object->{"data"}[1]{"SectionObjectPointer"}
 275                         if $Object->{"data"}[0]{"SectionObjectPointer"} ne $Object->{"data"}[1]{"SectionObjectPointer"};
 276         my $SectionObjectPointer=$Object->{"data"}[1]{"SectionObjectPointer"};
 277
 278         my $FileObject=$Object->{"FileObject"};
 279         if (my $FObject=$FileObject{$FileObject}) {
 280                 if (my $SObject=$SectionObjectPointer{$FObject->{"SectionObjectPointer"}}) {
 281                         warn "Changed SectionObjectPointer of FileObject $FileObject"
 282                                                         ." from ".$FObject->{"SectionObjectPointer"}." to ".$SectionObjectPointer
 283                                         if $FObject->{"SectionObjectPointer"} ne $SectionObjectPointer;
 284                         }
 285                 # Otherwise SectionObjectPointer could be deleted and rebuilt async in the meantime.
 286                 }
 287         $FileObject{$FileObject}={
 288                         "FileObject"=>$FileObject,
 289                         "SectionObjectPointer"=>$SectionObjectPointer,
 290                         };
 291
 292         if (my $SObject=$SectionObjectPointer{$SectionObjectPointer}) {
 293                 warn "Changed SharedCacheMap of SectionObjectPointer $SectionObjectPointer"
 294                                                 ." from ".$SObject->{"SharedCacheMap"}." to ".$SharedCacheMap
 295                                 if $SObject->{"SharedCacheMap"} ne $SharedCacheMap && eval($SObject->{"SharedCacheMap"});
 296                 }
 297         $SectionObjectPointer{$SectionObjectPointer}={
 298                         "SectionObjectPointer"=>$SectionObjectPointer,
 299                         "SharedCacheMap"=>$SharedCacheMap,
 300                         };
 301
 302         CcSetFileSizes($FileObject,map({ eval($Object->{$_}); } qw(AllocationSize FileSize ValidDataLength)));
 303         delete $Object->{$_} for (qw(FileObject ValidDataLength));
 304 }
 305
 306 sub CcUninitializeCacheMap($$)
 307 {
 308 my($FileObject,$TruncateSize)=@_;
 309
 310         $Object->{"FileObject"}=$FileObject;
 311 }
 312
 313 sub CcUninitializeCacheMap_leave($)
 314 {
 315 my($r)=@_;
 316
 317         my $FileObject=$Object->{"FileObject"};
 318         # 'r' means function success.
 319         # r=0 either if no CcInitializeCacheMap() was called at all
 320         # or if Cc was unable to detach SharedCacheMap and it remains valid
 321         # (FIXME: Do we SharedCacheMap->ref_count-- on in such case?).
 322         my $SectionObjectPointer=$FileObject{$FileObject}->{"SectionObjectPointer"} if $FileObject{$FileObject};
 323         my $SharedCacheMap=$SectionObjectPointer{$SectionObjectPointer}->{"SharedCacheMap"}
 324                         if $SectionObjectPointer && $SectionObjectPointer{$SectionObjectPointer};
 325         warn "Unexpected 'r' result $r for CcUninitializeCacheMap of FileObject $FileObject"
 326                         if !(eval($SharedCacheMap) && !SharedCacheMap_valid($Object->{"data"}[1]{"SharedCacheMap"})) != !$r;
 327         if (!eval $SharedCacheMap) {
 328                 for my $SharedCacheMap ($Object->{"data"}[0]{"SharedCacheMap"},$Object->{"data"}[1]{"SharedCacheMap"}) {
 329                         warn "Not expecting valid SharedCacheMap $SharedCacheMap"
 330                                         if SharedCacheMap_valid $SharedCacheMap;
 331                         }
 332                 return;
 333                 }
 334         for my $SharedCacheMap ($Object->{"data"}[0]{"SharedCacheMap"}) {
 335                 warn "Expecting valid SharedCacheMap $SharedCacheMap"
 336                                 if !SharedCacheMap_valid $SharedCacheMap;
 337                 }
 338         return if !(my $FObject=FObject $FileObject);
 339         return if !(my $SObject=SObject $FObject->{"SectionObjectPointer"});
 340         return if !(my $CObject=CObject $SObject->{"SharedCacheMap"});
 341         if (--$CObject->{"ref_count"}) {
 342                 for my $SharedCacheMap ($Object->{"data"}[1]{"SharedCacheMap"}) {
 343                         warn "Expecting still valid SharedCacheMap $SharedCacheMap after CcUninitializeCacheMap()"
 344                                                         ." with ref_count=".$CObject->{"ref_count"}
 345                                         if !SharedCacheMap_valid $SharedCacheMap;
 346                         }
 347                 return;
 348                 }
 349         if (!SharedCacheMap_valid $Object->{"data"}[1]{"SharedCacheMap"}) {
 350                 delete_CObject $CObject;
 351                 $SObject->{"SharedCacheMap"}=tohex(0);
 352                 # FileObject is still valid!
 353                 }
 354         else {
 355                 # FIXME: Do we SharedCacheMap->ref_count-- on in such case?
 356                 }
 357 }
 358
 359 sub CcSetFileSizes($$$$)
 360 {
 361 my($FileObject,$AllocationSize,$FileSize,$ValidDataLength)=@_;
 362
 363         return if !(my $CObject=CObject_from_FileObject $FileObject);
 364         my $SharedCacheMap=$CObject->{"SharedCacheMap"};
 365         if ($AllocationSize!=eval($CObject->{"AllocationSize"})) {
 366                 do { warn "Existing map $_ of FileObject $FileObject SharedCacheMap $SharedCacheMap during CcSetAllocationSizes(),"
 367                                                 ." AllocationSize=".$CObject->{"AllocationSize"} if $_; }
 368                                 for ($CObject->{"map"});
 369                 do { warn "Existing pin $_ of FileObject $FileObject SharedCacheMap $SharedCacheMap during CcSetAllocationSizes(),"
 370                                                 ." AllocationSize=".$CObject->{"AllocationSize"} if $_; }
 371                                 for (values(%{$CObject->{"pin"}}));
 372                 }
 373         # $ValidDataLength can be > $CObject->{"FileSize"};
 374         warn "ValidDataLength ".tohex($ValidDataLength)." > FileSize ".tohex($FileSize)
 375                         if $ValidDataLength>$FileSize;
 376         warn "0 != AllocationSize ".tohex($AllocationSize)." % ntfs_blocksize ".tohex($ntfs_blocksize)
 377                         if 0!=($AllocationSize%$ntfs_blocksize);
 378         # $AllocationSize can be higher
 379         warn "FileSize ".tohex($FileSize)." > AllocationSize ".tohex($AllocationSize)
 380                         if $FileSize>$AllocationSize;
 381         $CObject->{"FileSize"}=tohex($FileSize);
 382         $CObject->{"AllocationSize"}=tohex($AllocationSize);
 383 }
 384
 385 sub IRP_MJ_CREATE_leave()
 386 {
 387         do { warn "Non-NULL SectionObjectPointer $_ not expected" if eval($_); } for ($Object->{"data"}[0]{"SectionObjectPointer"});
 388         my $FileObject=$Object->{"data"}[0]{"FileObject"};
 389         warn "Existing FileObject $FileObject not expected" if $FileObject{$FileObject};
 390         my $SectionObjectPointer=$Object->{"data"}[1]{"SectionObjectPointer"};
 391         # We want to track even FileObject without SectionObjectPointer yet.
 392 #       if ($SectionObjectPointer && $SectionObjectPointer{$SectionObjectPointer})
 393         {
 394                 $FileObject{$FileObject}={
 395                                 "FileObject"=>$FileObject,
 396                                 "SectionObjectPointer"=>$SectionObjectPointer,
 397                                 };
 398                 }
 399         if (eval $SectionObjectPointer) {
 400                 my $SharedCacheMap=$Object->{"data"}[1]{"SharedCacheMap"};
 401                 if (my $SObject=$SectionObjectPointer{$SectionObjectPointer}) {
 402                         warn "Changed SharedCacheMap from stored ".$SObject->{"SharedCacheMap"}." to ".$SharedCacheMap
 403                                         if $SObject->{"SharedCacheMap"} ne $SharedCacheMap && $Object->{"by"} ne "IRP_MJ_CREATE";
 404                         }
 405                 $SectionObjectPointer{$SectionObjectPointer}={
 406                                 "SectionObjectPointer"=>$SectionObjectPointer,
 407                                 "SharedCacheMap"=>$SharedCacheMap,
 408                                 };
 409                 }
 410 }
 411
 412 sub BObject($)
 413 {
 414 my($Bcb)=@_;
 415
 416         cluck if !defined $Bcb;
 417         my $BObject=$Bcb{$Bcb};
 418         warn "Non-existent Bcb $Bcb" if !$BObject;
 419         return $BObject;
 420 }
 421
 422 sub delete_BObject($)
 423 {
 424 my($BObject)=@_;
 425
 426         my $Bcb=$BObject->{"Bcb"};
 427         warn "Deleting ref_count=".$BObject->{"ref_count"}." Bcb $Bcb" if $BObject->{"ref_count"};
 428         # Do not: warn "Deleting dirty Bcb $Bcb" if $BObject->{"dirty"};
 429         # as it is valid to allow sanity check below.
 430         warn "Deleting dirty Bcb $Bcb" if $BObject->{"dirty"} && $BObject->{"ref_count"};
 431         return if !(my $CObject=CObject $BObject->{"SharedCacheMap"});
 432         if ($BObject->{"type"} eq "map") {
 433                 for my $pin (values(%{$CObject->{"pin"}})) {
 434                         next if !defined $pin;
 435                         warn "unpin map but CcPinMappedData pin $pin still exists"
 436                                         if $Bcb{$pin}->{"by"} eq "CcPinMappedData";
 437                         }
 438                 }
 439         for my $ref ($BObject->{"type"} eq "map" ? \$CObject->{"map"} : \$CObject->{"pin"}{$BObject->{"FileOffset"}}) {
 440                 warn "Final unpin but ".$BObject->{"type"}." Bcb $Bcb not registered"
 441                                                 ." in SharedCacheMap ".$CObject->{"SharedCacheMap"}." ref ".($$ref || "<undef>")
 442                                 if !defined($BObject->{"OwnerPointer"}) && !($$ref && $$ref eq $Bcb)
 443                                                 && !($BObject->{"ref_count"}==0 && $BObject->{"dirty"});
 444                 if ($$ref && $$ref eq $Bcb) {
 445                         $$ref=undef();
 446                         # Do not: delete $CObject->{"pin"}{$BObject->{"FileOffset"}} if $BObject->{"type"} eq "pin";
 447                         # as it would destroy $$ref slot in &Bcb_checkref '($$ref && $Bcb ne $$ref)' codepath.
 448                         }
 449                 }
 450         delete $Bcb{$Bcb};
 451 }
 452
 453 sub MObject($)
 454 {
 455 my($MdlChain)=@_;
 456
 457         cluck if !defined $MdlChain;
 458         my $MObject=$MdlChain{$MdlChain};
 459         warn "Non-existent MdlChain $MdlChain" if !$MObject;
 460         return $MObject;
 461 }
 462
 463 sub Bcb_conflict($;@)
 464 {
 465 my($CObject,@Bcb_list)=@_;
 466
 467         my $arg=0;
 468         my %check=(
 469                 "map"=>$CObject->{"map"},
 470                 map(("arg".($arg++)=>$_),@Bcb_list),
 471                 %{$CObject->{"pin"}},
 472                 );
 473         my %reversed;
 474         my $BufferBase; # relativized to FileOffset 0
 475         my $BufferBase_val;
 476         while (my($key,$val)=each(%check)) {
 477                 next if !defined $val;
 478                 warn "Conflicting Bcb $val of keys $key and ".$reversed{$val}." of SharedCacheMap ".$CObject->{"SharedCacheMap"}
 479                                 if $reversed{$val};
 480                 # Buffer base should match even between 'map's and 'pin's
 481                 # as the data are always mapped only once.
 482                 if (my $BObject=BObject $val) {
 483                         my $Buffer=eval $BObject->{"Buffer"};
 484                         $Buffer-=eval($BObject->{"FileOffset"}) if exists $BObject->{"FileOffset"};
 485                         warn "Non-matching Bcb ".$BObject->{"type"}." $val Buffer base ".tohex($Buffer)
 486                                                         ." with Bcb ".$Bcb{$BufferBase_val}->{"type"}." $BufferBase_val BufferBase ".tohex($BufferBase)
 487                                         if defined($BufferBase) && $Buffer!=$BufferBase;
 488                         $BufferBase=$Buffer;
 489                         $BufferBase_val=$val;
 490                         }
 491                 $reversed{$val}=$key;
 492                 }
 493 }
 494
 495 # New $BObject will always be forced as the last stored reference.
 496 sub Bcb_checkref($$)
 497 {
 498 my($BObject,$ref)=@_;
 499
 500         return if !(my $CObject=CObject $BObject->{"SharedCacheMap"});
 501         my $type=$BObject->{"type"};
 502         my $Bcb=$BObject->{"Bcb"};
 503         if ($$ref && $Bcb ne $$ref) {
 504                 my $BObject2=$Bcb{$$ref};
 505                 warn "new $type Bcb $Bcb != old ".$BObject2->{"type"}." Bcb $$ref";
 506                 delete_BObject $BObject2;
 507                 warn "INTERNAL: Trailing ref to Bcb $$ref" if $$ref;
 508                 }
 509         if ($$ref) {
 510                 my $BObject2=$Bcb{$$ref};
 511                 warn "new $type $Bcb type ".$BObject->{"type"}." != old type $type $$ref type ".$BObject2->{"type"}
 512                                 if $BObject->{"type"} ne $BObject2->{"type"};
 513                 warn "new $type $Bcb Buffer ".$BObject->{"Buffer"}." != old $type $$ref Buffer ".$BObject2->{"Buffer"}
 514                                 if $BObject->{"Buffer"} ne $BObject2->{"Buffer"};
 515                 }
 516         if ($$ref && $$ref eq $Bcb) {
 517                 $BObject->{"ref_count"}+=$Bcb{$$ref}->{"ref_count"};
 518                 $$ref=undef();
 519                 }
 520         $Bcb{$Bcb}=$BObject;    # &Bcb_conflict needs this reference
 521         Bcb_conflict $CObject,$Bcb;
 522         $$ref=$Bcb;
 523 }
 524
 525 sub map_new($;$$)
 526 {
 527 my($SharedCacheMap,$FileOffset,$Length)=@_;
 528
 529         return if !(my $CObject=CObject $SharedCacheMap);
 530         if (defined($FileOffset) && defined($Length)) {
 531                 warn "Mapping data (end ".tohex($FileOffset+$Length).") out of FileSize ".$CObject->{"FileSize"}
 532                                 if $FileOffset+$Length>eval($CObject->{"FileSize"});
 533                 }
 534         $Object->{"SharedCacheMap"}=$CObject->{"SharedCacheMap"};
 535         if (defined $FileOffset) {
 536                 $Object->{"FileOffset"}=tohex($FileOffset);
 537                 }
 538         $Object->{"type"}="map";
 539         $Object->{"ref_count"}=1;
 540 }
 541
 542 sub map_new_from_FileObject($;$$)
 543 {
 544 my($FileObject,$FileOffset,$Length)=@_;
 545
 546         return if !(my $CObject=CObject_from_FileObject $FileObject);
 547         map_new $CObject->{"SharedCacheMap"},$FileOffset,$Length;
 548 }
 549
 550 sub map_new_leave($;$)
 551 {
 552 my($Bcb,$Buffer)=@_;
 553
 554         $Object->{"Bcb"}=$Bcb;
 555         return if !(my $CObject=CObject $Object->{"SharedCacheMap"});
 556
 557         if (defined $Buffer) {
 558                 $Object->{"Buffer"}=tohex(eval($Buffer)-(eval($Object->{"FileOffset"}) || 0));
 559                 }
 560         delete $Object->{"FileOffset"};
 561
 562         my $ref=\$CObject->{"map"};
 563         # There may exist some pin bcbs even if we are creating the new map bcb.
 564         Bcb_checkref $Object,$ref;
 565 }
 566
 567 sub CcMapData($$$)
 568 {
 569 my($FileObject,$FileOffset,$Length)=@_;
 570
 571         map_new_from_FileObject $FileObject,$FileOffset,$Length;
 572 }
 573
 574 sub CcMapData_leave($$)
 575 {
 576 my($Bcb,$Buffer)=@_;
 577
 578         map_new_leave $Bcb,$Buffer;
 579 }
 580
 581 sub pin_new($$$)
 582 {
 583 my($FileObject,$FileOffset,$Length)=@_;
 584
 585         return if !(my $CObject=CObject_from_FileObject $FileObject);
 586         warn "Pinning of non-PinAccess FileObject $FileObject" if !$CObject->{"PinAccess"};
 587         warn "Mapping data (end ".tohex($FileOffset+$Length).") out of FileSize ".$CObject->{"FileSize"}
 588                         if $FileOffset+$Length>eval($CObject->{"FileSize"});
 589         warn "Pinning Length ".tohex($Length)." > 0x1000" if $Length>0x1000;
 590         warn "Pinning across file page (start=".tohex($FileOffset).",end-1=".tohex($FileOffset+$Length-1).")"
 591                         if ($FileOffset&~0xFFF)!=(($FileOffset+$Length-1)&~0xFFF);
 592         $Object->{"SharedCacheMap"}=$CObject->{"SharedCacheMap"};
 593         $Object->{"FileOffset"}=tohex($FileOffset);
 594         $Object->{"type"}="pin";
 595         $Object->{"ref_count"}=1;
 596 }
 597
 598 sub pin_new_leave($$)
 599 {
 600 my($Bcb,$Buffer)=@_;
 601
 602         $Object->{"Bcb"}=$Bcb;
 603         return if !(my $CObject=CObject $Object->{"SharedCacheMap"});
 604         $Object->{"Buffer"}=tohex(eval($Buffer)-(eval($Object->{"FileOffset"})&0xFFF));
 605         my $shift=eval($Object->{"FileOffset"})&0xFFF;
 606         $Object->{"FileOffset"}=tohex(eval($Object->{"FileOffset"})-$shift);
 607         $Object->{"Buffer"}=tohex(eval($Buffer)-$shift);
 608
 609         my $ref=\$CObject->{"pin"}{$Object->{"FileOffset"}};
 610         # There may not exist map bcb even if we are creating the new pin bcb.
 611         Bcb_checkref $Object,$ref;
 612 }
 613
 614 sub CcPinRead($$$)
 615 {
 616 my($FileObject,$FileOffset,$Length)=@_;
 617
 618         pin_new $FileObject,$FileOffset,$Length;
 619 }
 620
 621 sub CcPinRead_leave($$)
 622 {
 623 my($Bcb,$Buffer)=@_;
 624
 625         pin_new_leave $Bcb,$Buffer;
 626 }
 627
 628 sub CcPreparePinWrite($$$)
 629 {
 630 my($FileObject,$FileOffset,$Length)=@_;
 631
 632         pin_new $FileObject,$FileOffset,$Length;
 633 }
 634
 635 sub CcPreparePinWrite_leave($$)
 636 {
 637 my($Bcb,$Buffer)=@_;
 638
 639         pin_new_leave $Bcb,$Buffer;
 640         my $BObject=BObject $Bcb;
 641         $BObject->{"dirty"}=1;
 642 }
 643
 644 sub CcPinMappedData($$$)
 645 {
 646 my($FileObject,$FileOffset,$Length)=@_;
 647
 648         pin_new $FileObject,$FileOffset,$Length;
 649 }
 650
 651 sub CcPinMappedData_leave($)
 652 {
 653 my($Bcb)=@_;
 654
 655         return if !(my $CObject=CObject $Object->{"SharedCacheMap"});
 656         do { warn "CcPinMappedData() with Bcb $Bcb on non-CcMapData()ed SharedCacheMap ".$CObject->{"SharedCacheMap"}; return; }
 657                         if !(my $mapBcb=$CObject->{"map"});
 658         return if !(my $BmapObject=BObject $mapBcb);
 659         my $Buffer=tohex(eval($BmapObject->{"Buffer"})+eval($Object->{"FileOffset"}));
 660
 661         my $Bcb2=$CObject->{"pin"}{tohex(eval($Object->{"FileOffset"})&~0xFFF)};
 662         my $BObject2=BObject $Bcb2 if $Bcb2;
 663
 664         pin_new_leave $Bcb,$Buffer;
 665 }
 666
 667 sub CcSetDirtyPinnedData($$)
 668 {
 669 my($Bcb,$Lsn)=@_;
 670
 671         return if !(my $BObject=BObject $Bcb);
 672         # Do not: warn "Lsn already set for Bcb $Bcb as ".$BObject->{"Lsn"}." while current Lsn=$Lsn" if $BObject->{"Lsn"};
 673         # as it is permitted.
 674         warn "Lsn goes backward for Bcb $Bcb old Lsn ".$BObject->{"Lsn"}." to a new Lsn=$Lsn"
 675                         if $BObject->{"Lsn"} && eval($BObject->{"Lsn"})>eval($Lsn);
 676         $BObject->{"Lsn"}=$Lsn if $Lsn ne "0x".("F"x8);
 677         $BObject->{"dirty"}=1;
 678         return if !(my $CObject=CObject $BObject->{"SharedCacheMap"});
 679 }
 680
 681 sub FlushToLsnRoutine($$)
 682 {
 683 my($LogHandle,$Lsn)=@_;
 684
 685         $Object->{"LogHandle"}=$LogHandle;
 686         $Object->{"Lsn"}=$Lsn;
 687 }
 688
 689 my $LogHandle_static;
 690 sub CcSetLogHandleForFile($$$)
 691 {
 692 my($FileObject,$LogHandle,$FlushToLsnRoutine)=@_;
 693
 694         return if !(my $CObject=CObject_from_FileObject $FileObject);
 695         warn "LogHandle ".$CObject->{"LogHandle"}." already exists for SharedCacheMap ".$CObject->{"SharedCacheMap"}
 696                         if $CObject->{"LogHandle"};
 697         return if !eval $LogHandle;     # $LogHandle may be "0x0"
 698         # ntfs.sys uses single LogHandle for its whole session:
 699         warn "Non-unique LogHandle $LogHandle while last LogHandle was $LogHandle_static"
 700                         if $LogHandle_static && $LogHandle ne $LogHandle_static;
 701         $CObject->{"LogHandle"}=$LogHandle;
 702         if (!$LogHandle{$LogHandle}) {
 703                 $LogHandle{$LogHandle}={
 704                                 "LogHandle"=>$LogHandle,
 705                                 };
 706                 }
 707 }
 708
 709 sub IRP_MJ_WRITE_leave_page($$)
 710 {
 711 my($ByteOffset,$Lsn_check)=@_;
 712
 713         my $SharedCacheMap=$Object->{"data"}[0]{"SharedCacheMap"};
 714         return if !(my $CObject=CObject $SharedCacheMap);
 715         my $FlushToLsnRoutine=$LastLeave if $LastLeave->{"by"} eq "FlushToLsnRoutine";
 716         # Do not: my $Bcb=$CObject->{"pin"}{$ByteOffset};
 717         # as Bcbs with $BObject->{"OwnerPointer"} are no longer stored in $CObject->{"pin"}.
 718         my @Bcbs;
 719         for my $Bcb (keys(%Bcb)) {
 720                 my $BObject=BObject $Bcb;
 721                 if (1
 722                                 && $BObject->{"type"} eq "pin"
 723                                 && $BObject->{"SharedCacheMap"} eq $SharedCacheMap
 724                                 && $BObject->{"FileOffset"} eq $ByteOffset) {
 725                         push @Bcbs,$Bcb;
 726                         }
 727                 }
 728         if (!@Bcbs) {
 729                 do {
 730                                 warn "Non-Bcb IRP_MJ_WRITE ByteOffset=$ByteOffset but some functions"
 731                                                 ." (".join(",",map({ $_->{"line_enter"}.":".$_->{"by"}; } @{$EnterLeave{$ProcessThread}})).")"
 732                                                 ." are nested:";
 733 #                               warn Dumper $CObject;
 734                                 # Direct IRP_MJ_WRITE can be from callbacked 'FlushToLsnRoutine'.
 735                                 # It can occur even from other callbacks ('DirtyPageRoutine' etc.)
 736                                 # but it was not needed here yet.
 737                                 } if @{$EnterLeave{$ProcessThread}}
 738                                                 && !(${$EnterLeave{$ProcessThread}}[$#{$EnterLeave{$ProcessThread}}]->{"by"} eq "FlushToLsnRoutine");
 739                 warn "Non-Bcb IRP_MJ_WRITE ByteOffset=$ByteOffset but FlushToLsnRoutine was preceding"
 740                                 if $FlushToLsnRoutine;
 741                 return;
 742                 }
 743         warn "Ambiguous matching Bcbs ".join(",",@Bcbs)
 744                                         ." to SharedCacheMap $SharedCacheMap WRITE ByteOffset $ByteOffset"
 745                         if @Bcbs>=2;
 746         my $Bcb=$Bcbs[0];
 747         return if !(my $BObject=BObject $Bcb);
 748         warn "IRP_MJ_WRITE on non-dirty Bcb $Bcb" if !$BObject->{"dirty"};
 749         if ($FlushToLsnRoutine) {
 750                 push @$Lsn_check,{
 751                                 "Bcb"=>$Bcb,
 752                                 "Bcb_Lsn",$BObject->{"Lsn"},
 753                                 } if $Lsn_check;
 754                 }
 755         else {
 756                 warn "Missing preceding FlushToLsnRoutine during IRP_MJ_WRITE of Bcb $Bcb with Lsn ".$BObject->{"Lsn"}
 757                                 if $BObject->{"Lsn"};
 758                 }
 759         warn "IRP_MJ_WRITE with FlushToLsnRoutine although not in AcquireForLazyWrite"
 760                         if $FlushToLsnRoutine && !($CObject->{"AcquireForLazyWrite"}>=1);
 761         # Keep $BObject->{"dirty"} there for &delete_BObject sanity checks.
 762         delete_BObject $BObject if $BObject->{"dirty"} && !$BObject->{"ref_count"};
 763 }
 764
 765 sub IRP_MJ_WRITE_leave()
 766 {
 767         do { warn "Length $_ not divisible by 0x1000" if eval($_)%0x1000; } for ($Object->{"WRITE"}{"Length"});
 768         my @Lsn_check;
 769         for my $reloffs (0..(eval($Object->{"WRITE"}{"Length"})/0x1000)-1) {
 770                 IRP_MJ_WRITE_leave_page tohex(eval($Object->{"WRITE"}{"ByteOffset"})+0x1000*$reloffs),\@Lsn_check;
 771                 }
 772
 773         if ($LastLeave->{"by"} eq "FlushToLsnRoutine" && (my $FlushToLsnRoutine=$LastLeave)) {
 774                 my $Lsn_max;
 775                 for (@Lsn_check) {
 776                         my $Lsn=eval $_->{"Bcb_Lsn"};
 777                         $Lsn_max=$Lsn if !defined($Lsn_max) || $Lsn_max<$Lsn;
 778                         }
 779                 warn "FlushToLsnRoutine of line_enter ".$FlushToLsnRoutine->{"line_enter"}
 780                                                 ." got Lsn ".$FlushToLsnRoutine->{"Lsn"}." although Bcbs have "
 781                                                 .join(",",map({ "(".$_->{"Bcb"}.":".$_->{"Bcb_Lsn"}.")"; } @Lsn_check))
 782                                 if tohex($Lsn_max) ne $FlushToLsnRoutine->{"Lsn"};
 783                 }
 784 }
 785
 786 sub CcPrepareMdlWrite($$$)
 787 {
 788 my($FileObject,$FileOffset,$Length)=@_;
 789
 790         $Object->{"FileObject"}=$FileObject;
 791         warn "FileOffset $FileOffset not divisible by 0x1000" if eval($FileOffset)%0x1000;
 792         $Object->{"FileOffset"}=$FileOffset;
 793         warn "Length $Length not divisible by 0x1000" if eval($Length)%0x1000;
 794         $Object->{"Length"}=$Length;
 795 }
 796
 797 sub CcPrepareMdlWrite_leave($$$)
 798 {
 799 my($MdlChain,$Status,$Information)=@_;
 800
 801         do { warn "Unexpected Status $Status"; return; } if eval $Status;
 802         warn "Unexpected Information $Information" if $Information ne $Object->{"Length"};
 803         warn "MdlChain $MdlChain already exists" if $MdlChain{$MdlChain};
 804         $MdlChain{$MdlChain}=$Object;
 805 }
 806
 807 sub CcMdlWriteComplete($$$)
 808 {
 809 my($FileObject,$FileOffset,$MdlChain)=@_;
 810
 811         return if !(my $MObject=MObject $MdlChain);
 812         warn "CcMdlWriteComplete() parameter FileObject $FileObject"
 813                                         ." not matching MdlChain $MdlChain FileObject ".$MObject->{"FileObject"}
 814                         if $FileObject ne $MObject->{"FileObject"};
 815         warn "CcMdlWriteComplete() parameter FileOffset $FileOffset"
 816                                         ." not matching MdlChain $MdlChain FileOffset ".$MObject->{"FileOffset"}
 817                         if $FileOffset ne $MObject->{"FileOffset"};
 818         # Propose MdlChain to a simulated Bcb.
 819         # We must split it by pages as pin can be just 0x1000 sized.
 820         return if !(my $CObject=CObject_from_FileObject $MObject->{"FileObject"});
 821         for my $reloffs (0..eval($MObject->{"Length"})/0x1000-1) {
 822                 my $BObject={ %$MObject };
 823                 $BObject->{"Bcb"}="MdlChain $MdlChain reloffs $reloffs";
 824                 $BObject->{"FileOffset"}=tohex(eval($MObject->{"FileOffset"})+$reloffs*0x1000);
 825                 $BObject->{"SharedCacheMap"}=$CObject->{"SharedCacheMap"};
 826                 $BObject->{"type"}="pin";
 827                 $BObject->{"ref_count"}=0;
 828                 $BObject->{"dirty"}=1;
 829                 warn "Bcb ".$BObject->{"Bcb"}." already exists" if $Bcb{$BObject->{"Bcb"}};
 830                 $Bcb{$BObject->{"Bcb"}}=$BObject;
 831                 }
 832         delete $MdlChain{$MdlChain};
 833 }
 834
 835 sub CcMdlWriteAbort($$)
 836 {
 837 my($FileObject,$MdlChain)=@_;
 838
 839         warn "CcMdlWriteAbort() not handled";
 840 }
 841
 842 sub AcquireForLazyWrite_leave($)
 843 {
 844 my($r)=@_;
 845
 846         warn "Unexpected 'r' $r" if $r ne "1";
 847         return if !(my $CObject=CObject $Object->{"data"}[0]{"SharedCacheMap"});
 848         $CObject->{"AcquireForLazyWrite"}++;
 849 }
 850
 851 sub ReleaseFromLazyWrite_leave()
 852 {
 853         return if !(my $CObject=CObject $Object->{"data"}[0]{"SharedCacheMap"});
 854         warn "Invalid 'AcquireForLazyWrite' value ".$CObject->{"AcquireForLazyWrite"}
 855                         if !($CObject->{"AcquireForLazyWrite"}>=1);
 856         $CObject->{"AcquireForLazyWrite"}--;
 857 }
 858
 859 sub CcRemapBcb($)
 860 {
 861 my($Bcb)=@_;
 862
 863         return if !(my $BObject=BObject $Bcb);
 864         map_new $BObject->{"SharedCacheMap"};
 865         $Object->{"Buffer"}=tohex(eval($BObject->{"Buffer"})-eval($BObject->{"FileOffset"} || 0));
 866 }
 867
 868 sub CcRemapBcb_leave($)
 869 {
 870 my($r)=@_;
 871
 872         map_new_leave $r;
 873 }
 874
 875 sub unpin($)
 876 {
 877 my($Bcb)=@_;
 878
 879         return if !(my $BObject=BObject $Bcb);
 880         return if --$BObject->{"ref_count"};
 881         if ($BObject->{"dirty"}) {
 882                 # last unpin of unreferenced dirty Bcb will no longer allow reincarnation
 883                 # of the same Bcb to the pin map of its SharedCacheMap.
 884                 return if !(my $CObject=CObject $BObject->{"SharedCacheMap"});
 885                 warn "unpin() of pin Bcb $Bcb but it is already not registered in SharedCacheMap ".$BObject->{"SharedCacheMap"}." pin map"
 886                                 if (!$CObject->{"pin"}{$BObject->{"FileOffset"}} || $CObject->{"pin"}{$BObject->{"FileOffset"}} ne $Bcb)
 887                                                 && !$BObject->{"OwnerPointer"};
 888                 delete $CObject->{"pin"}{$BObject->{"FileOffset"}}
 889                                 if $CObject->{"pin"}{$BObject->{"FileOffset"}} && ($CObject->{"pin"}{$BObject->{"FileOffset"}} eq $Bcb);
 890                 return;
 891                 }
 892         delete_BObject $BObject;
 893 }
 894
 895 sub CcUnpinData($)
 896 {
 897 my($Bcb)=@_;
 898
 899         unpin $Bcb;
 900 }
 901
 902 sub CcUnpinDataForThread($)
 903 {
 904 my($Bcb)=@_;
 905
 906         unpin $Bcb;
 907 }
 908
 909 sub CcSetBcbOwnerPointer($$)
 910 {
 911 my($Bcb,$OwnerPointer)=@_;
 912
 913         return if !(my $BObject=BObject $Bcb);
 914         warn "CcSetBcbOwnerPointer() on map Bcb $Bcb" if $BObject->{"type"} ne "pin";
 915         return if !(my $CObject=CObject $BObject->{"SharedCacheMap"});
 916         warn "Double CcSetBcbOwnerPointer() on Bcb $Bcb" if defined $BObject->{"OwnerPointer"};
 917         my $val=$CObject->{"pin"}{$BObject->{"FileOffset"}};
 918         warn "CcSetBcbOwnerPointer() on unregistered pin Bcb $Bcb" if !$val || $val ne $Bcb;
 919         delete $CObject->{"pin"}{$BObject->{"FileOffset"}} if $val && $val eq $Bcb;
 920         $BObject->{"OwnerPointer"}=$OwnerPointer;
 921 }
 922
 923 sub IRP_MJ_CLOSE_leave()
 924 {
 925         my $FileObject=$Object->{"data"}[0]{"FileObject"};
 926 #       # IRP_MJ_CLOSE of FileObject w/o CcInitializeCacheMap()?
 927 #       return if !$FileObject{$FileObject};
 928         return if !(my $FObject=FObject $FileObject);
 929         if (eval(my $SectionObjectPointer=$FObject->{"SectionObjectPointer"})) {
 930                 return if !(my $SObject=SObject $SectionObjectPointer);
 931                 my $SharedCacheMap=$SObject->{"SharedCacheMap"};
 932                 if (eval $SharedCacheMap) {
 933                         return if !(my $CObject=CObject $SObject->{"SharedCacheMap"});
 934                         # SharedCacheMap may still exist for FCB although this FileObject gets destroyed now.
 935 #                       warn "SectionObjectPointer $SectionObjectPointer still exists during IRP_MJ_CLOSE"
 936 #                                                       ." while SharedCacheMap ".$CObject->{"SharedCacheMap"}." ref_count ".$CObject->{"ref_count"}
 937 #                                       if $SectionObjectPointer && $CObject->{"ref_count"};
 938                         }
 939                 }
 940         delete_FObject $FObject;
 941 }
 942
 943
 944 local $_;
 945 my $hex='0x[\dA-F]+';
 946 my %last_irp_mj;
 947 while (<>) {
 948         chomp;
 949         s/\r$//;
 950         # We may get some foreign garbage without '\n' before our debug data line:
 951         # Do not use '\bTraceFS' as there really can be precediny _any_ data.
 952         s#^.*?TraceFS[(]($hex/$hex)[)]: ## or do { print "$_\n" if $filter; next; };
 953         $ProcessThread=$1;
 954
 955         $Object=undef();
 956         if (/^enter: (\w+)/) {
 957                 $Object={};
 958                 $Object->{"by"}=$1;
 959                 $Object->{"line_enter"}=$.;
 960                 $Object->{"ProcessThread"}=$ProcessThread;
 961                 push @{$EnterLeave{$ProcessThread}},$Object;
 962                 }
 963         elsif (/^leave: (\w+)/) {
 964                 warn "Empty pop stack during 'leave' of $1" if !($Object=pop @{$EnterLeave{$ProcessThread}});
 965                 warn "Non-matching popped 'by' ".$Object->{"by"}." ne current 'leave' $1"
 966                                 if $Object->{"by"} ne $1;
 967                 $Object->{"line_leave"}=$.;
 968                 push @{$LastLeave{$ProcessThread}},$Object;
 969                 }
 970         elsif (my($FileObject,$FileName,$Flags,$SectionObjectPointer,$SharedCacheMap)=
 971                         /^FileObject=($hex): FileName=(?:NULL|'(.*)'),Flags=($hex),SectionObjectPointer=($hex),->SharedCacheMap=($hex)/) {
 972                 my $aref=$EnterLeave{$ProcessThread};
 973                 warn "Empty stack during 'data' line" if !($Object=${$aref}[$#$aref]);
 974                 my $data={
 975                                 "FileObject"=>$FileObject,
 976                                 "FileName"=>$FileName,
 977                                 "Flags"=>$Flags,
 978                                 "SectionObjectPointer"=>$SectionObjectPointer,
 979                                 "SharedCacheMap"=>$SharedCacheMap,
 980                                 "line"=>$.,
 981                                 };
 982                 push @{$Object->{"data"}},$data;
 983                 my $isinit={ map(($_=>1),qw(
 984                                 CcInitializeCacheMap
 985                                 CcUninitializeCacheMap
 986                                 IRP_MJ_CREATE
 987                                 )) }->{$Object->{"by"}};
 988                 check_data $data
 989                                 if 1==@{$Object->{"data"}} || !$isinit;
 990                 if ($isinit) {
 991                         # Prevent 'SharedCacheMap' 0->N change by CcInitializeCacheMap() called inside.
 992                         for my $ref (@$aref[0..$#$aref-1]) {
 993                                 $ref->{"data"}[0]->{"SharedCacheMap"}=$SharedCacheMap;
 994                                 }
 995                         }
 996                 if (2<=@{$Object->{"data"}}) {
 997                         my $data_prev=$Object->{"data"}[$#{$Object->{"data"}}-1];
 998                         for my $field (qw(FileObject FileName Flags),($isinit ? () : qw(SharedCacheMap))) {
 999                                 next if !defined(my $prev=$data_prev->{$field});
1000                                 next if !defined(my $now=$data->{$field});
1001                                 my $by=$Object->{"by"};
1002                                 if ($field eq "Flags") {
1003                                         next if $by eq "IRP_MJ_CREATE" && $field eq "Flags";
1004                                         my $FO_CLEANUP_COMPLETE=0x4000;
1005                                         $now=tohex(eval($now)&~$FO_CLEANUP_COMPLETE) if $by eq "IRP_MJ_CLEANUP";
1006                                         my $FO_FILE_FAST_IO_READ=0x80000;
1007                                         $prev=tohex(eval($prev)&~$FO_FILE_FAST_IO_READ) if $by eq "IRP_MJ_CLEANUP";
1008                                         $now=tohex(eval($now)&~$FO_FILE_FAST_IO_READ) if $by eq "IRP_MJ_READ" && !(eval($prev)&$FO_FILE_FAST_IO_READ);
1009                                         my $FO_FILE_MODIFIED=0x1000;
1010                                         $now=tohex(eval($now)&~$FO_FILE_MODIFIED) if $by eq "IRP_MJ_WRITE" && !(eval($prev)&$FO_FILE_MODIFIED);
1011                                         my $FO_FILE_SIZE_CHANGED=0x2000;
1012                                         $prev=tohex(eval($prev)&~$FO_FILE_MODIFIED)
1013                                                         if $by eq "IRP_MJ_SET_INFORMATION" && !(eval($now)&$FO_FILE_MODIFIED);
1014                                         $prev=tohex(eval($prev)&~$FO_FILE_SIZE_CHANGED)
1015                                                         if $by eq "IRP_MJ_SET_INFORMATION" && !(eval($now)&$FO_FILE_SIZE_CHANGED);
1016                                         }
1017                                 next if $by eq "IRP_MJ_CLOSE" && $field eq "FileName";
1018                                 $prev=~s#\\$## if $by eq "IRP_MJ_CREATE";
1019                                 $prev="\\" if $by eq "IRP_MJ_CREATE" && $prev eq "";
1020                                 $prev=~s#:.*## if $by eq "IRP_MJ_CREATE" && $prev ne $now;
1021                                 next if $field eq "SharedCacheMap" && !SharedCacheMap_valid $prev && !SharedCacheMap_valid $now;
1022                                 do { warn "Changed data field $field, prev=".$data_prev->{$field}.", now=".$data->{$field}." by $by";
1023 #                                               print STDERR Dumper $data_prev,$data;
1024                                                 } if $prev ne $now;
1025                                 }
1026                         }
1027                 next;
1028                 }
1029         elsif (my($ByteOffset,$Length)=
1030                         /^WRITE: ByteOffset=($hex),Length=($hex)/) {
1031                 my $aref=$EnterLeave{$ProcessThread};
1032                 warn "Empty stack during 'data' line" if !($Object=${$aref}[$#$aref]);
1033                 $Object->{"WRITE"}={
1034                         "ByteOffset"=>$ByteOffset,
1035                         "Length"=>$Length,
1036                         };
1037                 next;
1038                 }
1039
1040         $LastLeave=${$LastLeave{$ProcessThread}}[$#{$LastLeave{$ProcessThread}}-1];
1041
1042         if (my($r)=
1043                         /^leave: IRP_MJ_\w+: r=($hex)/) {
1044                 # Failed requests should make no consequences.
1045                 next if eval($r);
1046                 }
1047
1048         if (my($FileObject,$AllocationSize,$FileSize,$ValidDataLength,$PinAccess)=
1049                         /^enter: CcInitializeCacheMap: FileObject=($hex),FileSizes,->AllocationSize=($hex),->FileSize=($hex),->ValidDataLength=($hex),PinAccess=([01]),/) {
1050                 CcInitializeCacheMap $FileObject,eval($AllocationSize),eval($FileSize),eval($ValidDataLength),eval($PinAccess);
1051                 next;
1052                 }
1053         if (/^leave: CcInitializeCacheMap\b/) {
1054                 CcInitializeCacheMap_leave;
1055                 next;
1056                 }
1057
1058         if (my($FileObject,$TruncateSize)=
1059                         /^enter: CcUninitializeCacheMap: FileObject=($hex),TruncateSize=($hex),/) {
1060                 CcUninitializeCacheMap $FileObject,eval($TruncateSize);
1061                 next;
1062                 }
1063         if (my($r)=
1064                         /^leave: CcUninitializeCacheMap: r=([01])/) {
1065                 CcUninitializeCacheMap_leave $r;
1066                 next;
1067                 }
1068
1069         if (my($FileObject,$AllocationSize,$FileSize,$ValidDataLength)=
1070                         /^enter: CcSetFileSizes: FileObject=($hex),FileSizes,->AllocationSize=($hex),->FileSize=($hex),->ValidDataLength=($hex)/) {
1071                 CcSetFileSizes $FileObject,eval($AllocationSize),eval($FileSize),eval($ValidDataLength);
1072                 next;
1073                 }
1074
1075         if (/^leave: IRP_MJ_CREATE\b/) {
1076                 IRP_MJ_CREATE_leave;
1077                 next;
1078                 }
1079
1080         if (/^leave: IRP_MJ_CLOSE\b/) {
1081                 IRP_MJ_CLOSE_leave;
1082                 next;
1083                 }
1084
1085         if (my($FileObject,$FileOffset,$Length)=
1086                         /^enter: CcMapData: FileObject=($hex),FileOffset=($hex),Length=($hex),Flags=0x1/) {
1087                 CcMapData $FileObject,eval($FileOffset),eval($Length);
1088                 next;
1089                 }
1090         if (my($Bcb,$Buffer)=
1091                         /^leave: CcMapData: r=1,Bcb=($hex),Buffer=($hex)/) {
1092                 CcMapData_leave $Bcb,$Buffer;
1093                 next;
1094                 }
1095
1096         if (my($FileObject,$FileOffset,$Length)=
1097                         /^enter: CcPinRead: FileObject=($hex),FileOffset=($hex),Length=($hex),Flags=0x1/) {
1098                 CcPinRead $FileObject,eval($FileOffset),eval($Length);
1099                 next;
1100                 }
1101         if (my($Bcb,$Buffer)=
1102                         /^leave: CcPinRead: r=1,Bcb=($hex),Buffer=($hex)/) {
1103                 CcPinRead_leave $Bcb,$Buffer;
1104                 next;
1105                 }
1106
1107         if (my($FileObject,$FileOffset,$Length)=
1108                         /^enter: CcPreparePinWrite: FileObject=($hex),FileOffset=($hex),Length=($hex),Zero=([01]),Flags=0x1/) {
1109                 CcPreparePinWrite $FileObject,eval($FileOffset),eval($Length);
1110                 next;
1111                 }
1112         if (my($Bcb,$Buffer)=
1113                         /^leave: CcPreparePinWrite: r=1,Bcb=($hex),Buffer=($hex)/) {
1114                 CcPreparePinWrite_leave $Bcb,$Buffer;
1115                 next;
1116                 }
1117
1118         if (my($FileObject,$FileOffset,$Length)=
1119                         /^enter: CcPinMappedData: FileObject=($hex),FileOffset=($hex),Length=($hex),Flags=0x1/) {
1120                 CcPinMappedData $FileObject,eval($FileOffset),eval($Length);
1121                 next;
1122                 }
1123         if (my($Bcb)=
1124                         /^leave: CcPinMappedData: r=1,Bcb=($hex)/) {
1125                 CcPinMappedData_leave $Bcb;
1126                 next;
1127                 }
1128
1129         if (my($BcbVoid,$Lsn)=
1130                         /^enter: CcSetDirtyPinnedData: BcbVoid=($hex),Lsn=($hex)/) {
1131                 CcSetDirtyPinnedData $BcbVoid,$Lsn;
1132                 next;
1133                 }
1134
1135         if (my($LogHandle,$Lsn)=
1136                         /^enter: FlushToLsnRoutine: LogHandle=($hex),Lsn=($hex)/) {
1137                 FlushToLsnRoutine $LogHandle,$Lsn;
1138                 next;
1139                 }
1140
1141         if (/^leave: IRP_MJ_WRITE\b/) {
1142                 IRP_MJ_WRITE_leave;
1143                 next;
1144                 }
1145
1146         if (my($r)=
1147                         /^leave: AcquireForLazyWrite: r=([01])/) {
1148                 AcquireForLazyWrite_leave $r;
1149                 }
1150
1151         if (/^leave: ReleaseFromLazyWrite\b/) {
1152                 ReleaseFromLazyWrite_leave;
1153                 }
1154
1155         if (my($FileObject,$LogHandle,$FlushToLsnRoutine)=
1156                         /^enter: CcSetLogHandleForFile: FileObject=($hex),LogHandle=($hex),FlushToLsnRoutine=($hex)/) {
1157                 CcSetLogHandleForFile $FileObject,$LogHandle,$FlushToLsnRoutine;
1158                 next;
1159                 }
1160
1161         if (my($FileObject,$FileOffset,$Length)=
1162                         /^enter: CcPrepareMdlWrite: FileObject=($hex),FileOffset=($hex),Length=($hex)/) {
1163                 CcPrepareMdlWrite $FileObject,$FileOffset,$Length;
1164                 next;
1165                 }
1166         if (my($MdlChain,$Status,$Information)=
1167                         /^leave: CcPrepareMdlWrite: MdlChain=($hex),IoStatus->Status=($hex),IoStatus->Information=($hex)/) {
1168                 CcPrepareMdlWrite_leave $MdlChain,$Status,$Information;
1169                 next;
1170                 }
1171
1172         if (my($FileObject,$FileOffset,$MdlChain)=
1173                         /^enter: CcMdlWriteComplete: FileObject=($hex),FileOffset=($hex),MdlChain=($hex)/) {
1174                 CcMdlWriteComplete $FileObject,$FileOffset,$MdlChain;
1175                 next;
1176                 }
1177
1178         if (my($FileObject,$MdlChain)=
1179                         /^enter: CcMdlWriteAbort: FileObject=($hex),MdlChain=($hex)/) {
1180                 CcMdlWriteAbort $FileObject,$MdlChain;
1181                 next;
1182                 }
1183
1184         if (my($Bcb)=
1185                         /^enter: CcRemapBcb: Bcb=($hex)/) {
1186                 CcRemapBcb $Bcb;
1187                 next;
1188                 }
1189         if (my($r)=
1190                         /^leave: CcRemapBcb: r=($hex)/) {
1191                 CcRemapBcb_leave $r;
1192                 next;
1193                 }
1194
1195         if (my($Bcb)=
1196                         /^enter: CcUnpinData: Bcb=($hex)/) {
1197                 CcUnpinData $Bcb;
1198                 next;
1199                 }
1200         if (my($Bcb)=
1201                         /^enter: CcUnpinDataForThread: Bcb=($hex)/) {
1202                 CcUnpinDataForThread $Bcb;
1203                 next;
1204                 }
1205
1206         if (my($Bcb,$OwnerPointer)=
1207                         /^enter: CcSetBcbOwnerPointer: Bcb=($hex),OwnerPointer=($hex)/) {
1208                 CcSetBcbOwnerPointer $Bcb,$OwnerPointer;
1209                 next;
1210                 }
1211
1212         print "$_\n" if $filter;
1213         }
1214 for my $FileObject (keys(%FileObject)) {
1215         warn "EXIT: still CcInitializeCacheMap FileObject $FileObject";
1216         next if !(my $FObject=FObject $FileObject);
1217         }