Improve DJabberd::Util validation and testcases

This commit tightens the validation in DJabberd::Util
and adds some more testcases.

lib/DJabberd/Util.pm

@@ -7,6 +7,7 @@ our @EXPORT_OK = qw(exml tsub lbsub as_bool as_num as_abs_path as_bind_addr);
 
 sub as_bool {
     my $val = shift;
+    die "Can't determine booleanness of 'undef'\n" unless defined($val);
     return 1 if $val =~ /^1|y|yes|true|t|on|enabled?$/i;
     return 0 if $val =~ /^0|n|no|false|f|off|disabled?$/i;
     die "Can't determine booleanness of '$val'\n";
@@ -20,13 +21,23 @@ sub as_num {
 
 sub as_bind_addr {
     my $val = shift;
+    die "'undef' is not a valid bind address or port\n" unless defined($val);
     # Must either be like 127.0.0.1:1234, a bare port number or an absolute path to a unix domain socket
-    if ($val =~ /^(\d\d?\d?\.\d\d?\d?\.\d\d?\d?\.\d\d?\d?:)?\d+$/ || ($val =~ m!^/! && -e $val)) {
+    # a socket
+    if ($val && $val =~ m!^/! && -e $val) {
         return $val;
     }
+    # an port, possibly including an IPv4 address
+    if ($val && $val =~ /^(?:\d\d?\d?\.\d\d?\d?\.\d\d?\d?\.\d\d?\d?:)?(\d+)$/) {
+        if($1 > 0 && $1 <= 65535) {
+            return $val;
+        }
+    }
     # looks like an IPv6 address
-    if ($val =~ /^\[[0-9a-f:]+\]:\d+$/) {
-        return $val;
+    if ($val && $val =~ /^\[[0-9a-f:]+\]:(\d+)$/) {
+        if($1 > 0 && $1 <= 65535) {
+            return $val;
+        }
     }
     die "'$val' is not a valid bind address or port\n";
 }

t/util.t

@@ -0,0 +1,69 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+use DJabberd::Util qw(exml tsub lbsub as_bool as_num as_abs_path as_bind_addr);
+use Test::More qw(no_plan);
+
+#
+# Test as_bool
+#
+foreach my $val (qw(1 y yes true t on enabled)) {
+    eval {
+        ok(as_bool($val),$val.' is true');
+    };
+}
+foreach my $val (qw(0 n no false f off disabled)) {
+    eval {
+        is(as_bool($val),0,$val.' is false');
+    };
+}
+foreach my $val (undef, 'A') {
+    no warnings;
+    my $eval_status = eval {
+        if(defined(as_bool($val))) {
+            return 0;
+        } else {
+            return 1;
+        }
+    };
+    ok(defined($@),$val.' is not of type bool');
+    ok(!defined($eval_status),$val.' is not of type bool');
+}
+
+#
+# Test as_num
+#
+foreach my $val (qw(0 1 1000 65534)) {
+    eval {
+        is(as_num($val),$val,$val.' is a valid num');
+    };
+}
+# invalid values
+{
+    no warnings;
+    foreach my $val (qw(0.0 1.2 3,5 2001:db8:: abc 100000 127.0.0.1:0 127.0.0.1:65536),undef) {
+        my $eval_status = eval {
+            as_bind_addr($val);
+        };
+        ok(defined($@),$val.' is not a valid num');
+        ok(!defined($eval_status),$val.' is not a valid num');
+    }
+}
+#
+# Test as_bind_addr
+#
+# valid values
+foreach my $val (qw(12345 127.0.0.1:12345 [2001:db8::1]:12345 /tmp /tmp/)) {
+    eval {
+        ok(as_bind_addr($val),$val.' is a valid bind addr');
+    };
+}
+# invalid values
+foreach my $val (qw(123456 2001:db8:: 2001:db8::12345 tmp/)) {
+    my $eval_status = eval {
+        as_bind_addr($val);
+    };
+    ok(defined($@),$val.' is not a valid bind addr');
+    ok(!defined($eval_status),$val.' is not a valid bind addr');
+}