gscriptor.gtk1.2

#!/usr/bin/perl -w

#    gscriptor: GTK interface to send APDU commands to a smart card
#    Copyright (C) 2001   Lionel Victor, Ludovic Rousseau
#             2002-2003   Ludovic Rousseau
#
#    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

# gscriptor uses libgtk-perl, please make sure it is correctly installed
# on your system

use strict;

use Gtk;
use File::Basename;
use Carp;
use Chipcard::PCSC;
use Chipcard::PCSC::Card;

init Gtk;
set_locale Gtk;

my $strAppName = "gscriptor";
my $strConfigFileName = "$ENV{HOME}/.$strAppName";
my @ResultStruct;
my %hConfig;

# PCSC related variables
my $hContext = new Chipcard::PCSC ();
die ("Can't create the Chipcard::PCSC object: $Chipcard::PCSC::errno\n") unless (defined $hContext);
my $hCard = new Chipcard::PCSC::Card ($hContext);
die ("Can't create the Chipcard::PCSC::Card object: $Chipcard::PCSC::errno\n") unless (defined $hContext);

############################### create widgets ###############################
my $wndMain   = new Gtk::Window ("toplevel");
my $txtScript = new Gtk::Text ();
my $txtResult = new Gtk::Text ();
my $rdbASCII  = new Gtk::RadioButton("ASCII");
my $rdbHex    = new Gtk::RadioButton("Hex", $rdbASCII);
my $chkWrap   = new Gtk::CheckButton ("Wrap lines");
my $btnRun    = new Gtk::Button ("Run");
my $txtStatus = new Gtk::Entry();


