#!/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; }