libconfig-model-perl 2.021-3+deb7u1 / usr / bin / cme

#!/usr/bin/perl 

eval 'exec /usr/bin/perl  -S $0 ${1+"$@"}'
    if 0; # not running under some shell
#
# This file is part of Config-Model
#
# This software is Copyright (c) 2012 by Dominique Dumont, Krzysztof Tyszecki.
#
# This is free software, licensed under:
#
#   The GNU Lesser General Public License, Version 2.1, February 1999
#

use strict;
use warnings;
use 5.10.1;

use Config::Model;
use Config::Model::Lister;
use Getopt::Long;
use Pod::Usage;
use Log::Log4perl qw(get_logger :levels);
use POSIX qw/setsid/;
use AnyEvent ;

my $log4perl_syst_conf_file = '/etc/log4config-model.conf';
my $log4perl_user_conf_file = $ENV{HOME} . '/.log4config-model';
my $fallback_conf           = << 'EOC';
log4perl.logger=WARN, Screen
log4perl.appender.Screen        = Log::Log4perl::Appender::Screen
log4perl.appender.Screen.stderr = 0
log4perl.appender.Screen.layout = Log::Log4perl::Layout::PatternLayout
log4perl.appender.Screen.layout.ConversionPattern = %d %m %n
EOC

my $log4perl_conf =
    -e $log4perl_user_conf_file ? $log4perl_user_conf_file
  : -e $log4perl_syst_conf_file ? $log4perl_syst_conf_file
  :                               \$fallback_conf;

Log::Log4perl::init($log4perl_conf);

my $ui_type;

eval { require Config::Model::TkUI; };
my $has_tk = $@ ? 0 : 1;

eval { require Config::Model::CursesUI; };
my $has_curses = $@ ? 0 : 1;

eval { require Config::Model::FuseUI; };
my $has_fuse = $@ ? 0 : 1;

my $model_dir;
my $trace = 0;
my $root_dir;

my $man        = 0;
my $help       = 0;
my $force_load = 0;
my $dev        = 0;
my $backend;
my $experience = 'beginner';
my $dumptype;
my $load;
my $force_save  = 0;
my $open_item   = '';
my $fuse_dir;
my $fuse_debug  = 0;
my $apply_fixes = 0;
my $search;
my $search_type = 'all';


my %command_option = (
    list    => [],
    check   => [],
    migrate => [],
    fix     => [],
    modify  => [],
    search  => [ 
        "search=s"                      => \$search,
        "narrow-search=s"               => \$search_type, 
    ],
    edit    => [
        "ui|if=s"               => \$ui_type,
        "open_item|open-item=s" => \$open_item,
    ],
    dump   => [ "dumptype:s" => \$dumptype, ],
    fusefs => [
        "fuse_dir|fuse-dir=s" => \$fuse_dir,
        "dfuse!"              => \$fuse_debug,
    ],
);

my @global_options = (
    "model_dir|model-dir=s"         => \$model_dir,
    "experience=s"                  => \$experience,
    "dev!"                          => \$dev,
    "force_load|force-load!"        => \$force_load,
    "root_dir|root-dir=s"           => \$root_dir,
    "backend=s"                     => \$backend,
    "stack-trace|trace!"            => \$trace,
    );

# retrieve the main command, i.e. the first arg without leading dash
my ($command) = grep { ! /^-/ } @ARGV ;

pod2usage(-message => 'no command specified', -verbose => 0) 
    unless defined $command ;

pod2usage( -verbose => 1 ) if $command =~ /help/;
pod2usage( -verbose => 2 ) if $command =~ /man/;

my $cmd_options =  $command_option{$command} 
    || pod2usage(-message => "unknown command: $command", -verbose => 0) ;

my $result = GetOptions( @global_options, @$cmd_options);

pod2usage(-verbose => 0) if not $result;

# now @ARGV should be $command, $application, [ $config_file ]
shift @ARGV;
my $application = shift @ARGV ;

# ignore $dev if run as root
if ( $> and $dev ) {
    unshift @INC, 'lib';
    $model_dir = 'lib/Config/Model/models/';
    warn "-dev option is ignored when run as root\n";
}

Config::Model::Exception::Any->Trace(1) if $trace;

if ( defined $root_dir && !-e $root_dir ) {
    mkdir $root_dir, 0755 || die "can't create $root_dir:$!";
}

my $model = Config::Model->new( model_dir => $model_dir );

my ( $categories, $appli_info, $appli_map ) =
  Config::Model::Lister::available_models;

my $root_model = $appli_map->{$application} ;

