mirror of
https://github.com/overcuriousity/autopsy-flatpak.git
synced 2025-07-14 17:06:16 +00:00
705 lines
18 KiB
Perl
705 lines
18 KiB
Perl
#-----------------------------------------------------------
|
|
# comdlg32.pl
|
|
# Plugin for Registry Ripper
|
|
#
|
|
# Change history
|
|
# 20121005 - updated to address shell item type 0x3A
|
|
# 20121005 - updated to parse shell item ID lists
|
|
# 20100409 - updated to include Vista and above
|
|
# 20100402 - updated IAW Chad Tilbury's post to SANS
|
|
# Forensic Blog
|
|
# 20080324 - created
|
|
#
|
|
# References
|
|
# Win2000 - http://support.microsoft.com/kb/319958
|
|
# XP - http://support.microsoft.com/kb/322948/EN-US/
|
|
#
|
|
# copyright 2012 Quantum Analytics Research, LLC
|
|
# Author: H. Carvey, keydet89@yahoo.com
|
|
#-----------------------------------------------------------
|
|
package comdlg32;
|
|
use strict;
|
|
use Time::Local;
|
|
|
|
my %config = (hive => "NTUSER\.DAT",
|
|
hasShortDescr => 1,
|
|
hasDescr => 0,
|
|
hasRefs => 0,
|
|
osmask => 22,
|
|
version => 20121008);
|
|
|
|
sub getConfig{return %config}
|
|
sub getShortDescr {
|
|
return "Gets contents of user's ComDlg32 key";
|
|
}
|
|
sub getDescr{}
|
|
sub getRefs {}
|
|
sub getHive {return $config{hive};}
|
|
sub getVersion {return $config{version};}
|
|
|
|
my $VERSION = getVersion();
|
|
|
|
sub pluginmain {
|
|
my $class = shift;
|
|
my $ntuser = shift;
|
|
::logMsg("Launching comdlg32 v.".$VERSION);
|
|
my $reg = Parse::Win32Registry->new($ntuser);
|
|
my $root_key = $reg->get_root_key;
|
|
::rptMsg("comdlg32 v.".$VERSION);
|
|
::rptMsg("");
|
|
# LastVistedMRU
|
|
my $key_path = "Software\\Microsoft\\Windows\\CurrentVersion\\Explorer\\ComDlg32";
|
|
my $key;
|
|
my @vals;
|
|
if ($key = $root_key->get_subkey($key_path)) {
|
|
::rptMsg($key_path);
|
|
::rptMsg("LastWrite Time ".gmtime($key->get_timestamp())." (UTC)");
|
|
|
|
my @subkeys = $key->get_list_of_subkeys();
|
|
|
|
if (scalar @subkeys > 0) {
|
|
foreach my $s (@subkeys) {
|
|
if ($s->get_name() eq "LastVisitedMRU") {
|
|
::rptMsg("LastVisitedMRU");
|
|
::rptMsg("LastWrite: ".gmtime($s->get_timestamp()));
|
|
parseLastVisitedMRU($s);
|
|
::rptMsg("");
|
|
}
|
|
|
|
if ($s->get_name() eq "OpenSaveMRU") {
|
|
::rptMsg("OpenSaveMRU");
|
|
::rptMsg("LastWrite: ".gmtime($s->get_timestamp()));
|
|
parseOpenSaveMRU($s);
|
|
::rptMsg("");
|
|
}
|
|
|
|
if ($s->get_name() eq "CIDSizeMRU") {
|
|
::rptMsg("CIDSizeMRU");
|
|
::rptMsg("LastWrite: ".gmtime($s->get_timestamp()));
|
|
parseCIDSizeMRU($s);
|
|
::rptMsg("");
|
|
}
|
|
|
|
if ($s->get_name() eq "FirstFolder") {
|
|
::rptMsg("FirstFolder");
|
|
::rptMsg("LastWrite: ".gmtime($s->get_timestamp()));
|
|
parseFirstFolder($s);
|
|
::rptMsg("");
|
|
}
|
|
|
|
if ($s->get_name() eq "LastVisitedPidlMRU" || $s->get_name() eq "LastVisitedPidlMRULegacy") {
|
|
::rptMsg("LastVisitedPidlMRU");
|
|
::rptMsg("LastWrite: ".gmtime($s->get_timestamp()));
|
|
parseLastVisitedPidlMRU($s);
|
|
::rptMsg("");
|
|
}
|
|
|
|
if ($s->get_name() eq "OpenSavePidlMRU") {
|
|
::rptMsg("OpenSavePidlMRU");
|
|
::rptMsg("LastWrite: ".gmtime($s->get_timestamp()));
|
|
parseOpenSavePidlMRU($s);
|
|
::rptMsg("");
|
|
}
|
|
}
|
|
}
|
|
else {
|
|
::rptMsg($key_path." has no subkeys.");
|
|
}
|
|
}
|
|
else {
|
|
::rptMsg($key_path." not found.");
|
|
}
|
|
}
|
|
|
|
sub parseLastVisitedMRU {
|
|
my $key = shift;
|
|
my %lvmru;
|
|
my @mrulist;
|
|
my @vals = $key->get_list_of_values();
|
|
|
|
if (scalar(@vals) > 0) {
|
|
# First, read in all of the values and the data
|
|
foreach my $v (@vals) {
|
|
$lvmru{$v->get_name()} = $v->get_data();
|
|
}
|
|
# Then, remove the MRUList value
|
|
if (exists $lvmru{MRUList}) {
|
|
::rptMsg(" MRUList = ".$lvmru{MRUList});
|
|
@mrulist = split(//,$lvmru{MRUList});
|
|
delete($lvmru{MRUList});
|
|
foreach my $m (@mrulist) {
|
|
my ($file,$dir) = split(/\x00\x00/,$lvmru{$m},2);
|
|
$file =~ s/\x00//g;
|
|
$dir =~ s/\x00//g;
|
|
::rptMsg(" ".$m." -> EXE: ".$file);
|
|
::rptMsg(" -> Last Dir: ".$dir);
|
|
}
|
|
}
|
|
else {
|
|
::rptMsg("LastVisitedMRU key does not have an MRUList value.");
|
|
}
|
|
}
|
|
else {
|
|
::rptMsg("LastVisitedMRU key has no values.");
|
|
}
|
|
::rptMsg("");
|
|
}
|
|
|
|
sub parseOpenSaveMRU {
|
|
my $key = shift;
|
|
|
|
parseOpenSaveValues($key);
|
|
::rptMsg("");
|
|
# Now, let's get the subkeys
|
|
my @sk = $key->get_list_of_subkeys();
|
|
if (scalar(@sk) > 0) {
|
|
foreach my $s (@sk) {
|
|
parseOpenSaveValues($s);
|
|
::rptMsg("");
|
|
}
|
|
}
|
|
else {
|
|
::rptMsg("OpenSaveMRU key has no subkeys.");
|
|
}
|
|
::rptMsg("");
|
|
}
|
|
|
|
sub parseOpenSaveValues {
|
|
my $key = shift;
|
|
::rptMsg("OpenSaveMRU\\".$key->get_name());
|
|
::rptMsg("LastWrite Time: ".gmtime($key->get_timestamp())." Z");
|
|
my %osmru;
|
|
my @vals = $key->get_list_of_values();
|
|
if (scalar(@vals) > 0) {
|
|
map{$osmru{$_->get_name()} = $_->get_data()}(@vals);
|
|
if (exists $osmru{MRUList}) {
|
|
::rptMsg(" MRUList = ".$osmru{MRUList});
|
|
my @mrulist = split(//,$osmru{MRUList});
|
|
delete($osmru{MRUList});
|
|
foreach my $m (@mrulist) {
|
|
::rptMsg(" ".$m." -> ".$osmru{$m});
|
|
}
|
|
}
|
|
else {
|
|
::rptMsg($key->get_name()." does not have an MRUList value.");
|
|
}
|
|
}
|
|
else {
|
|
::rptMsg($key->get_name()." has no values.");
|
|
}
|
|
}
|
|
|
|
sub parseCIDSizeMRU {
|
|
my $key = shift;
|
|
my %lvmru;
|
|
my @mrulist;
|
|
my @vals = $key->get_list_of_values();
|
|
my %mru;
|
|
my $count = 0;
|
|
|
|
if (scalar(@vals) > 0) {
|
|
# First, read in all of the values and the data
|
|
foreach my $v (@vals) {
|
|
$lvmru{$v->get_name()} = $v->get_data();
|
|
}
|
|
# Then, remove the MRUList value
|
|
::rptMsg("Note: All value names are listed in MRUListEx order.");
|
|
::rptMsg("");
|
|
if (exists $lvmru{MRUListEx}) {
|
|
my @mrulist = unpack("V*",$lvmru{MRUListEx});
|
|
foreach my $n (0..(scalar(@mrulist) - 2)) {
|
|
$mru{$count++} = $lvmru{$mrulist[$n]};
|
|
}
|
|
delete $mru{0xffffffff};
|
|
foreach my $m (sort {$a <=> $b} keys %mru) {
|
|
# my $file = parseStr($mru{$m});
|
|
my $file = (split(/\x00\x00/,$mru{$m},2))[0];
|
|
$file =~ s/\x00//g;
|
|
::rptMsg(" ".$file);
|
|
}
|
|
}
|
|
else {
|
|
# ::rptMsg($key_path." does not have an MRUList value.");
|
|
}
|
|
}
|
|
else {
|
|
# ::rptMsg($key_path." has no values.");
|
|
}
|
|
}
|
|
|
|
sub parseFirstFolder {
|
|
my $key = shift;
|
|
my %lvmru;
|
|
my @mrulist;
|
|
my @vals = $key->get_list_of_values();
|
|
my %mru;
|
|
my $count = 0;
|
|
|
|
if (scalar(@vals) > 0) {
|
|
# First, read in all of the values and the data
|
|
foreach my $v (@vals) {
|
|
$lvmru{$v->get_name()} = $v->get_data();
|
|
}
|
|
# Then, remove the MRUList value
|
|
::rptMsg("Note: All value names are listed in MRUListEx order.");
|
|
::rptMsg("");
|
|
if (exists $lvmru{MRUListEx}) {
|
|
my @mrulist = unpack("V*",$lvmru{MRUListEx});
|
|
foreach my $n (0..(scalar(@mrulist) - 2)) {
|
|
$mru{$count++} = $lvmru{$mrulist[$n]};
|
|
}
|
|
delete $mru{0xffffffff};
|
|
foreach my $m (sort {$a <=> $b} keys %mru) {
|
|
# my $file = parseStr($mru{$m});
|
|
my @files = split(/\x00\x00/,$mru{$m});
|
|
if (scalar(@files) == 0) {
|
|
::rptMsg(" No files listed.");
|
|
}
|
|
elsif (scalar(@files) == 1) {
|
|
$files[0] =~ s/\x00//g;
|
|
::rptMsg(" ".$files[0]);
|
|
}
|
|
elsif (scalar(@files) > 1) {
|
|
my @files2;
|
|
foreach my $file (@files) {
|
|
$file =~ s/\x00//g;
|
|
push(@files2,$file);
|
|
}
|
|
::rptMsg(" ".join(' ',@files2));
|
|
}
|
|
else {
|
|
|
|
}
|
|
}
|
|
}
|
|
else {
|
|
# ::rptMsg($key_path." does not have an MRUList value.");
|
|
}
|
|
}
|
|
else {
|
|
# ::rptMsg($key_path." has no values.");
|
|
}
|
|
}
|
|
|
|
sub parseLastVisitedPidlMRU {
|
|
my $key = shift;
|
|
my %lvmru;
|
|
my @mrulist;
|
|
my @vals = $key->get_list_of_values();
|
|
my %mru;
|
|
my $count = 0;
|
|
|
|
if (scalar(@vals) > 0) {
|
|
# First, read in all of the values and the data
|
|
foreach my $v (@vals) {
|
|
$lvmru{$v->get_name()} = $v->get_data();
|
|
}
|
|
# Then, remove the MRUList value
|
|
::rptMsg("Note: All value names are listed in MRUListEx order.");
|
|
::rptMsg("");
|
|
if (exists $lvmru{MRUListEx}) {
|
|
my @mrulist = unpack("V*",$lvmru{MRUListEx});
|
|
foreach my $n (0..(scalar(@mrulist) - 2)) {
|
|
$mru{$count++} = $lvmru{$mrulist[$n]};
|
|
}
|
|
delete $mru{0xffffffff};
|
|
|
|
foreach my $m (sort {$a <=> $b} keys %mru) {
|
|
my ($file,$shell) = split(/\x00\x00/,$mru{$m},2);
|
|
$file =~ s/\x00//g;
|
|
$shell =~ s/^\x00//;
|
|
my $str = parseShellItem($shell);
|
|
::rptMsg(" ".$file." - ".$str);
|
|
}
|
|
}
|
|
else {
|
|
::rptMsg("LastVisitedPidlMRU key does not have an MRUList value.");
|
|
}
|
|
}
|
|
else {
|
|
::rptMsg("LastVisitedPidlMRU key has no values.");
|
|
}
|
|
}
|
|
|
|
#-----------------------------------------------------------
|
|
#
|
|
#-----------------------------------------------------------
|
|
sub parseOpenSavePidlMRU {
|
|
my $key = shift;
|
|
my @subkeys = $key->get_list_of_subkeys();
|
|
|
|
if (scalar(@subkeys) > 0) {
|
|
foreach my $s (@subkeys) {
|
|
::rptMsg("OpenSavePidlMRU\\".$s->get_name());
|
|
::rptMsg("LastWrite Time: ".gmtime($s->get_timestamp()));
|
|
|
|
my @vals = $s->get_list_of_values();
|
|
|
|
my %lvmru = ();
|
|
my @mrulist = ();
|
|
my %mru = ();
|
|
my $count = 0;
|
|
|
|
|
|
if (scalar(@vals) > 0) {
|
|
# First, read in all of the values and the data
|
|
::rptMsg("Note: All value names are listed in MRUListEx order.");
|
|
::rptMsg("");
|
|
foreach my $v (@vals) {
|
|
$lvmru{$v->get_name()} = $v->get_data();
|
|
}
|
|
# Then, remove the MRUList value
|
|
if (exists $lvmru{MRUListEx}) {
|
|
my @mrulist = unpack("V*",$lvmru{MRUListEx});
|
|
foreach my $n (0..(scalar(@mrulist) - 2)) {
|
|
$mru{$count++} = $lvmru{$mrulist[$n]};
|
|
}
|
|
delete $mru{0xffffffff};
|
|
|
|
foreach my $m (sort {$a <=> $b} keys %mru) {
|
|
my $str = parseShellItem($mru{$m});
|
|
::rptMsg(" ".$str);
|
|
}
|
|
}
|
|
}
|
|
else {
|
|
::rptMsg($s->get_name()." has no values.");
|
|
}
|
|
::rptMsg("");
|
|
}
|
|
}
|
|
else {
|
|
::rptMsg($key->get_name()." has no subkeys.");
|
|
}
|
|
}
|
|
|
|
#-----------------------------------------------------------
|
|
#
|
|
#-----------------------------------------------------------
|
|
sub parseShellItem {
|
|
my $data = shift;
|
|
my $len = length($data);
|
|
my $str;
|
|
|
|
my $tag = 1;
|
|
my $cnt = 0;
|
|
while ($tag) {
|
|
my %item = ();
|
|
my $sz = unpack("v",substr($data,$cnt,2));
|
|
return %str unless (defined $sz);
|
|
$tag = 0 if (($sz == 0) || ($cnt + $sz > $len));
|
|
|
|
my $dat = substr($data,$cnt,$sz);
|
|
my $type = unpack("C",substr($dat,2,1));
|
|
# ::rptMsg(sprintf " Size: ".$sz." Type: 0x%x",$type);
|
|
|
|
if ($type == 0x1F) {
|
|
# System Folder
|
|
%item = parseSystemFolderEntry($dat);
|
|
$str .= "\\".$item{name};
|
|
}
|
|
elsif ($type == 0x2F) {
|
|
# Volume (Drive Letter)
|
|
%item = parseDriveEntry($dat);
|
|
$item{name} =~ s/\\$//;
|
|
$str .= "\\".$item{name};
|
|
}
|
|
elsif ($type == 0x31 || $type == 0x32 || $type == 0x3a || $type == 0x74) {
|
|
%item = parseFolderEntry($dat);
|
|
$str .= "\\".$item{name};
|
|
}
|
|
elsif ($type == 0x00) {
|
|
|
|
}
|
|
elsif ($type == 0xc3 || $type == 0x41 || $type == 0x42 || $type == 0x46 || $type == 0x47) {
|
|
# Network stuff
|
|
my $id = unpack("C",substr($dat,3,1));
|
|
if ($type == 0xc3 && $id != 0x01) {
|
|
%item = parseNetworkEntry($dat);
|
|
}
|
|
else {
|
|
%item = parseNetworkEntry($dat);
|
|
}
|
|
$str .= "\\".$item{name};
|
|
}
|
|
else {
|
|
$item{name} = sprintf "Unknown Type (0x%x)",$type;
|
|
$str .= "\\".$item{name};
|
|
# probe($dat);
|
|
}
|
|
$cnt += $sz;
|
|
}
|
|
$str =~ s/^\\//;
|
|
return $str;
|
|
}
|
|
|
|
#-----------------------------------------------------------
|
|
#
|
|
#-----------------------------------------------------------
|
|
sub parseSystemFolderEntry {
|
|
my $data = shift;
|
|
my %item = ();
|
|
|
|
my %vals = (0x00 => "Explorer",
|
|
0x42 => "Libraries",
|
|
0x44 => "Users",
|
|
0x4c => "Public",
|
|
0x48 => "My Documents",
|
|
0x50 => "My Computer",
|
|
0x58 => "My Network Places",
|
|
0x60 => "Recycle Bin",
|
|
0x68 => "Explorer",
|
|
0x70 => "Control Panel",
|
|
0x78 => "Recycle Bin",
|
|
0x80 => "My Games");
|
|
|
|
$item{type} = unpack("C",substr($data,2,1));
|
|
$item{id} = unpack("C",substr($data,3,1));
|
|
if (exists $vals{$item{id}}) {
|
|
$item{name} = $vals{$item{id}};
|
|
}
|
|
else {
|
|
$item{name} = parseGUID(substr($data,4,16));
|
|
}
|
|
return %item;
|
|
}
|
|
|
|
#-----------------------------------------------------------
|
|
# parseGUID()
|
|
# Takes 16 bytes of binary data, returns a string formatted
|
|
# as an MS GUID.
|
|
#-----------------------------------------------------------
|
|
sub parseGUID {
|
|
my $data = shift;
|
|
my $d1 = unpack("V",substr($data,0,4));
|
|
my $d2 = unpack("v",substr($data,4,2));
|
|
my $d3 = unpack("v",substr($data,6,2));
|
|
my $d4 = unpack("H*",substr($data,8,2));
|
|
my $d5 = unpack("H*",substr($data,10,6));
|
|
return sprintf "{%08x-%x-%x-$d4-$d5}",$d1,$d2,$d3;
|
|
}
|
|
|
|
#-----------------------------------------------------------
|
|
#
|
|
#-----------------------------------------------------------
|
|
sub parseDriveEntry {
|
|
my $data = shift;
|
|
my %item = ();
|
|
$item{type} = unpack("C",substr($data,2,1));;
|
|
$item{name} = substr($data,3,3);
|
|
return %item;
|
|
}
|
|
#-----------------------------------------------------------
|
|
# parseNetworkEntry()
|
|
#
|
|
#-----------------------------------------------------------
|
|
sub parseNetworkEntry {
|
|
my $data = shift;
|
|
my %item = ();
|
|
$item{type} = unpack("C",substr($data,2,1));
|
|
|
|
my @n = split(/\x00/,substr($data,4,length($data) - 4));
|
|
$item{name} = $n[0];
|
|
$item{name} =~ s/^\W//;
|
|
return %item;
|
|
}
|
|
#-----------------------------------------------------------
|
|
#
|
|
#-----------------------------------------------------------
|
|
sub parseFolderEntry {
|
|
my $data = shift;
|
|
my %item = ();
|
|
|
|
$item{type} = unpack("C",substr($data,2,1));
|
|
# Type 0x74 folders have a slightly different format
|
|
|
|
my $ofs_mdate;
|
|
my $ofs_shortname;
|
|
|
|
if ($item{type} == 0x74) {
|
|
$ofs_mdate = 0x12;
|
|
}
|
|
elsif (substr($data,4,4) eq "AugM") {
|
|
$ofs_mdate = 0x1c;
|
|
}
|
|
elsif ($item{type} == 0x31 || $item{type} == 0x32 || $item{type} == 0x3a) {
|
|
$ofs_mdate = 0x08;
|
|
}
|
|
else {}
|
|
# some type 0x32 items will include a file size
|
|
if ($item{type} == 0x32) {
|
|
my $size = unpack("V",substr($data,4,4));
|
|
if ($size != 0) {
|
|
$item{filesize} = $size;
|
|
}
|
|
}
|
|
|
|
my @m = unpack("vv",substr($data,$ofs_mdate,4));
|
|
($item{mtime_str},$item{mtime}) = convertDOSDate($m[0],$m[1]);
|
|
|
|
# Need to read in short name; nul-term ASCII
|
|
# $item{shortname} = (split(/\x00/,substr($data,12,length($data) - 12),2))[0];
|
|
$ofs_shortname = $ofs_mdate + 6;
|
|
my $tag = 1;
|
|
my $cnt = 0;
|
|
my $str = "";
|
|
while($tag) {
|
|
my $s = substr($data,$ofs_shortname + $cnt,1);
|
|
return %item unless (defined $s);
|
|
if ($s =~ m/\x00/ && ((($cnt + 1) % 2) == 0)) {
|
|
$tag = 0;
|
|
}
|
|
else {
|
|
$str .= $s;
|
|
$cnt++;
|
|
}
|
|
}
|
|
# $str =~ s/\x00//g;
|
|
my $shortname = $str;
|
|
my $ofs = $ofs_shortname + $cnt + 1;
|
|
# Read progressively, 1 byte at a time, looking for 0xbeef
|
|
$tag = 1;
|
|
$cnt = 0;
|
|
while ($tag) {
|
|
my $s = substr($data,$ofs + $cnt,2);
|
|
return %item unless (defined $s);
|
|
if (unpack("v",$s) == 0xbeef) {
|
|
$tag = 0;
|
|
}
|
|
else {
|
|
$cnt++;
|
|
}
|
|
}
|
|
$item{extver} = unpack("v",substr($data,$ofs + $cnt - 4,2));
|
|
|
|
# ::rptMsg(sprintf " BEEF Offset: 0x%x",$ofs + $cnt);
|
|
# ::rptMsg(" Version: ".$item{extver});
|
|
|
|
$ofs = $ofs + $cnt + 2;
|
|
|
|
@m = unpack("vv",substr($data,$ofs,4));
|
|
($item{ctime_str},$item{ctime}) = convertDOSDate($m[0],$m[1]);
|
|
$ofs += 4;
|
|
@m = unpack("vv",substr($data,$ofs,4));
|
|
($item{atime_str},$item{atime}) = convertDOSDate($m[0],$m[1]);
|
|
$ofs += 4;
|
|
|
|
my $jmp;
|
|
if ($item{extver} == 0x03) {
|
|
$jmp = 8;
|
|
}
|
|
elsif ($item{extver} == 0x07) {
|
|
$jmp = 22;
|
|
}
|
|
elsif ($item{extver} == 0x08) {
|
|
$jmp = 26;
|
|
}
|
|
else {}
|
|
|
|
$ofs += $jmp;
|
|
# ::rptMsg(sprintf " Offset: 0x%x",$ofs);
|
|
|
|
$str = substr($data,$ofs,length($data) - $ofs);
|
|
|
|
my $longname = (split(/\x00\x00/,$str,2))[0];
|
|
$longname =~ s/\x00//g;
|
|
|
|
if ($longname ne "") {
|
|
$item{name} = $longname;
|
|
}
|
|
else {
|
|
$item{name} = $shortname;
|
|
}
|
|
return %item;
|
|
}
|
|
|
|
#-----------------------------------------------------------
|
|
# convertDOSDate()
|
|
# subroutine to convert 4 bytes of binary data into a human-
|
|
# readable format. Returns both a string and a Unix-epoch
|
|
# time.
|
|
#-----------------------------------------------------------
|
|
sub convertDOSDate {
|
|
my $date = shift;
|
|
my $time = shift;
|
|
|
|
if ($date == 0x00 || $time == 0x00){
|
|
return (0,0);
|
|
}
|
|
else {
|
|
my $sec = ($time & 0x1f) * 2;
|
|
$sec = "0".$sec if (length($sec) == 1);
|
|
if ($sec == 60) {$sec = 59};
|
|
my $min = ($time & 0x7e0) >> 5;
|
|
$min = "0".$min if (length($min) == 1);
|
|
my $hr = ($time & 0xF800) >> 11;
|
|
$hr = "0".$hr if (length($hr) == 1);
|
|
my $day = ($date & 0x1f);
|
|
$day = "0".$day if (length($day) == 1);
|
|
my $mon = ($date & 0x1e0) >> 5;
|
|
$mon = "0".$mon if (length($mon) == 1);
|
|
my $yr = (($date & 0xfe00) >> 9) + 1980;
|
|
my $gmtime = timegm($sec,$min,$hr,$day,($mon - 1),$yr);
|
|
return ("$yr-$mon-$day $hr:$min:$sec",$gmtime);
|
|
# return gmtime(timegm($sec,$min,$hr,$day,($mon - 1),$yr));
|
|
}
|
|
}
|
|
#-----------------------------------------------------------
|
|
# probe()
|
|
#
|
|
# Code the uses printData() to insert a 'probe' into a specific
|
|
# location and display the data
|
|
#
|
|
# Input: binary data of arbitrary length
|
|
# Output: Nothing, no return value. Displays data to the console
|
|
#-----------------------------------------------------------
|
|
sub probe {
|
|
my $data = shift;
|
|
my @d = printData($data);
|
|
|
|
foreach (0..(scalar(@d) - 1)) {
|
|
print $d[$_]."\n";
|
|
}
|
|
}
|
|
#-----------------------------------------------------------
|
|
# printData()
|
|
# subroutine used primarily for debugging; takes an arbitrary
|
|
# length of binary data, prints it out in hex editor-style
|
|
# format for easy debugging
|
|
#-----------------------------------------------------------
|
|
sub printData {
|
|
my $data = shift;
|
|
my $len = length($data);
|
|
|
|
my @display = ();
|
|
|
|
my $loop = $len/16;
|
|
$loop++ if ($len%16);
|
|
|
|
foreach my $cnt (0..($loop - 1)) {
|
|
# How much is left?
|
|
my $left = $len - ($cnt * 16);
|
|
|
|
my $n;
|
|
($left < 16) ? ($n = $left) : ($n = 16);
|
|
|
|
my $seg = substr($data,$cnt * 16,$n);
|
|
my $lhs = "";
|
|
my $rhs = "";
|
|
foreach my $i ($seg =~ m/./gs) {
|
|
# This loop is to process each character at a time.
|
|
$lhs .= sprintf(" %02X",ord($i));
|
|
if ($i =~ m/[ -~]/) {
|
|
$rhs .= $i;
|
|
}
|
|
else {
|
|
$rhs .= ".";
|
|
}
|
|
}
|
|
$display[$cnt] = sprintf("0x%08X %-50s %s",$cnt,$lhs,$rhs);
|
|
}
|
|
return @display;
|
|
}
|
|
|
|
1;
|