############################## arrange widgets ###############################
# arrange_widgets () is used to arrange widgets in the windows.
#  It allows to conveniently allocate temporary variables for the various
# containers and the scrollbars, as well as the menu.
#  This function also sets some basic properties of the different
# widgets used... configuration is therefore grouped in a single place.
sub arrange_widgets () {
	$wndMain->set_title ("$strAppName");

	$txtScript->set_editable(1);
	$txtScript->set_word_wrap(1);

	$txtResult->set_word_wrap(1);

	$txtStatus->set_sensitive(0);
	$txtStatus->set_editable(0);

	$chkWrap->set_active(1);
	$rdbHex->set_active(1);

	# create and bind toolbars
	my $vscScript = new Gtk::VScrollbar ($txtScript->vadj);
	my $vscResult = new Gtk::VScrollbar ($txtResult->vadj);

	# create and set tooltips
	my $tipScript = new Gtk::Tooltips();
	my $tipResult = new Gtk::Tooltips();
	my $tipASCII  = new Gtk::Tooltips();
	my $tipHex    = new Gtk::Tooltips();
	my $tipRun    = new Gtk::Tooltips();
	my $tipWrap   = new Gtk::Tooltips();
	$tipScript->set_tip ($txtScript, "list of APDUs to exchange");
	$tipResult->set_tip ($txtResult, "result window");
	$tipASCII->set_tip ($rdbASCII, "show ASCII data");
	$tipHex->set_tip ($rdbHex, "show hexadecimal data");
	$tipRun->set_tip ($btnRun, "run the current script");
	$tipWrap->set_tip ($chkWrap, "wrap long lines");

	# create and set the menu with the accel_table
	my @menu_items = ({ path        => '/_File',
	                    type        => '<Branch>' },
	                  { path        => '/File/_New',
	                    callback    => \&NewScriptFile },
	                  { path        => '/File/_Open',
	                    accelerator => '<control>O',
	                    callback    => \&LoadScriptFile },
	                  { path        => '/File/_Save',
	                    accelerator => '<control>S',
	                    callback    => \&SaveScriptFile },
	                  { path        => '/File/Save _As',
	                    callback    => \&SaveAsScriptFile },
	                  { path        => '/File/sep',
	                    type        => '<Separator>' },
	                  { path        => '/File/_Quit',
					    accelerator => '<control>Q',
	                    callback    => \&CloseAppWindow },

	                  { path        => '/R_eader',
	                    type        => '<Branch>' },
	                  { path        => '/Reader/_Connect',
						accelerator => '<control>C',
	                    callback    => \&ConnectDefaultReader },
	                  { path        => '/Reader/Reco_nnect',
					    accelerator => '<control>R',
	                    callback    => \&ReconnectDefaultReader },
	                  { path        => '/Reader/_Disconnect',
						accelerator => '<control>D',
	                    callback    => \&DisconnectDefaultReader },
	                  { path        => '/Reader/sep',
	                    type        => '<Separator>' },
	                  { path        => '/Reader/_Status...',
	                    callback    => \&DefaultReaderStatus },

                      { path        => '/Ru_n',
                        type        => '<Branch>' },
	                  { path        => '/Run/_Run Script',
						accelerator => '<control>R',
	                    callback    => \&RunScript },
	                  { path        => '/Run/C_lear Result Area',
						accelerator => '<control>L',
	                    callback    => \&ClearResult },

	                  { path        => '/_Settings',
	                    type        => '<Branch>' },
	                  { path        => '/Settings/Reader',
	                    callback    => \&ReaderConfig },

	                  { path => '/_Help',
	                    type => '<LastBranch>' },
	                  { path => '/_Help/About',
	                    callback => \&Help }); 

	my $accel_group = new Gtk::AccelGroup();
	my $item_factory = new Gtk::ItemFactory( 'Gtk::MenuBar', '<main>', $accel_group);
	$item_factory->create_items( @menu_items );
	$wndMain->add_accel_group( $accel_group );

	# create and arrange box containers
	my $vbxMainBox   = new Gtk::VBox(0,3);
	my $hbxScriptBox = new Gtk::HBox(0,3);
	my $vbxScriptBox = new Gtk::VBox(0,10);
	my $hbxResultBox = new Gtk::HBox(0,3);
	my $vbxResultBox = new Gtk::VBox(0,3);

	$hbxScriptBox->add($txtScript);
	$hbxScriptBox->pack_end($vscScript, 0, 0, 0);
	$vbxScriptBox->add($hbxScriptBox);
	$vbxScriptBox->pack_end($btnRun, 0, 0, 0);
	$vbxScriptBox->pack_end($chkWrap, 0, 0, 0);
	$vbxScriptBox->set_border_width(5);
	$hbxResultBox->add($txtResult);
	$hbxResultBox->pack_end($vscResult, 0, 0, 0);
	$vbxResultBox->add($hbxResultBox);
	$vbxResultBox->pack_start($rdbASCII, 0, 0, 0);
	$vbxResultBox->pack_start($rdbHex, 0, 0, 0);
	$vbxResultBox->set_border_width(5);


	# create and fill frame containers
	my $frmScript = new Gtk::Frame ("Script");
	my $frmResult = new Gtk::Frame ("Result");
	$frmScript->set_border_width(5);
	$frmScript->add ($vbxScriptBox);
	$frmResult->set_border_width(5);
	$frmResult->add ($vbxResultBox);
	
	my $hpaned = new Gtk::HPaned;
	$hpaned->border_width(5);

	my $hbxBox = new Gtk::HBox (0,10);
	$hpaned->add1($frmScript);
	$hpaned->add2($frmResult);
	$hbxBox->add($hpaned);
	$vbxMainBox->pack_start ($item_factory->get_widget( '<main>' ), 0, 0, 0);
	$vbxMainBox->add ($hbxBox);
	$vbxMainBox->pack_end ($txtStatus, 0, 0, 0);
	$vbxMainBox->show_all();
	$wndMain->add($vbxMainBox);
}

# Connect widgets together
$chkWrap->signal_connect('toggled', sub { $txtScript->set_line_wrap($chkWrap->active); } );
$wndMain->signal_connect ("delete_event", \&CloseAppWindow);
$btnRun->signal_connect ("clicked", \&RunScript);
$rdbASCII->signal_connect('toggled', \&RefreshResult);
$rdbHex->signal_connect('toggled', \&RefreshResult);

ReadConfigFile();
arrange_widgets();

############################### create widgets ###############################

$txtStatus->set_text ("welcome to the $strAppName application !!! - not connected");

# Show up everything as we should be ready by now
$wndMain->show_all();

if (exists $hConfig{'script'}) {
	unless (ReadScriptFile ($hConfig{'script'})) {
		MessageBox ("Can not open $hConfig{'script'}: $!", ['OK']);
		delete $hConfig{'script'};
	}
}