if (not defined $root_model) {
  warn "Unknown application: $application\n";
}

if ( not defined $root_model or $command eq 'list') {
    print "The following applications are available:\n";
    foreach my $cat ( keys %$categories ) {
        my $names = $categories->{$cat} || [];
        next unless @$names;
        print "$cat:\n\t", join( "\n\t", @$names ), "\n";
    }
    exit 1;
}

my $config_file ;
$config_file = shift @ARGV if $appli_info->{$application}{require_config_file} ;

my $inst = $model->instance(
    root_class_name => $root_model,
    instance_name   => $application,
    root_dir        => $root_dir,
    check           => $force_load ? 'no' : 'yes',
    skip_read       => $load ? 1 : 0,
    backend         => $backend,
    config_file     => $config_file,
);

my $root = $inst->config_root;

if ($command eq 'edit' and not defined $ui_type ) {
    if ($has_tk) {
        $ui_type = 'tk';
    }
    elsif ($has_curses) {
        warn "You should install Config::Model::TkUI for a ",
            "more friendly user interface\n";
        $ui_type = 'curses';
    }
    else {
        warn "You should install Config::Model::TkUI or ",
            "Config::Model::CursesUI ", 
            "for a more friendly user interface\n";
        $ui_type = 'shell';
    }
}


if ( $command eq  'dump' ) {
    my $dump_string = $root->dump_tree( mode => $dumptype || 'custom' );
    print $dump_string ;
}
elsif ( $command eq 'check' ) {
    $root->dump_tree( mode => 'full' );
}
elsif ( $command eq 'search' ) {
    pod2usage(-message => "missing -search option with search command" )
        unless defined $search;
    my @res = $root->tree_searcher( type => $search_type )->search($search);
    foreach my $path ( @res ) {
        print "$path";
        my $obj = $root->grab($path);
        if ( $obj->get_type =~ /leaf|check_list/ ) {
            my $v = $obj->fetch;
            $v = defined $v ? $v : '<undef>';
            print " -> '$v'";
        }
        print "\n";
    }
}
elsif ($command eq 'migrate') {
    $force_save = 1;
    $root->migrate;
    
}
elsif ($command eq 'fix') {
    say "Fixing..." ;
    $inst->apply_fixes;
    $force_save = 1;
}
elsif ( $command eq 'modify' ) {
    $root->load("@ARGV");
    $force_save = 1;
}
elsif ( $command =~ /^fuse/ ) {
    die "could not load Config::Model::FuseUI. Is Fuse installed ?\n"
      unless $has_fuse;
    die "Missing -fuse_dir option\n" unless defined $fuse_dir;
    die "Directory $fuse_dir does not exists\n" unless -d $fuse_dir;

    my $ui = Config::Model::FuseUI->new(
        root       => $root,
        mountpoint => "$fuse_dir",
    );

    print "Mounting config on $fuse_dir in background.\n",
        "Use command 'fusermount -u $fuse_dir' to unmount\n";

    # now fork
    my $pid = fork;

    if ( defined $pid and $pid == 0 ) {

        # child process, just run fuse and wait for exit
        $ui->run_loop( debug => $fuse_debug );
        $force_save = 1;
    }
    else {
        exit;    # don't save data in parent process
    }
}
elsif ( $command eq 'edit' ) {
    if ( $ui_type eq 'simple' ) {

        # experience not yet implemented
        require Config::Model::SimpleUI;
        my $shell_ui = Config::Model::SimpleUI->new(
            root   => $root,
            title  => $root_model . ' configuration',
            prompt => ' >',
        );

        # engage in user interaction
        $shell_ui->run_loop;
    }
    elsif ( $ui_type eq 'shell' ) {

        # experience not yet implemented
        require Config::Model::TermUI;
        my $shell_ui = Config::Model::TermUI->new(
            root   => $root,
            title  => $root_model . ' configuration',
            prompt => ' >',
        );

        # engage in user interaction
        $shell_ui->run_loop;
    }
    elsif ( $ui_type eq 'curses' ) {
        die "cannot run curses interface: ",
            "Config::Model::CursesUI is not installed\n"
          unless $has_curses;
        my $err_file = '/tmp/cme-error.log';

        print "In case of error, check $err_file\n";

        open( FH, "> $err_file" ) || die "Can't open $err_file: $!";
        open STDERR, ">&FH";

        my $dialog = Config::Model::CursesUI->new( experience => $experience, );

        # engage in user interaction
        $dialog->start($model);

        close FH;
    }
    elsif ( $ui_type eq 'tk' ) {
        die "cannot run Tk interface: Config::Model::CursesUI is not installed\n"
          unless $has_tk;

        require Tk;
        require Tk::ErrorDialog;
        Tk->import;
        
        # BLEEUAARGHHH. 
        # Currently AnyEvent is loaded and called only within Debian::Dpkg backend
        # and C::M::Debian::Dependency. When called in a Tk environment
        # AnyEvent creates its own TK mw which may be along the one created below
        # this require make sure that AnyEvent Tk mw is created and used for Tk application 
        require AnyEvent::Impl::Tk ;
        # without that, C::M::TkUI::quit (which just destroys one $mw, not 2) is not enough
        # to end the program :-( 

        no warnings 'once' ;
        my $mw = $AnyEvent::Impl::Tk::mw ;#|| MainWindow->new;
        # $mw->withdraw;

        # Thanks to Jerome Quelin for the tip
        $mw->optionAdd( '*BorderWidth' => 1 );

        my $cmu = $mw->ConfigModelUI( 
            -root => $root, 
            -experience => $experience 
        );

        if ($open_item) {
            my $obj = $root->grab($open_item);
            $cmu->force_element_display($obj);
        }

        &MainLoop;    # Tk's
    }
    elsif ( $ui_type =~ /^no/i ) {

        # trigger a dump to load all sub-models
        my $dump = $root->dump_tree;
        $force_save = 1 if $apply_fixes or $load or @ARGV;
    }
    else {
        die "Unsupported user interface: $ui_type";
    }
}
else {
    die "Looks like the author forgot to implement $command. Bad author, bad.";
}

