rock_cache_dump.pl

rock_cache_dump.pl

#!/usr/bin/perl

use strict;
use warnings;
use Data::Dumper;
use Sys::Mmap;

my ($file) = @ARGV;
die "Usage: $0 <cache_dir>/rock\n" if not $file;

my @TLVS = ('VOID', 'KEY_URL', 'KEY_SHA', 'KEY_MD5', 'URL', 'STD', 'HITMETERING', 'VALID', 'VARY_HEADERS', 'STD_LFS', 'OBJSIZE', 'STOREURL', 'VARY_ID', 'END');

open my $fh, '<', $file or die;
my %H, $mmap;
mmap($mmap, 0, PROT_READ, MAP_SHARED, $fh) or die "Can't mmap: $!";

my $slots = length($mmap)/0x4000-1;
my($slot, $empty_slots, $used_slots, $first_slot, $start_time) = (0, 0, 0, 0, time);

while($slot<$slots){
        my($key, $total_len, $current_len, $version, $first_slot, $next_slot, $meta_ok, $tlvheader_len) = unpack('H32QLLLLCL', substr($mmap, ($slot+1)<<14, 45));
        if($first_slot){$used_slots++}else{$empty_slots++}
        process_slot($slot,$version, $tlvheader_len) if($next_slot && $meta_ok == 3 && $first_slot == $slot);
        $slot++
}
print Dumper(\%H);
print STDERR "File size: \t".int(length($mmap)/1024/1024)." MB\nTotal slots: \t".($empty_slots+$used_slots)."\nEmpty slots: \t$empty_slots\nUsed  slots: \t$used_slots\nUsage: \t\t".int($used_slots*100/($empty_slots+$used_slots))." %\nProcess time:\t".(time-$start_time)." s\n\n";

sub process_slot{
  my($slot, $version, $tlvheader_len) = @_;
  $tlvheader_len-=5;
  $H{$slot}={VERSION => "".localtime($version)};

  my $remain=substr($mmap, (($slot+1)<<14)+45, $tlvheader_len);

  my($type, $len, $value);
  while($remain){

        ($type, $len,$remain) = unpack('cLa*', $remain);
        ($value, $remain) = unpack("a$len"."a*", $remain);
        $H{$slot}{$TLVS[$type]} = $value;
        $H{$slot}{$TLVS[$type]} = unpack("A*", $H{$slot}{$TLVS[$type]}) if($type == 4 || $type == 8); #URL || VARY_HEADERS
        $H{$slot}{$TLVS[$type]} = unpack("H*", $H{$slot}{$TLVS[$type]}) if($type == 3 ); #KEY_MD5
        $H{$slot}{$TLVS[$type]} = unpack("Q*", $H{$slot}{$TLVS[$type]}) if($type == 10); #OBJSIZE
        $H{$slot}{$TLVS[$type]} = parse_STD(unpack("qqqqQSH4", $H{$slot}{$TLVS[$type]})) if($type == 9); #STD_LFS
  }

}

sub parse_STD{
   my($timestamp, $lastref, $expires, $lastmod) = map {"".localtime($_)} @_[0..3];
   my($swap_file_sz, $refcount, $flags)  = ($_[4], $_[5], $_[6]);
   return {timestamp => $timestamp, lastref => $lastref, expires => $expires, lastmod => $lastmod, swap_file_sz => $swap_file_sz, refcount => $refcount, flags => "0x".$flags};
}