From b95c08ea9a511429a648a3a25fe32077829cce01 Mon Sep 17 00:00:00 2001
From: Dimas Maulana <92920739+dimasma0305@users.noreply.github.com>
Date: Wed, 14 Oct 2026 19:27:17 +0800
Subject: [PATCH] Reject symlinks during archive imports (#622)

---
 perl_lib/EPrints/DataObj/Document.pm      |  2 +
 perl_lib/EPrints/Plugin/Import/Archive.pm | 15 ++++-
 tests/85_archive_import_symlinks.pl       | 70 +++++++++++++++++++++++
 3 files changed, 84 insertions(+), 3 deletions(-)
 create mode 100644 tests/85_archive_import_symlinks.pl

diff --git a/perl_lib/EPrints/DataObj/Document.pm b/perl_lib/EPrints/DataObj/Document.pm
index 7292075e..cb466c67 100644
--- a/perl_lib/EPrints/DataObj/Document.pm
+++ b/perl_lib/EPrints/DataObj/Document.pm
@@ -1182,6 +1182,8 @@ sub add_directory
 		wanted => sub {
 			return unless $rc and !-d $File::Find::name;
 			my $filepath = $File::Find::name;
+			return if -l $filepath;
+			return if !-f $filepath;
 			my $filename = substr($filepath, length($directory));
 			my $stored = $self->add_file( $filepath, $filename, 1 );
 			$rc = defined $stored;
diff --git a/perl_lib/EPrints/Plugin/Import/Archive.pm b/perl_lib/EPrints/Plugin/Import/Archive.pm
index 065d3dae..fed68211 100644
--- a/perl_lib/EPrints/Plugin/Import/Archive.pm
+++ b/perl_lib/EPrints/Plugin/Import/Archive.pm
@@ -7,6 +7,7 @@ EPrints::Plugin::Import::Archive
 package EPrints::Plugin::Import::Archive;
 
 use strict;
+use Fcntl qw(O_RDONLY O_NOFOLLOW);
 
 our @ISA = qw/ EPrints::Plugin::Import /;
 
@@ -81,6 +82,8 @@ sub create_epdata_from_directory
 		wanted => sub {
 			return if -d $File::Find::name;
 			my $filepath = $File::Find::name;
+			return if -l $filepath;
+			return if !-f $filepath;
 			my $filename = substr($filepath, length($dir) + 1);
 
 			$media_info = {};
@@ -90,7 +93,10 @@ sub create_epdata_from_directory
 				epdata => $media_info,
 				);
 
-			open(my $fh, "<", $filepath) or die "Error opening $filename: $!";
+			sysopen(my $fh, $filepath, O_RDONLY | O_NOFOLLOW)
+				or die "Error opening $filename: $!";
+			binmode($fh);
+			die "Not a regular file: $filename" unless -f $fh;
 			if( $single )
 			{
 				push @{$epdata->{files}}, {
@@ -116,7 +122,10 @@ sub create_epdata_from_directory
 				die "Too many files" if @{$epdata} > $too_many_files
 			}
 		},
-	}, $dir ) };
+	}, $dir );
+		die "Archive contains no regular files" if $single && !@{$epdata->{files}};
+	};
+	return undef if $@;
 
 	if( $single )
 	{
@@ -128,7 +137,7 @@ sub create_epdata_from_directory
 		};
 	}
 
-	return !$@ ? $epdata : undef;
+	return $epdata;
 }
 
 1;
diff --git a/tests/85_archive_import_symlinks.pl b/tests/85_archive_import_symlinks.pl
new file mode 100644
index 00000000..4865b9d8
--- /dev/null
+++ b/tests/85_archive_import_symlinks.pl
@@ -0,0 +1,70 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Test::More;
+use FindBin;
+use File::Find;
+use File::Temp qw(tempdir);
+
+{
+	package EPrints::Const;
+	sub EP_TRIGGER_MEDIA_INFO () { 1 }
+}
+
+{
+	package TestRepository;
+	sub new { bless {}, shift }
+	sub config { 100 }
+	sub run_trigger { return }
+}
+
+my $archive_plugin = "$FindBin::Bin/../perl_lib/EPrints/Plugin/Import/Archive.pm";
+do $archive_plugin or BAIL_OUT("Could not load $archive_plugin: $@ $!");
+
+my $root = tempdir(CLEANUP => 1);
+my $source = "$root/source";
+mkdir $source or BAIL_OUT("Could not create source directory: $!");
+
+open my $regular, '>', "$source/regular.txt" or BAIL_OUT("Could not write regular file: $!");
+print {$regular} "ordinary file\n";
+close $regular;
+
+my $outside = "$root/outside.txt";
+open my $secret, '>', $outside or BAIL_OUT("Could not write outside file: $!");
+print {$secret} "outside archive\n";
+close $secret;
+
+my $plugin = { repository => TestRepository->new };
+my $normal = EPrints::Plugin::Import::Archive::create_epdata_from_directory(
+	$plugin, $source, 0 );
+is( scalar @$normal, 1, "regular file is imported" );
+is( $normal->[0]->{files}->[0]->{filename}, "regular.txt", "regular filename is kept" );
+my $normal_fh = $normal->[0]->{files}->[0]->{_content};
+is( scalar <$normal_fh>, "ordinary file\n", "regular file content is readable" );
+
+my $empty = "$root/empty";
+mkdir $empty or BAIL_OUT("Could not create empty directory: $!");
+my $empty_single = EPrints::Plugin::Import::Archive::create_epdata_from_directory(
+	$plugin, $empty, 1 );
+ok( !defined $empty_single, "single-document archive with no regular files is rejected" );
+
+SKIP: {
+	my $link = "$source/link.txt";
+	skip "native symlinks are unavailable on this filesystem", 3
+		unless symlink( $outside, $link ) && -l $link;
+
+	my $mixed = EPrints::Plugin::Import::Archive::create_epdata_from_directory(
+		$plugin, $source, 0 );
+	is( scalar @$mixed, 1, "symlink to outside file is skipped" );
+	is( $mixed->[0]->{files}->[0]->{filename}, "regular.txt", "regular file still imports" );
+
+	my $link_only = "$root/link_only";
+	mkdir $link_only or BAIL_OUT("Could not create link-only directory: $!");
+	symlink( $outside, "$link_only/link.txt" ) or BAIL_OUT("Could not create second symlink: $!");
+	my $single = EPrints::Plugin::Import::Archive::create_epdata_from_directory(
+		$plugin, $link_only, 1 );
+	ok( !defined $single, "single-document archive with only a symlink is rejected" );
+}
+
+done_testing();