Bug #101795 for Mac-PropertyList: Mis-parse or hang while parsing non-pretty XML

Apple's PList tools produce pretty-printed XML property lists. But if superfluous white space is eliminated, Mac::PropertyList can either produce an incorrect parse or loop indefinitely. The problem appears to be in the processing of the container types <array> and <dict>. The handlers for these need to see the contained XML, but if white space has been eliminated (e.g. '<array><string>One</string></array>') this is not available to it. The solution appears to me to be to check the contents of $_ before calling the handlers for these, and do a $source->put_line( $_ ) if warranted. $_ should then be cleared to prevent multiple processing of the XML. A patch to Mac::PropertyList is attached, as are patches to t/array.t and t/dict.t that demonstrates the correctness of the patch (versus the unpatched code) in one trivial case. I am a bit puzzled what severity to attach to this ticket. On the one hand a mis-parse is a real problem, and an indefinite loop even more so. On the other, non-pretty .plist files may be rare in the wild; I cam across this when I lazily left out the white space in hand-written XML. Thank you for your time and attention, and the Mac::PropertyList module itself.

--- lib/Mac/PropertyList.old 2014-09-12 06:16:22.000000000 -0400 +++ lib/Mac/PropertyList.pm 2015-01-28 13:20:50.000000000 -0500 @@ -379,6 +379,11 @@ $value = $Readers{$1}->( $2 ); } elsif( s[^\s* < (dict|array) > ][]x ) { + # We need to put back the unprocessed text if + # any because the <dict> and <array> readers + # need to see it. + $source->put_line( $_ ) if defined $_ && '' ne $_; + $_ = ''; $value = $Readers{$1}->( $source ); } # these next two are some wierd cases i found in the iPhoto Prefs

--- t/array.old 2014-09-12 06:16:22.000000000 -0400 +++ t/array.t 2015-01-27 23:54:30.000000000 -0500 @@ -1,4 +1,4 @@ -use Test::More tests => 5; +use Test::More tests => 8; use Mac::PropertyList; @@ -31,3 +31,18 @@ ok( eq_array( \@values, [qw(Mimi Roscoe Juliet Buster)] ), "Object has right values" ); +note 'Try non-canonical layout'; +$plist = Mac::PropertyList::parse_plist( <<"HERE" ); +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd"> +<plist version="1.0"> +<array><string>Athos</string><string>Porthos</string><string>Aramis</string></array> +</array> +</plist> +HERE +isa_ok( $plist, "Mac::PropertyList::array", "Make object from non-canonical plist string" ); +is( $plist->count, 3, "Non-canonical object has right number of values" ); + +@values = $plist->values(); +ok( eq_array( \@values, [ qw{ Athos Porthos Aramis } ] ), + "Non-canonical object has right values" );

--- t/dict.old 2015-01-28 00:45:18.000000000 -0500 +++ t/dict.t 2015-01-28 00:43:06.000000000 -0500 @@ -1,4 +1,4 @@ -use Test::More tests => 15; +use Test::More tests => 21; use Mac::PropertyList; @@ -47,4 +47,24 @@ ok( $plist->exists( 'Buster' ), 'Buster key exists after delete' ); is( $plist->count, 1, "Has right count after delete" ); +note 'Try non-canonical layout'; +$plist = Mac::PropertyList::parse_plist( <<"HERE" ); +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd"> +<plist version="1.0"> +<dict><key>Clayton</key><string>John</string><key>Napier</key><string>Carson</string><key>Gridley</key><string>Jason</string></dict> +</plist> +HERE +isa_ok( $plist, 'Mac::PropertyList::dict' ); +is( $plist->count, 3, "Has right number of keys" ); + +@keys = sort $plist->keys; +ok( eq_array( \@keys, [qw(Clayton Gridley Napier)] ), "Check hash keys" ); + +@values = sort $plist->values; +ok( eq_array( \@values, [qw(Carson Jason John)] ), "Check hash values" ); + +ok( $plist->exists( 'Clayton' ), 'Claytin key exists' ); + +is( $plist->value( 'Clayton' ), 'John', "Check Clayton's value" );