main Gtk;
die ("The Gtk event loop failed to start resulting in abnormal program termination...\n");

######################### application engine follows #########################

sub MessageBox {
	my $strMessage = shift;
	my $strTitle = shift unless ref ($_[0]);
	my @ButtonDescr = @_;

	my $refCurButtonDescr;
	my $last_button;

	# Choose a nice title to our message box
	$strTitle = $strAppName unless $strTitle;
	@ButtonDescr = ["OK"] unless @ButtonDescr;

	my $dlgDialog = new Gtk::Dialog ();
	my $hbxButtonBox = new Gtk::HBox (0,3);
	my $hbxTextBox = new Gtk::HBox (0,3);

	# build up all the buttons and associate callbacks
	foreach $refCurButtonDescr (reverse @ButtonDescr) {
		croak ("invalid button name") unless scalar ($$refCurButtonDescr[0]);
		$$refCurButtonDescr[1] = sub { $dlgDialog->destroy(); } if $#$refCurButtonDescr == 0;
		warn ("button named '$$refCurButtonDescr[0]' has an invalid callback: '$$refCurButtonDescr[1]'")
			unless ref ($$refCurButtonDescr[1]);

		# Each button is constructed from its label
		my $btnTmpButton = new Gtk::Button($$refCurButtonDescr[0]);
		$btnTmpButton->can_default(1);

		# A mouse click on the button triggers a call to its embedded
		# callback then destroys the dialog box
		$btnTmpButton->signal_connect ("clicked", sub { &{$$refCurButtonDescr[1]}; $dlgDialog->destroy(); });
		$hbxButtonBox->pack_end($btnTmpButton, 0, 0, 10);

		$last_button = $btnTmpButton;
	}

	$dlgDialog->action_area->pack_start($hbxButtonBox, 1, 1, 0 );
	my $label = new Gtk::Label($strMessage);
	$hbxTextBox->pack_start($label, 0, 0, 30);
	$dlgDialog->vbox->add ($hbxTextBox);

	# the last button is the default one
	$last_button->grab_default();

	# Finally show up everything
	$dlgDialog->set_policy (0, 0, 1);
	$dlgDialog->set_default_size (0,0);
	$dlgDialog->set_title ($strTitle);
	$dlgDialog->set_modal(1);
	$dlgDialog->show_all();
}

