Commit 7cebdd2d authored by Nigel Kukard's avatar Nigel Kukard
Browse files

* Use the awit-perl-toolkit

This toolkit synchronizes various perl libraries used by various AllWorldIT projects
parent 459b347a
......@@ -33,9 +33,10 @@ $ mysql -u root -p policyd < policyd.mysql
2. Put cluebringer.conf in your /etc directory and adjust cluebringer.conf with your MySQL database details
3. Copy the cbp/ directory into /usr/local/lib/policyd-2.1/
3. Copy the cbp/ & awitpt/ directories into /usr/local/lib/policyd-2.1/
mkdir /usr/local/lib/policyd-2.1
cp -r cbp /usr/local/lib/policyd-2.1/
cp -r awitpt /usr/local/lib/policyd-2.1/
4. Copy cbpolicyd and cbpadmin into /usr/local/bin
cp cbpadmin /usr/local/bin/
......
# Caching engine
# Copyright (C) 2009, AllWorldIT
# Copyright (C) 2008, LinuxRulz
# Copyright (C) 2007 Nigel Kukard <nkukard@lbsd.net>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with this program; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
package cbp::cache;
use strict;
use warnings;
require Exporter;
our (@ISA,@EXPORT);
@ISA = qw(Exporter);
@EXPORT = qw(
cacheStoreKeyPair
cacheStoreComplexKeyPair
cacheGetKeyPair
cacheGetComplexKeyPair
);
use Cache::FastMmap;
use Storable;
# Cache stuff
my $cache_type = "FastMmap";
my $cache;
# Our current error message
my $error = "";
# Set current error message
# Args: error_message
sub setError
{
my $err = shift;
my ($package,$filename,$line) = caller;
my (undef,undef,undef,$subroutine) = caller(1);
# Set error
$error = "$subroutine($line): $err";
}
# Return current error message
# Args: none
sub Error
{
my $err = $error;
# Reset error
$error = "";
# Return error
return $err;
}
# Initialize cache
sub Init
{
my $server = shift;
my $ch;
# Create Cache
$ch = Cache::FastMmap->new(
'page_size' => 2048,
'num_pages' => 1000,
'expire_time' => 300,
'raw_values' => 1,
'unlink_on_exit' => 1,
);
# Stats
$ch->set('Cache/Stats/Hit',0);
$ch->set('Cache/Stats/Miss',0);
# Set server vars
$server->{'cache_engine'}{'handle'} = $ch;
};
# Destroy cache
sub Destroy
{
my $server = shift;
};
# Connect child to cache
sub connect
{
my $server = shift;
$cache = $server->{'cache_engine'}{'handle'};
}
# Disconnect child from cache
sub disconnect
{
my $server = shift;
}
# Store keypair in cache
# Parameters:
# CacheName - Name of cache we storing things in
# Key - Item key
# Value - Item value
sub cacheStoreKeyPair
{
my ($cacheName,$key,$value) = @_;
if (!defined($cacheName)) {
setError("Cache name not defined in store");
return -1;
}
if (!defined($key)) {
setError("Key not defined for cache '$cacheName' store");
return -1;
}
if (!defined($value)) {
setError("Value not defined for cache '$cacheName' key '$key' store");
return -1;
}
# If we're not caching just return
return 0 if ($cache_type eq 'none');
# Store
$cache->set("$cacheName/$key",$value);
return 0;
}
# Get data from key in cache
# Parameters:
# CacheName - Name of cache we storing things in
# Key - Item key
sub cacheGetKeyPair
{
my ($cacheName,$key) = @_;
if (!defined($cacheName)) {
setError("Cache name not defined in get");
return (-1);
}
if (!defined($key)) {
setError("Key not defined for cache '$cacheName' get");
return (-1);
}
# If we're not caching just return
if ($cache_type eq 'none') {
return (0,undef);
}
# Check and count
my $res = $cache->get("$cacheName/$key");
if ($res) {
$cache->get_and_set('Cache/Stats/Hit',sub { return ++$_[1]; });
} else {
$cache->get_and_set('Cache/Stats/Miss',sub { return ++$_[1]; });
}
return (0,$res);
}
# Store a complex item
# Parameters:
# CacheName - Name of cache we storing things in
# Key - Item key
# Value - Item value
sub cacheStoreComplexKeyPair
{
my ($cacheName,$key,$value) = @_;
my $rawValue = Storable::freeze($value);
if (!defined($rawValue)) {
setError("Unable to freeze cache value in '$cacheName'");
return -1;
}
return cacheStoreKeyPair($cacheName,$key,$rawValue);
}
# Get a complex item
# Parameters:
# CacheName - Name of cache we storing things in
# Key - Item key
sub cacheGetComplexKeyPair
{
my ($cacheName,$key) = @_;
my ($res,$rawValue) = cacheGetKeyPair($cacheName,$key);
# Thaw out item, if there is no error and we are defined
if (!$res && defined($rawValue)) {
$rawValue = Storable::thaw($rawValue);
}
return ($res,$rawValue);
}
# Return cache hit ratio
sub getHitRatio
{
my $res;
# Get counter
$res = defined($cache->get('Cache/Stats/Hit')) ? $cache->get('Cache/Stats/Hit') : 0;
return $res;
}
# Return cache miss ratio
sub getMissRatio
{
my $res;
# Get counter
$res = defined($cache->get('Cache/Stats/Miss')) ? $cache->get('Cache/Stats/Miss') : 0;
return $res;
}
1;
# vim: ts=4
# Database independent layer module
# Copyright (C) 2009, AllWorldIT
# Copyright (C) 2008, LinuxRulz
# Copyright (C) 2005-2007 Nigel Kukard <nkukard@lbsd.net>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with this program; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
package cbp::dbilayer;
use strict;
use warnings;
use cbp::config;
use DBI;
my $internalError = "";
sub internalErr
{
my $error = $internalError;
$internalError = "";
return $error;
}
# Initialize class and return a fully connected object
sub Init
{
my $server = shift;
my $dbconfig = $server->{'cbp'}->{'database'};
# Check if we created
my $dbh = cbp::dbilayer->new($dbconfig->{'DSN'},$dbconfig->{'Username'},$dbconfig->{'Password'},
$dbconfig->{'TablePrefix'});
return undef if (!defined($dbh));
return $dbh;
}
# Constructor
sub new
{
my ($class,$dsn,$username,$password,$table_prefix) = @_;
# Iternals
my $self = {
_type => undef,
_dbh => undef,
_error => undef,
_dsn => undef,
_username => undef,
_password => undef,
_table_prefix => "",
_in_transaction => undef,
};
# Set database parameters
if (defined($dsn)) {
$self->{_dsn} = $dsn;
$self->{_username} = $username;
$self->{_password} = $password;
$self->{_table_prefix} = $table_prefix if (defined($table_prefix) && $table_prefix ne "");
} else {
$internalError = "Invalid DSN given";
return undef;
}
# Try grab database type
$self->{_dsn} =~ /^DBI:([^:]+):/i;
$self->{_type} = (defined($1) && $1 ne "") ? lc($1) : "unknown";
# Create...
bless $self, $class;
return $self;
}
# Return current error message
# Args: none
sub Error
{
my ($self) = @_;
my $err = $self->{_error};
# Reset error
$self->{_error} = "";
# Return error
return $err;
}
# Return connection to database
# Args: none
sub connect
{
my ($self) = @_;
$self->{_dbh} = DBI->connect($self->{_dsn}, $self->{_username}, $self->{_password}, {
'AutoCommit' => 1,
'PrintError' => 0,
'FetchHashKeyName' => 'NAME_lc'
});
# Connect to database if we have to, check if we ok
if (!$self->{_dbh}) {
$self->{_error} = "Error connecting to database: $DBI::errstr";
return -1;
}
# Apon connect we are not in a transaction
$self->{_in_transaction} = 0;
return 0;
}
# Return database type
# Args: none
sub type
{
my $self = shift;
return $self->{_type};
}
# Check database connection
# Args: none
sub _check
{
my $self = shift;
# If we not in a transaction try connect
if ($self->{_in_transaction} == 0) {
# Try ping
if (!$self->{_dbh}->ping()) {
# Disconnect & reconnect
$self->{_dbh}->disconnect();
$self->connect();
}
}
}
# Return database selection results...
# Args: <select statement>
sub select
{
my ($self,$query,@params) = @_;
$self->_check();
# # Build single query instead of using binding of params
# # not all databases support binding, and not all support all
# # the places we use ?
# $query =~ s/\?/%s/g;
# # Map each element in params to the quoted value
# $query = sprintf($query,
# map { $self->quote($_) } @params
# );
#use Data::Dumper; print STDERR Dumper($query);
# Prepare query
my $sth;
if (!($sth = $self->{_dbh}->prepare($query))) {
$self->{_error} = $self->{_dbh}->errstr;
return undef;
}
# Check for execution error
# if (!$sth->execute()) {
if (!$sth->execute(@params)) {
$self->{_error} = $self->{_dbh}->errstr;
return undef;
}
return $sth;
}
# Perform a command
# Args: <command statement>
sub do
{
my ($self,$command,@params) = @_;
$self->_check();
# # Build single command instead of using binding of params
# # not all databases support binding, and not all support all
# # the places we use ?
# $command =~ s/\?/%s/g;
# # Map each element in params to the quoted value
# $command = sprintf($command,
# map { $self->quote($_) } @params
# );
#use Data::Dumper; print STDERR Dumper($command);
# Prepare query
my $sth;
# if (!($sth = $self->{_dbh}->do($command))) {
if (!($sth = $self->{_dbh}->do($command,undef,@params))) {
$self->{_error} = $self->{_dbh}->errstr;
return undef;
}
return $sth;
}
# Function to get last insert id
# Args: <table> <column>
sub lastInsertID
{
my ($self,$table,$column) = @_;
# Get last insert id
my $res;
if (!($res = $self->{_dbh}->last_insert_id(undef,undef,$table,$column))) {
$self->{_error} = $self->{_dbh}->errstr;
return undef;
}
return $res;
}
# Function to begin a transaction
# Args: none
sub begin
{
my ($self) = @_;
$self->_check();
$self->{_in_transaction}++;
# Don't really start transaction if we more than 1 deep
if ($self->{_in_transaction} > 1) {
return 1;
}
# Begin
my $res;
if (!($res = $self->{_dbh}->begin_work())) {
$self->{_error} = $self->{_dbh}->errstr;
return undef;
}
return $res;
}
# Function to commit a transaction
# Args: none
sub commit
{
my ($self) = @_;
# Reduce level
$self->{_in_transaction}--;
# If we not at top level, return success
if ($self->{_in_transaction} > 0) {
return 1;
}
# Reset transaction depth to 0
$self->{_in_transaction} = 0;
# Commit
my $res;
if (!($res = $self->{_dbh}->commit())) {
$self->{_error} = $self->{_dbh}->errstr;
return undef;
}
return $res;
}
# Function to rollback a transaction
# Args: none
sub rollback
{
my ($self) = @_;
# If we at top level, return success
if ($self->{_in_transaction} < 1) {
return 1;
}
$self->{_in_transaction} = 0;
# Rollback
my $res;
if (!($res = $self->{_dbh}->rollback())) {
$self->{_error} = $self->{_dbh}->errstr;
return undef;
}
return $res;
}
# Function to quote a database variable
# Args: <stuff to quote>
sub quote
{
my ($self,$stuff) = @_;
return $self->{_dbh}->quote($stuff);
}
# Function to cleanup DB query
# Args: <sth>
sub free
{
my ($self,$sth) = @_;
if ($sth) {
$sth->finish();
}
}
# Function to return the table prefix
sub table_prefix