view release on metacpan or  search on metacpan

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

        if not defined $prototype;
    my $obj = $prototype->new(
        user => $user,
        name => $prototype->name,
        config => $prototype->config,
        args => $args // {},
        app => $self->app,
    );
    $obj->log; # make sure logging is initialized
    return $obj;
}

# do not (!!!) implement this with async/await as it causes the the generated
# object to be somehow get a problem with reference counting with prevents
# timely destruction of the object 2024-06-12 tobi
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;
}

=head2 $configBlob = $cfg->getConfigBlob()

return the configuration state of the system as a blob

=cut

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 {
    require Crypt::Rijndael;
    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;
    require Archive::Zip;

    my $zip = Archive::Zip->new();
    my $cfg = $self->cfgHash;
    # flush all the changes in the database to the db file
    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));
}

=head2 $cfg->restoreConfigBlob(configBlob)

retore the confguration state