From: Alan T. DeKok <aland@freeradius.org>
Date: Sat, 2 Sep 2023 17:12:55 +0000 (-0400)
Subject: don't do stupid things on error
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=f1ee539f43f66cebe29bb7e794d1ba6d6d74f810;p=thirdparty%2Ffreeradius-server.git

don't do stupid things on error

return how many attributes we moved.  Ignore attributes we
didn't create.  Don't add up error codes (???)

Note that the Perl module does NOT do nested attributes.  And it
does NOT do nested attributes, or even flat attributes which have
parents such as Vendor-Specific.AVPair.  Instead, it puts the tail
attribute into its hash, and then can't find that attribute in the
root dictionary
---

diff --git a/raddb/mods-available/perl b/raddb/mods-available/perl
index 3bb1a425dc0..3d37369f0f1 100644
--- a/raddb/mods-available/perl
+++ b/raddb/mods-available/perl
@@ -17,6 +17,10 @@
 #  included in your module. If the module is called for a section which
 #  does not have a function defined, it will return `noop`.
 #
+#  WARNING: The Perl module does _not_ as yet support nested attributes,
+#  or even flat attributes which have parents.  e.g. Vendor-Specific.Cisco.AVPair.
+#  We hope to fix that soon.
+#
 
 #
 #  ## Configuration Settings
diff --git a/src/modules/rlm_perl/rlm_perl.c b/src/modules/rlm_perl/rlm_perl.c
index 07b1ac18b62..4760b4d4a88 100644
--- a/src/modules/rlm_perl/rlm_perl.c
+++ b/src/modules/rlm_perl/rlm_perl.c
@@ -779,9 +779,13 @@ static int get_hv_content(TALLOC_CTX *ctx, request_t *request, HV *my_hv, fr_pai
 			len = av_len(av);
 			for (j = 0; j <= len; j++) {
 				av_sv = av_fetch(av, j, 0);
-				ret = pairadd_sv(ctx, request, vps, key, *av_sv, hash_name, list_name) + ret;
+				if (pairadd_sv(ctx, request, vps, key, *av_sv, hash_name, list_name) < 0) continue;
+				ret++;
 			}
-		} else ret = pairadd_sv(ctx, request, vps, key, res_sv, hash_name, list_name) + ret;
+		} else {
+			if (pairadd_sv(ctx, request, vps, key, res_sv, hash_name, list_name) < 0) continue;
+			ret++;
+		}
 	}
 
 	if (!fr_pair_list_empty(vps)) PAIR_LIST_VERIFY(vps);
@@ -873,30 +877,27 @@ static unlang_action_t do_perl(rlm_rcode_t *p_result, module_ctx_t const *mctx,
 		LEAVE;
 
 		fr_pair_list_init(&vps);
-		if ((get_hv_content(request->request_ctx, request, rad_request_hv, &vps, "RAD_REQUEST", "request")) == 0) {
+		if ((get_hv_content(request->request_ctx, request, rad_request_hv, &vps, "RAD_REQUEST", "request")) > 0) {
 			fr_pair_list_free(&request->request_pairs);
 			fr_pair_list_append(&request->request_pairs, &vps);
-			fr_pair_list_init(&vps);
 		}
 
-		if ((get_hv_content(request->reply_ctx, request, rad_reply_hv, &vps, "RAD_REPLY", "reply")) == 0) {
+		if ((get_hv_content(request->reply_ctx, request, rad_reply_hv, &vps, "RAD_REPLY", "reply")) > 0) {
 			fr_pair_list_free(&request->reply_pairs);
 			fr_pair_list_append(&request->reply_pairs, &vps);
-			fr_pair_list_init(&vps);
 		}
 
-		if ((get_hv_content(request->control_ctx, request, rad_config_hv, &vps, "RAD_CONFIG", "control")) == 0) {
+		if ((get_hv_content(request->control_ctx, request, rad_config_hv, &vps, "RAD_CONFIG", "control")) > 0) {
 			fr_pair_list_free(&request->control_pairs);
 			fr_pair_list_append(&request->control_pairs, &vps);
-			fr_pair_list_init(&vps);
 		}
 
-		if ((get_hv_content(request->session_state_ctx, request, rad_state_hv, &vps, "RAD_STATE", "session-state")) == 0) {
+		if ((get_hv_content(request->session_state_ctx, request, rad_state_hv, &vps, "RAD_STATE", "session-state")) > 0) {
 			fr_pair_list_free(&request->session_state_pairs);
 			fr_pair_list_append(&request->session_state_pairs, &vps);
-			fr_pair_list_init(&vps);
 		}
 	}
+
 	RETURN_MODULE_RCODE(ret);
 }