423 lines
11 KiB
Plaintext
423 lines
11 KiB
Plaintext
|
#!/usr/bin/env perl
|
||
|
|
|
||
|
|
use strict;
|
||
|
|
use warnings;
|
||
|
|
use diagnostics -verbose;
|
||
|
|
use Term::Title 'set_titlebar', 'set_tab_title';
|
||
|
|
|
||
|
|
# perltidy --backup-and-modify-in-place -l=120 -cti=2 --opening-brace-on-new-line --opening-sub-brace-on-new-line -lp -vt=0 -vtc=0 -cab=0 sshc.pl
|
||
|
|
|
||
|
|
BEGIN
|
||
|
|
{
|
||
|
|
$diagnostics::DEBUG = 0;
|
||
|
|
$diagnostics::PRETTY = 1;
|
||
|
|
|
||
|
|
if (0)
|
||
|
|
{
|
||
|
|
use Perl::Critic;
|
||
|
|
my $file = $0;
|
||
|
|
my $critic = Perl::Critic->new( -severity => '3',
|
||
|
|
-verbose => 11 );
|
||
|
|
my @violations = $critic->critique($file);
|
||
|
|
|
||
|
|
my ( $i, $n ) = ( 0, scalar @violations );
|
||
|
|
for ( reverse Perl::Critic::Violation::sort_by_severity(@violations) )
|
||
|
|
{
|
||
|
|
print '-' x 20, "\n";
|
||
|
|
printf( "%3d/%d ", ++$i, $n );
|
||
|
|
print "[" . $_->severity() . "] " . $_;
|
||
|
|
print " -- source --- \n";
|
||
|
|
print " source: ", $_->source(), "\n";
|
||
|
|
print " -- /source --- \n";
|
||
|
|
print " expl: ", $_->explanation(), "\n";
|
||
|
|
print " desc: ", $_->description(), "\n";
|
||
|
|
print " dia : ", $_->diagnostics(), "\n";
|
||
|
|
print "\n --- press Enter to continue ---\n";
|
||
|
|
<STDIN>;
|
||
|
|
}
|
||
|
|
exit;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
use XML::Dumper;
|
||
|
|
use Data::Dumper;
|
||
|
|
use autodie qw< :io >;
|
||
|
|
use English qw(-no_match_vars);
|
||
|
|
$OUTPUT_AUTOFLUSH = 1;
|
||
|
|
|
||
|
|
use Curses;
|
||
|
|
use Curses::UI;
|
||
|
|
use Term::ANSIColor;
|
||
|
|
|
||
|
|
my $cui = Curses::UI->new( -color_support => 1,
|
||
|
|
-clear_on_exit => 0 );
|
||
|
|
|
||
|
|
|
||
|
|
my $ssh_config = &read_ssh_config;
|
||
|
|
|
||
|
|
#-color_support,-clear_on_exit,-mouse_support
|
||
|
|
#);
|
||
|
|
|
||
|
|
my $w = $cui->width();
|
||
|
|
my $h = $cui->height();
|
||
|
|
|
||
|
|
sub exit_dialog
|
||
|
|
{
|
||
|
|
my $return = $cui->dialog(
|
||
|
|
-message => 'Do you really want to quit?',
|
||
|
|
-title => 'Are you sure???',
|
||
|
|
-buttons => [ 'yes', 'no' ],
|
||
|
|
-border => 1,
|
||
|
|
|
||
|
|
);
|
||
|
|
|
||
|
|
exit 0 if $return;
|
||
|
|
|
||
|
|
return;
|
||
|
|
}
|
||
|
|
|
||
|
|
my %options = (
|
||
|
|
-title => 'profile',
|
||
|
|
-width => $w / 3,
|
||
|
|
-height => $h,
|
||
|
|
-border => 1,
|
||
|
|
-padtop => 3,
|
||
|
|
);
|
||
|
|
|
||
|
|
my %options_info = (
|
||
|
|
-title => 'infos',
|
||
|
|
-width => $w,
|
||
|
|
-height => 3,
|
||
|
|
-border => 1,
|
||
|
|
);
|
||
|
|
|
||
|
|
my %options2 = (
|
||
|
|
-title => 'details',
|
||
|
|
-width => $w,
|
||
|
|
-height => $options{-height},
|
||
|
|
-border => 1,
|
||
|
|
-padleft => $w - $options{-width} * 2,
|
||
|
|
-padtop => $options{-padtop},
|
||
|
|
);
|
||
|
|
|
||
|
|
my $win = $cui->add( 'window_id', 'Window', %options );
|
||
|
|
my $win_info = $cui->add( 'window_info', 'Window', %options_info );
|
||
|
|
|
||
|
|
$cui->set_binding( sub { \&exit_dialog(); }, 'q' );
|
||
|
|
|
||
|
|
my $label = $win_info->add(
|
||
|
|
'mylabel', 'Label',
|
||
|
|
-text => 'quit: q connect: ENTER',
|
||
|
|
-bold => 0,
|
||
|
|
)->draw();
|
||
|
|
|
||
|
|
#~ my $label2 = $win_info->add(
|
||
|
|
#~ 'mylabel1', 'Label',
|
||
|
|
#~ -text => 'Hello, world!\nds',
|
||
|
|
#~ -bold => 0,
|
||
|
|
#~ -x => 30
|
||
|
|
#~ )->draw();
|
||
|
|
|
||
|
|
my @values = sort { lc $a cmp lc $b } ( keys %{$ssh_config} );
|
||
|
|
|
||
|
|
my $listbox = $win->add(
|
||
|
|
'mylistbox', 'Listbox',
|
||
|
|
-values => \@values,
|
||
|
|
|
||
|
|
#~ -labels => {'12designer-dev'=>'12'},
|
||
|
|
-onselchange => sub { \&display_ssh_config($ssh_config); }
|
||
|
|
);
|
||
|
|
$listbox->set_binding( sub { &ssh_connect( $ssh_config, $listbox ) }, KEY_ENTER );
|
||
|
|
$listbox->{-onselchange}->();
|
||
|
|
$listbox->focus();
|
||
|
|
|
||
|
|
sub ssh_connect
|
||
|
|
{
|
||
|
|
my ( $config, $listbox ) = @_;
|
||
|
|
|
||
|
|
my $key = $listbox->get_active_value();
|
||
|
|
|
||
|
|
set_tab_title($key);
|
||
|
|
$cui->leave_curses();
|
||
|
|
|
||
|
|
my $cmdline = "ssh $key";
|
||
|
|
print colored ( "executing ssh : $cmdline", 'bold on_white' ), "\n";
|
||
|
|
|
||
|
|
my $e = system($cmdline);
|
||
|
|
|
||
|
|
$e /= 256;
|
||
|
|
|
||
|
|
if ( $e == 255 )
|
||
|
|
{
|
||
|
|
|
||
|
|
#~ print colored ("exit code = $e",'bold red'),"\n";
|
||
|
|
print colored ( "--- error occurred - see message above --- ", 'bold red on_black' ), "\n";
|
||
|
|
print colored ( "- press ENTER to continue ---", 'green on_white' );
|
||
|
|
<STDIN>;
|
||
|
|
}
|
||
|
|
|
||
|
|
}
|
||
|
|
|
||
|
|
# debugging function
|
||
|
|
sub dump
|
||
|
|
{
|
||
|
|
use XML::Dumper;
|
||
|
|
my $dump = new XML::Dumper;
|
||
|
|
|
||
|
|
# ===== Dump to a file
|
||
|
|
my $file = "dump.xml";
|
||
|
|
$dump->pl2xml( $_[0], $file );
|
||
|
|
}
|
||
|
|
|
||
|
|
$cui->mainloop();
|
||
|
|
|
||
|
|
sub CURSE_setProperty
|
||
|
|
{
|
||
|
|
my ( $obj, $property, $value ) = @_;
|
||
|
|
|
||
|
|
if ($obj)
|
||
|
|
{
|
||
|
|
|
||
|
|
#~ if ( exists($ob->{$property}) )
|
||
|
|
{
|
||
|
|
$obj->{$property} = $value;
|
||
|
|
|
||
|
|
$obj->draw();
|
||
|
|
}
|
||
|
|
|
||
|
|
#~ else
|
||
|
|
#~ {
|
||
|
|
#~ $cui->error(" \$obj has not such property : $property ");
|
||
|
|
#~ }
|
||
|
|
}
|
||
|
|
else
|
||
|
|
{
|
||
|
|
$cui->error('no such obj');
|
||
|
|
}
|
||
|
|
|
||
|
|
return;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub display_ssh_config
|
||
|
|
{
|
||
|
|
my $config = shift;
|
||
|
|
my $key = $win->getobj('mylistbox')->get_active_value();
|
||
|
|
|
||
|
|
if ( $cui->getobj('w2') )
|
||
|
|
{
|
||
|
|
$cui->delete('w2');
|
||
|
|
}
|
||
|
|
|
||
|
|
my $win2 = $cui->add( 'w2', 'Window', %options2 )->draw();
|
||
|
|
my $offSet = {
|
||
|
|
x => 0,
|
||
|
|
y => 0
|
||
|
|
};
|
||
|
|
|
||
|
|
# $key - of the hash with the dataset
|
||
|
|
# $offset - remember the postions of the labels
|
||
|
|
# $value_key - the config-key
|
||
|
|
# $default_value- if the config-key not exists display this instead [optional]
|
||
|
|
my $subFillLabels = sub {
|
||
|
|
my ( $key_, $_offSet, $list_already_onscreen, $value_key, $default_value ) = @_;
|
||
|
|
|
||
|
|
$value_key = lc $value_key;
|
||
|
|
$list_already_onscreen->{$value_key} = 1;
|
||
|
|
|
||
|
|
my ( $label_key, $label_val ) = ( 'label_k_' . $value_key, 'label_v_' . $value_key );
|
||
|
|
my $x_offset = 20;
|
||
|
|
|
||
|
|
my $entry = $config->{$key_};
|
||
|
|
|
||
|
|
if ( exists $entry->{$value_key} || $default_value )
|
||
|
|
{
|
||
|
|
my $init_obj = sub {
|
||
|
|
my ( $_key, $options ) = @_;
|
||
|
|
|
||
|
|
if ( !$win2->getobj($_key) )
|
||
|
|
{
|
||
|
|
$win2->add( @{$options} )->draw();
|
||
|
|
}
|
||
|
|
};
|
||
|
|
|
||
|
|
$init_obj->(
|
||
|
|
$label_key,
|
||
|
|
[
|
||
|
|
$label_key, 'Label',
|
||
|
|
-text => $value_key,
|
||
|
|
-bold => 1,
|
||
|
|
-x => $_offSet->{x},
|
||
|
|
-y => $_offSet->{y}
|
||
|
|
]
|
||
|
|
);
|
||
|
|
|
||
|
|
my $value = exists $entry->{$value_key} ? $entry->{$value_key} : $default_value;
|
||
|
|
my @value_labels = ( ref $value eq 'ARRAY' ) ? @{$value} : ($value);
|
||
|
|
|
||
|
|
for my $i ( 0 .. scalar @value_labels - 1 )
|
||
|
|
{
|
||
|
|
my $_label = $label_val . '_' . $i;
|
||
|
|
$init_obj->(
|
||
|
|
$label,
|
||
|
|
[
|
||
|
|
$_label, 'Label',
|
||
|
|
-bold => 0,
|
||
|
|
-x => $x_offset,
|
||
|
|
-y => $_offSet->{y},
|
||
|
|
-text => $value_labels[$i]
|
||
|
|
]
|
||
|
|
);
|
||
|
|
|
||
|
|
$_offSet->{y} += $win2->getobj($_label)->{-height};
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
};
|
||
|
|
|
||
|
|
my $list_already_onscreen = { 'host' => 1 };
|
||
|
|
|
||
|
|
$subFillLabels->( ( $key, $offSet, $list_already_onscreen ), ( 'Hostname', $key ) );
|
||
|
|
$subFillLabels->( ( $key, $offSet, $list_already_onscreen ), ('User') );
|
||
|
|
$subFillLabels->( ( $key, $offSet, $list_already_onscreen ), ('Port') );
|
||
|
|
$subFillLabels->( ( $key, $offSet, $list_already_onscreen ), ('IdentityFile') );
|
||
|
|
$subFillLabels->( ( $key, $offSet, $list_already_onscreen ), ('Compression') );
|
||
|
|
$subFillLabels->( ( $key, $offSet, $list_already_onscreen ), ('LocalForward') );
|
||
|
|
$subFillLabels->( ( $key, $offSet, $list_already_onscreen ), ('RemoteForward') );
|
||
|
|
|
||
|
|
#~ $cui->leave_curses();
|
||
|
|
|
||
|
|
grep {
|
||
|
|
if ( !( exists $list_already_onscreen->{$_} ) )
|
||
|
|
{
|
||
|
|
$subFillLabels->( ( $key, $offSet, $list_already_onscreen ), ($_) );
|
||
|
|
}
|
||
|
|
|
||
|
|
} sort keys %{ $config->{$key} };
|
||
|
|
|
||
|
|
#~ <STDIN>;
|
||
|
|
|
||
|
|
return;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub read_ssh_config
|
||
|
|
{
|
||
|
|
my $user = $ENV{'USER'};
|
||
|
|
|
||
|
|
my %config = ();
|
||
|
|
|
||
|
|
# temporary
|
||
|
|
my $host;
|
||
|
|
|
||
|
|
my $process_ssh_config = sub {
|
||
|
|
my ( $fh, $config ) = @_;
|
||
|
|
while (<$fh>)
|
||
|
|
{
|
||
|
|
( local $_ = $_ ) =~ s/\n//smx;
|
||
|
|
|
||
|
|
if (
|
||
|
|
m{
|
||
|
|
^(Host) # a comment
|
||
|
|
[\ \t] # or
|
||
|
|
([^#]+) # empty line
|
||
|
|
}smxi
|
||
|
|
)
|
||
|
|
{
|
||
|
|
$host = $2;
|
||
|
|
$config->{$host} = { lc "$1" => $host };
|
||
|
|
|
||
|
|
#print $host,"\n";
|
||
|
|
}
|
||
|
|
else
|
||
|
|
{
|
||
|
|
if (
|
||
|
|
m{
|
||
|
|
^\# # a comment
|
||
|
|
| # or
|
||
|
|
^$ # empty line
|
||
|
|
}smx
|
||
|
|
)
|
||
|
|
{
|
||
|
|
|
||
|
|
# ignore
|
||
|
|
}
|
||
|
|
else
|
||
|
|
{
|
||
|
|
if (
|
||
|
|
m{
|
||
|
|
([^\ \t]+) # match everything except
|
||
|
|
[\ \t] # with space and tab in between
|
||
|
|
([^\#]+) # match everthing except beginning comment
|
||
|
|
}smx
|
||
|
|
)
|
||
|
|
{
|
||
|
|
|
||
|
|
# coz the keys are case-insensitive - lower them all
|
||
|
|
my ( $key, $value ) = ( lc $1, $2 );
|
||
|
|
|
||
|
|
if ( exists $config->{$host}->{$key} )
|
||
|
|
{
|
||
|
|
if ( ref $config->{$host}->{$key} eq 'ARRAY' )
|
||
|
|
{
|
||
|
|
push @{ $config->{$host}->{$key} }, $value;
|
||
|
|
}
|
||
|
|
else
|
||
|
|
{
|
||
|
|
my $old_val = $config->{$host}->{$key};
|
||
|
|
$config->{$host}->{$key} = [ $old_val, $value ];
|
||
|
|
}
|
||
|
|
}
|
||
|
|
else
|
||
|
|
{
|
||
|
|
$config->{$host}->{$key} = $value;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
else
|
||
|
|
{
|
||
|
|
warn "regex not matched \n";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
#print $_ if (/^$/);
|
||
|
|
}
|
||
|
|
};
|
||
|
|
|
||
|
|
my $ssh_config_file = '/Users/' . $user . '/.ssh/config';
|
||
|
|
if ( -e $ssh_config_file )
|
||
|
|
{
|
||
|
|
my $error_on_open = open my $fh, q{<}, $ssh_config_file;
|
||
|
|
if ( !$error_on_open )
|
||
|
|
{
|
||
|
|
die $EXTENDED_OS_ERROR;
|
||
|
|
}
|
||
|
|
else
|
||
|
|
{
|
||
|
|
$process_ssh_config->( $fh, \%config );
|
||
|
|
my $error_on_close = close $fh;
|
||
|
|
if ( !$error_on_close )
|
||
|
|
{
|
||
|
|
die $EXTENDED_OS_ERROR;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
else
|
||
|
|
{
|
||
|
|
$cui->error(
|
||
|
|
-message => 'please create a ssh config file : '.$ssh_config_file,
|
||
|
|
-title => 'config missing',
|
||
|
|
-buttons => [ 'ok' ],
|
||
|
|
-border => 1,
|
||
|
|
);
|
||
|
|
exit 1;
|
||
|
|
}
|
||
|
|
|
||
|
|
#~ &dump( \%config );
|
||
|
|
#~ exit;
|
||
|
|
|
||
|
|
#~ &ssh_get_connection_info( \%config, 'zeus.fh-brandenburg.de' );
|
||
|
|
#~ exit;
|
||
|
|
|
||
|
|
return \%config;
|
||
|
|
}
|
||
|
|
|