do less alloc/free

[freeradius.git] / src / modules / rlm_perl / rlm_perl.c

diff --git a/src/modules/rlm_perl/rlm_perl.c b/src/modules/rlm_perl/rlm_perl.c
index 3a01ea9..80db218 100644 (file)
--- a/src/modules/rlm_perl/rlm_perl.c
+++ b/src/modules/rlm_perl/rlm_perl.c
@@ -297,6 +297,44 @@ static XS(XS_radiusd_radlog)
        XSRETURN_NO;
 }
 
+/*
+ *     This is a wraper for radius_axlat
+ *     Now users are able to get data that is accessible only via xlat
+ *     e.g. %{client:...}
+ *     Call syntax is radiusd::xlat(string), string will be handled the
+ *     same way it is described in EXPANSIONS section of man unlang
+ */
+static XS(XS_radiusd_xlat)
+{
+       dXSARGS;
+       char *in_str;
+       char *expanded;
+       ssize_t slen;
+       SV *rad_requestp_sv;
+       REQUEST *request;
+
+       if (items != 1) croak("Usage: radiusd::xlat(string)");
+
+       rad_requestp_sv = get_sv("RAD___REQUESTP", 0);
+       if (rad_requestp_sv == NULL) croak("Can not evalue xlat, RAD___REQUESTP is not set!");
+
+       request = INT2PTR(REQUEST *, SvIV(rad_requestp_sv));
+
+       in_str = (char *) SvPV(ST(0), PL_na);
+       expanded = NULL;
+       slen = radius_axlat(&expanded, request, in_str, NULL, NULL);
+
+       if (slen < 0) {
+               REDEBUG("Error parsing xlat '%s'", in_str);
+               XSRETURN_UNDEF;
+       }
+
+
+       XST_mPV(0, expanded);
+       talloc_free(expanded);
+       XSRETURN(1);
+}
+
 static void xs_init(pTHX)
 {
        char const *file = __FILE__;
@@ -305,6 +343,7 @@ static void xs_init(pTHX)
        newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
 
        newXS("radiusd::radlog",XS_radiusd_radlog, "rlm_perl");
+       newXS("radiusd::xlat",XS_radiusd_xlat, "rlm_perl");
 }
 
 /*
@@ -615,23 +654,34 @@ static void perl_store_vps(UNUSED TALLOC_CTX *ctx, REQUEST *request, VALUE_PAIR
                           const char *hash_name, const char *list_name)
 {
        VALUE_PAIR *vp;
+       char *tbuff;
+       size_t tbufflen = 1024;
 
        hv_undef(rad_hv);
 
        vp_cursor_t cursor;
 
+       /*
+        *      Find out how much room to allocate.
+        */
+       for (vp = fr_cursor_init(&cursor, vps);
+            vp;
+            vp = fr_cursor_next(&cursor)) {
+               if (((vp->length * 2) + 3) > tbufflen) {
+                       tbufflen = (vp->vp_length * 2) + 3;
+               }
+       }
+       tbuff = talloc_array(request, char, tbufflen);
+
        RINDENT();
        fr_pair_list_sort(vps, fr_pair_cmp_by_da_tag);
        for (vp = fr_cursor_init(&cursor, vps);
             vp;
             vp = fr_cursor_next(&cursor)) {
                VALUE_PAIR *next;
-
                char const *name;
-               char namebuf[256];
-               char buffer[1024];
-
                size_t len;
+               char namebuf[256];
 
                /*
                 *      Tagged attributes are added to the hash with name
@@ -676,15 +726,17 @@ static void perl_store_vps(UNUSED TALLOC_CTX *ctx, REQUEST *request, VALUE_PAIR
                        break;
 
                default:
-                       len = vp_prints_value(buffer, sizeof(buffer), vp, 0);
+                       len = vp_prints_value(tbuff, tbufflen, vp, 0);
                        RDEBUG("$%s{'%s'} = &%s:%s -> '%s'", hash_name, vp->da->name,
-                              list_name, vp->da->name, buffer);
+                              list_name, vp->da->name, tbuff);
                        (void)hv_store(rad_hv, name, strlen(name),
-                                      newSVpvn(buffer, truncate_len(len, sizeof(buffer))), 0);
+                                      newSVpvn(tbuff, truncate_len(len, tbufflen)), 0);
                        break;
                }
        }
        REXDENT();
+
+       talloc_free(tbuff);
 }
 
 /*
@@ -700,17 +752,21 @@ static void pairadd_sv(TALLOC_CTX *ctx, REQUEST *request, VALUE_PAIR **vps, char
        VALUE_PAIR      *vp;
        STRLEN len;
 
-       VERIFY_LIST(*vps);
-
        if (!SvOK(sv)) {
-       fail:
-               REDEBUG("Failed to create pair &%s:%s %s $%s{'%s'} -> '%s'", list_name, key,
+               REDEBUG("Internal failure creating pair &%s:%s %s $%s{'%s'} -> '%s'", list_name, key,
                        fr_int2str(fr_tokens, op, "<INVALID>"), hash_name, key, (val ? val : "undef"));
                return;
        }
+
        val = SvPV(sv, len);
        vp = fr_pair_make(ctx, vps, key, NULL, op);
-       if (!vp) goto fail;
+       if (!vp) {
+       fail:
+               REDEBUG("Failed to create pair - %s", fr_strerror());
+               REDEBUG("    &%s:%s %s $%s{'%s'} -> '%s'", list_name, key,
+                       fr_int2str(fr_tokens, op, "<INVALID>"), hash_name, key, (val ? val : "undef"));
+               return;
+       }
 
        switch (vp->da->type) {
        case PW_TYPE_STRING:
@@ -752,6 +808,8 @@ static void get_hv_content(TALLOC_CTX *ctx, REQUEST *request, HV *my_hv, VALUE_P
                        pairadd_sv(ctx, request, vps, key, res_sv, T_OP_EQ, hash_name, list_name);
                }
        }
+
+       if (*vps) VERIFY_LIST(*vps);
 }
 
 /*
@@ -776,6 +834,7 @@ static int do_perl(void *instance, REQUEST *request, char const *function_name)
        HV              *rad_request_proxy_hv;
        HV              *rad_request_proxy_reply_hv;
 #endif
+       SV              *rad_requestp_sv;
 
        /*
         *      Radius has told us to call this function, but none
@@ -810,6 +869,7 @@ static int do_perl(void *instance, REQUEST *request, char const *function_name)
                rad_config_hv = get_hv("RAD_CONFIG", 1);
                rad_request_hv = get_hv("RAD_REQUEST", 1);
                rad_state_hv = get_hv("RAD_STATE", 1);
+               rad_requestp_sv = get_sv("RAD___REQUESTP", 1);
 
                perl_store_vps(request->packet, request, &request->packet->vps, rad_request_hv, "RAD_REQUEST", "request");
                perl_store_vps(request->reply, request, &request->reply->vps, rad_reply_hv, "RAD_REPLY", "reply");
@@ -836,6 +896,15 @@ static int do_perl(void *instance, REQUEST *request, char const *function_name)
                }
 #endif
 
+               /*
+                * Store pointer to request structure globally so xlat works
+                * We mark it read-only for interpreter so end users will not be
+                * in posession to change it and crash radiusd with bogus pointer
+                */
+               SvREADONLY_off(rad_requestp_sv);
+               sv_setiv(rad_requestp_sv, PTR2IV(request));
+               SvREADONLY_on(rad_requestp_sv);
+
                PUSHMARK(SP);
                /*
                 * This way %RAD_xx can be pushed onto stack as sub parameters.