has file => sub { croak "the file parameter is mandatory" };
has secretFile => sub ($self) {
my $secretFile = $self->file.'.secret';
if (not -f $secretFile){
open my $rand, '>', $secretFile;
chmod 0600,$secretFile;
print $rand sprintf('%x%x',int(rand()*1e14),int(rand()*1e14));
close $rand;
chmod 0400,$secretFile;
}
return $secretFile;
};
has app => sub { croak "the app parameter is mandatory" }, weak => 1;
has log => sub {
shift->app->log;
};
has cfgHash => sub {
my $self = shift;
my $cfg_file = shift;
my $parser = $self->makeParser();
my $cfg = $parser->parse($self->file, {encoding => 'utf8'}) or croak($parser->{err});
$self->grammar(undef);
return $cfg;
};
has pod => sub {
my $self = shift;
my $parser = $self->makeParser();
my $E = '=';
my $footer = <<"FOOTER";
${E}head1 COPYRIGHT
Copyright (c) 2014 by OETIKER+PARTNER AG. All rights reserved.
${E}head1 AUTHOR
S<Tobias Oetiker E<lt>tobi\@oetiker.chE<gt>>
S<Fritz Zaucker E<lt>fritz.zaucker\@oetiker.chE<gt>>
${E}head1 HISTORY
2014-01-11 to 1.0 first version
2014-04-29 fz 1.1 implement plugin path
FOOTER
my $header = <<"HEADER";
${E}head1 NAME
callbackery.cfg - The Appliance FRONTEND Builder config file
${E}head1 SYNOPSIS
*** BACKEND ***
log_file = /tmp/nw-tobi.log
*** FRONTEND ***
logo = logo.png
spinner = myspinner.gif
logo_small = logo-small.png
title = Appliance Configurator
${E}head1 DESCRIPTION
The afb.cfg provides all the info for afb and its gui modules to interact with your appliance.
${E}head1 CONFIGURATION
HEADER
return $header.$parser->makepod().$footer;
};
has pluginPath => sub { ['CallBackery::GuiPlugin']; };
sub loadAndNewPlugin {
my $self = shift;
my $plugin = shift;
my $module;
my $ok;
for my $path (@{$self->pluginPath}) {
if (my $e = load_class "${path}::$plugin") {
die mkerror(3894,"Loading ${path}::$plugin: $e") if ref $e;
} else {
my $proto = "${path}::${plugin}"->new(log=>$self->log);
$proto->{prototype} = 1;
return $proto;
}
}
die mkerror(123, "Plugin Module $plugin not found");
};
has grammar => sub {
my $self = shift;
my $pluginList = {};
my $pluginPath = $self->pluginPath;
for my $path (@INC){
for my $pPath (@$pluginPath) {
my @pDirs = split /::/, $pPath;
my $fPath = File::Spec->catdir($path, @pDirs, '*.pm');
for my $file (glob($fPath)) {
my ($volume, $modulePath, $moduleName) = File::Spec->splitpath($file);
$moduleName =~ s{\.pm$}{};
$pluginList->{$moduleName} = 'Plugin Module';
}
}
}
return {
_sections => [ qw(BACKEND FRONTEND FRONTEND-COLORS /PLUGIN:\s*\S+/)],
_mandatory => [qw(BACKEND FRONTEND)],
BACKEND => {
_doc => 'BACKEND Settings',
_vars => [ qw(log_file cfg_db sesame_user sesame_pass) ],
_mandatory => [ qw(cfg_db sesame_user sesame_user) ],
log_file => { _doc => 'write a log file to this location (unless in development mode)'},
cfg_db => { _doc => 'file to store the config database'},
sesame_user => { _doc => <<'DOC'},
In Open Sesame mode, one has to use this username to get access to the system.
The password you enter does not matter.
DOC
sesame_pass => { _doc => <<'DOC'},
Using sesame_user and sesame_pass, the system can always be accessed.
In default configuration sesame_pass is NOT set.
DOC
},
FRONTEND => {
_doc => 'Settings for the Web FRONTEND',
_vars => [ qw(logo logo_small logo_noscale spinner title initial_plugin company_name company_url company_support
hide_password hide_password_icon hide_release hide_company max_width
)
],
logo => {
_doc => 'url for the logo brand the login sceen',
},
company_name => {
_doc => 'who created the app',
},
company_url => {
_doc => 'link to the company homepage'
},
max_width => {
_doc => 'maximum content width'
},
company_support => {
_doc => 'company support eMail'
},
logo_small => {
_doc => 'url for the small logo brand the UI',
},
logo_noscale => {
_doc => "don't scale logo on login window",
_re => '(yes|no|true|false)',
_re_error => 'pick yes or no OR true or false',
_sub => sub {
$_[0] = ($_[0] =~ /yes|true/) ? true : false;
return;
},
},
spinner => {
_doc => 'url for the busy animation spinner gif',
},
title => {
_doc => 'title string for the application'
},
initial_plugin => {
_doc => 'which tab should be active upon login ?'
},
hide_password => {
_doc => 'hide password field on login screen',
_re => '(yes|no|true|false)',
_re_error => 'pick yes or no OR true or false',
_sub => sub {
$_[0] = ($_[0] =~ /yes|true/) ? true : false;
return;
},
},
hide_password_icon => {
_doc => 'hide password icon on login screen',
_re => '(yes|no|true|false)',
_re_error => 'pick yes or no OR true or false',
_sub => sub {
$_[0] = ($_[0] =~ /yes|true/) ? true : false;
return;
},
},
hide_release => {
_doc => 'hide release string on login screen',
_re => '(yes|no|true|false)',
_re_error => 'pick yes or no OR true or false',
_sub => sub {
$_[0] = ($_[0] =~ /yes|true/) ? true : false;
return;
},
},
hide_company => {
_doc => 'hide company string on login screen',
_re => '(yes|no|true|false)',
_re_error => 'pick yes or no OR true or false',
_sub => sub {
$_[0] = ($_[0] =~ /yes|true/) ? true : false;
return;
},
},
},
'FRONTEND-COLORS' => {
_vars => [ '/[a-zA-Z]\S+/' ],
'/[a-zA-Z]\S+/' => {
_doc => <<COLORKEYS_END,
Use this section to override any color key used in the qooxdoo simple theme as well as the following:
C<tabview-page-background>,
C<tabview-page-border>,
C<tabview-button-background>,
C<tabview-button-checked-background>,
C<tabview-button-text>,
C<tabview-button-checked-text>,
C<tabview-button-border>,
C<tabview-button-checked-border>.
C<textfield-readonly>.
The keys can be set to standard web colors C<rrggbb> or to other key names.
COLORKEYS_END
_example => <<EXAMPLE_END,
ff0000
EXAMPLE_END
_sub => sub {
if ($_[0] =~ /^\s*([0-9a-f]{3,6})\s*$/i){
$_[0] = '#'.lc($1);
}
return undef;
}
}
},
'/PLUGIN:\s*\S+/' => {
_order => 1,
_doc => 'Plugins providing appliance specific funtionality',
_vars => [qw(module)],
_mandatory => [qw(module)],
module => {
_sub => sub {
eval {
$_[0] = $self->loadAndNewPlugin($_[0]);
};
if ($@){
return "Failed to load Plugin $_[0]: $@";
}
return undef;
},
_dyn => sub {
my $var = shift;
my $module = shift;
$module = $self->loadAndNewPlugin($module) if not ref $module;
my $tree = shift;
my $grammar = $module->grammar();
push @{$grammar->{_vars}}, 'module';
for my $key (keys %$grammar){
$tree->{$key} = $grammar->{$key};
}
},
_dyndoc => $pluginList,
},
}
};
};
sub makeParser {
my $self = shift;
my $parser = Config::Grammar::Dynamic->new($self->grammar);
return $parser;
}
sub getTranslations {
my $self = shift;
my $cfg = shift || {};
my %lx;
my $path = $cfg->{path} // $self->app->home->rel_file("share");
my $po = new Locale::PO();
for my $file (glob(File::Spec->catdir($path, '*.po'))) {
my ($volume, $localePath, $localeName) = File::Spec->splitpath($file);
my $locale = $localeName;
$locale =~ s/\.po$//;
my $lang = $locale;
$lang =~ s/_.+//;
local $_;
my $href = Locale::PO->load_file_ashash($file, 'utf8');
for my $key (keys %$href) {
my $o = $href->{$key};
my $id = $po->dequote($o->msgid);
my $str = $po->dequote($o->msgstr);
next unless $id;
$lx{$locale}{$id} = $str;
}
}
return \%lx;
}
sub postProcessCfg {
my $self = shift;
my $cfg = $self->cfgHash;
return $cfg if $cfg->{PLUGIN}{list};
my %plugin;
my @pluginOrder;
for my $section (sort keys %$cfg){
my $sec = $cfg->{$section};
next unless ref $sec eq 'HASH';
for my $key (keys %$sec){
next unless ref $sec->{$key} eq 'HASH' and $sec->{$key}{_text};
$sec->{$key} = $sec->{$key}{_text};
}
if ($section =~ /^PLUGIN:\s*(.+)/){
my $name = $1;
$pluginOrder[$sec->{_order}] = $name;
delete $sec->{_order};
my $obj = $cfg->{PLUGIN}{prototype}{$name} = $sec->{module};
delete $sec->{module};
$obj->config($sec);
$obj->name($name);
$obj->app($self->app);
$obj->massageConfig($cfg);
delete $cfg->{$section};
}
$cfg->{PLUGIN}{list} = \@pluginOrder;
}
if (exists $cfg->{'FRONTEND-COLORS'}) {
$cfg->{FRONTEND}{COLORS} = $cfg->{'FRONTEND-COLORS'};
delete $cfg->{'FRONTEND-COLORS'};
}
$cfg->{FRONTEND}{TRANSLATIONS} = $self->getTranslations();
return $cfg;
}
sub _getPluginObject {
my $self = shift;
my $name = shift;
my $user = shift;
my $args = shift;
my $prototype = $self->cfgHash->{PLUGIN}{prototype}{$name};
$name =~ s/[^-_0-9a-z]/_/gi;
die mkerror(39943,"No prototype for $name")
if not defined $prototype;
my $obj = $prototype->new(
user => $user,
name => $prototype->name,
config => $prototype->config,
args => $args // {},
app => $self->app,
);
$obj->log;
return $obj;
}
sub instantiatePlugin_p {
my $self = shift;
my $obj = $self->_getPluginObject(@_);
return $self->promisify($obj->checkAccess)->then(sub {
my $access = shift;
return $obj if $access;
my $name = $obj->name;
Mojo::Promise->reject(mkerror(39944,"No permission to access $name"));
});
}
sub instantiatePlugin {
my $self = shift;
my @args = @_;
my $obj = $self->_getPluginObject(@args);
my $name = $obj->name;
die mkerror(39944,"No permission to access $name")
if not $self->promiseDeath($obj->checkAccess);
return $obj;
}
has configPlugins => sub {
my $self = shift;
my $user = $self->app->userObject->new(app=>$self->app,userId=>'__CONFIG', log=>$self->log);
my $cfg = $self->cfgHash;
my @plugins;
for my $name (@{$cfg->{PLUGIN}{list}}){
my $obj = eval {
$self->instantiatePlugin($name,$user);
} or next;
push @plugins, $obj;
}
return \@plugins;
};
sub getCrypt {
my $self = shift;
my $password = substr((shift || '').('x' x 32),0,32);
return Crypt::Rijndael->new( $password,Crypt::Rijndael::MODE_CBC() );
}
sub pack16 {
my $self = shift;
my $string = shift;
my $len = length($string);
my $mod = 16 - ($len % 16);
return sprintf("%016x%s",$len,$string.('x' x $mod));
}
sub unpack16 {
my $self = shift;
my $string = shift;
my $len = substr($string,0,16);
if ( $len !~ /^[0-9a-f]{16}$/ or hex($len) > length($string)-16 ){
die mkerror(3844,trm("Wrong password!"));
}
return substr($string,16,hex($len));
}
sub getConfigBlob {
my $self = shift;
my $password = shift;
my $zip = Archive::Zip->new();
my $cfg = $self->cfgHash;
my $dumpfile = '/tmp/cbdump'.$$;
unlink $dumpfile if -f $dumpfile;
open my $dump, '|-','/usr/bin/sqlite3',$cfg->{BACKEND}{cfg_db};
print $dump ".output $dumpfile\n";
print $dump ".dump\n";
close $dump;
$zip->addFile({
filename => $dumpfile,
zipName => '{DATABASEDUMP}',
});
for my $obj (@{$self->configPlugins}){
my $name = $obj->name;
for my $file (@{$obj->stateFiles}) {
if (-r $file){
$zip->addFile({
filename => $file,
zipName => '{PLUGINSTATE.'.$name.'}'.$file
})
}
}
}
my $zipData;
open(my $fh, ">", \$zipData);
$zip->writeToFileHandle($fh,0);
my $crypt = $self->getCrypt($password);
return $crypt->encrypt($self->pack16($zipData));
}
sub restoreConfigBlob {
my $self = shift;
my $config = shift;
my $password = shift;
my $crypt = $self->getCrypt($password);
$config = $self->unpack16($crypt->decrypt($config));
my $cfg = $self->cfgHash;
my $user = $self->app->userObject->new(app=>$self->app,userId=>'__CONFIG', log=>$self->log);
open my $fh ,'<', \$config;
my $zip = Archive::Zip->new();
$zip->readFromFileHandle($fh);
my %stateFileCache;
for my $member ($zip->members){
for ($member->fileName){
/^\{DATABASE\}$/ && do {
$self->log->warn("Restoring Database!");
$self->app->database->mojoSqlDb->disconnect;
unlink glob $cfg->{BACKEND}{cfg_db}.'*';
$member->extractToFileNamed($cfg->{BACKEND}{cfg_db});
last;
};
/^\{DATABASEDUMP\}$/ && do {
$self->log->warn("Restoring Database Dump!");
$self->app->database->mojoSqlDb->disconnect;
unlink glob $cfg->{BACKEND}{cfg_db}.'*';
open my $sqlite, '|-', '/usr/bin/sqlite3',$cfg->{BACKEND}{cfg_db};
my $sql = $member->contents();
$sql =~ s/0$//;
print $sqlite $sql;
close $sqlite;
last;
};
m/^\{PLUGINSTATE\.([^.]+)\}(.+)/ && do {
my $plugin = $1;
my $file = $2;
if (not $stateFileCache{$plugin}){
my $obj = eval {
$self->instantiatePlugin($plugin,$user);
};
if (not $obj){
$self->log->warn("Ignoring $file from plugin $plugin since the plugin is not available here.");
next;
}
$stateFileCache{$plugin} = { map { $_ => 1 } @{$obj->stateFiles} };
};
if ($stateFileCache{$plugin}{$file}){
$member->extractToFileNamed($file);
}
else {
$self->log->warn("Ignoring $file from archive since it is not listed in $plugin stateFiles.");
}
}
}
}
$self->reConfigure;
}
sub reConfigure {
my $self = shift;
my $secretFile = $self->secretFile;
if (not -f $secretFile){
open my $rand, '>', $secretFile;
chmod 0600,$secretFile;
print $rand sprintf('%x%x',int(rand()*1e14),int(rand()*1e14));
close $rand;
chmod 0400,$secretFile;
}
for my $obj (@{$self->configPlugins}){
$obj->reConfigure;
}
}
sub unConfigure {
no autodie;
my $self = shift;
my $cfg = $self->cfgHash;
$self->log->debug("unlinking config database ".$cfg->{BACKEND}{cfg_db});
unlink $cfg->{BACKEND}{cfg_db} if -f $cfg->{BACKEND}{cfg_db};
open my $gen, '>', $cfg->{BACKEND}{cfg_db}.'.flush';
close $gen;
$self->reConfigure();
for my $obj (@{$self->configPlugins}){
for my $file (@{$obj->stateFiles},@{$obj->unConfigureFiles}) {
next if not -f $file;
$self->log->debug('['.$obj->name."] unlinking $file");
unlink $file;
}
}
unlink $cfg->{BACKEND}{log_file} if defined $cfg->{BACKEND}{log_file} and -f $cfg->{BACKEND}{log_file} ;
unlink $self->secretFile if -f $self->secretFile;
system "sync";
}
sub promisify {
my $self = shift;
my $value = shift;
if (eval { blessed $value && $value->isa('Mojo::Promise') }){
return $value;
}
return Mojo::Promise->resolve($value);
}
sub promiseDeath {
my $self = shift;
my $value = shift;
if (eval { blessed $value && $value->isa('Mojo::Promise') }){
Mojo::Exception->throw("unexpected promise respone!");
}
return $value;
}
1;