package App::ClusterSSH::Config; use strict; use warnings; use version; our $VERSION = version->new('0.02'); use Carp; use Try::Tiny; use FindBin qw($Script); use File::Copy; use base qw/ App::ClusterSSH::Base /; use App::ClusterSSH::Cluster; my $clusters; my %old_clusters; my @app_specific = (qw/ command title comms method parent /); # list of config items to not write out when writing the default config my @ignore_default_config = (qw/ user /); my %default_config = ( terminal => "xterm", terminal_args => "", terminal_title_opt => "-T", terminal_colorize => 1, terminal_bg_style => 'dark', terminal_allow_send_events => "-xrm '*.VT100.allowSendEvents:true'", terminal_font => "6x13", terminal_size => "80x24", use_hotkeys => "yes", key_quit => "Alt-q", key_addhost => "Control-Shift-plus", key_clientname => "Alt-n", key_history => "Alt-h", key_localname => "Alt-l", key_retilehosts => "Alt-r", key_macros_enable => "Alt-p", key_paste => "Control-v", key_username => "Alt-u", mouse_paste => "Button-2", auto_quit => "yes", auto_close => 5, use_natural_sort => 0, window_tiling => "yes", window_tiling_direction => "right", console_position => "", screen_reserve_top => 0, screen_reserve_bottom => 60, screen_reserve_left => 0, screen_reserve_right => 0, terminal_reserve_top => 5, terminal_reserve_bottom => 0, terminal_reserve_left => 5, terminal_reserve_right => 0, terminal_decoration_height => 10, terminal_decoration_width => 8, console => 'console', console_args => '', rsh => 'rsh', rsh_args => "", telnet => 'telnet', telnet_args => "", ssh => 'ssh', ssh_args => "", sftp => 'sftp', sftp_args => "", extra_tag_file => '', extra_cluster_file => '', external_cluster_command => '', unmap_on_redraw => "no", # Debian #329440 show_history => 0, history_width => 40, history_height => 10, command => q{}, hide_menu => 0, max_host_menu_items => 30, macros_enabled => 'yes', macro_servername => '%s', macro_hostname => '%h', macro_username => '%u', macro_newline => '%n', macro_version => '%v', max_addhost_menu_cluster_items => 6, menu_send_autotearoff => 0, menu_host_autotearoff => 0, unique_servers => 0, use_all_a_records => 0, send_menu_xml_file => $ENV{HOME} . '/.clusterssh/send_menu', auto_wm_decoration_offsets => "no", # Debian #842965 # don't set username here as takes precendence over ssh config user => '', ); sub new { my ( $class, %args ) = @_; my $self = $class->SUPER::new(%default_config); ( my $comms = $Script ) =~ s/^c//; $comms = 'telnet' if ( $comms eq 'tel' ); $comms = 'console' if ( $comms eq 'con' ); $comms = 'ssh' if ( $comms eq 'lusterssh' ); $comms = 'sftp' if ( $comms eq 'sftp' ); # list of allowed comms methods if ( 'ssh rsh telnet sftp console' !~ m/\b$comms\b/ ) { $self->{comms} = 'ssh'; } else { $self->{comms} = $comms; } $self->{title} = uc($Script); $clusters = App::ClusterSSH::Cluster->new(); return $self->validate_args(%args); } sub validate_args { my ( $self, %args ) = @_; my @unknown_config = (); foreach my $config ( sort( keys(%args) ) ) { if ( grep /$config/, @app_specific ) { # $self->{$config} ||= 'unknown'; next; } if ( exists $self->{$config} ) { $self->{$config} = $args{$config}; } else { push( @unknown_config, $config ); } } if (@unknown_config) { croak( App::ClusterSSH::Exception::Config->throw( unknown_config => \@unknown_config, error => $self->loc( 'Unknown configuration parameters: [_1]' . $/, join( ',', @unknown_config ) ) ) ); } if ( !$self->{comms} ) { croak( App::ClusterSSH::Exception::Config->throw( error => $self->loc( 'Invalid variable: comms' . $/ ), ), ); } if ( !$self->{ $self->{comms} } ) { croak( App::ClusterSSH::Exception::Config->throw( error => $self->loc( 'Invalid variable: [_1]' . $/, $self->{comms} ), ), ); } # check the terminal has been found correctly # looking for the terminal should not be fatal if ( !-e $self->{terminal} ) { eval { $self->{terminal} = $self->find_binary( $self->{terminal} ); }; if ($@) { warn $@->message; } } return $self; } sub parse_config_file { my ( $self, $config_file ) = @_; $self->debug( 2, 'Loading in config file: ', $config_file ); # if ( !-e $config_file || !-r $config_file ) { # croak( # App::ClusterSSH::Exception::Config->throw( # error => $self->loc( # 'File [_1] does not exist or cannot be read' . $/, # $config_file # ), # ), # ); # } # # open( CFG, $config_file ) or die("Couldnt open $config_file: $!"); # my $l; # my %read_config; # while ( defined( $l = ) ) { # next # if ( $l =~ /^\s*$/ || $l =~ /^#/ ) # ; # ignore blank lines & commented lines # $l =~ s/#.*//; # remove comments from remaining lines # $l =~ s/\s*$//; # remove trailing whitespace # # # look for continuation lines # chomp $l; # if ( $l =~ s/\\\s*$// ) { # $l .= ; # redo unless eof(CFG); # } # # next unless $l =~ m/\s*(\S+)\s*=\s*(.*)\s*/; # my ( $key, $value ) = ( $1, $2 ); # if ( defined $key && defined $value ) { # $read_config{$key} = $value; # $self->debug( 3, "$key=$value" ); # } # } # close(CFG); my %read_config; %read_config = $self->load_file( type => 'config', filename => $config_file ); # grab any clusters from the config before validating it if ( $read_config{clusters} ) { $self->debug( 3, "Picked up clusters defined in $config_file" ); foreach my $cluster ( sort split / /, $read_config{clusters} ) { if ( $read_config{$cluster} ) { $clusters->register_tag( $cluster, split( / /, $read_config{$cluster} ) ); $old_clusters{$cluster} = $read_config{$cluster}; delete( $read_config{$cluster} ); } } delete( $read_config{clusters} ); } # tidy up entries, just in case $read_config{terminal_font} =~ s/['"]//g if ( $read_config{terminal_font} ); $self->validate_args(%read_config); } sub load_configs { my ( $self, @configs ) = @_; for my $config ( '/etc/csshrc', $ENV{HOME} . '/.csshrc', $ENV{HOME} . '/.clusterssh/config', ) { $self->parse_config_file($config) if ( -e $config ); } # write out default config file if necesasry try { $self->write_user_config_file(); } catch { warn $_, $/; }; # Attempt to load in provided config files. Also look for anything # relative to config directory for my $config (@configs) { next unless ($config); # can be null when passed from Getopt::Long $self->parse_config_file($config) if ( -e $config ); my $file = $ENV{HOME} . '/.clusterssh/config_' . $config; $self->parse_config_file($file) if ( -e $file ); } return $self; } sub write_user_config_file { my ($self) = @_; # attempt to move the old config file to one side if ( -f "$ENV{HOME}/.csshrc" ) { eval { move( "$ENV{HOME}/.csshrc", "$ENV{HOME}/.csshrc.DISABLED" ) }; if ($@) { croak( App::ClusterSSH::Exception::Config->throw( error => $self->loc( 'Unable to move [_1] to [_2]: [_3]' . $/, '$HOME/.csshrc', '$HOME/.csshrc.DISABLED', $@ ), ) ); } else { warn( $self->loc( 'Moved [_1] to [_2]' . $/, '$HOME/.csshrc', '$HOME/.csshrc.DISABLED' ), ); } } return if ( -f "$ENV{HOME}/.clusterssh/config" ); if ( !-d "$ENV{HOME}/.clusterssh" ) { if ( !mkdir("$ENV{HOME}/.clusterssh") ) { croak( App::ClusterSSH::Exception::Config->throw( error => $self->loc( 'Unable to create directory [_1]: [_2]' . $/, '$HOME/.clusterssh', $! ), ), ); } } # Debian #673507 - migrate clusters prior to writing ~/.clusterssh/config # in order to update the extra_cluster_file property if (%old_clusters) { if ( open( my $fh, ">", "$ENV{HOME}/.clusterssh/clusters" ) ) { print $fh '# ' . $self->loc('Tag definitions moved from old .csshrc file'), $/; foreach ( sort( keys(%old_clusters) ) ) { print $fh $_, ' ', join( ' ', $old_clusters{$_} ), $/; } close($fh); } else { croak( App::ClusterSSH::Exception::Config->throw( error => $self->loc( 'Unable to write [_1]: [_2]' . $/, '$HOME/.clusterssh/clusters', $! ), ), ); } } if ( open( CONFIG, ">", "$ENV{HOME}/.clusterssh/config" ) ) { foreach ( sort( keys(%$self) ) ) { my $comment = ''; if ( grep /$_/, @ignore_default_config ) { $comment = '#'; } print CONFIG ${comment}, $_, '=', $self->{$_}, $/; } close(CONFIG); warn( $self->loc( 'Created new configuration file within [_1]' . $/, '$HOME/.clusterssh/' ) ); } else { croak( App::ClusterSSH::Exception::Config->throw( error => $self->loc( 'Unable to write default [_1]: [_2]' . $/, '$HOME/.clusterssh/config', $! ), ), ); } return $self; } # search given directories for the given file sub search_dirs { my ( $self, $file, @directories ) = @_; my $path; foreach my $dir (@directories) { $self->debug( 3, "Looking for $file in $dir" ); if ( -f $dir . '/' . $file && -x $dir . '/' . $file ) { $path = $dir . '/' . $file; $self->debug( 2, "Found at $path" ); last; } } return $path; } # could use File::Which for some of this but we also search a few other places # just in case $PATH isnt set up right sub find_binary { my ( $self, $binary ) = @_; if ( !$binary ) { croak( App::ClusterSSH::Exception::Config->throw( error => $self->loc('argument not provided') . $/, ), ); } $self->debug( 2, "Looking for $binary" ); # if not found, strip the path and look again if ( $binary =~ m!^/! ) { if ( -f $binary ) { $self->debug( 2, "Already have full path to in $binary" ); return $binary; } else { $self->debug( 2, "Full path for $binary incorrect; searching" ); $binary =~ s!^.*/!!; } } my $path; if ( !-x $binary || substr( $binary, 0, 1 ) ne '/' ) { $path = $self->search_dirs( $binary, split( /:/, $ENV{PATH} ) ); # if it is on $PATH then no need to qualitfy the path to it # keep it as it is if ($path) { return $binary; } else { $path = $self->search_dirs( $binary, qw! /bin /sbin /usr/sbin /usr/bin /usr/local/bin /usr/local/sbin /opt/local/bin /opt/local/sbin ! ); } } else { $self->debug( 2, "Already configured OK" ); $path = $binary; } if ( !$path || !-f $path || !-x $path ) { croak( App::ClusterSSH::Exception::Config->throw( error => $self->loc( '"[_1]" binary not found - please amend $PATH or the cssh config file' . $/, $binary ), ), ); } chomp($path); return $path; } sub dump { my ( $self, $no_exit, ) = @_; $self->debug( 3, 'Dumping config to STDOUT' ); print( '# Configuration dump produced by "cssh -d"', $/ ); foreach my $key ( sort keys %$self ) { my $comment = ''; if ( grep /$key/, @app_specific ) { next; } if ( grep /$key/, @ignore_default_config ) { $comment = '#'; } print $comment, $key, '=', $self->{$key}, $/; } $self->exit if ( !$no_exit ); } #use overload ( # q{""} => sub { # my ($self) = @_; # return $self->{hostname}; # }, # fallback => 1, #); 1; =pod =head1 NAME ClusterSSH::Config - Object representing application configuration =head1 SYNOPSIS =head1 DESCRIPTION Object representing application configuration =head1 METHODS =over 4 =item $host=ClusterSSH::Config->new ({ }) Create a new configuration object. =item $config->parse_config_file(''); Read in configuration from given filename =item $config->validate_args(); Validate and apply all configuration loaded at this point =item $path = $config->search_dirs('', @seaarch_directories); Search the given directories for the name given. Return undef if not found. =item $path = $config->find_binary(''); Locate the binary and return the full path. Doesn't just search $PATH in case the environment isn't set up correctly =item $config->load_configs(@extra); Load up configuration from known locations (warn if .csshrc file found) and load in option files as necessary. =item $config->write_user_config_file(); Write out default $HOME/.clusterssh/config file (before option config files are loaded). =item $config->dump() Write currently defined configuration to STDOUT =back =head1 AUTHOR Duncan Ferguson, C<< >> =head1 LICENSE AND COPYRIGHT Copyright 1999-2016 Duncan Ferguson. This program is free software; you can redistribute it and/or modify it under the terms of either: the GNU General Public License as published by the Free Software Foundation; or the Artistic License. See http://dev.perl.org/licenses/ for more information. =cut 1;