view release on metacpan or  search on metacpan

lib/Data/ChipsChallenge.pm  view on Meta::CPAN

#	my $x = 0;
#	for (my $i = 0; $i < scalar(@flat); $i++) {
#		$x++;
#		my $deb = sprintf("%02x", unpack("C", $flat[$i]));
#		print "$deb ";
#		print "\n" if $x >= 32;
#		$x = 0 if $x >= 32;
#	}
#	print "\n";

	my $i = 0;
	while ($i < 1024) {
		my $byte = $flat[$i];

		my $deb1 = sprintf("%02x", unpack("C", $byte));
#		print "Byte: $deb1\n";

		# See if the next 5 bytes are the same.
		my $copies = 0;
		for (my $j = 0; ($i + $j) < scalar(@flat); $j++) {
			my $compare = $flat[$i + $j];
			if ($byte eq $compare) {
#				print "Byte $i matches byte " . ($i+$j) . "\n";
				$copies++;
				last if $copies >= 255;
			}
			else {
				last;
			}
		}

		# Can we compress this?
		if ($copies >= 4) {
			# Yes! See how many copies there are exactly.
#			print "Compress byte $deb1 by $copies times\n";
			$i += $copies;
			my $len = pack("C", $copies);
			push (@compressed,
				$ff,
				$len,
				$byte,
			);
		}
		else {
			$i++;
			push (@compressed, $byte);
		}
	}

	# Return the compressed binary.
	my $bin = join("",@compressed);
	return $bin;
}

=head2 decode_password (bin RAW_BINARY)

Given the encoded level password in raw binary (4 bytes followed by a null byte),
this function returns the 4 ASCII byte password in clear text. This is the password
you'd type into Chip's Challenge.

Passwords are decoded by XORing the values in the raw binary by hex C<0x99>,
if you're curious.

=cut

sub decode_password {
	my ($self,$data) = @_;

	my @chars = split(//, $data, 5);

	# Decode each character.
	my $pass = '';
	for (my $i = 0; $i < 4; $i++) {
		my $dec = unpack("C",$chars[$i]);
		my $hex = uc(sprintf("%02x",$dec));

		# Decode it with XOR 0x99
		my $xor = $dec ^ 0x99;
		my $chr = chr($xor);
		$pass .= $chr;
	}

	return $pass;
}

=head2 encode_password (string PASSWORD)

Given the plain text password C<PASSWORD>, it encodes it and returns it as
a 5 byte binary string (including the trailing null byte).

=cut

sub encode_password {
	my ($self,$pass) = @_;

	my @chars = split(//, $pass, 4);

	# Encode each character.
	my $bin = '';
	for (my $i = 0; $i < 4; $i++) {
		my $dec = unpack("C", $chars[$i]);
		my $hex = sprintf("%02x",$dec);

		# XOR it with 0x99
		my $xor = hex("0x$hex") ^ 0x99;
		$bin .= pack("C",$xor);
	}
	$bin .= chr(0x00);

	# try...
	my $plain = $self->decode_password($bin);

	return $bin;
}

=head2 random_password

Returns a random 4-letter password.

=cut