#!/usr/bin/env perl
# gscriptor: GTK interface to send APDU commands to a smart card
# Copyright (C) 2001,2018 Lionel Victor, Ludovic Rousseau
# 2002-2010 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 warnings;
use Glib qw(TRUE FALSE);
use Gtk3 '-init';
use File::Basename;
use Carp;
use Chipcard::PCSC;
use Chipcard::PCSC::Card;
use Locale::TextDomain qw (pcsc-tools);
use Locale::Messages qw (LC_MESSAGES bind_textdomain_filter bind_textdomain_codeset turn_utf_8_on);
use POSIX ('setlocale');
# Set the locale according to our environment.
setlocale (LC_MESSAGES, '');
BEGIN {
bind_textdomain_filter 'pcsc-tools', \&turn_utf_8_on;
bind_textdomain_codeset 'pcsc-tools', 'utf-8';
}
my $strAppName = "gscriptor";
my $strConfigFileName = "$ENV{HOME}/.$strAppName";
my @ResultStruct;
my %hConfig;
my ($vscScript, $vscResult);
# PCSC related variables
my $hContext = Chipcard::PCSC->new;
die ("Can't create the Chipcard::PCSC object: $Chipcard::PCSC::errno\n") unless (defined $hContext);
my $hCard = Chipcard::PCSC::Card->new ($hContext);
die ("Can't create the Chipcard::PCSC::Card object: $Chipcard::PCSC::errno\n") unless (defined $hContext);
############################ create public widgets ###########################
my $wndMain = Gtk3::Window->new('toplevel');
my $infoBar = Gtk3::InfoBar->new;
my $txtInfo = Gtk3::Label->new;
my $txtScript = Gtk3::TextView->new;
my $txtResult = Gtk3::TextView->new;
my $rdbASCII = Gtk3::RadioButton->new_with_label(undef, 'ASCII');
my $rdbHex = Gtk3::RadioButton->new_with_label($rdbASCII->get_group(), 'Hex');
my $chkWrap = Gtk3::CheckButton->new(__("Wrap lines"));
my $btnRun = Gtk3::Button->new(__("Run"));
my $txtStatus = Gtk3::Entry->new;
############################## organise 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 () {
# configure text views
$txtScript->set_editable(TRUE);
$txtResult->set_editable(FALSE);
# configure status area
$txtStatus->set_sensitive(FALSE);
# configure info bar area
$infoBar->set_no_show_all(TRUE);
$infoBar->hide();
$txtInfo->show();
$infoBar->add_button( 'gtk-ok', 'ok' );
$infoBar->pack_start( $txtInfo, TRUE, TRUE, 1 );
$infoBar->signal_connect(
response => sub {
$infoBar->hide();
}
);
$infoBar->set_halign('fill');
# set text wrapping to TRUE and Hexadecimal display by default
$chkWrap->set_active(TRUE);
$txtScript->set_wrap_mode('GTK_WRAP_CHAR');
$rdbHex->set_active(TRUE);
# create and bind scrollable areas for text view
$vscScript = Gtk3::ScrolledWindow->new;
$vscScript->set_policy ('automatic', 'automatic');
$vscScript->add($txtScript);
$vscResult = Gtk3::ScrolledWindow->new;
$vscResult->set_policy ('automatic', 'automatic');
$vscResult->add($txtResult);
# create text tags
my $buffer = $txtResult->get_buffer;
$buffer->create_tag("red", foreground => "red");
$buffer->create_tag("blue", foreground => "blue");
$buffer->create_tag("monospace", family => "monospace");
# create and arrange box containers
my $hbxScriptBox = Gtk3::HBox->new (FALSE, 3);
my $vbxScriptBox = Gtk3::VBox->new (FALSE, 10);
my $hbxResultBox = Gtk3::HBox->new (FALSE, 3);
my $vbxResultBox = Gtk3::VBox->new (FALSE, 3);
# vbxScriptBox receives a box with the scripting area, a checkbox AND a 'run' button
$hbxScriptBox->pack_end($vscScript, TRUE, TRUE, 0);
$vbxScriptBox->add($hbxScriptBox);
$vbxScriptBox->pack_end($btnRun, FALSE, FALSE, 0);
$vbxScriptBox->pack_end($chkWrap, FALSE, FALSE, 0);
$vbxScriptBox->set_border_width(5);
# vbxResultBox receives a box with the results area, a couple of radio-buttons
$hbxResultBox->pack_end($vscResult, TRUE, TRUE, 0);
$vbxResultBox->add($hbxResultBox);
$vbxResultBox->pack_start($rdbASCII, FALSE, FALSE, 0);
$vbxResultBox->pack_start($rdbHex, FALSE, FALSE, 0);
$vbxResultBox->set_border_width(5);
# create and fill frame containers for vbxScriptBox and vbxResultBox
my $frmScript = Gtk3::Frame->new (__("Script"));
my $frmResult = Gtk3::Frame->new (__("Result"));
$frmScript->set_border_width(5);
$frmScript->add ($vbxScriptBox);
$frmResult->set_border_width(5);
$frmResult->add ($vbxResultBox);
# the Pane that contains (in a HBox) the script and result frames
my $hpaned = Gtk3::HPaned->new;
$hpaned->set_border_width(5);
$hpaned->add1($frmScript);
$hpaned->add2($frmResult);
my $hbxBox = Gtk3::HBox->new (FALSE, 10);
$hbxBox->add($hpaned);
# define the Menu bar and ToolBar
my $xmlUIDefinition = "
";
my @appActions = (
# name, stock id, label, shortcut, tooltip, action
[ "FileMenu", undef, __("_File") ],
[ "New", 'gtk-new', __("_New"), "N", __("Create a new file"), \&NewScriptFile ],
[ "Open", 'gtk-open', __("_Open"), "O", __("Open a file"), \&LoadScriptFile ],
[ "Save", 'gtk-save', __("_Save"), "S", __("Save current file"), \&SaveScriptFile ],
[ "SaveAs", 'gtk-save', __("Save _As..."), "S", __("Save to a file"), \&SaveAsScriptFile ],
[ "Quit", 'gtk-quit', __("_Quit"), "Q", __("Quit"), \&CloseAppWindow ],
[ "ReaderMenu", undef, __("R_eader") ],
[ "ReaderConnect", undef, __("_Connect"), "C", __("Connect to the current Reader"), \&ConnectDefaultReader ],
[ "ReaderReconnect", 'gtk-redo', __("Reco_nnect"), undef, __("Reconnect to the current Reader"), \&ReconnectDefaultReader ],
[ "ReaderDisconnect", undef, __("_Disconnect"), "D", __("Disconnect from the current Reader"), \&DisconnectDefaultReader ],
[ "ReaderStatus", 'gtk-properties', __("_Status"), undef, __("Display the current Reader's status"), \&DefaultReaderStatus ],
[ "RunMenu", undef, __("Ru_n") ],
[ "Run", 'gtk-execute', __("_Run Script"), undef, __("Run Script on current Reader"), \&RunScript ],
[ "Clear", 'gtk-clear', __("C_lear Results"), undef, __("Clear the Results Area"), \&ClearResult ],
[ "SettingsMenu", 'gtk-preferences', __("_Settings") ],
[ "SelectReader", 'gtk-preferences', __("Reader"), "P", __("Select the Reader"), \&ReaderConfig ],
[ "HelpMenu", undef, __("_Help") ],
[ "About", undef, __("_About"), "A", __("About"), \&About ],
);
my $ui = Gtk3::UIManager->new();
my $action_group = Gtk3::ActionGroup->new('AppWindowActions');
$action_group->add_actions( \@appActions, undef );
$ui->insert_action_group( $action_group, 0 );
$ui->add_ui_from_string( $xmlUIDefinition, length($xmlUIDefinition) );
my $vbxMainBox = Gtk3::VBox->new (FALSE, 5);
$vbxMainBox->pack_start ($ui->get_widget('/MenuBar'), FALSE, FALSE, 1);
$vbxMainBox->pack_start ($ui->get_widget('/ToolBar'), FALSE, FALSE, 1);
$vbxMainBox->pack_start ($infoBar, FALSE, FALSE, 1);
$vbxMainBox->add ($hbxBox);
$vbxMainBox->pack_end ($txtStatus, FALSE, FALSE, 0);
$vbxMainBox->show_all();
# Populate the application's main window
$wndMain->set_title ("$strAppName");
$wndMain->add($vbxMainBox);
# TODO: find a fancy icon
# $wndMain->set_icon_name('gtk-open');
$wndMain->add_accel_group( $ui->get_accel_group );
# Connect widgets together
$chkWrap->signal_connect('toggled', sub { $txtScript->set_wrap_mode($chkWrap->get_active ? 'GTK_WRAP_CHAR' : 'GTK_WRAP_NONE'); } );
$wndMain->signal_connect ("delete_event", \&CloseAppWindow);
$btnRun->signal_connect ("clicked", \&RunScript);
$rdbASCII->signal_connect('toggled', \&RefreshResult);
$rdbHex->signal_connect ('toggled', \&RefreshResult);
$wndMain->signal_connect ("delete_event", \&CloseAppWindow);
}
################# weave and show the application main window #################
arrange_widgets();
ReadConfigFile();
$txtStatus->set_text (__("welcome to the ") . $strAppName . __(" application! - not connected"));
$wndMain->show_all();
# FIXME: for some reason this would not display when called after Gtk3->main()
if (exists $hConfig{'script'}) {
unless (ReadScriptFile ($hConfig{'script'})) {
$txtInfo->set_text(__("Can not open") . " $hConfig{'script'}: $!");
$infoBar->set_message_type('error');
$infoBar->show;
delete $hConfig{'script'};
}
}
Gtk3->main();
# The "launcher" exits here... from now on the GTK thread will do the job.
exit;
######################### application engine follows #########################
sub ReaderConfig {
my $dlgReaderConfig = Gtk3::Dialog->new;
my $txtReader = Gtk3::Label->new (__("Reader"));
my $cboReaders = Gtk3::ComboBoxText->new;
my $txtProtocol = Gtk3::Label->new (__("Protocol"));
my $rdbT0 = Gtk3::RadioButton->new_with_label_from_widget(undef, "T=0");
my $rdbT1 = Gtk3::RadioButton->new_with_label_from_widget($rdbT0, "T=1");
my $rdbT01 = Gtk3::RadioButton->new_with_label_from_widget($rdbT0, "T=0 or T=1");
my $rdbRAW = Gtk3::RadioButton->new_with_label_from_widget($rdbT0, "T=RAW");
# check the radio button with the last preferred protocol if any
if (defined $hConfig {'protocol'}) {
$rdbT0->set_active(TRUE) if ($hConfig {'protocol'} == $Chipcard::PCSC::SCARD_PROTOCOL_T0);
$rdbT1->set_active(TRUE) if ($hConfig {'protocol'} == $Chipcard::PCSC::SCARD_PROTOCOL_T1);
$rdbT01->set_active(TRUE) if ($hConfig {'protocol'} == ($Chipcard::PCSC::SCARD_PROTOCOL_T0 | $Chipcard::PCSC::SCARD_PROTOCOL_T1));
$rdbRAW->set_active(TRUE) if ($hConfig {'protocol'} == $Chipcard::PCSC::SCARD_PROTOCOL_RAW);
}
my $hbxStatusBox = Gtk3::Table->new (4, 2, 1);
$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 ($rdbT01, 1, 2, 2, 3);
$hbxStatusBox->attach_defaults ($rdbRAW, 1, 2, 3, 4);
# Create the Box for reader selection's combo
my $hbxReaderBox = Gtk3::HBox->new (FALSE, 10);
$hbxReaderBox->set_border_width(5);
$hbxReaderBox->pack_start ($txtReader, FALSE, FALSE, 10);
$hbxReaderBox->pack_start ($cboReaders, TRUE, TRUE, 10);
my @readers_list = $hContext->ListReaders;
for (@readers_list) {
$cboReaders->append_text($_) if ($_);
}
# We select the first reader (default choice)
$cboReaders->set_active(0);
# Select the last preferred reader if any
if (defined $hConfig {'reader'}) {
my $i = 0;
my $reader = $hConfig {'reader'};
# escape metacharacters
$reader =~ s/\[/\\\[/g;
$reader =~ s/\]/\\\]/g;
$reader =~ s/\(/\\\[/g;
$reader =~ s/\)/\\\)/g;
for (@readers_list) {
$cboReaders->set_active($i) if (m/$reader/);
$i++;
}
}
$dlgReaderConfig->add_button( 'gtk-ok', 'ok' );
$dlgReaderConfig->add_button( 'gtk-cancel', 'cancel' );
$dlgReaderConfig->get_content_area()->add (new Gtk3::HSeparator());
$dlgReaderConfig->get_content_area()->add ($hbxReaderBox);
$dlgReaderConfig->get_content_area()->add ($hbxStatusBox);
$dlgReaderConfig->set_title('Smartcard Reader Preferences');
$dlgReaderConfig->set_modal(TRUE);
$dlgReaderConfig->set_destroy_with_parent(TRUE);
$dlgReaderConfig->show_all();
if ( 'ok' eq $dlgReaderConfig->run ) {
$hConfig{'reader'} = @readers_list[$cboReaders->get_active()];
$hConfig{'reader'} = "" if (! defined $hConfig{'reader'});
$hCard->Disconnect($Chipcard::PCSC::SCARD_UNPOWER_CARD);
$dlgReaderConfig->destroy();
$hConfig{'protocol'} = $Chipcard::PCSC::SCARD_PROTOCOL_RAW if ($rdbRAW->get_active());
$hConfig{'protocol'} = $Chipcard::PCSC::SCARD_PROTOCOL_T0 if ($rdbT0->get_active());
$hConfig{'protocol'} = $Chipcard::PCSC::SCARD_PROTOCOL_T1 if ($rdbT1->get_active());
$hConfig{'protocol'} = $Chipcard::PCSC::SCARD_PROTOCOL_T0|$Chipcard::PCSC::SCARD_PROTOCOL_T1 if ($rdbT01->get_active());
$txtInfo->set_text(__("New configuration !"));
$infoBar->set_message_type('GTK_MESSAGE_INFO');
$infoBar->show;
} else {
$dlgReaderConfig->destroy;
$txtInfo->set_text(__("Preserving old configuration"));
$infoBar->set_message_type('GTK_MESSAGE_ERROR');
$infoBar->show;
}
}
sub ReadConfigFile {
if (-f $strConfigFileName) {
die ("Can't open $strConfigFileName for reading: $!\n") unless (open (FILE, "<$strConfigFileName"));
while () {
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";
}
$wndMain->set_default_size(split / /, $hConfig{'WindowSize'}) if (defined $hConfig{'WindowSize'});
}
sub WriteConfigFile {
my $strTmpKey;
$hConfig{'WindowSize'} = join (" ", $wndMain->get_size());
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 (sort keys %hConfig) {
print FILE "$strTmpKey = \'$hConfig{$strTmpKey}\'\n" if (defined $hConfig{$strTmpKey});
}
close (FILE);
}
sub ReadScriptFile {
my $strScriptFileName = shift;
my $strBaseFileName = basename ($strScriptFileName);
return 0 unless open (FILE, "<$strScriptFileName");
$txtScript->get_buffer->set_text("");
($txtScript->get_buffer)->insert_at_cursor($_) while ();
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");
my $textbuffer = $txtScript->get_buffer;
print FILE $textbuffer->get_text($textbuffer->get_start_iter, $textbuffer->get_end_iter, 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_buffer->get_char_count()) {
my $dialog = Gtk3::MessageDialog->new(
$wndMain,
[qw( modal destroy-with-parent )],
'GTK_MESSAGE_QUESTION',
'ok',
__("The current work will be lost!\nAre you sure you want to continue?")
);
$dialog->add_button('gtk-cancel', 'cancel');
if ( 'ok' eq $dialog->run ) {
EraseCurrentScript();
}
$dialog->destroy;
}
}
sub EraseCurrentScript {
$txtScript->get_buffer->set_text("");
$wndMain->set_title ("$strAppName");
delete $hConfig{'script'};
}
sub SaveScriptFile {
my ($widget) = @_;
if (exists $hConfig{'script'}) {
my $file = $hConfig{'script'};
if (WriteScriptFile ($file)) {
$txtInfo->set_text(__("Successfully saved script to") . " $file");
$infoBar->set_message_type('GTK_MESSAGE_INFO');
$infoBar->show;
} else {
$txtInfo->set_text(__("Can't open") . " $file: $!");
$infoBar->set_message_type('GTK_MESSAGE_ERROR');
$infoBar->show;
}
} else {
SaveAsScriptFile ($widget);
}
}
sub SaveAsScriptFile {
my $file_dialog = Gtk3::FileChooserDialog->new('Save File', $wndMain, 'save', ('gtk-cancel', 'cancel', 'gtk-save', 'accept'));
if ( 'accept' eq $file_dialog->run ) {
my $file = $file_dialog->get_filename();
if (-d $file) {
$txtInfo->set_text(__("Can't open") . " $file: file is a directory");
$infoBar->set_message_type('GTK_MESSAGE_ERROR');
$infoBar->show;
} else {
if (WriteScriptFile ($file)) {
$txtInfo->set_text(__("Successfully saved script to") . " $file");
$infoBar->set_message_type('GTK_MESSAGE_INFO');
$infoBar->show;
} else {
$txtInfo->set_text(__("Can't open") . " $file: $!");
$infoBar->set_message_type('GTK_MESSAGE_ERROR');
$infoBar->show;
}
}
}
$file_dialog->destroy();
}
sub LoadScriptFile {
if ($txtScript->get_buffer->get_char_count()) {
my $dialog = Gtk3::MessageDialog->new(
$wndMain,
[qw( modal destroy-with-parent )],
'GTK_MESSAGE_QUESTION',
'ok',
__("The current work will be lost!\nAre you sure you want to continue?")
);
$dialog->add_button('gtk-cancel', 'cancel');
if ( 'ok' eq $dialog->run ) {
LoadScript();
}
$dialog->destroy;
} else {
LoadScript();
}
}
sub LoadScript {
my $file_dialog = Gtk3::FileChooserDialog->new('Load File', $wndMain, 'open', ('gtk-cancel', 'cancel', 'gtk-open', 'accept'));
if ( 'accept' eq $file_dialog->run ) {
my $file = $file_dialog->get_filename();
if (-d $file) {
$txtInfo->set_text(__("Can't open") . " $file: file is a directory");
$infoBar->set_message_type('GTK_MESSAGE_ERROR');
$infoBar->show;
} else {
unless (ReadScriptFile ($file)) {
$txtInfo->set_text(__("Can't open") . " $file: $!");
$infoBar->set_message_type('GTK_MESSAGE_ERROR');
$infoBar->show;
}
}
if (exists $hConfig{'script'}) {
$file_dialog->set_filename(dirname($hConfig{'script'})."/");
}
$file_dialog->destroy();
} else {
$txtInfo->set_text(__("Action Cancelled..."));
$infoBar->set_message_type('GTK_MESSAGE_OTHER');
$infoBar->show;
$file_dialog->destroy();
}
}
sub ClearResult {
$txtResult->get_buffer->set_text("");
@ResultStruct = ();
}
sub RefreshResult {
my $tmpLine;
my $tmp_value;
my $textbuffer = $txtResult->get_buffer;
my $tmp_text;
my $state = 0; # text
$textbuffer->set_text ("");
my $iter = $textbuffer->get_end_iter;
foreach $tmpLine (@ResultStruct) {
if (ref $tmpLine) {
$tmp_text = "";
if ($rdbHex->get_active) {
my $c = 0;
for (@$tmpLine) {
$tmp_text .= sprintf ("%02X ", $_);
if (++$c == 16) {
$tmp_text .= "\n";
$c = 0;
}
}
} else {
my $c = 0;
foreach $tmp_value (@$tmpLine) {
# 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)) {
$tmp_text .= chr ($tmp_value);
} else {
$tmp_text .= ".";
}
if ($c++ == 32) {
$tmp_text .= "\n";
$c = 0;
}
}
}
$textbuffer->insert_with_tags_by_name ($iter, "$tmp_text\n",
"monospace", $state ? "red" : "blue");
} else {
$textbuffer->insert ($iter, $tmpLine);
$state = 0;
my $r = __("Received: ");
$state = 1 if ($tmpLine =~ m/$r/);
}
}
}
sub ConnectDefaultReader {
my @readers_list = $hContext->ListReaders;
# if only one reader is found use it unconditionally
$hConfig{'reader'} = $readers_list[0] if ($#readers_list == 0);
if (defined $hConfig{'reader'} && !($hConfig{'reader'} eq '')) {
if (defined $hCard->{hCard}) {
my $dialog = Gtk3::MessageDialog->new(
$wndMain,
[qw( modal destroy-with-parent )],
'GTK_MESSAGE_QUESTION',
'gtk-ok',
__("The card is already connected...\nDo you want to reconnect?")
);
$dialog->add_button('gtk-cancel', 'cancel');
if ( 'ok' eq $dialog->run ) {
ReconnectDefaultReader();
}
$dialog->destroy;
} else {
$hCard->Connect ($hConfig{'reader'}, $Chipcard::PCSC::SCARD_SHARE_SHARED, $hConfig{'protocol'});
if (defined $hCard->{hCard}) {
$txtStatus->set_text(__("Connected to") . " '$hConfig{'reader'}'");
} else {
$txtInfo->set_text(__("Can not connect to the reader named") . " '$hConfig{'reader'}':\n$Chipcard::PCSC::errno");
$infoBar->set_message_type('GTK_MESSAGE_ERROR');
$infoBar->show;
};
}
} else {
$txtInfo->set_text(__("No default reader has been configured.\nPlease make sure you have configured a reader first."));
$infoBar->set_message_type('GTK_MESSAGE_ERROR');
$infoBar->show;
}
}
sub ReconnectDefaultReader {
if (defined $hCard->{hCard}) {
$hCard->Reconnect ($Chipcard::PCSC::SCARD_SHARE_SHARED, $hConfig{'protocol'}, $Chipcard::PCSC::SCARD_RESET_CARD);
if (defined $hCard->{hCard}) {
$txtStatus->set_text(__("Connected to") . " '$hConfig{'reader'}'");
} else {
$txtInfo->set_text(__("Can not reconnect to the reader named") . " '$hConfig{'reader'}':\n$Chipcard::PCSC::errno");
$infoBar->set_message_type('GTK_MESSAGE_ERROR');
$infoBar->show;
};
} else {
# we just propose to connect but do not call Reconnect()
# afterwards that would be quite useless
my $dialog = Gtk3::MessageDialog->new(
$wndMain,
[qw( modal destroy-with-parent )],
'GTK_MESSAGE_QUESTION',
'ok',
__("The Chipcard::PCSC:Card object is not connected...\n Do you want to connect?")
);
$dialog->add_button('gtk-cancel', 'cancel');
if ( 'ok' eq $dialog->run ) {
ConnectDefaultReader();
}
$dialog->destroy;
}
}
sub DisconnectDefaultReader {
if (defined $hCard->{hCard}) {
$hCard->Disconnect($Chipcard::PCSC::SCARD_UNPOWER_CARD);
if (defined $hCard->{hCard}) {
$txtInfo->set_text(__("Can not disconnect from the reader named") . " '$hConfig{'reader'}':\n$Chipcard::PCSC::errno");
$infoBar->set_message_type('GTK_MESSAGE_ERROR');
$infoBar->show;
} else {
$txtStatus->set_text(__("not connected"));
};
} else {
$txtInfo->set_text(__("The Chipcard::PCSC::Card object is not connected!"));
$infoBar->set_message_type('GTK_MESSAGE_ERROR');
$infoBar->show;
}
}
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) {
$MessageString .= "'Unknown state', ";
}
if ($StatusResult[1] & $Chipcard::PCSC::SCARD_ABSENT) {
$MessageString .= "Absent, ";
}
if ($StatusResult[1] & $Chipcard::PCSC::SCARD_PRESENT) {
$MessageString .= "Present, ";
}
if ($StatusResult[1] & $Chipcard::PCSC::SCARD_SWALLOWED) {
$MessageString .= "Swallowed, ";
}
if ($StatusResult[1] & $Chipcard::PCSC::SCARD_POWERED) {
$MessageString .= "Powered, ";
}
if ($StatusResult[1] & $Chipcard::PCSC::SCARD_NEGOTIABLE) {
$MessageString .= "'PTS is negotiable', ";
}
if ($StatusResult[1] & $Chipcard::PCSC::SCARD_SPECIFIC) {
$MessageString .= "'PTS has been set', ";
}
# remove the trailing ", "
substr ($MessageString, -2) = "";
# 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 (@{$StatusResult[3]}) { $MessageString .= sprintf ("%02X ", $_); }
} else {
$MessageString .= "not available";
}
$txtInfo->set_text($MessageString);
$infoBar->set_message_type('GTK_MESSAGE_INFO');
$infoBar->show;
} else {
$txtInfo->set_text(__("Can not retrieve reader status:\n") . "$Chipcard::PCSC::errno");
$infoBar->set_message_type('GTK_MESSAGE_ERROR');
$infoBar->show;
}
} else {
my $dialog = Gtk3::MessageDialog->new(
$wndMain,
[qw( modal destroy-with-parent )],
'GTK_MESSAGE_QUESTION',
'ok',
__("The reader is not connected...\n Do you want to connect?")
);
$dialog->add_button('gtk-cancel', 'cancel');
if ( 'ok' eq $dialog->run ) {
ConnectDefaultReader();
if (defined $hCard->{hCard}) {
DefaultReaderStatus();
}
}
$dialog->destroy;
}
}
sub RunScript {
if (defined $hCard->{hCard}) {
my $textbuffer = $txtScript->get_buffer;
my @tmpCommandArray = split /\n/, $textbuffer->get_text($textbuffer->get_start_iter, $textbuffer->get_end_iter, 1);
my $raCurrentResult;
my $nIndex;
my $cmd;
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";
ReconnectDefaultReader();
push @ResultStruct, "ATR: ";
my @s = $hCard->Status();
push @ResultStruct, \@{$s[3]};
push @ResultStruct, "\n";
next;
}
# if the command does not contains spaces (00A4030000) we expand it
s/(..)/$1 /g if (! m/ /);
# continue if line ends in \
if (m/\\$/)
{
chop; # remove the \
s/ *$/ /; # replace any spaces by ONE space
$cmd .= $_;
next; # read next line
}
$cmd .= $_;
# Extract bytes from the ascii string
# eval {
$raCurrentCommand = Chipcard::PCSC::ascii_to_array($cmd);
$cmd = "";
# } or do {
# $txtInfo->set_text("Cannot understand APDU : $@\nStopping script execution");
# $infoBar->set_message_type('GTK_MESSAGE_ERROR');
# $infoBar->show;
# last;
# };
# 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 {
$txtInfo->set_text(__("Transmit failed:") . " $Chipcard::PCSC::errno\n" . __("Stopping script execution"));
$infoBar->set_message_type('GTK_MESSAGE_ERROR');
$infoBar->show;
push @ResultStruct, __("\nErrors During Script Execution:") . " $Chipcard::PCSC::errno\n";
last;
}
}
push @ResultStruct, __("Script was executed without error...\n");
} else {
my $dialog = Gtk3::MessageDialog->new(
$wndMain,
[qw( modal destroy-with-parent )],
'GTK_MESSAGE_QUESTION',
'ok',
__("The Chipcard::PCSC::Card object is not connected!\nDo you want to connect?")
);
$dialog->add_button('gtk-cancel', 'cancel');
if ( 'ok' eq $dialog->run ) {
ConnectDefaultReader();
if (defined $hCard->{hCard}) {
RunScript();
}
}
$dialog->destroy;
}
RefreshResult();
}
sub CloseAppWindow {
undef $hCard;
undef $hContext;
WriteConfigFile();
Gtk3->main_quit();
}
sub About {
my $dialog = Gtk3::MessageDialog->new(
$wndMain,
[qw( modal destroy-with-parent )],
'GTK_MESSAGE_QUESTION',
'ok',
"$strAppName was coded by Lionel VICTOR, (C) 2001, 2018.
and debugged & improved by Ludovic ROUSSEAU, (C) 2001-2006.
$strAppName is (was) a small application written in Perl.
It basically demonstrates how easy it is to develop a
quick working prototype that uses smartcards in Perl.
"
);
$dialog->run;
$dialog->destroy;
}