FAT32ReaderでFS上の全ファイルを吸い出す

allfat32.pl

#!/usr/bin/perl

use utf8;
use strict;
use warnings;
use 5.006; # not checked
binmode STDOUT, ':encoding(cp932)';
binmode STDERR, ':encoding(cp932)';
use File::Spec::Functions qw/catfile/;
use Time::Piece;
use FAT32Reader;
use Encode;
use File::Type;
use MIME::Types;

BEGIN{
	if($^O eq 'MSWin32'){
		use Win32::File;
		use Win32API::File::Time qw{:win};
	}
};

my $dd = 'dd'; # PLEASE SET "dd" command name (ex. '/usr/bin/dd'(linux), 'C:\usr\bin\dd.exe'(windows) or 'dd')
#my $if = '\\\\?\Device\HarddiskVolume12'; # PLEASE SET HDD device name (ex. '/dev/sda'(linux) or '\\\\?\\Device\\Harddisk0\\Partition0'(dd for windows(http://www.chrysocome.net/dd)))
#my $if = '/mnt/usb/sdc_noerror'; # PLEASE SET HDD device name (ex. '/dev/sda'(linux) or '\\\\?\\Device\\Harddisk0\\Partition0'(dd for windows(http://www.chrysocome.net/dd)))
#my $if = 'E:\sdc_noerror'; # PLEASE SET HDD device name (ex. '/dev/sda'(linux) or '\\\\?\\Device\\Harddisk0\\Partition0'(dd for windows(http://www.chrysocome.net/dd)))
#my $if = '\\\\.\\Volume{954cf239-df9c-11e2-bc37-00219b68c7a9}';
my $if = '\\\\.\\Volume{77be6bfb-2680-11e3-a5b1-00219b68c7a9}';
#my $if = '\\\\?\\Device\\HarddiskVolume4';
#my $first_offset = 8064; # PLEASE SET the start sector of the first fat volume
my $first_offset = 0; # PLEASE SET the start sector of the first fat volume
my $null = 'NUL'; # PLEASE SET null device (ex. '/dev/null'(linux) or 'NUL'(windows))
my $sector_size = 512; # bytes per sector

my $fr = FAT32Reader->new(if => $if, first_offset => $first_offset, null => $null, sector_size => $sector_size);

$fr->prepare_bpb;

for my $name (keys %{$fr->{bpb}}){
	print "$name = $fr->{bpb}{$name}\n";
}

$fr->prepare_fat;

