#!/usr/bin/perl -w

my $GDT_BASIS=0x8003f000;
my $GDT_LIMIT=0x000003ff;
my $CR0=0xe001003b;
my $CR2=0x77d55d53;
my $CR3=0x00039000;
my $CR4=0x00000098;

my $PG_PRESENT_MASK=1<<0;
my $PG_PSE_MASK=1<<7;
my $CR4_PSE_MASK=1<<4;
my $TARGET_PAGE_BITS=12;
my $TARGET_PAGE_SIZE=(1 << $TARGET_PAGE_BITS);
my $TARGET_PAGE_MASK=0xffffffff - ($TARGET_PAGE_SIZE - 1);
my $DESC_G_MASK= (1 << 23);


my $ram;

my $current=0;

sub qemu_get_be32()
{
  my $buffer="    ";
  read STDIN,$buffer,4;
  $current+=4;
  return unpack("N",$buffer);
}

sub qemu_get_byte()
{
  
  my $buffer=" ";
  read STDIN,$buffer,1;
  $current+=1;
  return unpack("C",$buffer);
}

sub qemu_get_buffer($)
{
  my $buffer="";
  read STDIN,$buffer,$_[0];
  $current+=$_[0];
  return $buffer;
}

sub ftell()
{
  return $current;
}



my $magic=qemu_get_be32();

print "Magic: $magic\n";

if($magic ne 1363498573) # "QEVM")
{
  print "Dies ist kein QEMU VM Image.\n";
  exit;
}

print "QEMU Image detected.\n";

my $version=qemu_get_be32();

print "Version: $version\n";

mkdir "devices";


while(1)
{
#  print "Cur_Pos: ".ftell()."\n";
  my $idlen = qemu_get_byte();
  last if(eof(STDIN));
  print "Len: $idlen\n";
  my $idstr=qemu_get_buffer($idlen);
  print "IDSTR: $idstr\n";
  my $instance_id = qemu_get_be32();
  print "Instance_ID: $instance_id\n";
  my $version_id = qemu_get_be32();
  print "Version_ID: $version_id\n";
  my $record_len = qemu_get_be32();
  print "Record_Len: $record_len\n";
  my $cur_pos = ftell();
#  print "Cur_Pos: $cur_pos\n";


  my $content=qemu_get_buffer($record_len);

  open OUT,">devices/$idstr";
  print OUT $content;
  close OUT;

  if($idstr eq "timer")
  {

    #my $ret = $se->load_state($se->opaque, $version_id);
    #if ($ret < 0) 
    #{
    #  print STDERR "qemu: warning: error while loading state for instance 0x$instance_id of device '$idstr'\n";
    #}

  }
  elsif($idstr eq "cpu")
  {
    $GDT_BASIS=unpack("N",substr($content,266,4));
    $GDT_LIMIT=unpack("N",substr($content,270,4));
    $LDT_BASIS=unpack("N",substr($content,282,4));
    $LDT_LIMIT=unpack("N",substr($content,286,4));
    print "GDT: $GDT_BASIS $GDT_LIMIT\n";
    print "LDT: $LDT_BASIS $LDT_LIMIT\n";
  
    $CR3=unpack("N",substr($content,314,4));
    print sprintf "CR3: 0x%02X\n",$CR3; 
    $CR4=unpack("N",substr($content,318,4));
    print sprintf "CR4: 0x%02X\n",$CR4; 
    
  }
  elsif($idstr eq "ram")
  {
    my $Bytes=unpack("N",substr($content,0,4));
    print "$Bytes Bytes RAM gefunden.\n";
    my $got=0; my $pos=4;
    while($got<$Bytes)
    {
      if(unpack("C",substr($content,$pos,1)) == 0)
      {
        $pos++;
        $ram.=substr($content,$pos,$TARGET_PAGE_SIZE);
        $pos+=$TARGET_PAGE_SIZE;
        $got+=$TARGET_PAGE_SIZE;
      }
      else
      { 
        $pos++;
        $ram.=substr($content,$pos,1)x$TARGET_PAGE_SIZE;
        $pos++;
        $got+=$TARGET_PAGE_SIZE;
      }
    }
    open OUT,">devices/physicalram";
    print OUT $ram;
    close OUT;
  }
  else
  {
    print STDERR "qemu: warning: instance 0x$instance_id of device '$idstr' not present in current VM\n";
  }

  $current=$cur_pos+$record_len;
  seek STDIN,$current,0;

}

