From: Nick Porter <nick@portercomputing.co.uk>
Date: Mon, 19 May 2025 08:22:19 +0000 (+0100)
Subject: Add some tests of invalid attribute access
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=c2b63d95b3480f67ce8980c786e87e67925d531d;p=thirdparty%2Ffreeradius-server.git

Add some tests of invalid attribute access
---

diff --git a/src/tests/modules/perl/list.unlang b/src/tests/modules/perl/list.unlang
index 6150e391162..66ddb5e866a 100644
--- a/src/tests/modules/perl/list.unlang
+++ b/src/tests/modules/perl/list.unlang
@@ -21,6 +21,33 @@ if (Filter-Id != 'Secondary' || Filter-Id[#] != 1 ) {
 	test_fail
 }
 
+# Check we can't set a value on a tied hash
+perl.set_on_hash {
+	fail = 1
+}
+if (!fail) {
+	test_fail
+}
+
+# Check that setting an attribute instance more than one beyond the existing fails
+perl.set_beyond_limit {
+	fail = 1
+}
+if (!fail) {
+	test_fail
+}
+if (reply.Reply-Message[3] != 'Will set') {
+	test_fail
+}
+
+# Check that setting an invalid attribute fails
+perl.invalid_attr {
+	fail = 1
+}
+if (!fail) {
+	test_fail
+}
+
 reply := {}
 
 test_pass
diff --git a/src/tests/modules/perl/test.pl b/src/tests/modules/perl/test.pl
index cf3fe8391e7..7bbef91a76a 100644
--- a/src/tests/modules/perl/test.pl
+++ b/src/tests/modules/perl/test.pl
@@ -128,6 +128,22 @@ sub array_ops {
 	return RLM_MODULE_OK;
 }
 
+sub set_on_hash {
+	my $p = shift();
+	$p->{'reply'}{'User-Name'} = 'bob';
+}
+
+sub set_beyond_limit {
+	my $p = shift();
+	$p->{'reply'}{'Reply-Message'}[3] = 'Will set';
+	$p->{'reply'}{'Reply-Message'}[10] = 'Will not set';
+}
+
+sub invalid_attr {
+	my $p = shift();
+	$p->{'reply'}{'Invalid-Attr'}[0] = 'Hello';
+}
+
 sub log_attributes {
 	my %hash = %{$_[0]};
 	my $indent = $_[1];