print 'FAT ', $fr->is_fats_same ? 'OK' : 'NG', "\n";
my @fat_indexes_no_refered = (undef, undef, 2 .. $#{$fr->{fat}});
my @cluster_start_indexes;
my $first_fat_index_old = 0;
while(1){
#	print 'rest: ', (scalar grep {defined} @fat_indexes_no_refered) , "\n";
	my $first_fat_index;
	for my $fat_index ($first_fat_index_old .. $#fat_indexes_no_refered){
		if(defined $fat_indexes_no_refered[$fat_index]){
			$fat_indexes_no_refered[$fat_index] = undef;
			$first_fat_index = $fat_index;
			last;
		}
	}
	last unless defined $first_fat_index;
	$first_fat_index_old = $first_fat_index;
#	print "$first_fat_index\n" unless $first_fat_index % 5000;
	my $fat = $fr->{fat}[$first_fat_index];
	my $old_type;
	my $valid;
	while(1){
		my $type = $fr->fat_type($fat);
		if($type eq 'use to'){ # $fat is next $fat_index
			$valid = 1;
			$old_type = $type;
			if(! defined $fat_indexes_no_refered[$fat]){warn 'chain broken? :already refered = ', $fat}
			$fat_indexes_no_refered[$fat] = undef;
			$fat = $fr->{fat}[$fat];
		}elsif($type eq 'use end'){
			$valid = 1;
			$old_type = undef;
			last;
		}else{
			if(defined $old_type and $old_type eq 'use to'){
				die 'chain broken :', $type, ' = from ', $first_fat_index;
			}
			$old_type = undef;
			last;
		}
	}
	if($valid){
		push @cluster_start_indexes, $first_fat_index;
	}
}

print "valid sections = ", (join ' ', scalar @cluster_start_indexes), "\n";

my %all_files;

my %used_cluster_start_indexes;
for my $cluster_start_index (@cluster_start_indexes){
	my @files;
	eval{
		my $sfn_count = 0;
		my $data = $fr->read_data_cluster($cluster_start_index);
		for my $i (0 .. (length $data) / 32){
			my $bin = substr $data, 32 * $i, 32;
			my $type = $fr->data_entry_sfn_type($bin);
			if($type eq 'empty'){
				next;
			}elsif($type eq 'end'){
				last;
			}
			my $fnt = $fr->data_entry_type($bin);
			unless($fr->is_valid_data_entry($bin, $fnt)){
				if($fnt eq 'sfn'){
					die "invalid item structure\n", $fr->dumper(unpack 'C*', $bin);
				}else{
					next;
				}
			}
			if($fnt eq 'sfn'){
				$sfn_count++;
			}
		}
		unless($sfn_count){
			die 'no sfn';
		}
		@files = $fr->list_data_items($cluster_start_index);
	};
	if($@){
#		warn $@;
	}else{
		eval{
		if(@files){
			my $parent;
			for my $file (@files){
				if($file->sprintf_name eq '..'){
					$parent = $file;
					last;
				}
			}
			my $this_dir;
			if($parent){
#				print $fr->dumper(unpack 'C*', substr $fr->read_data_cluster($parent->{start_cluster}), 0, 100);
				for my $file ($parent->list_directory_items){
#					warn '../', $file->sprintf_name, ' ', $file->{start_cluster}, "\n";
					if($file->{start_cluster} == $cluster_start_index){
						$this_dir = $file;
						last;
					}
				}
			}
			$used_cluster_start_indexes{$cluster_start_index} = 1;
			my $cluster_dir_name =  '--cluster-' . $cluster_start_index;
			my $dir_name = ($this_dir ? $this_dir->sprintf_name : '--unknown-name--');
			warn $cluster_start_index, " ", $dir_name, " ", (scalar @files), "\n";
			my $cluster_dir_path = catfile 'contents', $cluster_dir_name;
			mkdir Encode::encode 'cp932', $cluster_dir_path;
			my $dir_path = catfile $cluster_dir_path, $dir_name;
			mkdir Encode::encode 'cp932', $dir_path;
			for my $file (@files){
				print $file->sprintf_file_info;
				$used_cluster_start_indexes{$file->{start_cluster}} = 1;
				my $path = catfile $dir_path, $file->sprintf_name;
				if($file->{attr}{ATTR_DIRECTORY}){
					mkdir Encode::encode 'cp932', $path;
				}else{
					$file->read_file_through(Encode::encode 'cp932', $path);
				}
				if($^O eq 'MSWin32'){
					my $ctime = Time::Piece->strptime($file->{create_date} . 'T' . $file->{create_time}, '%Y-%m-%dT%H:%M:%S');
					my $mtime = Time::Piece->strptime($file->{modify_date} . 'T' . $file->{modify_time}, '%Y-%m-%dT%H:%M:%S');
					SetFileTime($path, time, $mtime->epoch, $ctime->epoch);
					SetAttributes($path, HIDDEN) if $file->{attr}->{ATTR_HIDDEN};
					SetAttributes($path, READONLY) if $file->{attr}->{ATTR_READ_ONLY};
					SetAttributes($path, SYSTEM) if $file->{attr}->{ATTR_SYSTEM};
				}
			}
			if($^O eq 'MSWin32' and $this_dir){
				my $ctime = Time::Piece->strptime($this_dir->{create_date} . 'T' . $this_dir->{create_time}, '%Y-%m-%dT%H:%M:%S');
				my $mtime = Time::Piece->strptime($this_dir->{modify_date} . 'T' . $this_dir->{modify_time}, '%Y-%m-%dT%H:%M:%S');
				SetFileTime($dir_path, time, $mtime->epoch, $ctime->epoch);
				SetAttributes($dir_path, HIDDEN) if $this_dir->{attr}->{ATTR_HIDDEN};
				SetAttributes($dir_path, READONLY) if $this_dir->{attr}->{ATTR_READ_ONLY};
				SetAttributes($dir_path, SYSTEM) if $this_dir->{attr}->{ATTR_SYSTEM};
			}
#			$all_files{$cluster_start_index} = \@files;
		}
		};
		if($@){
			warn $cluster_start_index, " ", (scalar @files), "\n";
			warn $@;
		}
	}
}

my @unused_cluster_start_indexes = grep {! $used_cluster_start_indexes{$_}} @cluster_start_indexes;

my $file_type = File::Type->new();
my $mimetypes = MIME::Types->new();

my $dir_path = catfile 'contents', '--stray--';
mkdir Encode::encode 'cp932', $dir_path;
for my $cluster_start_index (@unused_cluster_start_indexes){
	my $head_data = $fr->read_data_cluster($cluster_start_index);
	my $mime_str = $file_type->checktype_contents($head_data);
	my $type = $mimetypes->type($mime_str);
	my @exts = eval{$type->extensions};
	warn $cluster_start_index, " ", $mime_str, " ", join(' ',@exts), "\n";
	if($@){
		warn $@;
		@exts = ('so');
	}
	my $path = catfile $dir_path, $cluster_start_index . '.' . $exts[0];
	$fr->read_data_from_cluster_through((Encode::encode 'cp932', $path), $cluster_start_index);
}