From faa03ffb8ccbf754d38d041570fcf2ce8816f36b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Petr=20=C5=A0abata?= <contyk@redhat.com>
Date: Wed, 2 Sep 2015 16:24:58 +0200
Subject: [PATCH] File::Glob: Dup glob state in CLONE()
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

File::Glob: Dup glob state in CLONE()

This solves [perl #119897] and [perl #117823], and restores the
behavior of glob() in conjunction with threads of 5.14 and older.

Since 5.16, code that used glob() inside a thread had been
unintentionally sharing state between threads, which lead to things
like this crashing and failing assertions:

./perl -Ilib -Mthreads -e 'scalar glob("*"); threads->create(sub { glob("*") })->join();'

Signed-off-by: Petr Šabata <contyk@redhat.com>
---
 MANIFEST                  |  1 +
 ext/File-Glob/Glob.xs     | 33 ++++++++++++++++++++++
 ext/File-Glob/t/threads.t | 71 +++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 105 insertions(+)
 create mode 100644 ext/File-Glob/t/threads.t

diff --git a/MANIFEST b/MANIFEST
index 181bb3f..9771022 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -3683,6 +3683,7 @@ ext/File-Glob/t/global.t	See if File::Glob works
 ext/File-Glob/TODO		File::Glob extension todo list
 ext/File-Glob/t/rt114984.t	See if File::Glob works
 ext/File-Glob/t/taint.t		See if File::Glob works
+ext/File-Glob/t/threads.t	See if File::Glob + threads works
 ext/GDBM_File/GDBM_File.pm	GDBM extension Perl module
 ext/GDBM_File/GDBM_File.xs	GDBM extension external subroutines
 ext/GDBM_File/hints/sco.pl	Hint for GDBM_File for named architecture
diff --git a/ext/File-Glob/Glob.xs b/ext/File-Glob/Glob.xs
index d74e7a4..6c69aa6 100644
--- a/ext/File-Glob/Glob.xs
+++ b/ext/File-Glob/Glob.xs
@@ -9,6 +9,9 @@
 #define MY_CXT_KEY "File::Glob::_guts" XS_VERSION
 
 typedef struct {
+#ifdef USE_ITHREADS
+    tTHX interp;
+#endif
     int		x_GLOB_ERROR;
     HV *	x_GLOB_ENTRIES;
 } my_cxt_t;
@@ -380,6 +383,33 @@ PPCODE:
     iterate(aTHX_ doglob_iter_wrapper);
     SPAGAIN;
 
+#ifdef USE_ITHREADS
+
+void
+CLONE(...)
+INIT:
+    HV *glob_entries_clone = NULL;
+CODE:
+    PERL_UNUSED_ARG(items);
+    {
+        dMY_CXT;
+        if ( MY_CXT.x_GLOB_ENTRIES ) {
+            CLONE_PARAMS param;
+            param.stashes    = NULL;
+            param.flags      = 0;
+            param.proto_perl = MY_CXT.interp;
+            
+            glob_entries_clone = MUTABLE_HV(sv_dup_inc((SV*)MY_CXT.x_GLOB_ENTRIES, &param));
+        }
+    }
+    {
+        MY_CXT_CLONE;
+        MY_CXT.x_GLOB_ENTRIES = glob_entries_clone;
+        MY_CXT.interp = aTHX;
+    }
+
+#endif
+
 BOOT:
 {
 #ifndef PERL_EXTERNAL_GLOB
@@ -394,6 +424,9 @@ BOOT:
     {
 	dMY_CXT;
 	MY_CXT.x_GLOB_ENTRIES = NULL;
+#ifdef USE_ITHREADS
+	MY_CXT.interp = aTHX;
+#endif
     }  
 }
 
diff --git a/ext/File-Glob/t/threads.t b/ext/File-Glob/t/threads.t
new file mode 100644
index 0000000..141450a
--- /dev/null
+++ b/ext/File-Glob/t/threads.t
@@ -0,0 +1,71 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) {
+        print "1..0\n";
+        exit 0;
+    }
+}
+use strict;
+use warnings;
+# Test::More needs threads pre-loaded
+use if $Config{useithreads}, 'threads';
+use Test::More;
+
+BEGIN {
+    if (! $Config{'useithreads'}) {
+        plan skip_all => "Perl not compiled with 'useithreads'";
+    }
+}
+
+use File::Temp qw(tempdir);
+use File::Spec qw();
+use File::Glob qw(csh_glob);
+
+my($dir) = tempdir(CLEANUP => 1)
+    or die "Could not create temporary directory";
+
+my @temp_files = qw(1_file 2_file 3_file);
+for my $file (@temp_files) {
+    open my $fh, ">", File::Spec->catfile($dir, $file)
+        or die "Could not create file $dir/$file: $!";
+    close $fh;
+}
+my $cwd = Cwd::cwd();
+chdir $dir
+    or die "Could not chdir to $dir: $!";
+
+sub do_glob { scalar csh_glob("*") }
+# Stablish some glob state
+my $first_file = do_glob();
+is($first_file, $temp_files[0]);
+
+my @files;
+push @files, threads->create(\&do_glob)->join() for 1..5;
+is_deeply(
+    \@files,
+    [($temp_files[1]) x 5],
+    "glob() state is cloned for new threads"
+);
+
+@files = threads->create({'context' => 'list'},
+    sub {
+        return do_glob(), threads->create(\&do_glob)->join()
+    })->join();
+
+is_deeply(
+    \@files,
+    [@temp_files[1,2]],
+    "..and for new threads inside threads"
+);
+
+my $second_file = do_glob();
+is($second_file, $temp_files[1], "state doesn't leak from threads");
+
+chdir $cwd
+    or die "Could not chdir back to $cwd: $!";
+
+done_testing;
-- 
2.4.3