sub ReaderConfig {
	my $dlgReaderConfig = new Gtk::Dialog ();
	my $txtReader = new Gtk::Label ("Reader");
	my $cboReaders = new Gtk::Combo();
	my $rdbT0  = new Gtk::RadioButton("T=0");
	my $rdbT1  = new Gtk::RadioButton("T=1", $rdbT0);
	my $rdbRAW = new Gtk::RadioButton("T=RAW", $rdbT0);
	my $txtProtocol = new Gtk::Label ("Protocol");

	# This sub adjusts the content of $hConfig with the selected protocol
	my $subProtocol = sub {
		$hConfig{'protocol'} = $Chipcard::PCSC::SCARD_PROTOCOL_RAW if ($rdbRAW->active);
		$hConfig{'protocol'} = $Chipcard::PCSC::SCARD_PROTOCOL_T0  if ($rdbT0->active);
		$hConfig{'protocol'} = $Chipcard::PCSC::SCARD_PROTOCOL_T1  if ($rdbT1->active);
	};
	$rdbT0->signal_connect ('toggled', $subProtocol);
	$rdbT1->signal_connect ('toggled', $subProtocol);
	$rdbRAW->signal_connect('toggled', $subProtocol);

	my $btnOK = new Gtk::Button ("OK");
	$btnOK->signal_connect( "clicked", sub {
		$hConfig{'reader'} = $cboReaders->entry->get_text();
		$hCard->Disconnect($Chipcard::PCSC::SCARD_UNPOWER_CARD);
		$dlgReaderConfig->destroy();
	});
	$btnOK->can_default(1);

	my $btnCancel = new Gtk::Button ("Cancel");
	$btnCancel->signal_connect( "clicked", sub {
		$dlgReaderConfig->destroy();
	});
	$btnCancel->can_default(1);

	my $hbxReaderBox = new Gtk::HBox (0,10);
	my $hbxButtonBox = new Gtk::HBox (0,3);
	my $hbxStatusBox = new Gtk::Table (3,2,1);

	$hbxReaderBox->pack_start ($txtReader, 0, 0, 10);
	$hbxReaderBox->pack_start ($cboReaders, 1, 1, 10);

	$hbxButtonBox->pack_end($btnCancel, 0, 0, 10);
	$hbxButtonBox->pack_end($btnOK, 0, 0, 10);

	# Select the last preferred protocol if any
	if (defined $hConfig {'protocol'}) {
		$rdbT0->set_active(1)  if ($hConfig {'protocol'} == $Chipcard::PCSC::SCARD_PROTOCOL_T0);
		$rdbT1->set_active(1)  if ($hConfig {'protocol'} == $Chipcard::PCSC::SCARD_PROTOCOL_T1);
		$rdbRAW->set_active(1) if ($hConfig {'protocol'} == $Chipcard::PCSC::SCARD_PROTOCOL_RAW);
	}

	$hbxStatusBox->attach_defaults ($txtProtocol, 0, 1, 0, 1);
	$hbxStatusBox->attach_defaults ($rdbT0, 1, 2, 0, 1);
	$hbxStatusBox->attach_defaults ($rdbT1, 1, 2, 1, 2);
	$hbxStatusBox->attach_defaults ($rdbRAW, 1, 2, 2, 3);

	$cboReaders->set_popdown_strings ($hContext->ListReaders ());
	$cboReaders->set_case_sensitive(1);
	$cboReaders->set_value_in_list(1, 0);
	# We select the last reader if available
	if (exists $hConfig{'reader'}) {
		$cboReaders->entry->set_text($hConfig{'reader'});
	}

	$dlgReaderConfig->action_area->pack_start($hbxButtonBox, 1, 1, 0 );
	$dlgReaderConfig->vbox->add ($hbxReaderBox);
	$dlgReaderConfig->vbox->add (new Gtk::HSeparator());
	$dlgReaderConfig->vbox->add ($hbxStatusBox);

	# the OK button is the default one
	$btnOK->grab_default();

	$dlgReaderConfig->set_policy (0, 0, 1);
	$dlgReaderConfig->set_default_size (0,0);
	$dlgReaderConfig->set_modal(1);
	$dlgReaderConfig->show_all();
}

sub ReadConfigFile {
	if (-f $strConfigFileName) {
		die ("Can't open $strConfigFileName for reading: $!\n") unless (open (FILE, "<$strConfigFileName"));
		while (<FILE>) {
			chomp;
			next if /^#/;
			next if /^\s*$/;
			if (/^\s*(\S+)\s*=\s*\'(.*)\'$/) {
				$hConfig{$1} = $2;
			} else {
				print STDERR "Error while parsing $strConfigFileName\n\t'$_'\n";
			}
		}
		close (FILE);
	} else {
		print STDERR "Couldn't read from $strConfigFileName. Using default configuration\n";
	}
}

sub WriteConfigFile {
	my $strTmpKey;

	die ("Can't open $strConfigFileName for writing: $!\n") unless (open (FILE, ">$strConfigFileName"));
	print FILE "# This file is automatically generated\n# Do not edit unless you know what you are doing\n\n";
	foreach $strTmpKey (keys %hConfig) {
		print FILE "$strTmpKey = \'$hConfig{$strTmpKey}\'\n";
	}
	close (FILE);
}

sub ReadScriptFile {
	my $strScriptFileName = shift;
	my $strBaseFileName = basename ($strScriptFileName);

	return 0 unless open (FILE, "<$strScriptFileName");
	$txtScript->freeze();
	$txtScript->delete_text (0,-1);
	while (<FILE>)
	{
		$txtScript->insert_text ($_, $txtScript->get_length);
	}
	$txtScript->thaw();
	close (FILE);
	# Upon successful completion, we also set the window title as well
	# as the current ScriptfileName in the configuration hash
	$hConfig{'script'} = $strScriptFileName;
	$wndMain->set_title ("$strAppName - <$strBaseFileName>");
	return 1;
}

