static int init_pool (CONF_SECTION *conf, PERL_INST *inst) {
POOL_HANDLE *handle;
int t;
PERL_POOL *pool;
pool = rad_malloc(sizeof(PERL_POOL));
memset(pool,0,sizeof(PERL_POOL));
inst->perl_pool = pool;
MUTEX_INIT(&pool->mutex);
/*
* Read The Config
*
*/
cf_section_parse(conf,pool,pool_conf);
inst->perl_pool = pool;
inst->perl_pool->detach = no;
for(t = 0;t < inst->perl_pool->start_clones ;t++){
if ((handle = pool_grow(inst)) == NULL) {
return -1;
}
}
return 1;
}
static unsigned long long
profile_palloc_single_chars(const unsigned long iterations)
{
struct timeval start;
struct timeval stop;
pool_reference char_ref_pool = pool_create(CHAR_REF_TYPE_ID);
pool_reference char_pool = pool_create(CHAR_TYPE_ID);
pool_grow(&char_ref_pool, iterations);
global_reference *char_refs = pool_to_array(char_ref_pool);
gettimeofday(&start, NULL);
for (unsigned long i = 0 ; i < iterations ; ++i) {
char_refs[i] = pool_alloc(&char_pool);
}
gettimeofday(&stop, NULL);
pool_destroy(&char_ref_pool);
pool_destroy(&char_pool);
return ((stop.tv_sec - start.tv_sec) * 1000000LLU) +
stop.tv_usec - start.tv_usec;
}
static POOL_HANDLE *pool_pop(PERL_INST *inst)
{
POOL_HANDLE *handle;
POOL_HANDLE *found;
POOL_HANDLE *tmp;
/*
* Lock the pool and be fast other thread maybe
* waiting for us to finish
*/
MUTEX_LOCK(&inst->perl_pool->mutex);
found = NULL;
for (handle = inst->perl_pool->head; handle ; handle = tmp) {
tmp = handle->next;
if (handle->status == idle){
found = handle;
break;
}
}
if (found == NULL) {
if (inst->perl_pool->current_clones < inst->perl_pool->max_clones ) {
found = pool_grow(inst);
if (found == NULL) {
radlog(L_ERR,"Cannot grow pool returning");
MUTEX_UNLOCK(&inst->perl_pool->mutex);
return NULL;
}
} else {
radlog(L_ERR,"rlm_perl:: reached maximum clones %d cannot grow",
inst->perl_pool->current_clones);
MUTEX_UNLOCK(&inst->perl_pool->mutex);
return NULL;
}
}
move2tail(found, inst);
found->status = busy;
MUTEX_LOCK(&found->lock);
inst->perl_pool->active_clones++;
found->request_count++;
/*
* Hurry Up
*/
MUTEX_UNLOCK(&inst->perl_pool->mutex);
radlog(L_DBG,"perl_pool: item 0x%lx asigned new request. Handled so far: %d",
(unsigned long) found->clone, found->request_count);
return found;
}
static unsigned long long
profile_palloc_dynarray(const unsigned long iterations)
{
struct timeval start;
struct timeval stop;
pool_reference char_pool_0 = pool_create(CHAR_TYPE_ID);
pool_reference char_pool_1 = pool_create(CHAR_TYPE_ID);
gettimeofday(&start, NULL);
for (unsigned long i = 0 ; i < iterations ; ++i) {
pool_grow(&char_pool_0, 1);
pool_grow(&char_pool_1, 1);
}
gettimeofday(&stop, NULL);
pool_destroy(&char_pool_0);
pool_destroy(&char_pool_1);
return ((stop.tv_sec - start.tv_sec) * 1000000LLU) +
stop.tv_usec - start.tv_usec;
}
static int pool_release(POOL_HANDLE *handle, PERL_INST *inst) {
POOL_HANDLE *tmp, *tmp2;
int spare, i, t;
time_t now;
/*
* Lock it
*/
MUTEX_LOCK(&inst->perl_pool->mutex);
/*
* If detach is set then just release the mutex
*/
if (inst->perl_pool->detach == yes ) {
handle->status = idle;
MUTEX_UNLOCK(&handle->lock);
MUTEX_UNLOCK(&inst->perl_pool->mutex);
return 0;
}
MUTEX_UNLOCK(&handle->lock);
handle->status = idle;
inst->perl_pool->active_clones--;
spare = inst->perl_pool->current_clones - inst->perl_pool->active_clones;
radlog(L_DBG,"perl_pool total/active/spare [%d/%d/%d]"
, inst->perl_pool->current_clones, inst->perl_pool->active_clones, spare);
if (spare < inst->perl_pool->min_spare_clones) {
t = inst->perl_pool->min_spare_clones - spare;
for (i=0;i<t; i++) {
if ((tmp = pool_grow(inst)) == NULL) {
MUTEX_UNLOCK(&inst->perl_pool->mutex);
return -1;
}
}
MUTEX_UNLOCK(&inst->perl_pool->mutex);
return 0;
}
now = time(NULL);
if ((now - inst->perl_pool->time_when_last_added) < inst->perl_pool->cleanup_delay) {
MUTEX_UNLOCK(&inst->perl_pool->mutex);
return 0;
}
if (spare > inst->perl_pool->max_spare_clones) {
spare -= inst->perl_pool->max_spare_clones;
for (tmp = inst->perl_pool->head; (tmp !=NULL ) && (spare > 0) ; tmp = tmp2) {
tmp2 = tmp->next;
if(tmp->status == idle) {
rlm_destroy_perl(tmp->clone);
delete_pool_handle(tmp,inst);
spare--;
break;
}
}
}
/*
* If the clone have reached max_request_per_clone clean it.
*/
if (inst->perl_pool->max_request_per_clone > 0 ) {
if (handle->request_count > inst->perl_pool->max_request_per_clone) {
rlm_destroy_perl(handle->clone);
delete_pool_handle(handle,inst);
}
}
/*
* Hurry Up :)
*/
MUTEX_UNLOCK(&inst->perl_pool->mutex);
return 0;
}