sub linear2physisch($)
{

  if($CR0 & (1<<31))
  {
    print "Paging aktiv\n";
  }
  else
  {
    print "Paging NICHT aktiv!\n";
    return $_[0];
  }

  my $a20_mask=0xffffffff; # 0xffefffff; # oder 0xffffffff
  print sprintf "Konvertiere 0x%02X ...\n",$_[0];

  my $pde_ptr = ((($CR3 & ~0xfff) + (($_[0] >> 20) & 0xfffffff8)) & $a20_mask);

  print sprintf "PDE_Pointer: 0x%02X\n",$pde_ptr;

  my $pde = unpack("V",substr($ram,$pde_ptr,4));

  print sprintf "PDE: 0x%02X ($pde)\n",$pde;
  print sprintf "TARGET MASK: 0x%02X   (size: $TARGET_PAGE_SIZE)\n",$TARGET_PAGE_MASK;

  if (!($pde & $PG_PRESENT_MASK))
  {
    print "Keine Pagetable present!\n";
    return -1;
  }

  my $pte=0;
  my $page_size=0;

  if (($pde & $PG_PSE_MASK) && ($CR4 & $CR4_PSE_MASK)) 
  {
    $pte = $pde & ~0x003ff000; 
    print "aligning to 4MB ...\n";
    $page_size = 4096 * 1024;
  }
  else 
  {
    print "page directory entry ...\n";
    $pte_ptr = ((($pde & ~0xfff) + (($_[0] >> 10) & 0xffc)) & $a20_mask);
    $pte = unpack("V",substr($ram,$pte_ptr,4));
    print sprintf "PTE: 0x%02X ($pte)\n",$pte;

    if (!($pte & $PG_PRESENT_MASK))
    {
      print "PageTable not PRESENT!\n";
      return -1;
    }
    $page_size = 4096;
  }
  print sprintf "PTE: 0x%02X ($pte)\n",$pte;
  $pte = $pte & $a20_mask;
  print sprintf "PTE: 0x%02X ($pte)\n",$pte;
  my $page_offset = ($_[0] & $TARGET_PAGE_MASK) & ($page_size - 1);
  print sprintf "Page_Offset: 0x%02X ($page_offset)\n",$page_offset;

  my $paddr = ($pte & $TARGET_PAGE_MASK) + $page_offset;
  print sprintf "Fertige Adresse in physischem Format: 0x%02X ($paddr)\n",$paddr;
  return $paddr;
}

sub output_segment($$)
{
  my ($segment,$gdt)=@_;
  print "\n\nSegment #$segment:\n";
  print "Segmentadresse: ".(8*$segment+$gdt)."\n";
  my $descriptor=substr($ram,8*$segment+$gdt,8);

  my $e1=unpack("V",substr($descriptor,0,4));
  my $e2=unpack("V",substr($descriptor,4,4));

  my $limit=($e1 & 0xffff) | ($e2 & 0x000f0000);

  $limit=($e2 & $DESC_G_MASK) ? ($limit << 12) | 0xfff  : $limit;

  my $base=(($e1 >> 16) | (($e2 & 0xff) << 16) | ($e2 & 0xff000000));


 
  print "Segmentlaenge: $limit\n";

  print sprintf "Basisadresse: 0x%02X ($base) \n",$base;



}


my $gdt=linear2physisch($GDT_BASIS);
foreach(0 .. 30)
{
  output_segment($_,$gdt);
}



my $ldt=linear2physisch($LDT_BASIS);