#!/usr/bin/perl -w
################################################################################
# xrdesktop, a gtk-perl frontend for rdesktop #
# Copyright (C) 2002 David Kovach #
# #
# 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 #
################################################################################
use Gtk;
use strict;
set_locale Gtk;
init Gtk;
my $false = 0;
my $true = 1;
my $window;
my $box1;
my $scrolled_window1;
my $buttonbox1;
my $button1;
my $button2;
my $button3;
my $button4;
my $button5;
my $list1;
my %ip_hash;
my %uname_hash;
my %geom_hash;
my %fullscreen_hash;
my %bitmap_upd_hash;
my %kmap_hash;
my %license_hash;
my %passthru_hash;
my $machine_name;
my $machine_ip;
my $machine_uname;
my $machine_geom;
my $machine_fs;
my $machine_bitmap_upd;
my $machine_kmap;
my $machine_lic;
my $machine_passthru;
my $raw_data;
my $field_type;
my $field_data;
my $machina;
my @machines;
my @temp;
my $selected_machine;
my $selected_machine_ip;
my $selected_uname;
my $selected_geom;
my $selected_fs;
my $selected_bitmap_upd;
my $selected_kmap;
my $selected_kmap_hex;
my $selected_lic;
my $selected_passthru;
my $dialog1;
my $dialog_button_ok;
my $dialog_button_cancel;
my $name_entry;
my $ip_entry;
my $uname_entry;
my $dialog2;
my $combo1;
my $combo2;
my $fs_checkbox;
my $bmp_checkbox;
my $lic_checkbox;
my $passthru_entry;
my $passthru;
# the BIGASS list of keymaps. fear its awesome girth and stuff.
## 02/10/2003 updated the list to work with rdesktop 1.2 and the
## new way they do keyboard layouts...feh
## left all the hex codes for which i could not find mappings as comments
## in the hopes that someday it will get fixed.
## also note that some of these are approximations and may or may
## not work at all.
my %kmap_trans_hash = (
"Albanian" => "en-us",
# "Arabic 101" => "0x00000401",
# "Arabic 102 AZERTY" => "0x00020401",
# "Arabic 102" => "0x00010401",
# "Armenian Eastern" => "0x0000042b",
# "Armenian Western" => "0x0001042b",
# "Azeri Cyrillic" => "0x0000082c",
# "Azeri Latin" => "0x0000042c",
# "Belarusian" => "0x00000423",
# "Belgian Comma" => "0x0001080c",
"Belgian Dutch" => "be",
"Belgian French" => "be",
"Bulgarian Latin" => "bg",
# "Bulgarian" => "0x00000402",
"Canadian French legacy" => "cf",
"Canadian French" => "en-us",
# "Canadian Multilingual Standard" => "0x00011009",
# "Chinese MS-PinYin98" => "0xe00e0804",
# "Chinese NeiMa" => "0xe0050804",
# "Chinese QuanPin" => "0xe0010804",
# "Chinese ShuangPin" => "0xe0020804",
"Chinese US Keyboard" => "ch",
# "Chinese ZhengMa" => "0xe0030804",
# "Chinese Alphanumeric" => "0xe01f0404",
# "Chinese Array" => "0xe0050404",
# "Chinese Big5 Code" => "0xe0040404",
# "Chinese ChangJie" => "0xe0020404",
# "Chinese DaYi" => "0xe0060404",
# "Chinese New ChangJie" => "0xe0090404",
# "Chinese New Phoneetic" => "0xe0080404",
# "Chinese Phonetic" => "0xe0010404",
# "Chinese Quick" => "0xe0030404",
"Chinese US Keyboard" => "ch",
# "Chinese Unicode" => "0xe0070404",
# "Croatian" => "0x0000041a",
# "Croatian Specific" => "0x0000041a",
"Czech QWERTY" => "cz",
# "Czech ProgrammerS" => "0x00020405",
"Czech" => "cz",
"Danish" => "dk",
# "Devanagari INSCRIPT" => "0x00000439",
"Dutch" => "nl",
"Estonian" => "et",
# "Faeroese" => "0x00000438",
# "Farsi" => "0x00000429",
"Finnish" => "su",
"French" => "fr",
# "Gaelic" => "0x00011809",
# "Georgian" => "0x00000437",
# changed the German keymap string from "gr" to "de"
# at the behest of Tobias Mohrluder. Thanks!
# hopefully this is right :)
"German IBM" => "de",
"German" => "de",
# "Greek 220 Latin" => "0x00030408",
"Greek 220" => "gk",
# "Greek 319 Latin" => "0x00040408",
"Greek 319" => "gk",
"Greek Latin" => "gk",
# "Greek Polytonic" => "0x00060408",
"Greek" => "gk",
# "Hebrew" => "0x0000040d",
# "Hindi Traditional" => "0x00010439",
"Hungarian 101-key" => "hu",
"Hungarian" => "hu",
"Icelandic" => "is",
"Irish" => "en-us",
"Italian 142" => "it",
"Italian" => "it",
# "Japanese Input System" => "0xe0010411",
"Japanese" => "jp",
# "Japanese 106" => "0x00000411",
# "Japanese pc98x1" => "0x00000411",
# "Kazakh" => "0x0000043f",
# "Korean Hangul MS-IME98" => "0xe0010412",
"Korean Hangul" => "ko",
"Latin American" => "la",
"Latvian QWERTY" => "en-us",
# "Latvian" => "0x00000426",
# "Lithuanian IBM" => "0x00000427",
# "Lithuanian" => "0x00010427",
# "Macedonian FYROM" => "0x0000042f",
# "Marathi" => "0x0000044e",
"Norwegian" => "no",
"Polish 214" => "pl",
"Polish Programmers" => "pl",
"Portuguese Brazilian ABNT" => "br",
# "Portuguese Brazilian ABNT2" => "0x00010416",
"Portuguese" => "po",
"Romanian" => "ro",
"Russian Typewriter" => "ru",
"Russian" => "ru",
# "Russian KO18-R" => "0x00000419",
"Serbian Cyrillic" => "en-us",
# "Serbian Latin" => "0x0000081a",
"Slovak QWERTY" => "sl",
"Slovak" => "sl",
# "Slovak Programmers" => "0x0000041b",
"Slovenian" => "yu",
#altered spanish keyboard courtesy of Jonay Gomez
"Spanish Variation" => "es",
# "Spanish" => "0x0000040a",
"Swedish" => "sv",
"Swiss French" => "sf",
# "Swiss German" => "0x0000080",
# "Tamil" => "0x00000449",
# "Tatar" => "0x00000444",
# "Thai Kedmanee non-shiftlock" => "0x0002041e",
# "Thai Kedmanee" => "0x0000041e",
# "Thai Pattachote non-shiftlock" => "0x0003041e",
# "Thai Pattachote" => "0x0001041e",
"Turkish F" => "tr",
"Turkish Q" => "tr",
# "US English Talbe for IBM Arabic 238_L" => "0x00050409",
"US" => "en-us",
# "US phantom key ver" => "0x00000409",
# "Ukranian" => "0x00000422",
"English" => "en-gb",
"US Dvorak left" => "usl",
"US Dvorak right" => "usr",
"US Dvorak" => "dv",
"US International" => "en-us",
# "Uzbek Cyrillic" => "0x00000843",
# "Vietnamese" => "0x0000042a",
"yu" => "yu",
"cf" => "cf",
"us9" => "en-us",
);
# create the window
$window = new Gtk::Window( "toplevel" );
$window->signal_connect( "delete_event", sub { Gtk->exit( 0 ); } );
$window->set_usize( 640, 300 );
$window->border_width( 5 );
$window->set_title("xrdesktop");
# make our first box
$box1 = new Gtk::VBox( $false, 0 );
$box1->set_border_width( 0 );
$window->add( $box1 );
$box1->show();
# this is the scrolled window to put the List widget inside
$scrolled_window1 = new Gtk::ScrolledWindow( undef, undef );
$box1->pack_start( $scrolled_window1, $true, $true, 0 );
$scrolled_window1->set_policy( "automatic", "automatic" );
$scrolled_window1->show();
# create the list, assign a signal to handle change of selection
$list1 = new_with_titles Gtk::CList("Name", "Hostname/IP", "Username", "Keymap", "Geometry", "Fullscreen", "Force Bitmap Updates", "Do Not Request License", "CMD Vars" );
$list1->set_selection_mode( "single" );
$list1->column_titles_passive();
$list1->set_column_width( 0, 100 );
$list1->set_column_width( 1, 150 );
$list1->set_column_width( 2, 80 );
$list1->set_column_width( 3, 65 );
$list1->set_column_width( 4, 100 );
$scrolled_window1->add( $list1 );
$list1->set_shadow_type( 'in' );
$list1->signal_connect( 'select_row', \&list_sel_row );
$list1->signal_connect( 'button_press_event', \&list_exec_row );
# see the sub at the end of the script for info
populate_clist_from_config();
# Make some buttons
$buttonbox1 = new Gtk::HButtonBox();
$button1 = new Gtk::Button( "Connect" );
$button2 = new Gtk::Button( "Add" );
$button3 = new Gtk::Button( "Delete" );
$button4 = new Gtk::Button( "Edit" );
$button5 = new Gtk::Button( "Quit" );
# tell them what to do
$button1->signal_connect( "clicked", \&rdesque_connect );
$button2->signal_connect( "clicked", \&rdesque_add );
$button3->signal_connect( "clicked", \&rdesque_delete );
$button4->signal_connect( "clicked", \&rdesque_edit );
$button5->signal_connect( "clicked", sub { Gtk->exit( 0 ); } );
# put stuff in the window
$box1->pack_start( $buttonbox1, $false, $false, 0 );
$buttonbox1->add( $button1 );
$buttonbox1->add( $button2 );
$buttonbox1->add( $button3 );
$buttonbox1->add( $button4 );
$buttonbox1->add( $button5 );
$window->show_all();
main Gtk;
exit( 0 );
# Subroutines
# simple sub, to launch rdesktop with the configured info
# when the connect button is clicked. rather tidy :)
# remove the print line before the system call if you like quietness
sub rdesque_connect
{
my $buffer;
if( $selected_uname ) { $buffer = $buffer . " -u $selected_uname"; }
if( $selected_geom ) { $buffer = $buffer . " -g $selected_geom"; }
if( $selected_kmap_hex ) { $buffer = $buffer . " -k $selected_kmap_hex"; }
if( $selected_fs eq "true" ) { $buffer = $buffer . " -f"; }
if( $selected_bitmap_upd eq "true" ) { $buffer = $buffer . " -b"; }
if( $selected_lic eq "true" ) { $buffer = $buffer . " -l"; }
if( $selected_passthru ) { $buffer = $buffer . " $selected_passthru"; }
#make the title whatever the string of the selected machine name is
#instead of the machine's ip, courtesy of Jonay Gomez. thanks!
#moved up here at the behest of Tobias Mohrluder. Thanks!
if( $selected_machine ) { $buffer = $buffer . " -T \"$selected_machine\""; }
if( $selected_machine_ip ) { $buffer = $buffer . " $selected_machine_ip"; }
else { die "No IP/Hostname selected! Aborting.\n"; }
print "commandline is \"rdesktop $buffer\"\n";
system("rdesktop $buffer \&");
}
# sub to add an entry into the list of machines to choose from
# all this sub actually does is set up the dialog box to
# collect the info, the do_add_server() sub is what
# really does all the updating of info
# yes i know the layout stuff is effin nasty
# deal with it, i'm new at this gooey stuff... :P
sub rdesque_add
{
$dialog1 = new Gtk::Dialog();
$dialog1->title("Add A Server");
$dialog_button_ok = new Gtk::Button( "Ok" );
$dialog_button_cancel = new Gtk::Button( "Cancel" );
$dialog_button_ok->signal_connect( "clicked", \&do_add_server );
$dialog_button_cancel->signal_connect( "clicked", sub { $dialog1->destroy(); } );
$name_entry = new Gtk::Entry( 75 );
$ip_entry = new Gtk::Entry( 75 );
$uname_entry = new Gtk::Entry( 75 );
$passthru_entry = new Gtk::Entry( 75 );
my $label1 = new Gtk::Label( "Enter a name for this server: " );
my $label2 = new Gtk::Label( "Enter an IP address or hostname to connect to: " );
my $label3 = new Gtk::Label( "Resolution: " );
my $label4 = new Gtk::Label( "Username: " );
my $label5 = new Gtk::Label( "Keyboard Mapping: " );
my $label6 = new Gtk::Label( "Additional Variables to pass: " );
$label1->set_justify( "left" );
$label2->set_justify( "left" );
$label3->set_justify( "left" );
$label4->set_justify( "left" );
$label5->set_justify( "left" );
$label6->set_justify( "left" );
my $vbox1 = new Gtk::VBox( $false, 0 );
my $vbox2 = new Gtk::VBox( $false, 0 );
my $vbox3 = new Gtk::VBox( $false, 0 );
my $vbox4 = new Gtk::VBox( $false, 0 );
my $vbox5 = new Gtk::VBox( $false, 0 );
my $vbox6 = new Gtk::VBox( $false, 0 );
my $vbox7 = new Gtk::VBox( $false, 0 );
my $hbox1 = new Gtk::HBox( $false, 0 );
my $hbox2 = new Gtk::HBox( $false, 0 );
my $hbox3 = new Gtk::HBox( $false, 0 );
my $hbox4 = new Gtk::HBox( $false, 0 );
my $hbox5 = new Gtk::HBox( $false, 0 );
my $hbox6 = new Gtk::HBox( $false, 0 );
my $hbox7 = new Gtk::HBox( $false, 0 );
$combo1 = new Gtk::Combo();
$combo2 = new Gtk::Combo();
my @combo_list = ("640x480", "800x600", "1024x768", "1280x1024", "1600x1200");
my @combo_list2 = sort keys %kmap_trans_hash;
$combo1->set_popdown_strings( @combo_list );
$combo1->set_use_arrows_always( $true );
$combo1->set_value_in_list( $false, $true );
$combo2->set_popdown_strings( @combo_list2 );
$combo2->set_use_arrows_always( $true );
$combo2->set_value_in_list( $true, $false );
$combo2->entry->set_text( "US" );
$fs_checkbox = new Gtk::CheckButton( "Fullscreen On" );
$bmp_checkbox = new Gtk::CheckButton( "Force Bitmap Update" );
$lic_checkbox = new Gtk::CheckButton( "Do Not Request License" );
$dialog1->vbox->set_homogeneous( $false );
$dialog1->vbox->pack_start( $hbox1, $false, $false, 0 );
$hbox1->pack_start( $vbox1, $false, $false, 0 );
$vbox1->pack_start( $label1, $false, $false, 0 );
$vbox1->pack_start( $name_entry, $false, $false, 0 );
$dialog1->vbox->pack_start( $hbox2, $false, $false, 0 );
$hbox2->pack_start( $vbox2, $false, $false, 0 );
$vbox2->pack_start( $label2, $false, $false, 0 );
$vbox2->pack_start( $ip_entry, $false, $false, 0 );
$dialog1->vbox->pack_start( $hbox4, $false, $false, 0 );
$hbox4->pack_start( $vbox4, $false, $false, 0 );
$vbox4->pack_start( $label4, $false, $false, 0 );
$vbox4->pack_start( $uname_entry, $false, $false, 0 );
$dialog1->vbox->pack_start( $hbox7, $false, $false, 0 );
$hbox7->pack_start( $vbox7, $false, $false, 0 );
$vbox7->pack_start( $label6, $false, $false, 0 );
$vbox7->pack_start( $passthru_entry, $false, $false, 0 );
$dialog1->vbox->pack_start( $hbox3, $false, $false, 0 );
$hbox3->pack_start( $vbox3, $false, $false, 0 );
$vbox3->pack_start( $label3, $false, $false, 0 );
$vbox3->pack_start( $combo1, $false, $false, 0 );
$dialog1->vbox->pack_start( $hbox5, $false, $false, 0 );
$hbox5->pack_start( $vbox5, $false, $false, 0 );
$vbox5->pack_start( $label5, $false, $false, 0 );
$vbox5->pack_start( $combo2, $false, $false, 0 );
$dialog1->vbox->pack_start( $hbox6, $false, $false, 0 );
$hbox6->pack_start( $vbox6, $false, $false, 0 );
$vbox6->pack_start( $fs_checkbox, $false, $false, 0 );
$vbox6->pack_start( $bmp_checkbox, $false, $false, 0 );
$vbox6->pack_start( $lic_checkbox, $false, $false, 0 );
$dialog1->action_area->pack_start( $dialog_button_ok, $true, $true, 0 );
$dialog1->action_area->pack_start( $dialog_button_cancel, $true, $true, 0 );
$dialog1->show_all();
}
# remove a machine entry from the list
sub rdesque_delete
{
my $name_deleted;
my $ip_deleted;
$name_deleted = $selected_machine;
$ip_deleted = $ip_hash{$selected_machine};
delete $ip_hash{$selected_machine};
delete $uname_hash{$selected_machine};
delete $geom_hash{$selected_machine};
delete $fullscreen_hash{$selected_machine};
delete $bitmap_upd_hash{$selected_machine};
delete $kmap_hash{$selected_machine};
delete $license_hash{$selected_machine};
delete $passthru_hash{$selected_machine};
write_out_config();
print "Server deleted: name = $name_deleted, ip/hostname = $ip_deleted\n";
populate_clist_from_config();
}
# change an existing entry in the list
# much like the rdesque_add() sub, all this does
# set up a dialog to display the info and change it
# all the real legwork is done by do_edit_server()
# yes, the layout stuff is nasty, see comments for rdesque_add()
sub rdesque_edit
{
$dialog2 = new Gtk::Dialog();
$dialog2->title("Edit A Server");
$dialog_button_ok = new Gtk::Button( "Ok" );
$dialog_button_cancel = new Gtk::Button( "Cancel" );
$dialog_button_ok->signal_connect( "clicked", \&do_edit_server );
$dialog_button_cancel->signal_connect( "clicked", sub { $dialog2->destroy(); } );
$name_entry = new Gtk::Entry( 75 );
$ip_entry = new Gtk::Entry( 75 );
$uname_entry = new Gtk::Entry( 75 );
$passthru_entry = new Gtk::Entry( 75 );
my $label1 = new Gtk::Label( "Enter a name for this server: " );
my $label2 = new Gtk::Label( "Enter an IP address or hostname to connect to: ");
my $label3 = new Gtk::Label( "Resolution: " );
my $label4 = new Gtk::Label( "Username: " );
my $label5 = new Gtk::Label( "Keyboard Mapping: " );
my $label6 = new Gtk::Label( "Additional Variables to pass: " );
$label1->set_justify( "left" );
$label2->set_justify( "left" );
$label3->set_justify( "left" );
$label4->set_justify( "left" );
$label5->set_justify( "left" );
$label6->set_justify( "left" );
my $vbox1 = new Gtk::VBox( $false, 0 );
my $vbox2 = new Gtk::VBox( $false, 0 );
my $vbox3 = new Gtk::VBox( $false, 0 );
my $vbox4 = new Gtk::VBox( $false, 0 );
my $vbox5 = new Gtk::VBox( $false, 0 );
my $vbox6 = new Gtk::VBox( $false, 0 );
my $vbox7 = new Gtk::VBox( $false, 0 );
my $hbox1 = new Gtk::HBox( $false, 0 );
my $hbox2 = new Gtk::HBox( $false, 0 );
my $hbox3 = new Gtk::HBox( $false, 0 );
my $hbox4 = new Gtk::HBox( $false, 0 );
my $hbox5 = new Gtk::HBox( $false, 0 );
my $hbox6 = new Gtk::HBox( $false, 0 );
my $hbox7 = new Gtk::HBox( $false, 0 );
$combo1 = new Gtk::Combo();
$combo2 = new Gtk::Combo();
my @combo_list = ("640x480", "800x600", "1024x768", "1280x1024", "1600x1200");
my @combo_list2 = sort keys %kmap_trans_hash;
$combo1->set_popdown_strings( @combo_list );
$combo1->set_use_arrows_always( $true );
$combo1->set_value_in_list( $false, $true );
$combo2->set_popdown_strings( @combo_list2 );
$combo2->set_use_arrows_always( $true );
$combo2->set_value_in_list( $true, $false );
$fs_checkbox = new Gtk::CheckButton( "Fullscreen On" );
$bmp_checkbox = new Gtk::CheckButton( "Force Bitmap Update" );
$lic_checkbox = new Gtk::CheckButton( "Do Not Request License" );
$dialog2->vbox->set_homogeneous( $false );
$dialog2->vbox->pack_start( $hbox1, $false, $false, 0 );
$hbox1->pack_start( $vbox1, $false, $false, 0 );
$vbox1->pack_start( $label1, $false, $false, 0 );
$vbox1->pack_start( $name_entry, $false, $false, 0 );
$dialog2->vbox->pack_start( $hbox2, $false, $false, 0 );
$hbox2->pack_start( $vbox2, $false, $false, 0 );
$vbox2->pack_start( $label2, $false, $false, 0 );
$vbox2->pack_start( $ip_entry, $false, $false, 0 );
$dialog2->vbox->pack_start( $hbox4, $false, $false, 0 );
$hbox4->pack_start( $vbox4, $false, $false, 0 );
$vbox4->pack_start( $label4, $false, $false, 0 );
$vbox4->pack_start( $uname_entry, $false, $false, 0 );
$dialog2->vbox->pack_start( $hbox7, $false, $false, 0 );
$hbox4->pack_start( $vbox7, $false, $false, 0 );
$vbox4->pack_start( $label6, $false, $false, 0 );
$vbox4->pack_start( $passthru_entry, $false, $false, 0 );
$dialog2->vbox->pack_start( $hbox3, $false, $false, 0 );
$hbox3->pack_start( $vbox3, $false, $false, 0 );
$vbox3->pack_start( $label3, $false, $false, 0 );
$vbox3->pack_start( $combo1, $false, $false, 0 );
$dialog2->vbox->pack_start( $hbox6, $false, $false, 0 );
$hbox6->pack_start( $vbox6, $false, $false, 0 );
$vbox6->pack_start( $label5, $false, $false, 0 );
$vbox6->pack_start( $combo2, $false, $false, 0 );
$dialog2->vbox->pack_start( $hbox5, $false, $false, 0 );
$hbox5->pack_start( $vbox5, $false, $false, 0 );
$vbox5->pack_start( $fs_checkbox, $false, $false, 0 );
$vbox5->pack_start( $bmp_checkbox, $false, $false, 0 );
$vbox5->pack_start( $lic_checkbox, $false, $false, 0 );
$dialog2->action_area->pack_start( $dialog_button_ok, $true, $true, 0 );
$dialog2->action_area->pack_start( $dialog_button_cancel, $true, $true, 0 );
$name_entry->set_text( $selected_machine );
$ip_entry->set_text( $ip_hash{$selected_machine} );
$uname_entry->set_text( $uname_hash{$selected_machine} );
$passthru_entry->set_text( $passthru_hash{$selected_machine} );
$combo1->entry->set_text( $geom_hash{$selected_machine} );
$combo2->entry->set_text( $kmap_hash{$selected_machine} );
if( $fullscreen_hash{$selected_machine} eq "true")
{
$fs_checkbox->set_active( $true );
}
else { $fs_checkbox->set_active( $false ); }
if( $bitmap_upd_hash{$selected_machine} eq "true" )
{
$bmp_checkbox->set_active( $true );
}
else { $bmp_checkbox->set_active( $false ); }
if( $license_hash{$selected_machine} eq "true" )
{
$lic_checkbox->set_active( $true );
}
else { $lic_checkbox->set_active( $false ); }
$dialog2->show_all();
}
# handler for when a row is selected, grabs info from the selected row
# looks the corresponding values up in the hash and
# stuffs them into variables to be used in other subs
sub list_sel_row
{
my ( $sel_widget, $sel_row, $sel_column, $sel_event ) = @_;
my $fs_tf;
my $bmp_tf;
$selected_machine = $list1->get_text( $sel_row, 0 );
$selected_machine_ip = $ip_hash{$selected_machine};
$selected_uname = $uname_hash{$selected_machine};
$selected_geom = $geom_hash{$selected_machine};
$selected_fs = $fullscreen_hash{$selected_machine};
$selected_bitmap_upd = $bitmap_upd_hash{$selected_machine};
$selected_lic = $license_hash{$selected_machine};
$selected_kmap = $kmap_hash{$selected_machine};
$selected_kmap_hex = $kmap_trans_hash{$selected_kmap};
$selected_passthru = $passthru_hash{$selected_machine};
if( $selected_fs eq "true" ) { $fs_tf = "ON"; }
else { $fs_tf = "OFF"; }
if( $selected_bitmap_upd eq "true" ) { $bmp_tf = "Forcing Bitmap Updates"; }
else { $bmp_tf = "not Forcing Bitmap Updates"; }
print "You selected \"$selected_machine\", with the IP \"$selected_machine_ip\", Geometry is \"$selected_geom\"\nUsername is \"$selected_uname\", Fullscreen is $fs_tf, $bmp_tf\nKeyboard Mapping is \"$selected_kmap\"\n\n";
}
sub list_exec_row {
return 1 unless $selected_machine_ip;
my ($w, $ev) = @_;
if ($ev->{type} eq '2button_press' and $ev->{button} == 1) {
# well, probably we should emulate proper signal marshalling
# for 'click' on the 'Connect' button, but for the moment it's
# enough to simply call 'rdesque_connect'
# list double-click patch by Alexey Morozov
&rdesque_connect;
}
return 1;
}
# fairly simple, just spits out a config file based on the
# data contained in the hashes
sub write_out_config
{
my $machina_p;
my @machines_p;
my $count = 1;
unlink( "$ENV{HOME}/.xrdesktop_config" );
# fixed by Ken Caruso
open( CONFIG, ">$ENV{HOME}/.xrdesktop_config" );
select( CONFIG );
print "\# NO USER SERVICABLE PARTS. AT ALL.\n";
print "#\n\n";
@machines_p = keys %ip_hash;
foreach $machina_p (sort @machines_p)
{
print "# Entry $count\n";
print "Name=$machina_p\n";
print "IP=$ip_hash{$machina_p}\n";
print "Uname=$uname_hash{$machina_p}\n";
print "Geometry=$geom_hash{$machina_p}\n";
print "Fullscreen=$fullscreen_hash{$machina_p}\n";
print "Bitmap_Updates=$bitmap_upd_hash{$machina_p}\n";
print "Keymap=$kmap_hash{$machina_p}\n";
print "NoReqLic=$license_hash{$machina_p}\n";
print "Passthru=$passthru_hash{$machina_p}\n\n";
$count++;
}
select( STDOUT );
close( CONFIG );
}
# does the actual adding of the server to the hash and config files
# since the rdesque_add() sub just creates the dialog.
# this is the one linked to the "ok" button in the add dialog
sub do_add_server
{
my $name_added = $name_entry->get_text();
my $ip_added = $ip_entry->get_text();
my $uname_added = $uname_entry->get_text();
my $reso = $combo1->entry->get_text();
my $kmap = $combo2->entry->get_text();
my $pthru = $passthru_entry->get_text();
my $fs_state;
my $bmp_state;
my $lic_state;
if( $fs_checkbox->active ) {$fs_state = "true";}
else {$fs_state = "false";}
if( $bmp_checkbox->active ) {$bmp_state = "true";}
else {$bmp_state = "false";}
if( $lic_checkbox->active ) {$lic_state = "true";}
else {$lic_state = "false";}
chomp $name_added;
chomp $ip_added;
chomp $uname_added;
chomp $reso;
chomp $fs_state;
chomp $bmp_state;
chomp $lic_state;
chomp $kmap;
chomp $pthru;
my $check_dupe_key = exists $ip_hash{$name_added};
if( $name_added ne "" && $ip_added ne "" && $check_dupe_key != $true )
{
$ip_hash{$name_added} = $ip_added;
$uname_hash{$name_added} = $uname_added;
$geom_hash{$name_added} = $reso;
$fullscreen_hash{$name_added} = $fs_state;
$bitmap_upd_hash{$name_added} = $bmp_state;
$license_hash{$name_added} = $lic_state;
$kmap_hash{$name_added} = $kmap;
$passthru_hash{$name_added} = $pthru;
write_out_config();
# print "Added: name=$name_added, ip/hostname=$ip_added, username=$uname_added\nResolution=$reso, Fullscreen=$fs_state, Force Bitmap Updates=$bmp_state\nKeyboard Mapping=$kmap\n\n";
$dialog1->destroy();
populate_clist_from_config();
}
else
{
my $field1;
my $doh_dialog = new Gtk::Dialog();
$doh_dialog->title("Er....");
my $doh_ok = new Gtk::Button( "Ok" );
$doh_ok->signal_connect( "clicked", sub { $doh_dialog->destroy(); } );
my $doh_label = new Gtk::Label();
if( $name_added eq "" )
{
$field1 = "You left the Name field blank.\nConfig NOT updated";
$doh_label->set_text( $field1 );
}
elsif( $ip_added eq "" )
{
$field1 = "You left the IP/Hostname field blank.\nConfig NOT updated";
$doh_label->set_text( $field1 );
}
elsif( $check_dupe_key )
{
$doh_label->set_text( "An entry named \"$name_added\" already exists.\nPlease choose another name." );
}
else
{
$field1 = "***CRITICAL ERROR***";
$doh_label->set_text( $field1 );
}
$doh_dialog->vbox->pack_start( $doh_label, $true, $true, 0 );
$doh_dialog->action_area->pack_start( $doh_ok, $true, $true, 0 );
$doh_dialog->show_all();
}
}
# does the actual editing of the server in the hash and config
# files since the rdesque_edit() sub just creates the dialog.
# this is the one linked to the "ok button in the dialog
sub do_edit_server
{
my $name_edited = $name_entry->get_text();
my $ip_edited = $ip_entry->get_text();
my $uname_edited = $uname_entry->get_text();
my $pthru = $passthru_entry->get_text();
my $reso = $combo1->entry->get_text();
my $kmap = $combo2->entry->get_text();
my $fs_state;
my $bmp_state;
my $lic_state;
if( $fs_checkbox->active ) {$fs_state = "true";}
else {$fs_state = "false";}
if( $bmp_checkbox->active ) {$bmp_state = "true";}
else {$bmp_state = "false";}
if( $lic_checkbox->active ) {$lic_state = "true";}
else {$lic_state = "false";}
chomp $name_edited;
chomp $ip_edited;
chomp $uname_edited;
chomp $reso;
chomp $fs_state;
chomp $bmp_state;
chomp $lic_state;
chomp $kmap;
chomp $pthru;
if( $name_edited ne "" && $ip_edited ne "" )
{
my $old_name = $selected_machine;
my $old_ip = $ip_hash{$selected_machine};
delete $ip_hash{$selected_machine};
$ip_hash{$name_edited} = $ip_edited;
delete $uname_hash{$selected_machine};
$uname_hash{$name_edited} = $uname_edited;
delete $geom_hash{$selected_machine};
$geom_hash{$name_edited} = $reso;
delete $fullscreen_hash{$selected_machine};
$fullscreen_hash{$name_edited} = $fs_state;
delete $bitmap_upd_hash{$selected_machine};
$bitmap_upd_hash{$name_edited} = $bmp_state;
delete $license_hash{$selected_machine};
$license_hash{$name_edited} = $lic_state;
delete $kmap_hash{$selected_machine};
$kmap_hash{$name_edited} = $kmap;
delete $passthru_hash{$selected_machine};
$passthru_hash{$name_edited} = $pthru;
write_out_config();
print "Old data: name = $old_name, ip/hostname = $old_ip\n";
print "New data: name = $name_edited, ip/hostname = $ip_edited\n";
$dialog2->destroy();
populate_clist_from_config();
}
else
{
my $field1;
my $doh_dialog = new Gtk::Dialog();
$doh_dialog->title("Er....");
my $doh_ok = new Gtk::Button( "Ok" );
$doh_ok->signal_connect( "clicked", sub { $doh_dialog->destroy(); } );
if( $name_edited eq "" ) { $field1 = "Name"; }
elsif( $ip_edited eq "" ) { $field1 = "IP/Hostname"; }
else { $field1 = "***CRITICAL ERROR***"; }
my $doh_label = new Gtk::Label( "You left the $field1 field blank.\nConfig NOT updated." );
$doh_dialog->vbox->pack_start( $doh_label, $true, $true, 0 );
$doh_dialog->action_area->pack_start( $doh_ok, $true, $true, 0 );
$doh_dialog->show_all();
}
}
# reads in the config file (~/.xrdesktop_config by default)
# plugs all the data into a hash ($ip_hash) and
# sets up the $list1 widget with the data in the hash
sub populate_clist_from_config
{
unless( -e "$ENV{HOME}/.xrdesktop_config") { write_out_config();}
open( CONFIG, "$ENV{HOME}/.xrdesktop_config");
while( <CONFIG> )
{
# ignore comments and blank lines
next if /^#/;
next if /^$/;
# get me some data
$raw_data = $_;
chomp $raw_data;
( $field_type, $field_data ) = split /=/, $raw_data;
chomp $field_type;
chomp $field_data;
# stuff the first line (hopefully Name) into vars
if( $field_type eq "Name" ) {$machine_name = $field_data;}
elsif( $field_type eq "IP" ) {$machine_ip = $field_data;}
elsif( $field_type eq "Uname" ) {$machine_uname = $field_data;}
elsif( $field_type eq "Geometry" ) { $machine_geom = $field_data;}
elsif( $field_type eq "Fullscreen" ) {$machine_fs = $field_data;}
elsif( $field_type eq "Bitmap_Updates" ) {$machine_bitmap_upd = $field_data;}
elsif( $field_type eq "Keymap" ) {$machine_kmap = $field_data;}
elsif( $field_type eq "NoReqLic" ) {$machine_lic = $field_data;}
elsif( $field_type eq "Passthru" ) {$machine_passthru = $field_data;}
else {print "Bad Data: $field_type : $field_data\n";}
# stuff the second line (hopefully IP) into vars
$raw_data = <CONFIG>;
chomp $raw_data;
( $field_type, $field_data ) = split /=/, $raw_data;
chomp $field_type;
chomp $field_data;
if( $field_type eq "Name" ) {$machine_name = $field_data;}
elsif( $field_type eq "IP" ) {$machine_ip = $field_data;}
elsif( $field_type eq "Uname" ) {$machine_uname = $field_data;}
elsif( $field_type eq "Geometry" ) { $machine_geom = $field_data;}
elsif( $field_type eq "Fullscreen" ) {$machine_fs = $field_data;}
elsif( $field_type eq "Bitmap_Updates" ) {$machine_bitmap_upd = $field_data;}
elsif( $field_type eq "Keymap" ) {$machine_kmap = $field_data;}
elsif( $field_type eq "NoReqLic" ) {$machine_lic = $field_data;}
elsif( $field_type eq "Passthru" ) {$machine_passthru = $field_data;}
else {print "Bad Data: $field_type : $field_data\n";}
# stuff the third line (hopefully Uname) into vars
$raw_data = <CONFIG>;
chomp $raw_data;
( $field_type, $field_data ) = split /=/, $raw_data;
chomp $field_type;
chomp $field_data;
if( $field_type eq "Name" ) {$machine_name = $field_data;}
elsif( $field_type eq "IP" ) {$machine_ip = $field_data;}
elsif( $field_type eq "Uname" ) {$machine_uname = $field_data;}
elsif( $field_type eq "Geometry" ) { $machine_geom = $field_data;}
elsif( $field_type eq "Fullscreen" ) {$machine_fs = $field_data;}
elsif( $field_type eq "Bitmap_Updates" ) {$machine_bitmap_upd = $field_data;}
elsif( $field_type eq "Keymap" ) {$machine_kmap = $field_data;}
elsif( $field_type eq "NoReqLic" ) {$machine_lic = $field_data;}
elsif( $field_type eq "Passthru" ) {$machine_passthru = $field_data;}
else {print "Bad Data: $field_type : $field_data\n";}
# stuff the fourth line (hopefully Geometry) into vars
$raw_data = <CONFIG>;
chomp $raw_data;
( $field_type, $field_data ) = split /=/, $raw_data;
chomp $field_type;
chomp $field_data;
if( $field_type eq "Name" ) {$machine_name = $field_data;}
elsif( $field_type eq "IP" ) {$machine_ip = $field_data;}
elsif( $field_type eq "Uname" ) {$machine_uname = $field_data;}
elsif( $field_type eq "Geometry" ) { $machine_geom = $field_data;}
elsif( $field_type eq "Fullscreen" ) {$machine_fs = $field_data;}
elsif( $field_type eq "Bitmap_Updates" ) {$machine_bitmap_upd = $field_data;}
elsif( $field_type eq "Keymap" ) {$machine_kmap = $field_data;}
elsif( $field_type eq "NoReqLic" ) {$machine_lic = $field_data;}
elsif( $field_type eq "Passthru" ) {$machine_passthru = $field_data;}
else {print "Bad Data: $field_type : $field_data\n";}
# stuff the fifth line (hopefully Fullscreen) into vars
$raw_data = <CONFIG>;
chomp $raw_data;
( $field_type, $field_data ) = split /=/, $raw_data;
chomp $field_type;
chomp $field_data;
if( $field_type eq "Name" ) {$machine_name = $field_data;}
elsif( $field_type eq "IP" ) {$machine_ip = $field_data;}
elsif( $field_type eq "Uname" ) {$machine_uname = $field_data;}
elsif( $field_type eq "Geometry" ) { $machine_geom = $field_data;}
elsif( $field_type eq "Fullscreen" ) {$machine_fs = $field_data;}
elsif( $field_type eq "Bitmap_Updates" ) {$machine_bitmap_upd = $field_data;}
elsif( $field_type eq "Keymap" ) {$machine_kmap = $field_data;}
elsif( $field_type eq "NoReqLic" ) {$machine_lic = $field_data;}
elsif( $field_type eq "Passthru" ) {$machine_passthru = $field_data;}
else {print "Bad Data: $field_type : $field_data\n";}
# stuff the sixth line (hopefully Bitmap_Updates) into vars
$raw_data = <CONFIG>;
chomp $raw_data;
( $field_type, $field_data ) = split /=/, $raw_data;
chomp $field_type;
chomp $field_data;
if( $field_type eq "Name" ) {$machine_name = $field_data;}
elsif( $field_type eq "IP" ) {$machine_ip = $field_data;}
elsif( $field_type eq "Uname" ) {$machine_uname = $field_data;}
elsif( $field_type eq "Geometry" ) { $machine_geom = $field_data;}
elsif( $field_type eq "Fullscreen" ) {$machine_fs = $field_data;}
elsif( $field_type eq "Bitmap_Updates" ) {$machine_bitmap_upd = $field_data;}
elsif( $field_type eq "Keymap" ) {$machine_kmap = $field_data;}
elsif( $field_type eq "NoReqLic" ) {$machine_lic = $field_data;}
elsif( $field_type eq "Passthru" ) {$machine_passthru = $field_data;}
else {print "Bad Data: $field_type : $field_data\n";}
# stuff the seventh line (hopefully Keymap) into vars
$raw_data = <CONFIG>;
chomp $raw_data;
( $field_type, $field_data ) = split /=/, $raw_data;
chomp $field_type;
chomp $field_data;
if( $field_type eq "Name" ) {$machine_name = $field_data;}
elsif( $field_type eq "IP" ) {$machine_ip = $field_data;}
elsif( $field_type eq "Uname" ) {$machine_uname = $field_data;}
elsif( $field_type eq "Geometry" ) { $machine_geom = $field_data;}
elsif( $field_type eq "Fullscreen" ) {$machine_fs = $field_data;}
elsif( $field_type eq "Bitmap_Updates" ) {$machine_bitmap_upd = $field_data;}
elsif( $field_type eq "Keymap" ) {$machine_kmap = $field_data;}
elsif( $field_type eq "NoReqLic" ) {$machine_lic = $field_data;}
elsif( $field_type eq "Passthru" ) {$machine_passthru = $field_data;}
else {print "Bad Data: $field_type : $field_data\n";}
# stuff the eighth line (hopefully NoReqLic) into vars
$raw_data = <CONFIG>;
chomp $raw_data;
( $field_type, $field_data ) = split /=/, $raw_data;
chomp $field_type;
chomp $field_data;
if( $field_type eq "Name" ) {$machine_name = $field_data;}
elsif( $field_type eq "IP" ) {$machine_ip = $field_data;}
elsif( $field_type eq "Uname" ) {$machine_uname = $field_data;}
elsif( $field_type eq "Geometry" ) { $machine_geom = $field_data;}
elsif( $field_type eq "Fullscreen" ) {$machine_fs = $field_data;}
elsif( $field_type eq "Bitmap_Updates" ) {$machine_bitmap_upd = $field_data;}
elsif( $field_type eq "Keymap" ) {$machine_kmap = $field_data;}
elsif( $field_type eq "NoReqLic" ) {$machine_lic = $field_data;}
elsif( $field_type eq "Passthru" ) {$machine_passthru = $field_data;}
else {print "Bad Data: $field_type : $field_data\n";}
# stuff the ninth line (hopefully Passthru) into vars
$raw_data = <CONFIG>;
chomp $raw_data;
( $field_type, $field_data ) = split /=/, $raw_data;
chomp $field_type;
chomp $field_data;
if( $field_type eq "Name" ) {$machine_name = $field_data;}
elsif( $field_type eq "IP" ) {$machine_ip = $field_data;}
elsif( $field_type eq "Uname" ) {$machine_uname = $field_data;}
elsif( $field_type eq "Geometry" ) { $machine_geom = $field_data;}
elsif( $field_type eq "Fullscreen" ) {$machine_fs = $field_data;}
elsif( $field_type eq "Bitmap_Updates" ) {$machine_bitmap_upd = $field_data;}
elsif( $field_type eq "Keymap" ) {$machine_kmap = $field_data;}
elsif( $field_type eq "NoReqLic" ) {$machine_lic = $field_data;}
elsif( $field_type eq "Passthru" ) {$machine_passthru = $field_data;}
else {print "Bad Data: $field_type : $field_data\n";}
# finally, stuff it all into the hashes
chomp $machine_name;
chomp $machine_ip;
chomp $machine_uname;
chomp $machine_geom;
chomp $machine_fs;
chomp $machine_bitmap_upd;
chomp $machine_kmap;
chomp $machine_passthru;
$ip_hash{$machine_name} = $machine_ip;
$uname_hash{$machine_name} = $machine_uname;
$geom_hash{$machine_name} = $machine_geom;
$fullscreen_hash{$machine_name} = $machine_fs;
$bitmap_upd_hash{$machine_name} = $machine_bitmap_upd;
$license_hash{$machine_name} = $machine_lic;
$kmap_hash{$machine_name} = $machine_kmap;
$passthru_hash{$machine_name} = $machine_passthru;
}
close CONFIG;
# and last, but not least, stuff it all into the clist
$list1->clear();
@machines = keys %ip_hash;
foreach $machina (sort @machines)
{
@temp = ($machina, $ip_hash{$machina}, $uname_hash{$machina}, $kmap_hash{$machina}, $geom_hash{$machina}, $fullscreen_hash{$machina}, $bitmap_upd_hash{$machina}, $license_hash{$machina}, $passthru_hash{$machina} );
$list1->append(@temp);
}
$list1->select_row( 0, 0 );
}
syntax highlighted by Code2HTML, v. 0.9.1