#!/usr/bin/perl
#
#   simple fbox recovery tool
#
#   Copyright (C) 2004 Enrik Berkhan <enrik.berkhan@inka.de>
#   Copyright (C) 2006 Daniel Eiband <eiband@online.de>
#
#   This program is free software; you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation; either version 2 of the License, or
#   (at your option) any later version.
#
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License
#   along with this program; if not, write to the Free Software
#   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#

use IO::Socket::INET;
use Socket;
use Getopt::Std;
use Errno qw(EEXIST);
use Net::FTP;
use Fcntl qw(SEEK_END SEEK_SET);
use String::CRC32;

use warnings;

use constant FLASH_TYPE_NOR  => 1;
use constant FLASH_TYPE_NAND => 2;
use constant FLASH_TYPE_SPI  => 4;

$| = 1;

my %opt;
getopts('hrf:i:l:s:u', \%opt);

if ($opt{h}) {
	print "usage: recover -h\n";
	print "       recover [-l IPADDR] [-i IPADDR] [-f firmware.image] [-r]\n";
	print "       recover [-l IPADDR] [-i IPADDR] -s image\n";
	print "       recover [-l IPADDR] [-i IPADDR] -u\n";
	print "       -i IPADDR: set boot time IP to IPADDR within environment\n";
	print "       -l IPADDR: choose local addr (for multihomed)\n";
	print "       -f image:  extract fs and kernel from tarfile and flash\n";
	print "       -s image:  boot (standalone) image directly from RAM\n";
	print "       -r:        reboot fbox\n";
	print "       -u:        update box with filesystem.image, kernel.image from cwd\n";
	exit;
}

my $ipaddr;
my $setip;
if ($opt{i}) {
	$setip = unpack("N", inet_aton($opt{i}));
} else {
	$setip = 0;
}

$opt{l} = "0.0.0.0" unless defined $opt{l};
my $probe = IO::Socket::INET->new(Proto => 'udp',
									Broadcast => 1,
									LocalAddr => $opt{l},
									LocalPort => 5035
) or die "socket: $!";
#my $packet = pack("vCCVNV", 0, 18, 1, 1, $setip, 0);
our $packet = pack("vCCVNV", 0, 18, 1, 1, 0, 0);
our $broadcast = sockaddr_in(5035, INADDR_BROADCAST);

print "Looking for Fritz!Box ";
$SIG{"ALRM"} =
	sub {
		return if --$scanning <= 0;
		if (scalar @boxes == 0) {
			$probe->send($packet, 0, $broadcast);
			print "o";
		} else {
			print ".";
		}
	};
$scanning = 50;
$probe->send($packet, 0, $broadcast);
print "o";
while($scanning) {
	my $reply;

	alarm(1);
	if (my $peer = $probe->recv($reply, 16)) {
		next if (length($reply) < 16);
		my ($port, $addr) = sockaddr_in($peer);
		my ($major, $minor1, $minor2, $code, $addr2) = unpack("vCCVV", $reply);
		$addr2 = pack("N", $addr2);
		if ($code == 2) {
			print "O";
			push @boxes, [$major, $minor1, $minor2, $addr, $addr2];
			$scanning = 2 if ($scanning > 2);
		}
	}
}

if (scalar @boxes == 0) {
	print " none found, giving up.\n";
	exit 1;
} else {
	print " found!\n";
}

foreach $box (@boxes) {
	my ($major, $minor1, $minor2, $addr, $addr2) = @$box;
	printf "ADAM2 version $major.$minor1.$minor2 at %s (%s)\n",
		inet_ntoa($addr), inet_ntoa($addr2);
}

if (scalar @boxes > 1) {
	print "more than one boxes: no work\n";
}

# set ip now if differing!

