mirror of
https://github.com/duncs/clusterssh.git
synced 2025-04-22 01:12:24 +00:00
Revert "Add in some more backend functions"
This reverts commit 66e7fce6fa.
This commit is contained in:
Duncan Ferguson
parent
47a2a58f47
commit
90dbc37d83
6 changed files with 0 additions and 504 deletions
|
|
@ -1,71 +0,0 @@
|
|||
package App::ClusterSSH::Gui;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use version;
|
||||
our $VERSION = version->new(qw$Revision: 1$);
|
||||
|
||||
use Carp;
|
||||
|
||||
use base qw/ App::ClusterSSH::Base /;
|
||||
use App::ClusterSSH::Gui::XDisplay;
|
||||
|
||||
sub new {
|
||||
my ( $class, %args ) = @_;
|
||||
|
||||
my $self = $class->SUPER::new( %args );
|
||||
|
||||
$self->{window_mgr} = App::ClusterSSH::Gui::XDisplay->new();
|
||||
|
||||
if(! $self->{window_mgr} ) {
|
||||
croak 'Failed to get X connection', $/;
|
||||
}
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub xdisplay {
|
||||
my ($self) = @_;
|
||||
return $self->{ window_mgr };
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
=pod
|
||||
|
||||
=head1
|
||||
|
||||
ClusterSSH::Gui
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use ClusterSSH::Gui
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Object for interacting with the user for both console and terminals
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over 4
|
||||
|
||||
=item $host=ClusterSSH::Gui->new()
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Duncan Ferguson (<duncan_j_ferguson (at) yahoo.co.uk>)
|
||||
|
||||
=head1 LICENSE AND COPYRIGHT
|
||||
|
||||
Copyright (c) 2010 Duncan Ferguson (<duncan_j_ferguson (at) yahoo.co.uk>).
|
||||
All rights reserved
|
||||
|
||||
This module is free software; you can redistribute it and/or
|
||||
modify it under the same terms as Perl itself. See L<perlartistic>.
|
||||
|
||||
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.
|
||||
|
|
@ -1,121 +0,0 @@
|
|||
package App::ClusterSSH::Gui::Terminal;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use version;
|
||||
our $VERSION = version->new(qw$Revision: 1$);
|
||||
|
||||
use Carp;
|
||||
|
||||
use base qw/ App::ClusterSSH::Base /;
|
||||
use App::ClusterSSH::Gui::Terminal::Command;
|
||||
|
||||
our %terminal_id_for;
|
||||
|
||||
sub new {
|
||||
my ( $class, %args ) = @_;
|
||||
|
||||
# if ( !$args{command} ) {
|
||||
# croak('"command" not provided');
|
||||
# }
|
||||
|
||||
if ( !$args{host} || ref $args{host} ne 'App::ClusterSSH::Host' ) {
|
||||
croak('"command" not provided or invalid');
|
||||
}
|
||||
|
||||
my $self = $class->SUPER::new(%args);
|
||||
|
||||
$self->{pipenm} = tmpnam();
|
||||
$self->debug( 4, 'Set temp name to ', $self->{pipenm} );
|
||||
mkfifo( $self->{pipenm}, 0600 ) or croak( 'Cannot create pipe: ', $! );
|
||||
|
||||
$self->{pid} = fork();
|
||||
if ( !defined( $self->{pid} ) ) {
|
||||
croak( 'Could not fork: ', $! );
|
||||
}
|
||||
|
||||
# NOTE: the pid is re-fetched from the xterm window (via helper_script)
|
||||
# later as it changes and we need an accurate PID as it is widely used
|
||||
|
||||
if ( $self->{pid} == 0 ) {
|
||||
|
||||
# this is the child
|
||||
# Since this is the child, we can mark any server unresolved without
|
||||
# affecting the main program
|
||||
$self->{command} = App::ClusterSSH::Terminal::Command->new();
|
||||
$self->debug( 4, 'Running: ', $self->{command} );
|
||||
exec($self->{command}, '-p','sdfsdf','options') == 0 or die( 'Exec failed: ', $! );
|
||||
}
|
||||
|
||||
if ( !$terminal_id_for{ $args{host}->{hostname} } ) {
|
||||
$terminal_id_for{ $args{host}->{hostname} } = $self;
|
||||
$self->{id} = $terminal_id_for{ $args{host}->{hostname} };
|
||||
}
|
||||
else {
|
||||
my $count = 0;
|
||||
until ( !$terminal_id_for{ $args{host}->{hostname} . ' ' . $count } )
|
||||
{
|
||||
$count++;
|
||||
}
|
||||
$terminal_id_for{ $args{host}->{hostname} . ' ' . $count } = $self;
|
||||
$self->{id}
|
||||
= $terminal_id_for{ $args{host}->{hostname} . ' ' . $count };
|
||||
}
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub get_id {
|
||||
my ($self) = @_;
|
||||
return $self->{id};
|
||||
}
|
||||
|
||||
sub get_pid {
|
||||
my ($self) = @_;
|
||||
return $self->{pid};
|
||||
}
|
||||
|
||||
sub command {
|
||||
my ($self) = @_;
|
||||
return $self->{command};
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
=pod
|
||||
|
||||
=head1
|
||||
|
||||
ClusterSSH::Gui::Terminal
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use ClusterSSH::Gui::Terminal;
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Object for creating and maintaining terminal session to server
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over 4
|
||||
|
||||
=item $host=ClusterSSH::Gui->new()
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Duncan Ferguson (<duncan_j_ferguson (at) yahoo.co.uk>)
|
||||
|
||||
=head1 LICENSE AND COPYRIGHT
|
||||
|
||||
Copyright (c) 2010 Duncan Ferguson (<duncan_j_ferguson (at) yahoo.co.uk>).
|
||||
All rights reserved
|
||||
|
||||
This module is free software; you can redistribute it and/or
|
||||
modify it under the same terms as Perl itself. See L<perlartistic>.
|
||||
|
||||
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.
|
||||
|
|
@ -1,122 +0,0 @@
|
|||
package App::ClusterSSH::Gui::Terminal::Command;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use version;
|
||||
our $VERSION = version->new(qw$Revision: 1$);
|
||||
|
||||
use Carp;
|
||||
|
||||
use base qw/ App::ClusterSSH::Base /;
|
||||
|
||||
sub new {
|
||||
my ( $class, %args ) = @_;
|
||||
|
||||
my $self = $class->SUPER::new(%args);
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
use overload (
|
||||
q{""} => sub {
|
||||
my ($self) = @_;
|
||||
return $self->{script};
|
||||
},
|
||||
fallback => 1,
|
||||
);
|
||||
|
||||
sub script() {
|
||||
my ($self) = @_;
|
||||
|
||||
# -p => pipe name
|
||||
# -s => server name
|
||||
# -u => username
|
||||
# -p => port
|
||||
# -c => command to run
|
||||
# -b => session binary (ssh, telnet, rsh, etc)
|
||||
# -a => session arguments
|
||||
my $script = <<'!EOF!';
|
||||
use strict;
|
||||
use Getopt::Std;
|
||||
my %o;
|
||||
getopts( "p:s:u:p:c:d:b:a:", \%o );
|
||||
|
||||
if($o{p}) {
|
||||
open( my $pipe, ">", $o{p} ) or die( "Failed to open pipe: ", $!, $/ );
|
||||
print {$pipe} $$, ":", $ENV{WINDOWID}
|
||||
or die( "Failed to write to pipe: ", $!, $/ );
|
||||
close($pipe) or die( "Failed to close pipe: ", $!, $/ );
|
||||
}
|
||||
|
||||
my $command = join( " ", $o{b}, $o{a}, );
|
||||
|
||||
if ( $o{u} ) {
|
||||
if ( $o{b} !~ /telnet$/ ) {
|
||||
$command .= join( " ", "-l", $o{u} );
|
||||
}
|
||||
}
|
||||
|
||||
if ( $o{b} =~ /telnet$/ ) {
|
||||
$command .= join( " ", $o{s}, $o{p} );
|
||||
}
|
||||
else {
|
||||
if ( $o{p} ) {
|
||||
$command .= join( " ", "-p", $o{p} );
|
||||
}
|
||||
$command .= $o{s};
|
||||
}
|
||||
|
||||
$command .= $o{c};
|
||||
|
||||
if ( $o{d} ) {
|
||||
warn( "Running: ", $command, $/ );
|
||||
}
|
||||
exec($command);
|
||||
!EOF!
|
||||
eval $script;
|
||||
if ($@) {
|
||||
croak( 'Error in compiling helper script: ', $@ );
|
||||
}
|
||||
return $script;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
=pod
|
||||
|
||||
=head1
|
||||
|
||||
ClusterSSH::Gui::Terminal
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use ClusterSSH::Gui::Terminal;
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Object for creating and maintaining terminal session to server
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over 4
|
||||
|
||||
=item $host=ClusterSSH::Gui->new()
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Duncan Ferguson (<duncan_j_ferguson (at) yahoo.co.uk>)
|
||||
|
||||
=head1 LICENSE AND COPYRIGHT
|
||||
|
||||
Copyright (c) 2010 Duncan Ferguson (<duncan_j_ferguson (at) yahoo.co.uk>).
|
||||
All rights reserved
|
||||
|
||||
This module is free software; you can redistribute it and/or
|
||||
modify it under the same terms as Perl itself. See L<perlartistic>.
|
||||
|
||||
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.
|
||||
|
|
@ -1,102 +0,0 @@
|
|||
package App::ClusterSSH::Gui::XDisplay;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use version;
|
||||
our $VERSION = version->new(qw$Revision: 1$);
|
||||
|
||||
use Carp;
|
||||
use X11::Protocol;
|
||||
|
||||
use base qw/ X11::Protocol App::ClusterSSH::Base /;
|
||||
|
||||
sub new {
|
||||
my ( $class, %args ) = @_;
|
||||
|
||||
my $self = $class->SUPER::new(%args);
|
||||
|
||||
$self->{x11} = X11::Protocol->new();
|
||||
|
||||
if ( !$self->{x11} ) {
|
||||
croak 'Failed to get X connection', $/;
|
||||
}
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub xdisplay {
|
||||
my ($self) = @_;
|
||||
return $self->{x11};
|
||||
}
|
||||
|
||||
sub get_font_size() {
|
||||
my ($self, $terminal_font) = @_;
|
||||
$self->debug( 2, "Fetching font size" );
|
||||
|
||||
# get atom name<->number relations
|
||||
my $quad_width = $self->xdisplay->atom("QUAD_WIDTH");
|
||||
my $pixel_size = $self->xdisplay->atom("PIXEL_SIZE");
|
||||
|
||||
my $font = $self->xdisplay->new_rsrc;
|
||||
$self->xdisplay->OpenFont( $font, $terminal_font );
|
||||
|
||||
my %font_info;
|
||||
|
||||
eval { (%font_info) = $self->xdisplay->QueryFont($font); }
|
||||
|| die( "Fatal: Unrecognised font used ($terminal_font).\n"
|
||||
. "Please amend \$HOME/.csshrc with a valid font (see man page).\n"
|
||||
);
|
||||
|
||||
my $internal_font_width = $font_info{properties}{$quad_width};
|
||||
my $internal_font_height = $font_info{properties}{$pixel_size};
|
||||
|
||||
if ( !$internal_font_width || !$internal_font_height ) {
|
||||
die( "Fatal: Unrecognised font used ($terminal_font).\n"
|
||||
. "Please amend \$HOME/.csshrc with a valid font (see man page).\n"
|
||||
);
|
||||
}
|
||||
|
||||
$self->debug( 2, "Done with font size" );
|
||||
return ( internal_font_width => $internal_font_width , internal_font_height=>$internal_font_height);
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
=pod
|
||||
|
||||
=head1
|
||||
|
||||
ClusterSSH::Gui
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use ClusterSSH::Gui
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Object for interacting with the user for both console and terminals
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over 4
|
||||
|
||||
=item $host=ClusterSSH::Gui->new()
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Duncan Ferguson (<duncan_j_ferguson (at) yahoo.co.uk>)
|
||||
|
||||
=head1 LICENSE AND COPYRIGHT
|
||||
|
||||
Copyright (c) 2010 Duncan Ferguson (<duncan_j_ferguson (at) yahoo.co.uk>).
|
||||
All rights reserved
|
||||
|
||||
This module is free software; you can redistribute it and/or
|
||||
modify it under the same terms as Perl itself. See L<perlartistic>.
|
||||
|
||||
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.
|
||||
20
t/20gui.t
20
t/20gui.t
|
|
@ -1,20 +0,0 @@
|
|||
use strict;
|
||||
use warnings;
|
||||
|
||||
use FindBin qw($Bin);
|
||||
use lib "$Bin/../lib";
|
||||
|
||||
use Test::More;
|
||||
use Test::Trap;
|
||||
|
||||
BEGIN { use_ok( 'App::ClusterSSH::Gui' ) }
|
||||
|
||||
# force default language for tests
|
||||
App::ClusterSSH::Gui->set_lang('en');
|
||||
|
||||
my $gui;
|
||||
|
||||
$gui = App::ClusterSSH::Gui->new();
|
||||
isa_ok( $gui, 'App::ClusterSSH::Gui' );
|
||||
|
||||
done_testing();
|
||||
|
|
@ -1,68 +0,0 @@
|
|||
use strict;
|
||||
use warnings;
|
||||
|
||||
use FindBin qw($Bin);
|
||||
use lib "$Bin/../lib";
|
||||
|
||||
use Test::More;
|
||||
use Test::Trap;
|
||||
use Sys::Hostname;
|
||||
|
||||
BEGIN { use_ok('App::ClusterSSH::Gui::Terminal::Command') }
|
||||
|
||||
# force default language for tests
|
||||
App::ClusterSSH::Gui::Terminal::Command->set_lang('en');
|
||||
|
||||
my $obj;
|
||||
|
||||
trap {
|
||||
$obj = App::ClusterSSH::Gui::Terminal::Command->new();
|
||||
};
|
||||
is( $trap->leaveby, 'die', 'returned ok' );
|
||||
like( $trap->die, qr/command is undefined at /, 'Got appropriate croak message' );
|
||||
is( $trap->stderr, '', 'Expecting no STDERR' );
|
||||
is( $trap->stdout, '', 'Expecting no STDOUT' );
|
||||
|
||||
trap {
|
||||
$obj = App::ClusterSSH::Gui::Terminal::Command->new( command => 'true' );
|
||||
};
|
||||
is( $trap->leaveby, 'return', 'returned ok' );
|
||||
is( $trap->die, undef, 'returned ok' );
|
||||
is( $trap->stdout, '', 'Expecting no STDOUT' );
|
||||
is( $trap->stdout, '', 'Expected no STDERR' );
|
||||
isa_ok( $obj, 'App::ClusterSSH::Gui::Terminal::Command' );
|
||||
|
||||
my $script;
|
||||
trap {
|
||||
$script = $obj->script();
|
||||
};
|
||||
is( $trap->leaveby, 'return', 'returned ok' );
|
||||
is( $trap->die, undef, 'returned ok' );
|
||||
is( $trap->stdout, '', 'Expecting no STDOUT' );
|
||||
is( $trap->stdout, '', 'Expected no STDERR' );
|
||||
isa_ok( $obj, 'App::ClusterSSH::Gui::Terminal::Command' );
|
||||
|
||||
my $output;
|
||||
trap {
|
||||
$output = qx/$^X -e '$script' -- -c hostname/;
|
||||
};
|
||||
is( $trap->leaveby, 'return', 'returned ok' );
|
||||
is( $trap->die, undef, 'returned ok' );
|
||||
is( $trap->stdout, '', 'Expecting no STDOUT' );
|
||||
is( $trap->stdout, '', 'Expected no STDERR' );
|
||||
isa_ok( $obj, 'App::ClusterSSH::Gui::Terminal::Command' );
|
||||
chomp($output);
|
||||
is( $output, hostname(), 'Hostname output as expected');
|
||||
|
||||
trap {
|
||||
$output = qx/$^X -e '$script' -- -d 3 -c hostname 2>&1/;
|
||||
};
|
||||
is( $trap->leaveby, 'return', 'returned ok' );
|
||||
is( $trap->die, undef, 'returned ok' );
|
||||
is( $trap->stdout, '', 'Expecting no STDOUT' );
|
||||
is( $trap->stderr, '', 'Expected no STDERR' );
|
||||
isa_ok( $obj, 'App::ClusterSSH::Gui::Terminal::Command' );
|
||||
chomp($output);
|
||||
is( $output, 'Running: hostname'.$/.hostname(), 'Hostname output as expected');
|
||||
|
||||
done_testing();
|
||||
Loading…
Add table
Reference in a new issue