diff --git a/Makefile.am b/Makefile.am index a1a625d..0fc3bf0 100644 --- a/Makefile.am +++ b/Makefile.am @@ -66,7 +66,8 @@ PL_LOG_COMPILER = $(PERL) AM_PL_LOG_FLAGS = -Mstrict -w \ -I'$(abs_top_builddir)' \ -I'$(abs_top_srcdir)'/t/lib -handwritten_tests = +handwritten_tests = \ + t/parse_assignments.pl generated_tests = \ t/version.pl TESTS = $(handwritten_tests) $(generated_tests) diff --git a/configure.ac b/configure.ac index a6327d2..7aa257f 100644 --- a/configure.ac +++ b/configure.ac @@ -30,8 +30,17 @@ m4_foreach_w([_m], [ ], [AX_PROG_PERL_MODULES([_m], [], [AC_MSG_ERROR([missing required Perl module _m])])]) -# Perl modules required for tests. Only prints a warning if not -# installed. +# Perl modules required for tests. If these modules are not installed +# then some tests will fail. Only prints a warning if not installed. +m4_foreach_w([_m], [ + Data::Dumper + Test::More + ], [AX_PROG_PERL_MODULES([_m], [], + [AC_MSG_WARN([some tests will fail due to missing module _m])])]) + +# Optional Perl modules for tests. If these modules are not installed +# then some tests will be skipped, but no tests should fail. Only +# prints a warning if not installed. m4_foreach_w([_m], [ Test::Warnings ], [AX_PROG_PERL_MODULES([_m], [], diff --git a/ddclient.in b/ddclient.in index 247bf7f..2c911eb 100755 --- a/ddclient.in +++ b/ddclient.in @@ -1055,11 +1055,10 @@ sub read_cache { sub parse_assignments { my ($rest) = @_; my %variables = (); - my ($name, $value); while (1) { - $rest =~ s/^\s+//; - ($name, $value, $rest) = parse_assignment($rest); + (my $name, my $value, $rest) = parse_assignment($rest); + $rest =~ s/^[,\s]+//; if (defined $name) { if ($name eq 'fw-banlocal') { warning("'fw-banlocal' is deprecated and does nothing"); @@ -1074,14 +1073,13 @@ sub parse_assignments { } sub parse_assignment { my ($rest) = @_; - my ($c, $name, $value); + my ($name, $value); my ($escape, $quote) = (0, ''); - if ($rest =~ /^\s*([a-z][0-9a-z_-]*)=(.*)/i) { + if ($rest =~ /^[,\s]*([a-z][0-9a-z_-]*)=(.*)/i) { ($name, $rest, $value) = ($1, $2, ''); - while (length($c = substr($rest, 0, 1))) { - $rest = substr($rest,1); + while (length(my $c = substr($rest, 0, 1))) { if ($escape) { $value .= $c; $escape = 0; @@ -1092,13 +1090,16 @@ sub parse_assignment { } elsif (!$quote && $c =~ /[\'\"]/) { $quote = $c; } elsif (!$quote && $c =~ /^[\n\s,]/) { + # The terminating character is not consumed. last; } else { $value .= $c; } + $rest = substr($rest,1); } } - warning("assignment ended with an open quote") if $quote; + warning("assignment to '%s' ended with the escape character (\\)", $name) if $escape; + warning("assignment to '%s' ended with an unterminated quote (%s)", $name, $quote) if $quote; return ($name, $value, $rest); } ###################################################################### diff --git a/t/parse_assignments.pl b/t/parse_assignments.pl new file mode 100644 index 0000000..e6e1477 --- /dev/null +++ b/t/parse_assignments.pl @@ -0,0 +1,55 @@ +use Test::More; +use Data::Dumper; + +SKIP: { eval { require Test::Warnings; } or skip($@, 1); } +eval { require 'ddclient'; } or BAIL_OUT($@); + +$Data::Dumper::Sortkeys = 1; + +sub tc { + return { + name => shift, + input => shift, + want_vars => shift, + want_rest => shift, + }; +} + +my @test_cases = ( + tc('no assignments', "", {}, ""), + tc('one assignment', "a=1", { a => '1' }, ""), + tc('empty value', "a=", { a => '' }, ""), + tc('sep: comma', "a=1,b=2", { a => '1', b => '2' }, ""), + tc('sep: space', "a=1 b=2", { a => '1', b => '2' }, ""), + tc('sep: comma space', "a=1, b=2", { a => '1', b => '2' }, ""), + tc('sep: space comma', "a=1 ,b=2", { a => '1', b => '2' }, ""), + tc('sep: space comma space', "a=1 , b=2", { a => '1', b => '2' }, ""), + tc('leading space', " a=1", { a => '1' }, ""), + tc('trailing space', "a=1 ", { a => '1' }, ""), + tc('leading comma', ",a=1", { a => '1' }, ""), + tc('trailing comma', "a=1,", { a => '1' }, ""), + tc('empty assignment', "a=1,,b=2", { a => '1', b => '2' }, ""), + tc('rest', "a", {}, "a"), + tc('rest leading space', " x", {}, "x"), + tc('rest trailing space', "x ", {}, "x "), + tc('rest leading comma', ",x", {}, "x"), + tc('rest trailing comma', "x,", {}, "x,"), + tc('assign space rest', "a=1 x", { a => '1' }, "x"), + tc('assign comma rest', "a=1,x", { a => '1' }, "x"), + tc('assign comma space rest', "a=1, x", { a => '1' }, "x"), + tc('assign space comma rest', "a=1 ,x", { a => '1' }, "x"), + tc('single quoting', "a='\", '", { a => '", ' }, ""), + tc('double quoting', "a=\"', \"", { a => "', " }, ""), + tc('mixed quoting', "a=1\"2\"'3'4", { a => "1234" }, ""), + tc('unquoted escaped backslash', "a=\\\\", { a => "\\" }, ""), + tc('squoted escaped squote', "a='\\''", { a => "'" }, ""), + tc('dquoted escaped dquote', "a=\"\\\"\"", { a => '"' }, ""), +); + +for my $tc (@test_cases) { + my ($got_rest, %got_vars) = ddclient::parse_assignments($tc->{input}); + is(Dumper(\%got_vars), Dumper($tc->{want_vars}), "$tc->{name}: vars"); + is($got_rest, $tc->{want_rest}, "$tc->{name}: rest"); +} + +done_testing();