$ipaddr = (@{$boxes[0]})[4];
{
	package ADAM2FTP;
	use base qw(Net::FTP);
	# ADAM2 requires upper case commands, some brain dead firewall doesn't ;-)
	sub _USER { shift->command("USER",@_)->response() }
	# sub _PASV { shift->command("P\@SW")->response() == Net::FTP::CMD_OK }

	# EVA responses are not RFC 959 compliant - they miss the first line
	# s. https://tools.ietf.org/html/rfc959, section 4.2
	#
	# This results in the following behavior of Net::CMD::response()
	# in error case:
	#    EVA outputs just one line, according to RFC 959 it's actually
	#    the last line, but at the same time it's the 1st line
	#    => response() parses it and (by coincidence) works as decribed
	#       in the documentation
	# in success case:
	#    EVA outputs multiple lines
	#      actual response line(s) (response payload)
	#      and the last line
	#    the 1st line of the actual response doesn't match "the status line"-pattern
	#    => response() fails to parse it and returns
	#       either empty string (older versions of Net::Cmd)
	#       or     CMD_ERROR    (recent versions of Net::Cmd)
	#
	# TODO: override response if possible, overriding parse_response is not enough

	sub _GETENV {
		my $ftp = shift;
		my $value;

		$ftp->command("GETENV",@_);

		# EVA responses are not RFC 959 compliant
		# do not rely on the return values of Net::Cmd->response()
		# as they depend on the version of Net::Cmd (s. the long note above)

		# instead simply iterate over all response lines and exit
		# after reaching the line matching "the status line"-pattern

		while (1) {
			my $line = $ftp->getline();
			chomp($line);

			# status line? always the last line in EVA responses
			if ($line =~ s/^(\d\d\d)[ ]//) {
				if ($1 eq "200") {
					$ftp->debug_print(0, "getenv: $value\n")
						if $ftp->debug();
					return $value;
				}
				return undef;
			}

			unless (defined($value)) {
				my ($rname, $rvalue) = split(/\s+/, $line, 2);
				$value = $rvalue if ($rname); # no assignment on empty lines
			}
		}
	}
	sub getenv {
		my $ftp = shift;
		my $name = shift;
		return $ftp->_GETENV($name);
	}
	sub _REBOOT { shift->command("REBOOT")->response() == Net::FTP::CMD_OK }
	sub reboot {
		my $ftp = shift;
		$ftp->_REBOOT;
		$ftp->close;
	}
	sub check {
		my $ftp = shift;

		delete ${*$ftp}{'net_ftp_port'};
		delete ${*$ftp}{'net_ftp_pasv'};

		my $data = $ftp->_data_cmd('CHECK' ,@_) or return undef;
		my $sum;
		if (${${*$ftp}{'net_cmd_resp'}}[0] =~ /^Flash check 0x([0-9A-F]{8})/) {
			$sum = hex($1);
		}
		$data->_close();
		return $sum;
	}
	# data_cmd ueberschreiben, da die Verbindung sonst zu spaet erfolgt!

	sub _data_cmd
	{
		my $ftp = shift;
		my $cmd = uc shift;
		my $ok = 1;
		my $where = delete ${*$ftp}{'net_ftp_rest'} || 0;
		my $arg;

		for $arg (@_) {
				croak("Bad argument '$arg'\n")
				if $arg =~ /[\r\n]/s;
			}

		if(${*$ftp}{'net_ftp_passive'} &&
			 !defined ${*$ftp}{'net_ftp_pasv'} &&
			 !defined ${*$ftp}{'net_ftp_port'})
		{
			my $data = undef;

			$ok = defined $ftp->pasv;
			$ok = $ftp->_REST($where)
				if $ok && $where;

			if($ok)
			{
				# zuerst verbinden!
				$data = $ftp->_dataconn();
				$ftp->command($cmd,@_);
				$ok = Net::FTP::CMD_INFO == $ftp->response();
				if($ok)
				{
					$data->reading
					if $data && $cmd =~ /RETR|LIST|NLST/;
					return $data
				}
				$data->_close
				if $data;
			}
			return undef;
		}

		$ok = $ftp->port
			unless (defined ${*$ftp}{'net_ftp_port'} || defined ${*$ftp}{'net_ftp_pasv'});

		$ok = $ftp->_REST($where)
			if $ok && $where;

		return undef
			unless $ok;

		$ftp->command($cmd,@_);

		return 1
			if(defined ${*$ftp}{'net_ftp_pasv'});

		$ok = CMD_INFO == $ftp->response();

		return $ok
			unless exists ${*$ftp}{'net_ftp_intern_port'};

		if($ok)
		{
			my $data = $ftp->_dataconn();
			$data->reading
				 if $data && $cmd =~ /RETR|LIST|NLST/;
			return $data;
		}

		close(delete ${*$ftp}{'net_ftp_listen'});
			return undef;
	}
}

