Autor: @Xianur0
Para saber mas sobre el script click Aquí
Correo: xianur0.null[at]gmail.com
Descripción: Script en Perl que permite realizar un análisis forense a partir de una imagen dd

#!/usr/bin/perl
# By Xianur0
# xianur0.null[at]gmail.com
$imagen = $ARGV[0] || die("Uso: $1 imagen.dd\n");
open BIN,$imagen;
my %uris = ();
my %disks = ();
my %bookmarks = ();
my %cookies = ();
my %emails = ();
my %volumenes = ();
my %mysqls = ();
my %proxys = ();
my $bookmark = "";
my $nbookmark = "";
my @lineas = ();
my $lineabin = "";
my $minpass = 5;
my $maxpass = 20;
my $todo = "";
my $grabar = 0;
sub ascii2char($)
{
	(my $str = shift) =~ s/@([0-9]{2})@/chr($1)/eg;
	return $str;
}
sub hex2ascii($)
{
	(my $str = shift) =~ s/([a-fA-F0-9]{2})/chr(hex $1)/eg;
	return $str;
}
open PASSWORD,">resultados/passwords.txt";
open MYSQL,">resultados/mysql.txt";
open URI,">resultados/uri.txt";
open COOKIE,">resultados/cookies.txt";
open BOOKMARKS,">resultados/bookmarks.txt";
open VOLUMEN,">resultados/volumenes.txt";
open DISK,">resultados/disks.txt";
open EMAIL,">resultados/emails.txt";
open PROXY,">resultados/proxys.txt";
open ENCRYPTED,">resultados/encrypted.txt";
open BRUTE,">resultados/bruteforce.txt";
open STRINGS,">resultados/strings.txt";
print "Extrayendo datos...\n";
while($lineabin = ) {
	@lineas = ($lineabin =~ m/([\w\d&\*<>=\-\_\[\]\s"'\/\\\%;\:\.\t\,\#\)\(\@\?\0`]+)/g);
	BUCLE: foreach $linea (@lineas) {
		$linea =~ s/\0//g;
		next BUCLE if(length($linea) < 4);
		print STRINGS $linea."\n";
		if(length($linea) >= $minpass && length($linea) <= $maxpass && $linea !~ /^(\s|\t)+$/) {
			print BRUTE $linea."\n";
		}
		if($nbookmark ne "") {
			if($linea =~ /(<|>)/) {
				$bookmark .= $linea;
			} else {
				$bookmarks{$nbookmark} = $bookmark;
				$nbookmark = "";
				$bookmark = "";
			}
		}
		if($linea =~ /((https?|file|ftp|smb):\/\/.+)/) {
			my $uri = $1;
			$uri =~ s/\s+.+//g;
			print URI $uri."\n" if($uris{$uri} < 1 || $uris{$uri} eq "");
			$uris{$uri}++;
		}
		if($linea =~ /(\/dev\/disk\/by-id\/(.+))/) {
			my $disk = $1;
			print DISK $disk."\n" if($disks{$disk} < 1 || $disks{$disk} eq "");
			$disks{$disk}++;
		}
		if($linea =~ /<\/?bookmark(\shref=[^>]+)?>/) {
			if($nbookmark ne "") {
				print BOOKMARKS $bookmark."\n" if($bookmarks{$nbookmark} < 1 || $bookmarks{$nbookmark} eq "");
				$bookmarks{$nbookmark}++;
				$nbookmark = "";
				$bookmark = "";
			}
			elsif($linea =~ /