if ($force_save) {
    my @changes = $inst->list_changes ;
    say "\n",join( "\n- ","Changes:", @changes ) if @changes;
    $inst->write_back  ;
}
exit 0;

__END__

=pod

=head1 NAME

cme - Edit data of configuration managed by Config::Model

=head1 SYNOPSIS

  # general synopsis
  cme [ global_options ] command application [ options ] arguments

  # edit dpkg config with GUI
  cme edit dpkg 

  # edit /etc/sshd_config (requires Config::Model::OpenSsh)
  sudo cme edit sshd
  
  # edit ~/.ssh/config (requires Config::Model::OpenSsh)
  cme edit ssh
  
  # just check the validity of a file 
  cme check multistrap file.conf 
  
  # check dpkg files, update deprecated parameters and save
  cme migrate dpkg 
  
  # like migrate, but also apply all suggested fixes
  cme fix dpkg 
  
  # modify configuration with command line
  cme modify dpkg source 'format="quilt (3.0)"'

  # edit a file (file name specification is mandatory here)
  cme edit multistrap my.conf 

  # map conf data to a fuse file system
  cme fusefs multistrap my.conf -d fuse_dir
  
  # likewise for dpkg data
  cme fusefs dpkg -d fuse_dir
  
  # list all available applications (depends on your installation)
  cme list 
  

=head1 DESCRIPTION

C<cme> program will use Config::Model configuration
descriptions to check or modify or fix configuration files.

=head1 Commands

=head2 list

Show a list all applications where a model is available. This list depends on 
installed Config::Model modules.

=head2 edit

Edit a configuration. By default, a Tk GUI will be opened If L<Config::Model::TkUI> is
installed. You can choose another user interface with the C<-ui> option:

=over

=item *

C<tk>: provides a Tk graphical interface (If L<Config::Model::TkUI> is
installed).

=item *

C<curses>: provides a curses user interface (If
L<Config::Model::CursesUI> is installed).

=item *

C<shell>: provides a shell like interface.  See L<Config::Model::TermUI>
for details.

=back

=head2 check

Checks the content of the configuration file of an application. Prints warnings
and errors on STDOUT.

Example:

 cme check lcdproc
 
=head2 migrate

Checks the content of the configuration file of an application, update deprecated
(old value are saved to new parameters) and save the new configuration.  

For more details, see L<Config::Model::Value/Upgrade>

=head2 fix

Like C<migrate> and, when possible, fix the warnings of a configuration.

=head2 modify

Modify a configuration file with the values passed on the command line.
These command must follow the syntax defined in L<Config::Model::Loader>.

Example:

   cme modify dpkg source format="quilt (3.0)"
   cme modify multistrap my_mstrap.conf sections:base source="http://ftp.fr.debian.org"

=head2 search

You can search the configuration with the following options

=over 

=item -search

Specifies a string or pattern to search. C<cme> will a list of path pointing 
to the matching tree element and their value. 
See L<Config::Model::AnyThing/grab(...)> for details
on the path syntax.

=item -narrow-search

Narrows down the search to:

=over 

