File Coverage

blib/lib/Finnigan/OLE2File.pm

Criterion	Covered	Total	%
statement	120	135	88.8
branch	16	32	50.0
condition	1	6	16.6
subroutine	17	19	89.4
pod	13	13	100.0
total	167	205	81.4

package Finnigan::OLE2File;

use strict;
use warnings FATAL => qw( all );
our $VERSION = 0.0206;

use Finnigan;
use base 'Finnigan::Decoder';
use Carp qw/confess/;

use overload ('""' => 'stringify');

my $NDIF = 109;
my $FAT_POINTER_SIZE = 4; # 32 bits
my $PROPERTY_SIZE    = 128;
my $UNUSED       = 0xFFFFFFFF;   # -1
my $END_OF_CHAIN = 0xFFFFFFFE;   # -2
my $FAT_SECTOR  = 0xFFFFFFFD;   # -3
my $DIF_SECTOR = 0xFFFFFFFC;   # -4

my %SPECIAL = ($END_OF_CHAIN => 1, $UNUSED => 1, $FAT_SECTOR => 1, $DIF_SECTOR => 1);

sub decode {
  my ($class, $stream, $version) = @_;

  my @fields = (
                "magic"       => ['a8',     'RawBytes'],
                "header"      => ['object', 'Finnigan::OLE2Header'],
               );

  my $self = Finnigan::Decoder->read($stream, \@fields, $version);
  bless $self, $class;

  die "incorect OLE2 id" unless $self->magic eq "\xD0\xCF\x11\xE0\xA1\xB1\x1A\xE1";

  # configure values
  $self->{stream} = $stream;
  $self->{"sector size"} = (1 << $self->header->bb_log);
  $self->{"fat count"} = $self->header->bb_count;
  $self->{"items per fat"} = $self->{"sector size"} / 4; # (size of sector pointer)
  $self->{"ss size"} = (1 << $self->header->sb_log);
  $self->{"items per minifat"} = $self->{"items per fat"};

  # read the DIF (Double-Indirect FAT)
  $self->SUPER::decode(
                       $stream,
                       ["dif" => ['object', 'Finnigan::OLE2DIF']],
                       [$self->header->dif_start, $self->header->dif_count],
                      );

  $self->{"block ref addr"} =
    $self->{addr}
      + $self->{data}->{magic}->{size}
        + $self->{data}->{header}->{size}
          + $NDIF * $FAT_POINTER_SIZE;

  # read the big FAT
  $self->{fat} = [];
  my $start = 0;
  my $count = $self->{"items per fat"};
  for my $index ( 0 .. scalar @{$self->dif->sect} - 1 ) {
    my $block = $self->dif->sect->[$index];
    last if $block == $UNUSED;
    $self->seek_block($block);
    $self->SUPER::decode(
                         $stream,
                         ["fat[$block]" => ['object', 'Finnigan::OLE2FAT']],
                         [$start, $count],
                        );
    push @{$self->{fat}}, $self->{data}->{"fat[$block]"}->{value};
  }

  # Read the mini-FAT
  $self->{minifat} = [];
  my @chain = $self->get_chain($self->header->sb_start, 'big');
  $start = 0;
  $count = $self->{"items per minifat"};
  for my $index ( 0 .. $#chain ) {
    my $block = $chain[$index];
    $self->seek_block($block);
    $self->SUPER::decode(
                         $stream,
                         ["minifat[$block]" => ['object', 'Finnigan::OLE2FAT']],
                         [$start, $count],
                        );
    push @{$self->{minifat}}, $self->{data}->{"minifat[$block]"}->{value};
    $start += $count;
  }

  # Read properties
  @chain = $self->get_chain($self->header->bb_start, 'big');
  my $prop_per_sector = int( $self->{"sector size"} / $PROPERTY_SIZE );
  $self->{properties} = [];
  foreach my $block ( @chain ) {
    $self->seek_block($block);
    foreach my $index ( 1 .. $prop_per_sector ) {
      # read the property name and return to start
      my $addr = tell $stream;
      my $bytes_to_read = 64;
      my $rec;
      my $nbytes = CORE::read $stream, $rec, $bytes_to_read;
      $nbytes == $bytes_to_read
        or die "could not read the $bytes_to_read bytes of property name at $addr";
      seek $stream, $addr, 0;

      my $charset;
      if ( $rec =~ /^\w\0\w\0/ ) {
        $charset = "UTF-16-LE";
      }
      elsif ( $rec =~ /^\0\w\0\w/ ) {
        $charset = "UTF-16-BE";
      }
      elsif ( $rec =~ /^\0{64}/ ) {
        last; # a null entry indicates the end of directory
      }
      else {
        my @hex = map { if (/[A-z]/) {$_} else { sprintf "%2.2x", ord($_) } } split("", $rec);
        confess "unknown encoding or not a string at $addr (@hex)";
      }

      $self->SUPER::decode(
                           $stream,
                           ["property[$block][$index]" => ['object', 'Finnigan::OLE2Property']],
                           [$self->header->bb_log, $charset]
                          );
      push @{$self->{properties}}, $self->{data}->{"property[$block][$index]"}->{value};
    }
  }

  # read the small block depot (which resides in the root entry's data stream)
  my $dir = new Finnigan::OLE2DirectoryEntry($self, 0);
  $self->{rootdir} = $dir;
  $self->{sbd} = $dir->data;

  return $self;
}

