#!/usr/bin/perl -w
###############################################################################
#    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
###############################################################################
# 2004 by Marcus Thiesen (marcus@thiesen.org)
# Program to analyse BasicCard (www.basiccard.com) I/O Logs
# Version 0.0001 (This is messy alpha code)
###############################################################################

use strict;

my $protocol = -1; #depends on atr, T=0 or T=1;
my $type = ""; # command or response

my $ourclass = "77";
my %ourcom = (
	"C2" => "setCardID",
	"C1" => "getCardID",
);

## some additional info
my %predefcom = (
	"00" => "GET STATE",
	"02" => "EEPROM SIZE",
	"04" => "CLEAR EEPROM",
	"06" => "WRITE EEPROM",
	"08" => "READ EEPROM",
	"0A" => "EEPROM CRC",
	"0C" => "SET STATE",
	"0E" => "GET APPLICATION ID",
	"10" => "START ENCRYPTION",
	"12" => "END ENCRYPTION",
	"14" => "ECHO",
	"16" => "ASSIGN NAD",
	"18" => "FILE IO",
);

# Some shortcuts and service functions:
sub printt{ print "\t" . shift(@_) . "\n";}
sub printtt{ print "\t\t" . shift(@_) . "\n";}

sub htostr{ my $r =""; foreach my $t (@_) { $r .= $t . " "; } return $r;};

sub htoa{
	my $ret = "";	
	foreach my $char (@_) {
		$ret .=chr(hex($char));
	}
	return $ret;
}

# Protocol dependend analyze functions:
sub analyze_inf_t1_command(@) {
	my @inf = @_;

	my $CLA = shift @inf;
	my $INS = shift @inf;
	my $P1 = shift @inf;
	my $P2 = shift @inf;
	my $LC = shift @inf;

	if ($CLA eq "C0") {
		printtt("Class Byte: $CLA (Pre-Defined Command)") ;
		printtt("Inst. Byte: $INS (" . $predefcom{$INS} . ")" );
	} elsif ($CLA eq $ourclass) {
		printtt("Class Byte: $CLA (Self-Defined Command)") ;
		printtt("Inst. Byte: $INS (" . $ourcom{$INS} . ")" );
	} else {
		printtt("Class Byte: $CLA");
		printtt("Inst. Byte: $INS");
	}

	printtt("P1 = $P1, P2 = $P2") if ($P1 && $P2);
	printtt("Length: " .hex($LC)) if ($LC);
	if ($LC && hex($LC) > 0) {
		my @data;
		for (my $i = 1; $i <= hex($LC); $i++) {
			my $byte = shift @inf;
			if ($byte) {
				push @data, $byte;
			}
		}
		if (@data) {
			printtt("IDATA: " . htostr(@data));
			printtt("IDATA ASCII: " . htoa(@data));

			my $LE = shift @inf;
			printtt("Lenght Expected: $LE") if $LE;
			die "Length error occured" if @inf;
		}
	}
}

sub analyze_inf_t1_response(@) {
	my @data = @_;

	my $SW2 = pop @data;
	my $SW1 = pop @data;

	if (@data) {
		my @ODATA = @data;
		printtt("ODATA: " . htostr(@ODATA));	
		printtt("ODATA ASCII: " . htoa(@ODATA));	
	}	

	printtt("SW1: $SW1, SW2: $SW2");
	printtt("swCommandOK") if ("$SW1$SW2" eq "9000");
	if ($SW1 eq "61") {
		printtt("sw1LeWarning (Le was not " . hex($SW2) . ")");
	}
	if ($SW1 eq "66") {
		printtt("swKeyNotFound") if ($SW2 eq "11");
		printtt("swPolyNotFound") if ($SW2 eq "12");
		printtt("swKeyTooShort") if ($SW2 eq "13");		
		printtt("swKeyDisabled") if ($SW2 eq "14");
		printtt("swUnknownAlgorithm") if ($SW2 eq "15");
		printtt("swAlreadyEncrypting") if ($SW2 eq "C0");
		printtt("swNotEncrypting") if ($SW2 eq "C1");
		printtt("swBadCommandCRC") if ($SW2 eq "C2");
		printtt("swDesCheckError") if ($SW2 eq "C3");
		printtt("swCoprocessorError") if ($SW2 eq "C4");
		printtt("swAesCheckError") if ($SW2 eq "C5");
	}
}

sub analyze_atr(@) {
	my @data = @_;

	print "ATR\n";
	printt "Direct Convention";
	if ($data[1] eq "EF") {
		printt"Enhanced Basic Card";
		$protocol = 1;
	};
	if ($data[1] eq "FC") {
		die "Professional Basic Card not yet supported\n";
	}
	my $TA3 = $data[6];
	if ( $TA3 eq "50") {
		printt ("&H50: Compact Card");
	} elsif ( $TA3 eq "20") {
		printt ("&H20: Enhanced Card");
	} else { die "Unsupported value in TA3: $TA3\n"; } 

	printt "Historic Characters:";
	print "\t\t";
	print htoa(@data[8..int @data - 1]);
	print "\n";
} 


sub analyze_protocol_t1(@) {
	my @data = @_;
	die "Couldn't analyze ATR\n" if ($protocol == -1);
	print "\n";

	#compute the checksum
	my $checksum;
	foreach my $byte (@data[0..@data-2]) {
		if ($checksum) {
			no warnings;
			$checksum = $checksum ^ hex($byte);
			use warnings;
		} else {
			$checksum = hex($byte);
		}
	}
	$checksum = uc(substr(unpack("H*", pack("N", $checksum)), -2));

	my $NAD = shift @data;
	my $PCB = shift @data;
	
	printt "NAD: $NAD\tPCB: $PCB";

	my @inf;
	if ( ($PCB eq "00") || ($PCB == "40" )) {

	my $LEN = shift @data;

	printt "Length: " .hex($LEN) . " Bytes";

	for (my $i = 0; $i<hex($LEN); $i++) {
		push @inf, shift @data;
	}

	printt "INF: " . htostr(@inf);

	my $LRC = shift @data;

	printt "Checksum: $LRC (" . ($checksum eq $LRC ? "OK" : "LRC ERROR"). ")";

	# should be empty now:
	die "Length header mismatch" if (@data);
	} else {
		die "Non I-block commands not implemented\n";
	}

	analyze_inf_t1_command(@inf) if ($type eq "command");
	analyze_inf_t1_response(@inf) if ($type eq "response");
}

#main
print "BasicCard LogAnalayzer Version 0.001 (2004 by Marcus Thiesen [marcus\@thiesen.org])\n";
print "This program is free software, you can redistribute and modify it\n";
print "under the terms of the GPL\n";
print "\n";

foreach my $line (<>) {
	chomp $line;
	my @data = map { uc($_) } split /\s/, $line;
	print $line ,"\n";
	if (shift(@data) eq "<-") {
		$type = "response";
		print "incoming $type: ";
	} else {
		$type = "command";
		print "outgoing $type: ";
	}
	@data = grep /[0-9A-F]{2}/, @data;
	if ($data[0] eq "3B") {
		analyze_atr(@data);
	} else {
		if ($protocol == 1) {
			analyze_protocol_t1(@data);
		} else {
			die "Protocol T=$protocol not implemented\n";
		}
	}
 	print "\n";
#	sleep 5;
}