=item element 

=item value 

=item key 

=item summary 

Summary text

=item description

description text 

=item help

value help text

=back 

=back 

Example:

 $ cme search multistrap my_mstrap.conf -s http -narrow value
 sections:base source -> 'http://ftp.fr.debian.org'
 sections:debian source -> 'http://ftp.uk.debian.org/debian'
 sections:toolchains source -> 'http://www.emdebian.org/debian'

=head2 dump

Dump configuration content on STDOUT with Config::Model syntax.

By default, dump only custom values, i.e. different from application
built-in values or model default values. You can use the C<-dumptype> option for
other types of dump:
 
 -dumptype [ full | preset | custom ]

Choose to dump every values (full), only preset values or only
customized values (default)

=head2 fusefs 

Map the configuration file content to a FUSE virtual file system. 
You must give a directory where
the virtual file system will be mounted with option C<-fuse-dir>. 
To stop (and write the configuration data back to the configuration file), 
run C<< fusermount -u <mounted_fuse_dir> >>. Use C<-dfuse> option to debug
fuse problems.

=head1 Global options

The following options are available for all commands:

=over

=item -experience

Change the experience level. By default only parameters with "beginner" experience
are shown or modifiable. You can choose C<advanced> or C<master> level to get 
access to more parameters. Note that experience level can be changed in the GUI with the 
I<options> menu.

=item -force-load

Load file even if error are found in data. Bad data are discarded

=item -dev

Use this option if you want to test a model under development. This
option will add C<lib> in C<@INC> and use C<lib/Config/Model/models>
as model directory. This option is ignored when run as root.

=item -model-dir

Specify an alternate directory to find model files. Mostly useful for
tests.

=item -root-dir

Specify a pseudo root directory to read and write the configuration
files. (Actual default directory and file names depends on the model
(See C<-model> option). For instance, if you specify C<~/mytest>, the
C</etc/ssh/sshd_config> files will be written in C<~/mytest/etc/ssh/>
directory.

=item -stack-trace

Provides a full stack trace when exiting on error.

=item -backend

Specify a read/write backend. The actual backend name depends on the model
passed to C<-model> option. See L<Config::Model::AutoRead> for details.

=back

=head1 Embedding cme

You can use cme from another program by using C<-ui simple>
option. This way you will be able to send command on the standard input
of C<cme> and get the results from the standard output.

=head1 Logging

All Config::Model logging is now based on L<Log::Log4perl>. 
Logging can be configured in the following files:

=over

=item *

 ~/.log4config-model

=item * 

 /etc/log4config-model.conf

=back

Without these files, the following Log4perl config is used:

 log4perl.logger=WARN, Screen
 log4perl.appender.Screen        = Log::Log4perl::Appender::Screen
 log4perl.appender.Screen.stderr = 0
 log4perl.appender.Screen.layout = Log::Log4perl::Layout::PatternLayout
 log4perl.appender.Screen.layout.ConversionPattern = %d %m %n

Log4perl uses the following categories:

=over

=item Anything

=item Anything::Change

Trace change notification through configuration tree and instance.

=item Backend

=item Backend::Debian::Dpkg

=item Backend::Debian::Dpkg::Control

=item Backend::Debian::Dpkg::Copyright

=item Backend::Fstab

=item Backend::IniFile

=item Backend::PlainFile

=item Backend::ShellVar

=item Backend::Yaml

=item FuseUI

=item Instance

=item Loader

=item Model::Searcher

=item Tree::Element::CheckList

=item Tree::Element::Id

=item Tree::Element::Id::Hash

=item Tree::Element::Id::List

=item Tree::Element::Value

=item Tree::Element::Value::Dependency

=item Tree::Node

=item Tree::Node::Warped

=item ValueComputer

=item Warper

=item Wizard::Helper

=item Model


=back

More categories will come.

=head1 SUPPORT

For support, please check the following resources:

=over

=item *

The config-model users mailing list:

 config-model-users at lists.sourceforge.net

=item *

The config-model wiki: L<http://config-model.wiki.sourceforge.net/>

=back

=head1 FEEDBACKS

Feedback from users are highly desired. If you find this module useful, please
share your use cases, success stories with the author or with the config-model-
users mailing list. 

=head1 AUTHOR

Dominique Dumont, ddumont at cpan dot org

=head1 SEE ALSO

L<Config::Model::Model>, 
L<Config::Model::Instance>, 
L<Config::Model::Node>, 
L<Config::Model::HashId>,
L<Config::Model::ListId>,
L<Config::Model::WarpedNode>,
L<Config::Model::Value>

=cut