/*
* Update some rows in the specified table
* _h: structure representing database connection
* _k: key names
* _o: operators
* _v: values of the keys that must match
* _uk: updated columns
* _uv: updated values of the columns
* _n: number of key=value pairs
* _un: number of columns to update
*/
int perlvdb_db_update(db_con_t* h, db_key_t* k, db_op_t* o, db_val_t* v,
db_key_t* uk, db_val_t* uv, int n, int un) {
AV *condarr;
AV *updatearr;
SV *condarrref;
SV *updatearrref;
SV *ret;
condarr = conds2perlarray(k, o, v, n);
updatearr = pairs2perlarray(uk, uv, un);
condarrref = newRV_noinc((SV*)condarr);
updatearrref = newRV_noinc((SV*)updatearr);
ret = perlvdb_perlmethod(getobj(h), PERL_VDB_UPDATEMETHOD,
condarrref, updatearrref, NULL, NULL);
av_undef(condarr);
av_undef(updatearr);
return IV2int(ret);
}
/*
* Query table for specified rows
* h: structure representing database connection
* k: key names
* op: operators
* v: values of the keys that must match
* c: column names to return
* n: number of key=values pairs to compare
* nc: number of columns to return
* o: order by the specified column
*/
int perlvdb_db_query(db_con_t* h, db_key_t* k, db_op_t* op, db_val_t* v,
db_key_t* c, int n, int nc,
db_key_t o, db_res_t** r) {
AV *condarr;
AV *retkeysarr;
SV *order;
SV *condarrref;
SV *retkeysref;
SV *resultset;
int retval = 0;
/* Create parameter set */
condarr = conds2perlarray(k, op, v, n);
retkeysarr = keys2perlarray(c, nc);
if (o) order = newSVpv(o, 0);
else order = &PL_sv_undef;
condarrref = newRV_noinc((SV*)condarr);
retkeysref = newRV_noinc((SV*)retkeysarr);
/* Call perl method */
resultset = perlvdb_perlmethod(getobj(h), PERL_VDB_QUERYMETHOD,
condarrref, retkeysref, order, NULL);
av_undef(condarr);
av_undef(retkeysarr);
/* Transform perl result set to OpenSER result set */
if (!resultset) {
/* No results. */
LM_ERR("no perl result set.\n");
retval = -1;
} else {
if (sv_isa(resultset, "OpenSER::VDB::Result")) {
retval = perlresult2dbres(resultset, r);
/* Nested refs are decreased/deleted inside the routine */
SvREFCNT_dec(resultset);
} else {
LM_ERR("invalid result set retrieved from perl call.\n");
retval = -1;
}
}
return retval;
}
/*
* Delete a row from the specified table
* h: structure representing database connection
* k: key names
* o: operators
* v: values of the keys that must match
* n: number of key=value pairs
*/
int perlvdb_db_delete(db_con_t* h, db_key_t* k, db_op_t* o, db_val_t* v,
int n) {
AV *arr;
SV *arrref;
SV *ret;
arr = conds2perlarray(k, o, v, n);
arrref = newRV_noinc((SV*)arr);
ret = perlvdb_perlmethod(getobj(h), PERL_VDB_DELETEMETHOD,
arrref, NULL, NULL, NULL);
av_undef(arr);
return IV2int(ret);
}
/*
* Insert a row into specified table
* h: structure representing database connection
* k: key names
* v: values of the keys
* n: number of key=value pairs
*/
int perlvdb_db_insertreplace(db_con_t* h, db_key_t* k, db_val_t* v,
int n, char *insertreplace) {
AV *arr;
SV *arrref;
SV *ret;
arr = pairs2perlarray(k, v, n);
arrref = newRV_noinc((SV*)arr);
ret = perlvdb_perlmethod(getobj(h), insertreplace,
arrref, NULL, NULL, NULL);
av_undef(arr);
return IV2int(ret);
}
bool KviPerlInterpreter::execute(
const QString &szCode,
QStringList &args,
QString &szRetVal,
QString &szError,
QStringList &lWarnings)
{
if(!m_pInterpreter)
{
szError = __tr2qs_ctx("Internal error: perl interpreter not initialized","perl");
return false;
}
g_lWarningList.clear();
QByteArray szUtf8 = szCode.toUtf8();
PERL_SET_CONTEXT(m_pInterpreter);
// clear the _ array
AV * pArgs = get_av("_",1);
SV * pArg = av_shift(pArgs);
while(SvOK(pArg))
{
SvREFCNT_dec(pArg);
pArg = av_shift(pArgs);
}
if(args.count() > 0)
{
// set the args in the _ arry
av_unshift(pArgs,(I32)args.count());
int idx = 0;
for(QStringList::Iterator it = args.begin();it != args.end();++it)
{
QString tmp = *it;
const char * val = tmp.toUtf8().data();
if(val)
{
pArg = newSVpv(val,tmp.length());
if(!av_store(pArgs,idx,pArg))
SvREFCNT_dec(pArg);
}
idx++;
}
}
// call the code
SV * pRet = eval_pv(szUtf8.data(),false);
// clear the _ array again
pArgs = get_av("_",1);
pArg = av_shift(pArgs);
while(SvOK(pArg))
{
SvREFCNT_dec(pArg);
pArg = av_shift(pArgs);
}
av_undef(pArgs);
// get the ret value
if(pRet)
{
if(SvOK(pRet))
szRetVal = svToQString(pRet);
}
if(!g_lWarningList.isEmpty())
lWarnings = g_lWarningList;
// and the eventual error string
pRet = get_sv("@",false);
if(pRet)
{
if(SvOK(pRet))
{
szError = svToQString(pRet);
if(!szError.isEmpty())return false;
}
}
return true;
}
int perlresult2dbres(SV *perlres, db1_res_t **r) {
SV *colarrayref = NULL;
AV *colarray = NULL;
SV *acol = NULL;
int colcount = 0;
SV *rowarrayref = NULL;
AV *rowarray = NULL;
int rowcount = 0;
SV *arowref = NULL;
AV *arow = NULL;
int arowlen = 0;
SV *aelement = NULL;
SV *atypesv = 0;
int atype = 0;
SV *aval = NULL;
char *charbuf;
char *currentstring;
int i, j;
int retval = 0;
STRLEN len;
SV *d1; /* helper variables */
/*db_val_t cur_val;*/ /* Abbreviation in "switch" below. The currently
modified db result value. */
if (!(SvROK(perlres) &&
(sv_derived_from(perlres, "Kamailio::VDB::Result")))) {
goto error;
}
/* Memory allocation for C side result structure */
*r = (db1_res_t *)pkg_malloc(sizeof(db1_res_t));
if (!(*r)) {
LM_ERR("no pkg memory left\n");
return -1;
}
memset(*r, 0, sizeof(db1_res_t));
/* Fetch column definitions */
colarrayref = perlvdb_perlmethod(perlres, PERL_VDB_COLDEFSMETHOD,
NULL, NULL, NULL, NULL);
if (!(SvROK(colarrayref))) goto error;
colarray = (AV *)SvRV(colarrayref);
if (!(SvTYPE(colarray) == SVt_PVAV)) goto error;
colcount = av_len(colarray) + 1;
/* Allocate col def memory */
(*r)->col.n = colcount;
(*r)->col.types = (db_type_t*)pkg_malloc(colcount*sizeof(db_type_t));
(*r)->col.names = (db_key_t*)pkg_malloc(colcount*sizeof(db_key_t));
/* reverse direction, as elements are removed by "SvREFCNT_dec" */
for (i = colcount-1; i >= 0; i--) {
acol = *av_fetch(colarray, i, 0);
d1 = perlvdb_perlmethod(acol, PERL_VDB_TYPEMETHOD,
NULL, NULL, NULL, NULL);
if (!SvIOK(d1)) goto error;
(*r)->col.types[i] = SvIV(d1);
SvREFCNT_dec(d1);
d1 = perlvdb_perlmethod(acol, PERL_VDB_NAMEMETHOD,
NULL, NULL, NULL, NULL);
if (!SvPOK(d1)) goto error;
currentstring = SvPV(d1, len);
charbuf = pkg_malloc(len+1);
strncpy(charbuf, currentstring, len+1);
(*r)->col.names[i]->s = charbuf;
(*r)->col.names[i]->len = strlen(charbuf);
SvREFCNT_dec(d1);
}
rowarrayref = perlvdb_perlmethod(perlres, PERL_VDB_ROWSMETHOD,
NULL, NULL, NULL, NULL);
if (!(SvROK(rowarrayref))) { /* Empty result set */
(*r)->n = 0;
(*r)->res_rows = 0;
(*r)->last_row = 0;
goto end;
}
rowarray = (AV *)SvRV(rowarrayref);
if (!(SvTYPE(rowarray) == SVt_PVAV)) goto error;
rowcount = av_len(rowarray) + 1;
(*r)->n = rowcount;
(*r)->res_rows = rowcount;
(*r)->last_row = rowcount;
(*r)->rows = (db_row_t *)pkg_malloc(rowcount*sizeof(db_row_t));
for (i = 0; i < rowcount; i++) {
arowref = *av_fetch(rowarray, 0, 0);
if (!SvROK(arowref)) goto error;
arow = (AV *)SvRV(arowref);
if (!(SvTYPE(colarray) == SVt_PVAV)) goto error;
arowlen = av_len(arow) + 1;
(*r)->rows[i].n = arowlen;
(*r)->rows[i].values =
(db_val_t *)pkg_malloc(arowlen*sizeof(db_val_t));
for (j = 0; j < arowlen; j++) {
aelement = *av_fetch(arow, j, 0);
#define cur_val (((*r)->rows)[i].values)[j]
/*cur_val = (((*r)->rows)[i].values)[j];*/
/* cur_val is just an "abbreviation" */
if (!(sv_isobject(aelement) &&
sv_derived_from(aelement, PERL_CLASS_VALUE))) {
cur_val.nul = 1;
continue;
}
atype = SvIV(atypesv = perlvdb_perlmethod(aelement,
PERL_VDB_TYPEMETHOD,
NULL, NULL, NULL, NULL));
aval = perlvdb_perlmethod(aelement, PERL_VDB_DATAMETHOD,
NULL, NULL, NULL, NULL);
(*r)->rows[i].values[j].type = atype;
if (!SvOK(aval)) {
cur_val.nul = 1;
} else {
switch (atype) {
case DB1_INT:
cur_val.val.int_val =
SvIV(aval);
cur_val.nul = 0;
break;
case DB1_DOUBLE:
cur_val.val.double_val =
SvNV(aval);
cur_val.nul = 0;
break;
case DB1_STRING:
case DB1_STR:
/* We dont support DB1_STR for now.
* Set DB1_STRING instead */
cur_val.type = DB1_STRING;
currentstring = SvPV(aval, len);
charbuf = pkg_malloc(len+1);
strncpy(charbuf, currentstring,
len+1);
cur_val.val.string_val =
charbuf;
cur_val.nul = 0;
break;
case DB1_DATETIME:
cur_val.val.time_val =
(time_t)SvIV(aval);
cur_val.nul = 0;
break;
case DB1_BLOB:
currentstring = SvPV(aval, len);
charbuf = pkg_malloc(len+1);
strncpy(charbuf, currentstring,
len+1);
cur_val.val.blob_val.s =
charbuf;
cur_val.val.blob_val.len = len;
cur_val.nul = 0;
break;
case DB1_BITMAP:
cur_val.val.bitmap_val =
SvIV(aval);
cur_val.nul = 0;
break;
default:
LM_CRIT("cannot handle this data type.\n");
return -1;
break;
}
}
SvREFCNT_dec(atypesv);
SvREFCNT_dec(aval);
}
}
end:
av_undef(colarray);
av_undef(rowarray);
return retval;
error:
LM_CRIT("broken result set. Exiting, leaving Kamailio in unknown state.\n");
return -1;
}
int perl_trapd_handler( netsnmp_pdu *pdu,
netsnmp_transport *transport,
netsnmp_trapd_handler *handler)
{
trapd_cb_data *cb_data;
SV *pcallback;
netsnmp_variable_list *vb;
netsnmp_oid *o;
SV *arg;
SV *rarg;
SV **tmparray;
int i, c = 0;
u_char *outbuf;
size_t ob_len = 0, oo_len = 0;
AV *varbinds;
HV *pduinfo;
dSP;
ENTER;
SAVETMPS;
if (!pdu || !handler)
return 0;
/* nuke v1 PDUs */
if (pdu->command == SNMP_MSG_TRAP)
pdu = convert_v1pdu_to_v2(pdu);
cb_data = handler->handler_data;
if (!cb_data || !cb_data->perl_cb)
return 0;
pcallback = cb_data->perl_cb;
/* get PDU related info */
pduinfo = newHV();
#define STOREPDU(n, v) hv_store(pduinfo, n, strlen(n), v, 0)
#define STOREPDUi(n, v) STOREPDU(n, newSViv(v))
#define STOREPDUs(n, v) STOREPDU(n, newSVpv(v, 0))
STOREPDUi("version", pdu->version);
STOREPDUs("notificationtype", ((pdu->command == SNMP_MSG_INFORM) ? "INFORM":"TRAP"));
STOREPDUi("requestid", pdu->reqid);
STOREPDUi("messageid", pdu->msgid);
STOREPDUi("transactionid", pdu->transid);
STOREPDUi("errorstatus", pdu->errstat);
STOREPDUi("errorindex", pdu->errindex);
if (pdu->version == 3) {
STOREPDUi("securitymodel", pdu->securityModel);
STOREPDUi("securitylevel", pdu->securityLevel);
STOREPDU("contextName",
newSVpv(pdu->contextName, pdu->contextNameLen));
STOREPDU("contextEngineID",
newSVpv(pdu->contextEngineID,
pdu->contextEngineIDLen));
STOREPDU("securityEngineID",
newSVpv(pdu->securityEngineID,
pdu->securityEngineIDLen));
STOREPDU("securityName",
newSVpv(pdu->securityName, pdu->securityNameLen));
} else {
STOREPDU("community",
newSVpv(pdu->community, pdu->community_len));
}
if (transport && transport->f_fmtaddr) {
char *tstr = transport->f_fmtaddr(transport, pdu->transport_data,
pdu->transport_data_length);
STOREPDUs("receivedfrom", tstr);
free(tstr);
}
/*
* collect OID objects in a temp array first
*/
/* get VARBIND related info */
i = count_varbinds(pdu->variables);
tmparray = malloc(sizeof(*tmparray) * i);
for(vb = pdu->variables; vb; vb = vb->next_variable) {
/* get the oid */
o = SNMP_MALLOC_TYPEDEF(netsnmp_oid);
o->name = o->namebuf;
o->len = vb->name_length;
memcpy(o->name, vb->name, vb->name_length * sizeof(oid));
#undef CALL_EXTERNAL_OID_NEW
#ifdef CALL_EXTERNAL_OID_NEW
PUSHMARK(sp);
rarg = sv_2mortal(newSViv((IV) 0));
arg = sv_2mortal(newSVrv(rarg, "netsnmp_oidPtr"));
sv_setiv(arg, (IV) o);
XPUSHs(rarg);
PUTBACK;
i = perl_call_pv("NetSNMP::OID::newwithptr", G_SCALAR);
SPAGAIN;
if (i != 1) {
snmp_log(LOG_ERR, "unhandled OID error.\n");
/* ack XXX */
}
/* get the value */
tmparray[c++] = POPs;
SvREFCNT_inc(tmparray[c-1]);
PUTBACK;
#else /* build it and bless ourselves */
{
HV *hv = newHV();
SV *rv = newRV_noinc((SV *) hv);
SV *rvsub = newRV_noinc((SV *) newSViv((UV) o));
SV *sv;
rvsub = sv_bless(rvsub, gv_stashpv("netsnmp_oidPtr", 1));
hv_store(hv, "oidptr", 6, rvsub, 0);
rv = sv_bless(rv, gv_stashpv("NetSNMP::OID", 1));
tmparray[c++] = rv;
}
#endif /* build oid ourselves */
}
/*
* build the varbind lists
*/
varbinds = newAV();
for(vb = pdu->variables, i = 0; vb; vb = vb->next_variable, i++) {
/* push the oid */
AV *vba;
vba = newAV();
/* get the value */
outbuf = NULL;
ob_len = 0;
oo_len = 0;
sprint_realloc_by_type(&outbuf, &ob_len, &oo_len, 1,
vb, 0, 0, 0);
av_push(vba,tmparray[i]);
av_push(vba,newSVpvn(outbuf, oo_len));
free(outbuf);
av_push(vba,newSViv(vb->type));
av_push(varbinds, (SV *) newRV_noinc((SV *) vba));
}
PUSHMARK(sp);
/* store the collected information on the stack */
XPUSHs(sv_2mortal(newRV_noinc((SV*) pduinfo)));
XPUSHs(sv_2mortal(newRV_noinc((SV*) varbinds)));
/* put the stack back in order */
PUTBACK;
/* actually call the callback function */
if (SvTYPE(pcallback) == SVt_PVCV) {
perl_call_sv(pcallback, G_DISCARD);
/* XXX: it discards the results, which isn't right */
} else if (SvROK(pcallback) && SvTYPE(SvRV(pcallback)) == SVt_PVCV) {
/* reference to code */
perl_call_sv(SvRV(pcallback), G_DISCARD);
} else {
snmp_log(LOG_ERR, " tried to call a perl function but failed to understand its type: (ref = %x, svrok: %lu, SVTYPE: %lu)\n", (uintptr_t)pcallback, SvROK(pcallback), SvTYPE(pcallback));
}
#ifdef DUMPIT
fprintf(stderr, "DUMPDUMPDUMPDUMPDUMPDUMP\n");
sv_dump(pduinfo);
fprintf(stderr, "--------------------\n");
sv_dump(varbinds);
#endif
/* svREFCNT_dec((SV *) pduinfo); */
#ifdef NOT_THIS
{
SV *vba;
while(vba = av_pop(varbinds)) {
av_undef((AV *) vba);
}
}
av_undef(varbinds);
#endif
free(tmparray);
/* Not needed because of the G_DISCARD flag (I think) */
/* SPAGAIN; */
/* PUTBACK; */
#ifndef __x86_64__
FREETMPS; /* FIXME: known to cause a segfault on x86-64 */
#endif
LEAVE;
return NETSNMPTRAPD_HANDLER_OK;
}
