dotfiles/home/bin/sshc

423 lines
11 KiB
Plaintext
Raw Normal View History

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