Contents of /trunk/pcsc-tools/trunk/gscriptor

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

# $Id: gscriptor,v 1.23 2003-11-08 17:07:02 rousseau Exp $

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',
                            accelerator => '<control>N',
                            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>n',
                            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 prefered 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 succesfull 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 successfull 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
                                        # enhence 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;
                        }

                        # 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(Chipcard::PCSC::array_to_ascii($raCurrentResult)), "\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 #
