void
purple_perl_plugin_action_cb(PurplePluginAction *action)
{
SV **callback;
HV *hv = NULL;
gchar *hvname;
PurplePlugin *plugin;
PurplePerlScript *gps;
dSP;
plugin = action->plugin;
gps = (PurplePerlScript *)plugin->info->extra_info;
hvname = g_strdup_printf("%s::plugin_actions", gps->package);
hv = get_hv(hvname, FALSE);
g_free(hvname);
if (hv == NULL)
croak("No plugin_actions hash found in \"%s\" plugin.", purple_plugin_get_name(plugin));
ENTER;
SAVETMPS;
callback = hv_fetch(hv, action->label, strlen(action->label), 0);
if (callback == NULL || *callback == NULL)
croak("No plugin_action function named \"%s\" in \"%s\" plugin.", action->label, purple_plugin_get_name(plugin));
PUSHMARK(sp);
XPUSHs(purple_perl_bless_object(gps->plugin, "Purple::Plugin"));
PUTBACK;
call_sv(*callback, G_EVAL | G_VOID | G_DISCARD);
SPAGAIN;
if (SvTRUE(ERRSV)) {
purple_debug_error("perl",
"Perl plugin action function exited abnormally: %s\n",
SvPVutf8_nolen(ERRSV));
}
PUTBACK;
FREETMPS;
LEAVE;
}
KHARON_DECL int
encode_get_type(void *data)
{
SV *in = data;
D(fprintf(stderr, "get_type = %p\n", in));
if (!SvOK(in))
return STATE_UNDEF;
if (SvROK(in)) {
switch (SvTYPE(SvRV(in))) {
case SVt_PVAV: return STATE_LIST;
case SVt_PVHV: return STATE_MAP;
/* XXXrcd: memory leaks, likely... */
case SVt_IV: croak("Trying to encode SVt_IV");
case SVt_NV: croak("Trying to encode SVt_NV");
case SVt_PV: croak("Trying to encode SVt_PV");
// case SVt_RV: croak("Trying to encode SVt_RV");
case SVt_PVCV: croak("Trying to encode SVt_PVCV");
case SVt_PVGV: croak("Trying to encode SVt_PVGV");
case SVt_PVMG: croak("Trying to encode SVt_PVMG");
default:
croak("Encode error: bad data type");
}
}
return STATE_SCALAR;
}
void read_page(UINT32 offset, UCHAR* page) {
// Note: -D_FILE_OFFSET_BITS=64 is required
UINT64 offs = offset;
offs *= FILER_PAGE;
fseek(m_in, offs , SEEK_SET);
UINT32 cnt = fread(page, 1, FILER_PAGE, m_in);
if (cnt != FILER_PAGE)
croak("Failed reading page index %d: %s", offset);
}
SV * newSVOpt(long value, char * optname, struct opts * o)
{
int i;
for(i=0;o[i].name;i++)
if (o[i].value == value)
return newSVpv(o[i].name, 0);
croak("invalid %s value %d", optname, value);
return NULL;
}
Point
Drawable_size ( Handle self, Bool set, Point size)
{
if ( set)
croak("Attempt to write read-only property %s", "Drawable::size");
size. x = var-> w;
size. y = var-> h;
return size;
}
void decode_varint(pTHX_ unsigned char *input, STRLEN len, struct cc_type *type, SV *output)
{
if (UNLIKELY(len <= 0)) {
croak("decode_varint: len <= 0");
} else if (len == 1) {
decode_tinyint(aTHX_ input, len, type, output);
} else if (len == 2) {
decode_smallint(aTHX_ input, len, type, output);
} else if (len == 3) {
unsigned char bytes[4];
memcpy(bytes+1, input, 3);
if (input[0] & 0x80) {
bytes[0] = 0xff;
} else {
bytes[0] = 0;
}
decode_int(aTHX_ bytes, 4, type, output);
} else if (len == 4) {
decode_int(aTHX_ input, len, type, output);
#ifdef CAN_64BIT
} else if (len < 8) {
unsigned char bytes[8];
memset(bytes, (input[0] & 0x80) ? 0xff : 0, 8);
memcpy(bytes+8-len, input, len);
decode_bigint(aTHX_ bytes, 8, type, output);
} else if (len == 8) {
decode_bigint(aTHX_ input, len, type, output);
#endif
} else {
unsigned char *tmp;
char *tmpout;
struct cc_bignum bn;
int i;
Newxz(tmpout, (len*4)+2, char);
if (!IS_BIG_ENDIAN) {
Newxz(tmp, len, unsigned char);
for (i = 0; i < len; i++) {
tmp[len-i-1] = (unsigned char)input[i];
}
} else {
tmp = input;
}
cc_bignum_init_bytes(&bn, tmp, len);
cc_bignum_stringify(&bn, tmpout, (len*4)+2);
sv_setpv(output, tmpout);
cc_bignum_destroy(&bn);
if (!IS_BIG_ENDIAN) {
Safefree(tmp);
}
Safefree(tmpout);
}
}
srl_iterator_t *
srl_build_iterator_struct(pTHX_ HV *opt)
{
srl_iterator_t *iter = NULL;
Newx(iter, 1, srl_iterator_t);
if (iter == NULL) croak("Out of memory");
srl_init_iterator(aTHX_ iter, opt);
return iter;
}
static PurpleCmdRet
perl_cmd_cb(PurpleConversation *conv, const gchar *command,
gchar **args, gchar **error, void *data)
{
int i = 0, count, ret_value = PURPLE_CMD_RET_OK;
SV *cmdSV, *tmpSV, *convSV;
PurplePerlCmdHandler *handler = data;
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
/* Push the conversation onto the perl stack */
convSV = sv_2mortal(purple_perl_bless_object(conv, "Purple::Conversation"));
XPUSHs(convSV);
/* Push the command string onto the perl stack */
cmdSV = newSVpv(command, 0);
cmdSV = sv_2mortal(cmdSV);
XPUSHs(cmdSV);
/* Push the data onto the perl stack */
XPUSHs((SV *)handler->data);
/* Push any arguments we may have */
for (i = 0; args[i] != NULL; i++) {
/* XXX The mortality of these created SV's should prevent
* memory issues, if I read/understood everything correctly...
*/
tmpSV = newSVpv(args[i], 0);
tmpSV = sv_2mortal(tmpSV);
XPUSHs(tmpSV);
}
PUTBACK;
count = call_sv(handler->callback, G_EVAL | G_SCALAR);
if (count != 1)
croak("call_sv: Did not return the correct number of values.\n");
if (SvTRUE(ERRSV)) {
purple_debug_error("perl",
"Perl plugin command function exited abnormally: %s\n",
SvPVutf8_nolen(ERRSV));
}
SPAGAIN;
ret_value = POPi;
PUTBACK;
FREETMPS;
LEAVE;
return ret_value;
}
void *
buffer_append_space(Buffer *buffer, uint32_t len)
{
uint32_t newlen;
void *p;
if (len > BUFFER_MAX_CHUNK)
croak("buffer_append_space: len %u too large (max %u)", len, BUFFER_MAX_CHUNK);
/* If the buffer is empty, start using it from the beginning. */
if (buffer->offset == buffer->end) {
buffer->offset = 0;
buffer->end = 0;
}
restart:
/* If there is enough space to store all data, store it now. */
if (buffer->end + len <= buffer->alloc) {
p = buffer->buf + buffer->end;
buffer->end += len;
return p;
}
/* Compact data back to the start of the buffer if necessary */
if (buffer_compact(buffer))
goto restart;
/* Increase the size of the buffer and retry. */
if (buffer->alloc + len < 4096)
newlen = (buffer->alloc + len) * 2;
else
newlen = buffer->alloc + len + 4096;
if (newlen > BUFFER_MAX_LEN)
croak("buffer_append_space: alloc %u too large (max %u)",
newlen, BUFFER_MAX_LEN);
#ifdef XS_DEBUG
PerlIO_printf(PerlIO_stderr(), "Buffer extended to %d\n", newlen);
#endif
Renew(buffer->buf, (int)newlen, u_char);
buffer->alloc = newlen;
goto restart;
/* NOTREACHED */
}
void
perl_mongo_sv_to_bson (bson_t * bson, SV *sv, HV *opts) {
if (!SvROK (sv)) {
croak ("not a reference");
}
if ( ! sv_isobject(sv) ) {
switch ( SvTYPE(SvRV(sv)) ) {
case SVt_PVHV:
hvdoc_to_bson (bson, sv, opts, EMPTY_STACK);
break;
case SVt_PVAV:
avdoc_to_bson(bson, sv, opts, EMPTY_STACK);
break;
default:
sv_dump(sv);
croak ("type unhandled");
}
}
else {
SV *obj;
char *class;
obj = SvRV(sv);
class = HvNAME(SvSTASH(obj));
if ( strEQ(class, "Tie::IxHash") ) {
ixhashdoc_to_bson(bson, sv, opts, EMPTY_STACK);
}
else if ( strEQ(class, "MongoDB::BSON::_EncodedDoc") ) {
STRLEN str_len;
SV **svp;
SV *encoded;
const char *bson_str;
bson_t *child;
encoded = _hv_fetchs_sv((HV *)obj, "bson");
bson_str = SvPV(encoded, str_len);
child = bson_new_from_data((uint8_t*) bson_str, str_len);
bson_concat(bson, child);
bson_destroy(child);
}
else if (SvTYPE(obj) == SVt_PVHV) {
static void xs_getnameinfo(pTHX_ CV *cv)
{
dVAR;
dXSARGS;
SV *addr;
int flags;
char host[1024];
char serv[256];
char *sa; /* we'll cast to struct sockaddr * when necessary */
STRLEN addr_len;
int err;
if(items < 1 || items > 2)
croak_xs_usage(cv, "addr, flags=0");
SP -= items;
addr = ST(0);
if(items < 2)
flags = 0;
else
flags = SvIV(ST(1));
if(!SvPOK(addr))
croak("addr is not a string");
addr_len = SvCUR(addr);
/* We need to ensure the sockaddr is aligned, because a random SvPV might
* not be due to SvOOK */
Newx(sa, addr_len, char);
Copy(SvPV_nolen(addr), sa, addr_len, char);
#ifdef HAS_SOCKADDR_SA_LEN
((struct sockaddr *)sa)->sa_len = addr_len;
#endif
err = getnameinfo((struct sockaddr *)sa, addr_len,
host, sizeof(host),
serv, sizeof(serv),
flags);
Safefree(sa);
XPUSHs(err_to_SV(aTHX_ err));
if(err)
XSRETURN(1);
XPUSHs(sv_2mortal(newSVpv(host, 0)));
XPUSHs(sv_2mortal(newSVpv(serv, 0)));
XSRETURN(3);
}
guint32 amglue_SvU32(SV *sv)
{
guint64 v64 = amglue_SvU64(sv);
if (v64 > G_MAXUINT32) {
croak("Expected a 32-bit unsigned integer; value out of range");
return 0;
} else {
return (guint32)v64;
}
}
gint32 amglue_SvI32(SV *sv)
{
gint64 v64 = amglue_SvI64(sv);
if (v64 < G_MININT32 || v64 > G_MAXINT32) {
croak("Expected a 32-bit integer; value out of range");
return 0;
} else {
return (gint32)v64;
}
}
guint8 amglue_SvU8(SV *sv)
{
guint64 v64 = amglue_SvU64(sv);
if (v64 > G_MAXUINT8) {
croak("Expected a 8-bit unsigned integer; value out of range");
return 0;
} else {
return (guint8)v64;
}
}
void decode_boolean(pTHX_ unsigned char *input, STRLEN len, struct cc_type *type, SV *output)
{
if (UNLIKELY(len != 1))
croak("decode_boolean: len != 1");
if (*input)
sv_setsv(output, &PL_sv_yes);
else
sv_setsv(output, &PL_sv_no);
}
guint16 amglue_SvU16(SV *sv)
{
guint64 v64 = amglue_SvU64(sv);
if (v64 > G_MAXUINT16) {
croak("Expected a 16-bit unsigned integer; value out of range");
return 0;
} else {
return (guint16)v64;
}
}
gint8 amglue_SvI8(SV *sv)
{
gint64 v64 = amglue_SvI64(sv);
if (v64 < G_MININT8 || v64 > G_MAXINT8) {
croak("Expected a 8-bit integer; value out of range");
return 0;
} else {
return (gint8)v64;
}
}
gint16 amglue_SvI16(SV *sv)
{
gint64 v64 = amglue_SvI64(sv);
if (v64 < G_MININT16 || v64 > G_MAXINT16) {
croak("Expected a 16-bit integer; value out of range");
return 0;
} else {
return (gint16)v64;
}
}
static moment_t
THX_moment_with_day_of_week(pTHX_ const moment_t *mt, IV v) {
dt_t dt;
if (v < 1 || v > 7)
croak("Parameter 'day' is out of the range [1, 7]");
dt = moment_local_dt(mt);
return THX_moment_with_local_dt(aTHX_ mt, dt - (dt_dow(dt) - v));
}
/**********************************************************
*
* Bind
*
**********************************************************/
int
perl_back_bind(
Operation *op,
SlapReply *rs )
{
int count;
PerlBackend *perl_back = (PerlBackend *) op->o_bd->be_private;
/* allow rootdn as a means to auth without the need to actually
* contact the proxied DSA */
switch ( be_rootdn_bind( op, rs ) ) {
case SLAP_CB_CONTINUE:
break;
default:
return rs->sr_err;
}
PERL_SET_CONTEXT( PERL_INTERPRETER );
ldap_pvt_thread_mutex_lock( &perl_interpreter_mutex );
{
dSP; ENTER; SAVETMPS;
PUSHMARK(SP);
XPUSHs( perl_back->pb_obj_ref );
XPUSHs(sv_2mortal(newSVpv( op->o_req_dn.bv_val , 0)));
XPUSHs(sv_2mortal(newSVpv( op->orb_cred.bv_val , op->orb_cred.bv_len)));
PUTBACK;
count = call_method("bind", G_SCALAR);
SPAGAIN;
if (count != 1) {
croak("Big trouble in back_bind\n");
}
rs->sr_err = POPi;
PUTBACK; FREETMPS; LEAVE;
}
ldap_pvt_thread_mutex_unlock( &perl_interpreter_mutex );
Debug( LDAP_DEBUG_ANY, "Perl BIND returned 0x%04x\n", rs->sr_err, 0, 0 );
/* frontend will send result on success (0) */
if( rs->sr_err != LDAP_SUCCESS )
send_ldap_result( op, rs );
return ( rs->sr_err );
}
void
extract_text(struct image *img)
{
int y, x, sx;
CHAR *buf, *s;
struct rgb rgb;
struct component *c, *last_c = NULL;
int shape;
struct text *t, *last_t = NULL;
buf = malloc(sizeof(CHAR)*img->w);
if (!buf) croak(1, "extract_text:malloc(buf)");
for (y = 0; y < img->h; y++) {
last_c = NULL;
last_t = NULL;
for (x = 0; x < img->w; x++) {
s = buf;
sx = x;
while (img->d[y][x] != ' ' && component_marks->d[y][x] == ' ') {
*s++ = img->d[y][x++];
}
*s = '\0';
if (s != buf) {
printf("%d,%d: |%s|\n", y, sx, buf);
c = find_enclosing_component(&components, y, sx);
if (is_color(buf, &rgb) && c) {
double percepted_luminance = 1 - ( 0.299 * rgb.r + 0.587 * rgb.g + 0.114 * rgb.b)/0xF;
c->has_custom_background = 1;
c->custom_background = rgb;
if (percepted_luminance >= 0.5)
c->white_text = 1;
printf("COLOR %x%x%x\n", rgb.r, rgb.g, rgb.b);
} else if (is_shape(buf, &shape) && c) {
c->shape = shape;
} else {
if (last_t && last_c == c &&
sx > 0 && img->d[y][sx-1] == ' ' &&
last_t->x + last_t->len + 1 == sx)
{
extend_text(last_t, 1, buf);
} else {
t = create_text(y, sx, buf);
TAILQ_INSERT_TAIL(c ? &c->text : &free_text, t, list);
last_c = c;
last_t = t;
}
}
}
}
}
free(buf);
}
static ECAslot *eca_dup(const ECAslot *src) {
dTHX;
ECAslot *dup = calloc(1, sizeof(*src));
if (!dup) croak("can't locate memory");
dup->key = newSVpv_share(SvPV_nolen(src->key), 0);
if (src->value) dup->value = newSVsv(src->value);
if (src->check) dup->check = newSVsv(src->check);
if (src->inject) dup->inject = newSVsv(src->inject);
return dup;
}
void decode_uuid(pTHX_ unsigned char *input, STRLEN len, struct cc_type *type, SV *output)
{
if (UNLIKELY(len != 16))
croak("decode_uuid: len != 16");
sv_setpvf(output, "%.2x%.2x%.2x%.2x-%.2x%.2x-%.2x%.2x-%.2x%.2x-%.2x%.2x%.2x%.2x%.2x%.2x",
input[0], input[1], input[2], input[3],
input[4], input[5], input[6], input[7],
input[8], input[9], input[10], input[11],
input[12], input[13], input[14], input[15]);
}
static inline SV *hv_he_store_or_croak(HV *hv, SV *key, SV *val) {
dTHX;
HE *he = hv_fetch_ent(hv, key, TRUE, 0U);
if (!he) {
SvREFCNT_dec(val);
croak("Can't store value");
}
SV *sv = HeVAL(he);
SvSetMagicSV(sv, val);
return sv;
}
void
scan_extended_request(const char **src, const char *max, HV *out) {
U8 type;
U32 tag;
SV *sv = newSV(0);
hv_stores(out, "oid", sv);
scan_raw(src, max, &type, &tag, sv);
if (type != (ASN1_CONTEXT_SPECIFIC | ASN1_PRIMITIVE) || tag != 0)
croak("scan_extended_request: bad value");
if (!sv_utf8_decode(sv))
croak("scan_string_utf8: invalid UTF8 data received");
if (*src < max) {
sv = newSV(0);
hv_stores(out, "value", sv);
scan_raw(src, max, &type, &tag, sv);
if (type != (ASN1_CONTEXT_SPECIFIC | ASN1_PRIMITIVE) || tag != 1)
croak("scan_extended_request: bad value");
}
}
static bool
collect_all_symbols (const char *key, STRLEN keylen, SV *val, void *ud)
{
HV *hash = (HV *)ud;
if (!hv_store (hash, key, keylen, newRV_inc(val), 0)) {
croak("failed to store symbol ref");
}
return TRUE;
}
// Returns the number of properties in the SSPROP structure for the
// given provider.
int no_of_ssprops(provider_enum provider) {
switch (provider) {
case provider_sqloledb : return no_of_ssprops_sqloledb;
case provider_sqlncli : return no_of_ssprops_sqlncli;
case provider_sqlncli10 : return no_of_ssprops_sqlncli10;
case provider_sqlncli11 : return no_of_ssprops_sqlncli11;
default :
croak("Internal error: Unexpected value %d passed to no_of_ssprops");
return 0;
}
}
static INLINE void failresources (parser_t * parser, const char * format, ...)
{
char buffer[ERRORMSGBUFFERSIZE];
va_list a;
va_start (a, format);
vsnprintf (buffer, ERRORMSGBUFFERSIZE, format, a);
va_end (a);
croak ("Parsing failed at line %d, byte %d/%d: %s", parser->line,
parser->end - parser->input,
parser->length, buffer);
}
static INLINE void
failbug (char * file, int line, parser_t * parser, const char * format, ...)
{
char buffer[ERRORMSGBUFFERSIZE];
va_list a;
va_start (a, format);
vsnprintf (buffer, ERRORMSGBUFFERSIZE, format, a);
va_end (a);
croak ("JSON::Parse: %s:%d: Internal error at line %d: %s",
file, line, parser->line, buffer);
}
void
croak_gerror(const char *domain, GError **error)
{
static char *errstr = NULL;
g_free(errstr);
if (error) {
errstr = g_strdup((*error)->message);
g_clear_error(error);
croak("%s: %s", domain, errstr);
}
}