sub WriteScriptFile {
	my $strScriptFileName = shift;
	my $strBaseFileName = basename ($strScriptFileName);

	return 0 unless open (FILE, ">$strScriptFileName");
	print FILE $txtScript->get_chars (0,-1);
	close (FILE);
	# Upon successful completion, we also set the window title as well
	# as the current ScriptfileName in the configuration hash
	$hConfig{'script'} = $strScriptFileName;
	$wndMain->set_title ("$strAppName - <$strBaseFileName>");
	return 1;
}

sub NewScriptFile {
	if ($txtScript->get_length()) {
		# That call to MessageBox will connect the OK button with a callback
		# that actually erase the script
		MessageBox(
			"The current work will be lost !\nAre you sure you want to continue ?",
			["OK", sub { EraseCurrentScript(); } ],
			["CANCEL"]
		);
	}
}

sub EraseCurrentScript {
	$txtScript->delete_text (0,-1);
	$wndMain->set_title ("$strAppName");
	delete $hConfig{'script'};
}

sub SaveScriptFile {
	my ($widget) = @_;
	if (exists $hConfig{'script'}) {
		WriteScriptFile ($hConfig{'script'});
	} else {
		SaveAsScriptFile ($widget);
	}
}

sub SaveAsScriptFile {
	my ($widget) = @_;

	my $file_dialog = new Gtk::FileSelection( "Save File" );
	$file_dialog->ok_button->signal_connect( "clicked", sub {
		my $file = $file_dialog->get_filename();

		if (-d $file) {
			MessageBox ("Can't open $file: file is a directory", ['OK']);
		} else {
			MessageBox ("Can't open $file: $!", ['OK']) unless WriteScriptFile ($file);
		}
		$file_dialog->destroy();
	});
	$file_dialog->cancel_button->signal_connect( "clicked", sub { $file_dialog->destroy(); });
	if (exists $hConfig{'script'}) {
		$file_dialog->set_filename(dirname($hConfig{'script'}))
	}

	$file_dialog->show();
}

sub LoadScriptFile {
	if ($txtScript->get_length()) {
		MessageBox(
			"The current work will be lost !\nAre you sure you want to continue ?",
			["OK", \&LoadScript],
			["CANCEL"]
		);
	} else {
		LoadScript();
	}
}

sub LoadScript {
	my $file_dialog = new Gtk::FileSelection( "Load File" );
	$file_dialog->ok_button->signal_connect( "clicked", sub {
		my $file = $file_dialog->get_filename();

		if (-d $file) {
			MessageBox ("Can't open $file: file is a directory", ['OK']);
		} else {
			MessageBox ("Can't open $file: $!", ['OK']) unless ReadScriptFile ($file);
		}
		$file_dialog->destroy();
	});
	$file_dialog->cancel_button->signal_connect( "clicked", sub { $file_dialog->destroy(); });
	if (exists $hConfig{'script'}) {
		$file_dialog->set_filename(dirname($hConfig{'script'})."/");
	}

	$file_dialog->show();
}

sub ClearResult {
	$txtResult->delete_text (0, -1);
	@ResultStruct = ();
}

sub RefreshResult {
	my $tmpLine;
	my $tmp_value;

	$txtResult->freeze();
	$txtResult->delete_text (0, -1);
	foreach $tmpLine (@ResultStruct) {
		if (ref $tmpLine) {
			foreach $tmp_value (@$tmpLine) {
				if ($rdbHex->active) {
					$txtResult->insert_text (sprintf ("%02X ", $tmp_value), $txtResult->get_length);
				} else {
					# TODO: enhance filtering of non-printable chars
					# TODO: how can we use array_to_ascii here ??? maybe
					# enhance the function so it can directly receive
					# ranges of chars to ignore optionally ?
					if (($tmp_value > 0x20) && ($tmp_value < 0x80)) {
						$txtResult->insert_text (chr ($tmp_value), $txtResult->get_length);
					} else {
						$txtResult->insert_text ('.', $txtResult->get_length);
					}
				}
			}
			$txtResult->insert_text ("\n", $txtResult->get_length);
		} else {
			$txtResult->insert_text ($tmpLine, $txtResult->get_length);
		}
	}
	$txtResult->thaw();
}

