win32: do not allow seekdir() out of bounds

Previously you could use seekdir/readdir on Windows to examine
the memory space of the process until this triggered SIGSEGV.

Adds a new test file t/win32/seekdir.t

[Note: patch fixup and squash by Yves]

5 files changed, 85 insertions, 3 deletions

diff --git a/.mailmap b/.mailmap
index 22d07576c4..84a1f9035f 100644
--- a/.mailmap
+++ b/.mailmap
@@ -81,7 +81,8 @@ Albert Dvornik <bert@alum.mit.edu> Albert Dvornik <bert@genscan.com>
 Alberto Simões <ambs@cpan.org> Alberto Simoes <ambs@cpan.org>
 Alberto Simões <ambs@cpan.org> Alberto Simões <hashashin@gmail.com>
 Alberto Simões <ambs@cpan.org> ambs <ambs@cpan.org>
-Alex Davies <adavies@ptc.com> Alex Davies <alex.davies@talktalk.net>
+Alex Davies <alex.davies501@gmail.com> Alex Davies <adavies@ptc.com>
+Alex Davies <alex.davies501@gmail.com> Alex Davies <alex.davies@talktalk.net>
 Alex Vandiver <alexmv@mit.edu> Alex Vandiver <alex@chmrr.net>
 Alexander Alekseev <alex@alemate.ru> alex <alex@alemate.ru>
 Alexander Bluhm <alexander_bluhm@genua.de> alexander_bluhm@genua.de <alexander_bluhm@genua.de>
diff --git a/AUTHORS b/AUTHORS
index 4fe8393178..3287436cdf 100644
--- a/AUTHORS
+++ b/AUTHORS
@@ -60,7 +60,7 @@ Albert Dvornik                 <bert@alum.mit.edu>
 Alberto Simões                 <ambs@cpan.org>
 Alessandro Forghieri           <alf@orion.it>
 Alex                           <aleksandrosansan@gmail.com>
-Alex Davies                    <adavies@ptc.com>
+Alex Davies                    <alex.davies501@gmail.com>
 Alex Gough                     <alex@rcon.org>
 Alex Solovey                   <a.solovey@gmail.com>
 Alex Vandiver                  <alexmv@mit.edu>
diff --git a/MANIFEST b/MANIFEST
index 193d703ec6..63d7ba0f4c 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -6333,6 +6333,7 @@ t/win32/crypt.t			Test Win32 crypt for compatibility
 t/win32/fs.t			Test Win32 link for compatibility
 t/win32/popen.t			Test for stdout races in backticks, etc
 t/win32/runenv.t		Test if Win* perl honors its env variables
+t/win32/seekdir.t		Test that seekdir/readdir are restricted to relevant memory
 t/win32/signal.t		Test Win32 signal emulation
 t/win32/stat.t			Test Win32 stat emulation
 t/win32/symlink.t		Test Win32 symlink
diff --git a/t/win32/seekdir.t b/t/win32/seekdir.t
new file mode 100644
index 0000000000..fab8643dbe
--- /dev/null
+++ b/t/win32/seekdir.t
@@ -0,0 +1,75 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require "./test.pl";
+}
+
+use warnings;
+use strict;
+use Errno;
+
+{ # Test we can seekdir to all positions.
+
+    my $dh;
+    ok(opendir($dh, ".") == 1, "able to opendir('.')");
+
+    # Build up a list of all the files and their positions.
+    my @p_f;  # ([POS_0, FILE_0], [POS_1, FILE_1], ...)
+    while (1) {
+        my $p = telldir $dh;
+        my $f = readdir $dh;
+        last unless defined $f;
+        push @p_f, [$p, $f];
+    }
+
+    # Test we can seekdir() to the given position and that
+    # readdir() returns the expected file name.
+    my $test = sub {
+        my ($p_f, $type) = @_;
+        my ($p, $f) = @$p_f;
+        ok(seekdir($dh, $p), "$type seekdir($p)");
+        ok(readdir($dh) eq $f, "$type readdir() -> $f \tas expected");
+    };
+    # Go forwards.
+    $test->($_, "forward") for @p_f;
+    # Go backwards.
+    $test->($_, "backward") for reverse @p_f;
+    # A mixed traversal: longest file names first.
+    my @sorted_p_f = sort {
+            length $b->[1] <=> length $a->[1]
+                or
+            $a->[1] cmp $b->[1]
+    } @p_f;
+    $test->($_, "mixed") for @sorted_p_f;
+
+    # Test behaviour of seekdir(-1).
+    ok(seekdir($dh, -1), "seekdir(-1) returns true...");
+    ok(!defined readdir($dh), "...but next readdir() gives undef");
+
+    # Test behaviour of seekdir() to a position beyond what we
+    # have read so far.
+    my $final_p_f = $p_f[-1];
+    my $end_pos = $final_p_f->[0] + length $final_p_f->[1];
+    ok(seekdir($dh, $end_pos), "seekdir($end_pos) possible");
+    ok(telldir($dh) == $end_pos, "telldir() equal to where we seekdir()d");
+    # At this point we readdir() the trailing NUL of the last file name.
+    ok(readdir($dh) eq '', "readdir() here gives an empty string");
+
+    # Reached the end of files to seekdir() to.
+    ok(telldir($dh) == -1, "telldir() now equal to -1");
+    ok(!defined readdir($dh), "next readdir() gives undef");
+
+    # NB. `seekdir(DH, POS)` always returns true regardless of the
+    # value of POS, providing DH is a valid directory handle.
+    # However, if POS _is_ out of range then `telldir(DH)` is -1,
+    # and `readdir(DH)` returns undef.
+    ok(seekdir($dh, $end_pos + 1), "seekdir($end_pos + 1) returns true...");
+    ok(telldir($dh) == -1, "....but telldir() == -1 indicating out of range");
+    ok(!defined readdir($dh), "... and next readdir() gives undef");
+
+    ok(closedir($dh) == 1, "Finally. closedir() returns true");
+}
+
+done_testing();
diff --git a/win32/win32.c b/win32/win32.c
index 8947f0204c..f42e6a23ce 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -1016,7 +1016,12 @@ win32_telldir(DIR *dirp)
 DllExport void
 win32_seekdir(DIR *dirp, long loc)
 {
-    dirp->curr = loc == -1 ? NULL : dirp->start + loc;
+    /* Ensure dirp->curr remains within `dirp->start` buffer. */
+    if (loc >= 0 && dirp->end - dirp->start > (ptrdiff_t) loc) {
+        dirp->curr = dirp->start + loc;
+    } else {
+        dirp->curr = NULL;
+    }
 }
 
 /* Rewinddir resets the string pointer to the start */