sub getenv_test {
	my $ftp = shift;

	my $getenv_hwrev = $ftp->getenv('HWRevision');
	print "getenv_hwrev is " . ($getenv_hwrev // "undef") . "\n";

	my $getenv_empty = $ftp->getenv('');
	print "getenv_empty is " . ($getenv_empty // "undef") . "\n";

	my $getenv_non_existing = $ftp->getenv('non_existing');
	print "getenv_non_existing is " . ($getenv_non_existing // "undef") . "\n";

	die "getenv_test: always die\n";
}

sub is_in_HWRevision_whitelist {
	my @hwRevisionWhiteList = (
		"F", # FRITZ!Box SL Annex B
		"G", # FRITZ!Box Annex B

		# all other HWRevisions are known to be numerical
		# or could be made numerical by stripping .1.0.0, .1.1.0 suffixes
		58,
		60..66,
		71..73,
		76..79,
		82..86,
		89,
		93..95,
		# unsure 96, # FRITZ!Box ATH DB120
		97,
		101..102,
		# unsure 104, # VoIP Gateway 5188
		106..109,
		111..113,
		116..119,
		121..122,
		125..129,
		# unsure 131, # Alice IAD 5130
		133..137,
		# unsure 138, # FRITZ!Repeater N/G
		139,
		141..142,
		# unsure 143, # Speedport W101 Bridge
		144..146,
		# unsure 147..149, # DSL-EasyBox A802/A602/A402
		# unsure 150, # FRITZ!Box Ikanos
		152,
		# unsure 153, # Alice IAD 7570
		154..156,
		159..160,
		# unsure 161, FRITZ!Box Bene
		162,
		164,
		165,
		167..168,
		170..172,
		# unsure 173, # FRITZ!Repeater 300E
		# unsure 174, # Alice IAD WLAN 3331
		178..179,
		181, # VR9, 7360 SL but NOR-only
		183, # VR9, 7360 v1 but NOR-only
		188..189,
		# unsure 191, # IKS VX185, 7369
		196, # VR9, 7360 v2 but NOR-only
		197
	);

	my $hwRevision = shift;

	if (defined($hwRevision) && length($hwRevision) > 0) {
		# strip suffixes: .1.0.0, .1.1.0
		if ($hwRevision =~ m/^(\d+)[.]1[.][01][.]0$/) {
			$hwRevision = $1;
		}

		return  1
			if (grep($_ eq $hwRevision, @hwRevisionWhiteList));
	}

	return 0;
}

sub is_in_HWRevision_whitelist_test {
	my %test_cases = (
		undef => 0,
		""  => 0,
		#
		"F" => 1,
		"G" => 1,
		#
		"H" => 0,
		#
		-1 => 0,
		0 => 0,
		#
		94 => 1,
		"94" => 1,
		"94.1.0.0" => 1,
		"94.1.1.0" => 1,
		#
		"94.1.2.0" => 0,
		#
		185 => 0,
		#
		226 => 0,
		#
		181 => 1,
		183 => 1,
		196 => 1,
		
		182 => 0
	);

	keys %test_cases;
	while (my($test_case, $expected_result) = each %test_cases) {
		my $actual_result = is_in_HWRevision_whitelist($test_case);

		my $ok = ( defined($actual_result) &&  defined($expected_result) && ($actual_result == $expected_result))
		      || (!defined($actual_result) && !defined($expected_result));

		print "failed: is_in_HWRevision_whitelist(" . ($test_case // "undef") . ")=" . ($actual_result // "undef") . " instead of expected " . ($expected_result // "undef") . "\n"
			if (!$ok);
	}

	die "is_in_HWRevision_whitelist_test: always die\n";
}

sub parse_flashsize {
	my %metric_prefix_factor = (
		"k" => 1024,
		"K" => 1024, # it's actually k but AVM uses capital K
		"M" => 1024 * 1024
	);

	my $getenv_flashsize = shift;
	my $var_name = shift;

	if ($getenv_flashsize =~ m/(^|\s)\Q$var_name\E=((\d+)([kKM])B|(0x(\d|[A-Fa-f])+))(\s|$)/) {
		return $3 * $metric_prefix_factor{$4}
			if $3 && $4;
		return hex($5)
			if $5;
	}

	return undef;
}

sub flashtypes {
	# Note: heuristic!
	my $getenv_flashsize = shift;

	if (defined($getenv_flashsize)) {
		my $nor_size    = parse_flashsize($getenv_flashsize,    "nor_size");
		my $nand_size   = parse_flashsize($getenv_flashsize,   "nand_size");
		my $sflash_size = parse_flashsize($getenv_flashsize, "sflash_size");

		# matches exactly an 8-digit-hex-number
		if (!defined($nor_size) && $getenv_flashsize =~ m/^0x(\d|[A-Fa-f]){8}$/) {
			$nor_size = hex($getenv_flashsize);
		}

		no warnings 'uninitialized';
		return ($nor_size > 0 ? FLASH_TYPE_NOR : 0) | ($nand_size > 0 ? FLASH_TYPE_NAND : 0) | ($sflash_size > 0 ? FLASH_TYPE_SPI : 0)
			if ($nor_size > 0                       || $nand_size > 0                        || $sflash_size > 0);
	}

	return undef;
}

sub flashtypes_string {
	my $flashtype_bits = shift;

	my @t = ();
	if (defined(flashtype_bits)) {
		push @t, "NOR"  if (($flashtype_bits &  FLASH_TYPE_NOR) == FLASH_TYPE_NOR );
		push @t, "NAND" if (($flashtype_bits & FLASH_TYPE_NAND) == FLASH_TYPE_NAND);
		push @t, "SPI"  if (($flashtype_bits &  FLASH_TYPE_SPI) == FLASH_TYPE_SPI );
	}
	return join(",", @t);
}

sub flashtypes_test {
	my %test_cases = (
		"0x00400000"                                       => FLASH_TYPE_NOR,                 # 7050
		"0x00800000"                                       => FLASH_TYPE_NOR,                 # 7170, 7270 v1
		"0x01000000"                                       => FLASH_TYPE_NOR,                 # 7270 v2/v3, 7390, 7570
		"nor_size=16MB"                                    => FLASH_TYPE_NOR,                 # 7320, 7330, 7330 SL
		"nor_size=16MB sflash_size=0KB nand_size=0MB"      => FLASH_TYPE_NOR,                 # 7360
		"nor_size=0MB sflash_size=0KB nand_size=128MB"     => FLASH_TYPE_NAND,                # 7430
		"nor_size=0MB sflash_size=1024KB nand_size=512MB"  => FLASH_TYPE_NAND|FLASH_TYPE_SPI, # 7490
		"nor_size=0MB sflash_size=0KB nand_size=512MB"     => FLASH_TYPE_NAND,                # 7590
		"nor_size=0MB sflash_size=2MB nand_size=2048MB"    => FLASH_TYPE_NAND|FLASH_TYPE_SPI, # 6490
		"nor_size=0x0 sflash_size=16MB nand_size=0MB"      => FLASH_TYPE_SPI,                 # FRITZ!Repeater 300E

		"nor_size=0x0F000000 sflash_size=0x00000D00"       => FLASH_TYPE_NOR|FLASH_TYPE_SPI ,  # manually created test-case
		"Xnor_size=16MB"                                   => undef, # because of X at the beginning
		"foo bar"                                          => undef,
		""                                                 => undef,
		"   "                                              => undef,
		undef                                              => undef
	);

	keys %test_cases;
	while (my($test_case, $expected_result) = each %test_cases) {
		my $actual_result = flashtypes($test_case);

		my $ok = ( defined($actual_result) &&  defined($expected_result) && ($actual_result == $expected_result))
		      || (!defined($actual_result) && !defined($expected_result));

		print "failed: flashtypes(" . ($test_case // "undef") . ")=" . ($actual_result // "undef") . " instead of expected " . ($expected_result // "undef") . "\n"
			if (!$ok);
	}

	die "flashtypes_test: always die\n";
}

# passive mode geht mit Net::FTP nicht, connected zu spaet fuer ADAM2!
# EVA kann nur passive mode
$ftp = ADAM2FTP->new(inet_ntoa($ipaddr), Passive => 1, Debug => 0, Timeout => 600)
	or die "can't FTP ADAM2";
$ftp->login("adam2", "adam2") or die "can't login adam2";
$ftp->binary();

# tests
#getenv_test($ftp);
#is_in_HWRevision_whitelist_test();
#flashtypes_test();

my $pid   = $ftp->getenv('ProductID');
my $hwrev = $ftp->getenv('HWRevision');
my $fwrev = $ftp->getenv('firmware_info');
my $ulrev = $ftp->getenv('urlader-version');
my @mtd0 = split(',', $ftp->getenv('mtd0'), 2);
my @mtd1 = split(',', $ftp->getenv('mtd1'), 2);
my @mtd2 = split(',', $ftp->getenv('mtd2'), 2);
my @mtd3 = split(',', $ftp->getenv('mtd3'), 2);
my @mtd4 = split(',', $ftp->getenv('mtd4'), 2);
my $mtd0len = hex($mtd0[1]) - hex($mtd0[0]);
my $mtd1len = hex($mtd1[1]) - hex($mtd1[0]);
my $mtd2len = hex($mtd2[1]) - hex($mtd2[0]);
my $mtd3len = hex($mtd3[1]) - hex($mtd3[0]);
my $mtd4len = hex($mtd4[1]) - hex($mtd4[0]);

my $flashsize = $ftp->getenv('flashsize');
my $flashtypes = flashtypes($flashsize);

my $is_supported_whitelist_method = is_in_HWRevision_whitelist($hwrev);
my $is_supported_heuristic_method = (defined($pid) && !($pid =~ m/PUMA/i))
	&& ($flashtypes == FLASH_TYPE_NOR || $flashtypes == FLASH_TYPE_SPI);

my $undef = "missing";
print "Product ID: " . ($pid // $undef) . "\n";
print "Hardware Revision: " . ($hwrev // $undef) . "\n";
print "Urlader  Revision: " . ($ulrev // $undef) . "\n";
print "Firmware Revision: " . ($fwrev // $undef) . "\n";
print "Flash type(s): " . flashtypes_string($flashtypes) . " (heuristic!)\n";
print "Supported box: "
	. ($is_supported_whitelist_method ? "yes" : "no") . " (whitelist method), "
	. ($is_supported_heuristic_method ? "yes" : "no") . " (heuristic method)\n";
print "MTD0: " . ($mtd0len // $undef) . " bytes\n";
print "MTD1: " . ($mtd1len // $undef) . " bytes\n";
print "MTD2: " . ($mtd2len // $undef) . " bytes\n";
print "MTD3: " . ($mtd3len // $undef) . " bytes\n";
print "MTD4: " . ($mtd4len // $undef) . " bytes\n";

unless ($is_supported_whitelist_method) {
	die
		"\n" .
		"Failed to detect the box type or unsupported box detected, aborting...\n" .
		"This script most likely doesn't work with your box.\n" .
		"Please don't try to force its execution as it might\n" .
		"irreparably brick your box.\n" .
		"If you consider this message as being an error\n" .
		"please make a bug report at https://freetz.github.io\n" .
		"\n" ;
}

$ftp->hash(\*STDOUT, 64 * 1024);

$mtd0 = "filesystem.image";
$mtd1 = "kernel.image";

if ($opt{f}) {
	unless (-f $opt{f}) {
		die "$opt{f} not found\n";
	}
	mkdir "recover.tmp";
	if ($! && $! != EEXIST) {
		die "recover.tmp: $!"
	};
	my $tar = "./tools/tar";
	system("$tar xvf $opt{f} -C recover.tmp ./var/tmp/kernel.image ./var/tmp/filesystem.image");
	if ($? >> 8) {
		die "$tar failed";
	} elsif ($? & 127) {
		die "$tar killed";
	}
	chmod 0644, "recover.tmp/var/tmp/filesystem.image",
		"recover.tmp/var/tmp/kernel.image";

	$mtd0 = "recover.tmp/var/tmp/filesystem.image";
	$mtd1 = "recover.tmp/var/tmp/kernel.image";
}

if ($opt{f} || $opt{u}) {

	$ftp->quot("MEDIA", "FLSH");

	if (-f $mtd0 && -s $mtd0) {
		$sum = remove_cksum($mtd0, $mtd0len);
		$opt{r} = 1;
		print "Flashing $mtd0 to mtd0 ...";
		$ftp->put($mtd0, "mtd0");
		if ($ftp->status() == $ftp->CMD_OK) {
			if (defined $sum) {
				my $flashsum = $ftp->check("mtd0");
				if (defined $flashsum && $sum eq $flashsum) {
					print "checksum ok!\n";
				} else {
					print "checksum bad! ($sum vs. $flashsum)\n";
				}
			}
			print "success!\n";
		} else {
			print "FAILED: ", $ftp->code(), " ", $ftp->message(), "\n";
			$opt{r} = 0;
		}
	}

	if (-f $mtd1 && -s $mtd1) {
		$sum = remove_cksum($mtd1, $mtd1len);
		print "Flashing $mtd1 to mtd1 ...";
		$ftp->put($mtd1, "mtd1");
		if ($ftp->status() == $ftp->CMD_OK) {
			if (defined $sum) {
				my $flashsum = $ftp->check("mtd1");
				if (defined $flashsum && $sum eq $flashsum) {
					print "checksum ok!\n";
				} else {
					print "checksum bad! ($sum vs. $flashsum)\n";
				}
			}
			print "success!\n";
		} else {
			print "FAILED: ", $ftp->code(), " ", $ftp->message(), "\n";
			$opt{r} = 0;
		}
	}

} elsif ($opt{s}) {
	print "Sending and booting $opt{s}...";
	$ftp->quot("MEDIA", "SDRAM");
	$ftp->put("$opt{s}", "mtd4");
	if ($ftp->status() == $ftp->CMD_OK) {
		print "success!\n";
		$ftp->close();
		exit;
	} else {
		print "FAILED: ", $ftp->code(), " ", $ftp->message(), "\n";
		$opt{r} = 0;
	}
}

sleep(0.1);
if ($opt{r}) {
	print "Rebooting...\n";
	$ftp->reboot();
} else {
	$ftp->quit();
}

END {
	if ($opt{f}) {
		unlink("recover.tmp/var/tmp/kernel.image");
		unlink("recover.tmp/var/tmp/filesystem.image");
		rmdir("recover.tmp/var/tmp");
		rmdir("recover.tmp/var");
		rmdir("recover.tmp");
	}
}

sub remove_cksum {
	my $name = shift;
	my $mtdsize = shift;

	open F, "+<$name" or die "open: $!";
	$size = (stat F)[7];
	die "stat: $!" unless defined($size);
	if ($size >= 8) {
		seek F, -8, SEEK_END or die "seek: $!";
		read F, $magic, 4;
		read F, $chksum, 4;
		if (unpack("V", $magic) == 0xC453DE23) {
			$size -= 8;
			truncate F, $size or die "truncate: $!";
			print "$name: removed checksum\n";
		} else {
			print "$name: no checksum\n";
		}
		seek F, 0, SEEK_SET or die "seek: $!";
		$chksum = crc32(*F);
		$chksum = crc32("\xff" x ($mtdsize - $size), $chksum);
		printf "CRC32: %08X\n", $chksum;
		return $chksum;
	}
	return undef;
}