sub ConnectDefaultReader {
	if (exists $hConfig{'reader'} && !($hConfig{'reader'} eq '')) {
		if (defined $hCard->{hCard}) {
			MessageBox (
				"The card is already connected...\nDo you want to reconnect ?",
				['OK', \&ReconnectDefaultReader],
				['CANCEL']
			);
		} else {
			$hCard->Connect ($hConfig{'reader'}, $Chipcard::PCSC::SCARD_SHARE_EXCLUSIVE, $hConfig{'protocol'});
			if (defined $hCard->{hCard}) {
				$txtStatus->set_text ("Connected to '$hConfig{'reader'}'");
			} else {
				MessageBox ("Can not connect to the reader named '$hConfig{'reader'}':\n$Chipcard::PCSC::errno", ['OK'])
			};
		}
	} else {
		MessageBox ("No default reader has been configured\nPlease make sure you have configured a reader first", ['OK']);
	}
}

sub ReconnectDefaultReader {
	if (defined $hCard->{hCard}) {
		$hCard->Reconnect ($Chipcard::PCSC::SCARD_SHARE_EXCLUSIVE, $hConfig{'protocol'}, $Chipcard::PCSC::SCARD_RESET_CARD);
		if (defined $hCard->{hCard}) {
			$txtStatus->set_text ("Connected to '$hConfig{'reader'}'");
		} else {
			MessageBox ("Can not reconnect to the reader named '$hConfig{'reader'}':\n$Chipcard::PCSC::errno", ['OK'])
		};
	} else {
		# we just propose to connect but do not call Reconnect()
		# afterwards that would be quite useless
		MessageBox ("The Chipcard::PCSC:Card object is not connected...\n Do you want to connect ?",
		['OK', sub {ConnectDefaultReader();}],
		['CANCEL']);
	}
}

sub DisconnectDefaultReader {
	if (defined $hCard->{hCard}) {
		$hCard->Disconnect($Chipcard::PCSC::SCARD_UNPOWER_CARD);
		if (defined $hCard->{hCard}) {
			MessageBox ("Can not disconnect from the reader named '$hConfig{'reader'}':\n$Chipcard::PCSC::errno", ['OK']);
		} else {
			$txtStatus->set_text ("not connected");
		};
	} else {
		MessageBox ("The Chipcard::PCSC::Card object is not connected !", ['OK']);
	}
}

sub DefaultReaderStatus {
	if (defined $hCard->{hCard}) {
		my @StatusResult = $hCard->Status();
		if (defined $StatusResult[0]) {
#TODO This stinks can't I rewrite it so it looks better&shorter
			my $tmpVal = 0;

			my $MessageString = "You are connected to reader $StatusResult[0].\n";
			$MessageString .= "Card status (". sprintf ("0x%04X",$StatusResult[1]) ."): ";

			# Verbosely describes the Card Status (powered, inserted, etc...
			if ($StatusResult[1] & $Chipcard::PCSC::SCARD_UNKNOWN) {
				if ($tmpVal) { $MessageString .= ", "; } ++$tmpVal;
				$MessageString .= "'Unknown state'";
			}
			if ($StatusResult[1] & $Chipcard::PCSC::SCARD_ABSENT) {
				if ($tmpVal) { $MessageString .= ", "; } ++$tmpVal;
				$MessageString .= "Absent";
			}
			if ($StatusResult[1] & $Chipcard::PCSC::SCARD_PRESENT) {
				if ($tmpVal) { $MessageString .= ", "; } ++$tmpVal;
				$MessageString .= "Present";
			}
			if ($StatusResult[1] & $Chipcard::PCSC::SCARD_SWALLOWED) {
				if ($tmpVal) { $MessageString .= ", "; } ++$tmpVal;
				$MessageString .= "Swallowed";
			}
			if ($StatusResult[1] & $Chipcard::PCSC::SCARD_POWERED) {
				if ($tmpVal) { $MessageString .= ", "; } ++$tmpVal;
				$MessageString .= "Powered";
			}
			if ($StatusResult[1] & $Chipcard::PCSC::SCARD_NEGOTIABLE) {
				if ($tmpVal) { $MessageString .= ", "; } ++$tmpVal;
				$MessageString .= "'PTS is negotiable'";
			}
			if ($StatusResult[1] & $Chipcard::PCSC::SCARD_SPECIFIC) {
				if ($tmpVal) { $MessageString .= ", "; } ++$tmpVal;
				$MessageString .= "'PTS has been set'";
			}

			# Verbosely describes the currently active protocol
			$MessageString .= ".\nThe active protocol (".sprintf ("0x%04X", $StatusResult[2]).") is ";
			if (($StatusResult[2] & $Chipcard::PCSC::SCARD_PROTOCOL_T0)) {
				$MessageString .= "T=0 ";
			} elsif (($StatusResult[2] & $Chipcard::PCSC::SCARD_PROTOCOL_T1)) {
				$MessageString .= "T=1 ";
			} elsif (($StatusResult[2] & $Chipcard::PCSC::SCARD_PROTOCOL_RAW)) {
				$MessageString .= "RAW ";
			} else {
				$MessageString .= "unknown";
			}

			# Displays the ATR (if available)
			$MessageString .= ".\nThe ATR is ";
			if (defined $StatusResult[3]) {
				foreach $tmpVal (@{$StatusResult[3]}) { $MessageString .= sprintf ("%02X ", $tmpVal); }
			} else {
				$MessageString .= "not available";
			}
			MessageBox ($MessageString, ['OK']);
		} else {
			MessageBox ("Can not retrieve reader status:\n$Chipcard::PCSC::errno", ['OK'])
		}
	} else {
		MessageBox ("The reader is not connected...\n Do you want to connect ?",
		['OK', sub {ConnectDefaultReader(); if (defined $hCard->{hCard}) {DefaultReaderStatus();}}],
		['CANCEL']);
	}
}