sub list {
  shift->{rootdir}->list();
}

sub stream {
  shift->{stream};
}

sub magic {
  shift->{data}->{magic}->{value};
}

sub header {
  shift->{data}->{header}->{value};
}

sub dif {
  shift->{data}->{dif}->{value};
}

sub fat {
  my ( $self, $block ) = @_;
  shift->{data}->{"fat[$block]"}->{value};
}

sub stringify {
  my $self = shift;

  my $n = scalar @{$self->{properties}};
  return "Windows Compound Binary File: $n nodes";
}

sub sector_size {
  my ( $self, $stream_size ) = @_;
  return $self->{"sector size"} unless $stream_size; # big by default
  return $self->{"sector size"} if $stream_size and $stream_size eq 'big';
  return $self->{"ss size"} if $stream_size and $stream_size eq 'mini';
}

sub seek_block {
  my ($self, $block) = @_;
  seek $self->{stream}, $self->{"block ref addr"} + $block * $self->sector_size('big'), 0;
}

sub read {
  my ($self, $stream_size, $start, $blocks_to_read) = @_;
  my $sector_size = $self->sector_size($stream_size);
  if ( $stream_size eq 'big' ) {
    my $rec;
    my $addr = tell $self->stream;
    my $bytes_to_read = $blocks_to_read * $sector_size;
    $self->seek_block($start);
    my $nbytes = CORE::read $self->stream, $rec, $bytes_to_read;
    $nbytes == $bytes_to_read
      or die "could not read $bytes_to_read bytes of property name at $addr";
    return $rec;
  }
  else {
    return substr $self->{sbd}, $start*$sector_size, $blocks_to_read*$sector_size;
  }
}

sub get_chain {
  my ($self, $start, $stream_size) = @_;

  my ($fat, $items_per_fat, $err_prefix);
  my @result;
  if ( $stream_size eq 'mini' ) {
    $fat = $self->{minifat};
    $items_per_fat = $self->{"items per minifat"};
    $err_prefix = "SFAT chain";
  }
  else {
    $fat = $self->{fat};
    $items_per_fat = $self->{"items per fat"};
    $err_prefix = "FAT chain";
  }

  my $block = $start;
  my %block_set;
  my $previous = $block;
  while ( $block != $END_OF_CHAIN ) {
    die (
         sprintf "%s: Invalid block index (0x%08x), previous=%s", $err_prefix, $block, $previous
        ) if $SPECIAL{$block};
    die ( sprintf "%s: Found a loop (%s=>%s)", $err_prefix, $previous, $block )
      if $block_set{$block};
    $block_set{$block}++;
    push @result, $block;
    $previous = $block;
    my $index = int($block / $items_per_fat);
    $block = $fat->[$index]->sect->[$block];
    last unless defined $block;
  }

  return @result;
}

sub find {
  my ($self, $path) = @_;
  $self->{rootdir}->find($path);
}

1;
__END__