#!/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"; ; } 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' ); ; } } # 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} }; #~ ; 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; }