sub RunScript {
	if (defined $hCard->{hCard}) {
		my @tmpCommandArray = split /\n/, $txtScript->get_chars (0,-1);
		my $raCurrentResult;
		my $nIndex;

		push @ResultStruct, "Beginning script execution...\n\n";
		foreach $_ (@tmpCommandArray) {
			# this variable has to be inside the loop as we store a
			# reference to it in the result struct... it has to be
			# unique for each command line
			my $raCurrentCommand;

			# Skip blank lines and comments
			next if /^\s*$/;
			next if /^#/;

			if (/reset/i) {
				push @ResultStruct, "[Reset]\n\n";
				ReconnectDefaultReader();
				next;
			}

			# if the command does not contains spaces (00A4030000) we expand it
			s/(..)/$1 /g if (! m/ /);

			# Extract bytes from the ascii string
			$raCurrentCommand = Chipcard::PCSC::ascii_to_array($_);

			# push them in the Display structure
			push @ResultStruct, "Sending: ";
			push @ResultStruct, $raCurrentCommand;
			
			# Transmit them to the card
			$raCurrentResult = $hCard->Transmit ($raCurrentCommand);
			if (ref $raCurrentResult) {
				push @ResultStruct, "Received: ";
				push @ResultStruct, $raCurrentResult;
				push @ResultStruct, Chipcard::PCSC::Card::ISO7816Error(substr Chipcard::PCSC::array_to_ascii($raCurrentResult), -5), "\n\n";
			} else {
				MessageBox ("Transmit failed: $Chipcard::PCSC::errno\nStopping script execution", ['OK']);
				push @ResultStruct, "\nErrors During Script Execution: $Chipcard::PCSC::errno\n";
				last;
			}
		}
		push @ResultStruct, "Script was executed without error...\n";
	} else {
		MessageBox ("The Chipcard::PCSC::Card object is not connected !\nDo you want to connect ?",
		['OK', sub {ConnectDefaultReader(); if (defined $hCard->{hCard}) {RunScript();}}],
		['CANCEL']);
	}
	RefreshResult();
}

sub CloseAppWindow {
	undef $hCard;
	undef $hContext;
	WriteConfigFile();
	Gtk->exit(0);
}

sub Help {
MessageBox ("
$strAppName is coded by Lionel VICTOR, (C) 2001.
and debugged by Ludovic ROUSSEAU, (C) 2001-2003.

$strAppName is a small application written in Perl.
It basically demonstrates how easy it is to develop a
quick working prototype that uses smartcards in Perl.
",
['OK']
);
}

# End of File #