Validate format name against known formatters before string eval

ChangeLog.md

@@ -6,9 +6,14 @@ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/).
 
 ## [Unreleased]
 
+## [v1.0.1] - 2026-09-08
+
 ### Fixed
 
 * Typo in Pod (thanks @stefanhaerter)
+* Validate the `format` argument against a list of known formatters before
+  using it to build and load a class name, preventing code injection via a
+  malicious format string
 
 ## [v1.0.0] - 2025-11-17
 

lib/XML/Feed.pm

@@ -13,11 +13,16 @@ use Module::Pluggable search_path => "XML::Feed::Format",
                       require     => 1,
                       sub_name    => 'formatters';
 
-our $VERSION = 'v1.0.0';
+our $VERSION = '1.0.1';
 our $MULTIPLE_ENCLOSURES = 0;
 our @formatters;
+our %formatters;
 BEGIN {
     @formatters = __PACKAGE__->formatters;
+    for my $formatter (@formatters) {
+        (my $name = $formatter) =~ s/^XML::Feed::Format:://;
+        $formatters{$name} = 1;
+    }
 }
 
 sub _parse_args {
@@ -57,6 +62,8 @@ sub new {
         $args = $class->_parse_args(pop @_);
     }
 
+    Carp::croak("Unsupported format $format: not a recognised feed format")
+        unless $formatters{$format};
     my $format_class = 'XML::Feed::Format::' . $format;
     eval "use $format_class";
     Carp::croak("Unsupported format $format: $@") if $@;
@@ -114,6 +121,8 @@ sub parse {
     }
 
     my $format_class = join '::', __PACKAGE__, "Format", $format;
+    return $class->error("Unsupported format $format: not a recognised feed format")
+        unless $formatters{$format};
     eval "use $format_class";
     return $class->error("Unsupported format $format: $@") if $@;
     bless $feed, $format_class;

lib/XML/Feed/Content.pm

@@ -2,7 +2,7 @@ package XML::Feed::Content;
 use strict;
 use warnings;
 
-our $VERSION = '0.65';
+our $VERSION = '1.0.1';
 
 use base qw( Class::ErrorHandler );
 

lib/XML/Feed/Enclosure.pm

@@ -2,7 +2,7 @@ package XML::Feed::Enclosure;
 use strict;
 use warnings;
 
-our $VERSION = '0.65';
+our $VERSION = '1.0.1';
 
 use base qw( Class::ErrorHandler );
 

lib/XML/Feed/Entry.pm

@@ -3,14 +3,16 @@ use strict;
 use warnings;
 use v5.10;
 
-our $VERSION = '0.65';
+our $VERSION = '1.0.1';
 
 use base qw( Class::ErrorHandler );
 
 use Scalar::Util qw( blessed );
 
 use Carp;
 
+use XML::Feed ();
+
 sub wrap {
     my $class = shift;
     my($item) = @_;
@@ -23,6 +25,8 @@ sub new {
     my $class = shift;
     my($format) = @_;
     $format //= 'Atom';
+    Carp::croak("Unsupported format $format: not a recognised feed format")
+        unless $XML::Feed::formatters{$format};
     my $format_class = 'XML::Feed::Format::' . $format;
     eval "use $format_class";
     Carp::croak("Unsupported format $format: $@") if $@;

lib/XML/Feed/Entry/Format/Atom.pm

@@ -3,7 +3,7 @@ use strict;
 use warnings;
 use v5.10;
 
-our $VERSION = '0.65';
+our $VERSION = '1.0.1';
 
 use base qw( XML::Feed::Entry );
 use XML::Feed::Content;

lib/XML/Feed/Entry/Format/RSS.pm

@@ -3,7 +3,7 @@ use strict;
 use warnings;
 use v5.10;
 
-our $VERSION = '0.65';
+our $VERSION = '1.0.1';
 
 sub format { 'RSS ' . $_[0]->{'_version'} }
 

lib/XML/Feed/Format/Atom.pm

@@ -3,7 +3,7 @@ use strict;
 use warnings;
 use v5.10;
 
-our $VERSION = '0.65';
+our $VERSION = '1.0.1';
 
 use base qw( XML::Feed );
 use XML::Atom::Feed;

lib/XML/Feed/Format/RSS.pm

@@ -3,7 +3,7 @@ use strict;
 use warnings;
 use v5.10;
 
-our $VERSION = '0.65';
+our $VERSION = '1.0.1';
 
 use base qw( XML::Feed );
 use DateTime::Format::Mail;

lib/XML/Feed/Util.pm

@@ -2,7 +2,7 @@ package XML::Feed::Util;
 use strict;
 use warnings;
 
-our $VERSION = '0.65';
+our $VERSION = '1.0.1';
 
 use base qw( Exporter );
 use DateTime::Format::Flexible;

t/32-format-injection.t

@@ -0,0 +1,49 @@
+use strict;
+use warnings;
+use Test::More tests => 11;
+
+use XML::Feed;
+use XML::Feed::Entry;
+
+# %formatters should be populated with the known, safe format names.
+ok exists $XML::Feed::formatters{Atom}, 'Atom is a known formatter';
+ok exists $XML::Feed::formatters{RSS},  'RSS is a known formatter';
+
+my $marker = '/tmp/xml-feed-format-injection-test';
+unlink $marker;
+
+my $malicious = qq{Atom; system('touch $marker')};
+
+eval {
+    XML::Feed->new($malicious);
+};
+like $@, qr{Unsupported format \Q$malicious\E:}, 'XML::Feed->new rejects an unrecognised format';
+ok !-e $marker, 'XML::Feed->new did not execute injected code';
+
+eval {
+    XML::Feed::Entry->new($malicious);
+};
+like $@, qr{Unsupported format \Q$malicious\E:}, 'XML::Feed::Entry->new rejects an unrecognised format';
+ok !-e $marker, 'XML::Feed::Entry->new did not execute injected code';
+
+{
+    my $result = XML::Feed->parse(\<<'XML', $malicious);
+<?xml version="1.0"?>
+<rss version="2.0"><channel><title>Test</title></channel></rss>
+XML
+    ok !defined($result), 'XML::Feed->parse rejects an unrecognised format';
+    like( XML::Feed->errstr, qr{Unsupported format \Q$malicious\E:}, 'XML::Feed->parse error message' );
+    ok !-e $marker, 'XML::Feed->parse did not execute injected code';
+}
+
+unlink $marker;
+
+eval {
+    XML::Feed->new('Nofeed;semicolon');
+};
+like $@, qr{Unsupported format Nofeed;semicolon:}, 'XML::Feed->new rejects format names with a semicolon';
+
+eval {
+    XML::Feed::Entry->new('Nofeed;semicolon');
+};
+like $@, qr{Unsupported format Nofeed;semicolon:}, 'XML::Feed::Entry->new rejects format names with a semicolon';