view release on metacpan or  search on metacpan

lib/CallBackery/Config.pm  view on Meta::CPAN

            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.

lib/CallBackery/Config.pm  view on Meta::CPAN

    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));
}

# how long to keep trying when someone else holds a lock on the config
# database; package scoped so that tests can shorten it
our $RESTORE_BUSY_TIMEOUT_MS = 30_000;

# Build a replacement config database with $builder and then copy it over the
# live one with SQLite's online backup API, so that the database keeps its
# inode.
#
# Replacing the file instead (the way this used to work) leaves every long
# lived handle in the system attached to the old, now unlinked inode: the
# config daemon and its workers, the application server, and any helper that
# happens to be running at the time. Those handles go on reading stale
# configuration and fail on their first write with SQLITE_READONLY_DBMOVED,
# which SQLite reports as "attempt to write a readonly database".
#
# The staging database lives next to the config database rather than in a
# world readable temp directory, since it holds the same secrets, and on the
# same filesystem, so it does not compete for space with anything else.
sub _stageAndRestoreDb ($self,$builder) {
    my $cfgDb = $self->cfgHash->{BACKEND}{cfg_db};
    my $staging = $cfgDb.'.restore.'.$$;
    my $err;
    eval {
        # unlink glob, not plain unlink: a leftover journal of our own would
        # otherwise be rolled back into the staging database
        no autodie;
        unlink glob $staging.'*';
        use autodie;
        $builder->($staging);
        chmod 0600, $staging;
        my $dbh = DBI->connect("dbi:SQLite:dbname=$cfgDb",'','',{
            RaiseError => 1,
            PrintError => 0,
            AutoCommit => 1,
        });
        # the backup runs the destination's busy handler while it waits for
        # the write lock; on top of that we retry, because a backup that
        # starts while another connection sits in a read transaction gives up
        # rather than waiting
        $dbh->sqlite_busy_timeout($RESTORE_BUSY_TIMEOUT_MS);
        my $deadline = Time::HiRes::time() + $RESTORE_BUSY_TIMEOUT_MS / 1000;
        my ($busy,$tries) = (undef,0);
        while (1) {
            $busy = undef;
            last if eval { $dbh->sqlite_backup_from_file($staging) };
            $busy = $@ || $dbh->errstr || 'unknown error';
            last if Time::HiRes::time() >= $deadline;
            # first attempt and then roughly every five seconds, so that a
            # long wait is visible without a log line per retry
            $self->log->warn("Config database busy, retrying restore: $busy")
                if $tries++ % 50 == 0;
            Time::HiRes::sleep(0.1);
        }
        $dbh->disconnect;
        # giving up here is safe: the live database has not been touched, so
        # this degrades to a clean error rather than a half restored config
        die mkerror(3845,trm("Could not restore the configuration database: %1",$busy))
            if $busy;
        1;
    } or $err = $@;
    no autodie;
    unlink glob $staging.'*';
    die $err if $err;
    return;
}

=head2 $cfg->restoreConfigBlob(configBlob)

retore the confguration state

=cut

sub restoreConfigBlob {
    my $self = shift;
    my $config = shift;
    my $password = shift;
    require Archive::Zip;
    my $crypt = $self->getCrypt($password);
    $config = $self->unpack16($crypt->decrypt($config));

    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->_stageAndRestoreDb(sub ($staging) {
                    $member->extractToFileNamed($staging);
                });
                last;
            };
            /^\{DATABASEDUMP\}$/ && do {
                $self->log->warn("Restoring Database Dump!");
                $self->_stageAndRestoreDb(sub ($staging) {
                    open my $sqlite, '|-', '/usr/bin/sqlite3',$staging;
                    my $sql = $member->contents();
                    $sql =~ s/0$//; # for some reason the dump ends in 0
                    print $sqlite $sql;
                    # autodie turns a non zero exit of sqlite3 into a die, so a
                    # dump that does not replay never reaches the live database
                    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;
                    }