Skip Menu |
Report information
Id: 126755
Status: resolved
Priority: 0/
Queue: perl5

Owner: Nobody
Requestors: john [at] autosectools.com
Cc:
AdminCc:

Operating System: (no value)
PatchStatus: (no value)
Severity: (no value)
Type: (no value)
Perl Version: (no value)
Fixed In: (no value)



To: <perl5-security-report [...] perl.org>
From: "John Leitch" <john [...] autosectools.com>
Date: Sat, 28 Nov 2015 13:30:28 +0100
Subject: Perl 5.22 VDir::MapPathA/W Out-of-bounds Reads and Buffer Over-reads
Download (untitled) / with headers
text/plain 5.4k
Download (untitled) / with headers
text/html 42.4k

Message body is not shown because it is too large.

Download VDirMapPathA.patch
text/plain 1.5k

Message body is not shown because sender requested not to inline it.

From: Dave Mitchell <davem [...] iabyn.com>
Date: Tue, 1 Dec 2015 18:07:52 +0000
To: perl5-security-report [...] perl.org
Subject: Re: [perl #126755] Perl 5.22 VDir::MapPathA/W Out-of-bounds Reads and Buffer Over-reads
Download (untitled) / with headers
text/plain 2.2k
On Sat, Nov 28, 2015 at 04:30:57AM -0800, John Leitch wrote: Show quoted text
> Perl 5.22 suffers from two out-of-bounds read and multiple small buffer > over-read vulnerabilities in the VDir::MapPathA and VDir::MapPathW > functions that could potentially be exploited to achieve arbitrary code > execution. The out-of-bounds read issues exist because the functions in > question do not validate that the chr argument passed to DriveIndex, > which calculates an index:
So in summary: present in all releases of perl since perl-5.005_02-2346-g7766f13 to blead, is win32 code that processes file names which start with "X:..." where X is a drive number. Many places call this code, eg stat(), glob() etc, so it's very likely that perl code that accepts attacker-controlled filenames can be made to pass that attacker-controlled pathname to VDir::MapPathA. Once there, a drive letter X not in the usual A..Z, a..z can cause a write buffer overflow. Specifically, it does the equivalent of: char szBuffer[...]; ... drive = pathname[0]; index = (drive | 0x20) - 'a'; /* whoops: may be < 0 or > max index */ char *ptr = dirTableA[index]; /* this may be a random pointer now */ /* copy arbitrary string which may be of arbitrary length and thus may * overwrite the end of szBuffer, and put random stuff at the end of * the stack */ strcpy(szBuffer, ptr); /* copying How dangerous this is consists, I think, of 3 elements: 1. Is code that already accepts unvalidated pathnames from an attacker already insecure? Does this make it even less secure? 2. Is the stack smashing dangerous? I don't know much about win32 on intel. Does the stack still grow downwards? Is there anything below it? The other vars local to this function are unused by this point so the donb;t matter. Can the return PC etc be overwritten? 3. Even if the stack itself isn't trashed, is szBuffer[] getting filled with trash exploitable? The issues, of not validating string length before doing e.g. if (pInName[1] == ':') { ...} I suspect are relatively harmless (but I could be wrong). My gut feeling is that this is a "CVE, create immediate maint releases" -level issue. Finally, the attached patch looks good to me. -- O Unicef Clearasil! Gibberish and Drivel! -- "Bored of the Rings"
Date: Tue, 1 Dec 2015 21:08:08 +0100
Subject: Re: [perl #126755] Perl 5.22 VDir::MapPathA/W Out-of-bounds Reads and Buffer Over-reads
To: <perl5-security-report [...] perl.org>
From: "John Leitch" <john [...] autosectools.com>
Download (untitled) / with headers
text/plain 3.4k
To touch on your three points: 1) This is largely application specific and dependent on subsequent operations performed using the path. I could envision scenarios where a controllable path may be exposed to the attack surface (in a web application, for example) with the reasonable expectation that arbitrary code execution may occur as a result. 2) On x86 the stack grows down and call instructions push the return address on the stack, so it's possible the IP/PC can be controlled using this. Compiler mitigations such as stack canaries may mitigate this to an extent, but it cannot be assumed that they will be present in every build. 3) Quickly glancing through code, I don't see any obvious way corrupting szBuffer[] could be leveraged for purposes of exploitation. It may be worth dedicating more time, but nothing jumps out. Regarding the small over-reads, I do not believe them to be exploitable, but it seemed like they were worth fixing in the event that somewhere down the line it was proven otherwise. John Show quoted text
-----Original Message----- From: Dave Mitchell via RT Sent: Tuesday, December 1, 2015 7:08 PM To: john@autosectools.com Subject: Re: [perl #126755] Perl 5.22 VDir::MapPathA/W Out-of-bounds Reads and Buffer Over-reads On Sat, Nov 28, 2015 at 04:30:57AM -0800, John Leitch wrote:
> Perl 5.22 suffers from two out-of-bounds read and multiple small buffer > over-read vulnerabilities in the VDir::MapPathA and VDir::MapPathW > functions that could potentially be exploited to achieve arbitrary code > execution. The out-of-bounds read issues exist because the functions in > question do not validate that the chr argument passed to DriveIndex, > which calculates an index:
So in summary: present in all releases of perl since perl-5.005_02-2346-g7766f13 to blead, is win32 code that processes file names which start with "X:..." where X is a drive number. Many places call this code, eg stat(), glob() etc, so it's very likely that perl code that accepts attacker-controlled filenames can be made to pass that attacker-controlled pathname to VDir::MapPathA. Once there, a drive letter X not in the usual A..Z, a..z can cause a write buffer overflow. Specifically, it does the equivalent of: char szBuffer[...]; ... drive = pathname[0]; index = (drive | 0x20) - 'a'; /* whoops: may be < 0 or > max index */ char *ptr = dirTableA[index]; /* this may be a random pointer now */ /* copy arbitrary string which may be of arbitrary length and thus may * overwrite the end of szBuffer, and put random stuff at the end of * the stack */ strcpy(szBuffer, ptr); /* copying How dangerous this is consists, I think, of 3 elements: 1. Is code that already accepts unvalidated pathnames from an attacker already insecure? Does this make it even less secure? 2. Is the stack smashing dangerous? I don't know much about win32 on intel. Does the stack still grow downwards? Is there anything below it? The other vars local to this function are unused by this point so the donb;t matter. Can the return PC etc be overwritten? 3. Even if the stack itself isn't trashed, is szBuffer[] getting filled with trash exploitable? The issues, of not validating string length before doing e.g. if (pInName[1] == ':') { ...} I suspect are relatively harmless (but I could be wrong). My gut feeling is that this is a "CVE, create immediate maint releases" -level issue. Finally, the attached patch looks good to me. -- O Unicef Clearasil! Gibberish and Drivel! -- "Bored of the Rings"
Subject: Re: [perl #126755] Perl 5.22 VDir::MapPathA/W Out-of-bounds Reads and Buffer Over-reads
Date: Tue, 1 Dec 2015 22:12:45 -0500
CC: perl5-security-report [...] perl.org
To: Dave Mitchell <davem [...] iabyn.com>
From: Ricardo Signes <perl.security [...] rjbs.manxome.org>
Download (untitled) / with headers
text/plain 294b
* Dave Mitchell <davem@iabyn.com> [2015-12-01T13:07:52] Show quoted text
> My gut feeling is that this is a "CVE, create immediate maint releases" > -level issue. > > Finally, the attached patch looks good to me.
Other thoughts, anyone? If we're gonna do it, I guess I better get started doin' it. -- rjbs
Download signature.asc
application/pgp-signature 473b

Message body not shown because it is not plain text.

Date: Wed, 2 Dec 2015 15:12:02 +1100
Subject: Re: [perl #126755] Perl 5.22 VDir::MapPathA/W Out-of-bounds Reads and Buffer Over-reads
To: perl5-security-report [...] perl.org
From: Tony Cook <tony [...] develop-help.com>
Download (untitled) / with headers
text/plain 1.9k
On Sat, Nov 28, 2015 at 04:30:57AM -0800, John Leitch wrote: Show quoted text
> To fix the issue, it is recommended that the VDir::MapPathA and
VDir::MapPathW functions validate the drive letter to ensure no out-of-bounds reads occur, and also check the length of the pInName argument to ensure no buffer over-reads occur. A proposed patch is attached. However, the patch only addresses the issues in VDir::MapPathA because it was not immediately clear how to hit VDir::MapPathW for the purpose of testing. It might be possible through Cwd::chdir(), since that calls Win32::GetFullPathName() which can call PerlDir_mapW() which ends up calling VDir::MapPathW(). Show quoted text
> diff --git a/win32/vdir.h b/win32/vdir.h > index 42c306b..37515f7 100644 > --- a/win32/vdir.h > +++ b/win32/vdir.h > @@ -383,6 +383,7 @@ char *VDir::MapPathA(const char *pInName) > * possiblities -- relative path or absolute path with or without drive letter > * OR UNC name > */ > + int driveIndex; > char szBuffer[(MAX_PATH+1)*2]; > char szlBuf[MAX_PATH+1]; > int length = strlen(pInName); > @@ -402,15 +403,18 @@ char *VDir::MapPathA(const char *pInName) > } > /* strlen(pInName) is now <= MAX_PATH */ > > - if (pInName[1] == ':') { > + if (length > 1 && pInName[1] == ':') { > /* has drive letter */ > - if (IsPathSep(pInName[2])) { > + if (length > 2 && IsPathSep(pInName[2])) { > /* absolute with drive letter */ > DoGetFullPathNameA((char*)pInName, sizeof(szLocalBufferA), szLocalBufferA); > } > else { > /* relative path with drive letter */ > - strcpy(szBuffer, GetDirA(DriveIndex(*pInName))); > + driveIndex = DriveIndex(*pInName); > + if (driveIndex < 0 || driveIndex >= driveCount) > + Perl_croak_nocontext("Bad drive letter '%c'", pInName[0]);
I'm not sure it should croak, perhaps it should just treat the name as a local filename, so with a current directory of "C:\FOO" we'd return "C:\FOO\]:" for your chdir example. Tony
Date: Wed, 2 Dec 2015 10:38:01 +0100
Subject: Re: [perl #126755] Perl 5.22 VDir::MapPathA/W Out-of-bounds Reads and Buffer Over-reads
To: <perl5-security-report [...] perl.org>
From: "John Leitch" <john [...] autosectools.com>
Download (untitled) / with headers
text/plain 2.3k
I'll take a look to see if I can hit the W functions tonight. As for prefixing the CWD, it would also be necessary to replace the ':' with something as it is an invalid dir/file character on Windows. Show quoted text
-----Original Message----- From: Tony Cook via RT Sent: Wednesday, December 2, 2015 5:12 AM To: john@autosectools.com Subject: Re: [perl #126755] Perl 5.22 VDir::MapPathA/W Out-of-bounds Reads and Buffer Over-reads On Sat, Nov 28, 2015 at 04:30:57AM -0800, John Leitch wrote:
> To fix the issue, it is recommended that the VDir::MapPathA and
VDir::MapPathW functions validate the drive letter to ensure no out-of-bounds reads occur, and also check the length of the pInName argument to ensure no buffer over-reads occur. A proposed patch is attached. However, the patch only addresses the issues in VDir::MapPathA because it was not immediately clear how to hit VDir::MapPathW for the purpose of testing. It might be possible through Cwd::chdir(), since that calls Win32::GetFullPathName() which can call PerlDir_mapW() which ends up calling VDir::MapPathW().
> diff --git a/win32/vdir.h b/win32/vdir.h > index 42c306b..37515f7 100644 > --- a/win32/vdir.h > +++ b/win32/vdir.h > @@ -383,6 +383,7 @@ char *VDir::MapPathA(const char *pInName) > * possiblities -- relative path or absolute path with or without > drive letter > * OR UNC name > */ > + int driveIndex; > char szBuffer[(MAX_PATH+1)*2]; > char szlBuf[MAX_PATH+1]; > int length = strlen(pInName); > @@ -402,15 +403,18 @@ char *VDir::MapPathA(const char *pInName) > } > /* strlen(pInName) is now <= MAX_PATH */ > > - if (pInName[1] == ':') { > + if (length > 1 && pInName[1] == ':') { > /* has drive letter */ > - if (IsPathSep(pInName[2])) { > + if (length > 2 && IsPathSep(pInName[2])) { > /* absolute with drive letter */ > DoGetFullPathNameA((char*)pInName, sizeof(szLocalBufferA), > szLocalBufferA); > } > else { > /* relative path with drive letter */ > - strcpy(szBuffer, GetDirA(DriveIndex(*pInName))); > + driveIndex = DriveIndex(*pInName); > + if (driveIndex < 0 || driveIndex >= driveCount) > + Perl_croak_nocontext("Bad drive letter '%c'", pInName[0]);
I'm not sure it should croak, perhaps it should just treat the name as a local filename, so with a current directory of "C:\FOO" we'd return "C:\FOO\]:" for your chdir example. Tony
CC: perl5-security-report [...] perl.org
From: Tony Cook <tony [...] develop-help.com>
To: John Leitch <john [...] autosectools.com>
Date: Wed, 2 Dec 2015 22:01:24 +1100
Subject: Re: [perl #126755] Perl 5.22 VDir::MapPathA/W Out-of-bounds Reads and Buffer Over-reads
Download (untitled) / with headers
text/plain 437b
On Wed, Dec 02, 2015 at 10:38:01AM +0100, John Leitch wrote: Show quoted text
> I'll take a look to see if I can hit the W functions tonight. As for > prefixing the CWD, it would also be necessary to replace the ':' with > something as it is an invalid dir/file character on Windows.
Perhaps it should just return the original filename, to avoid confusion in error messages when the caller gets around to using the returned value in an API call. Tony
Date: Thu, 3 Dec 2015 17:09:59 +0100
Subject: Re: [perl #126755] Perl 5.22 VDir::MapPathA/W Out-of-bounds Reads and Buffer Over-reads
From: "John Leitch" <john [...] autosectools.com>
To: <perl5-security-report [...] perl.org>
Download (untitled) / with headers
text/plain 1.1k
After further testing I was able to hit MapPathW, but not in a manner that allowed me to fully control pInName, so I was unable to trigger the vulnerability. Unfortunately I wasn't able to dedicate much time, so that's not to say it isn't possible, and I'm not comfortable fixing the issue without the ability to effectively confirm correctness. That said, attached is an updated patch for MapPathA that returns pInName in the event the drive letter is invalid. John Show quoted text
-----Original Message----- From: Tony Cook via RT Sent: Wednesday, December 2, 2015 12:02 PM To: john@autosectools.com Subject: Re: [perl #126755] Perl 5.22 VDir::MapPathA/W Out-of-bounds Reads and Buffer Over-reads On Wed, Dec 02, 2015 at 10:38:01AM +0100, John Leitch wrote:
> I'll take a look to see if I can hit the W functions tonight. As for > prefixing the CWD, it would also be necessary to replace the ':' with > something as it is an invalid dir/file character on Windows.
Perhaps it should just return the original filename, to avoid confusion in error messages when the caller gets around to using the returned value in an API call. Tony

Message body is not shown because sender requested not to inline it.

Subject: Re: [perl #126755] Perl 5.22 VDir::MapPathA/W Out-of-bounds Reads and Buffer Over-reads
Date: Sun, 13 Dec 2015 21:12:01 +0100
From: "John Leitch" <john [...] autosectools.com>
To: <perl5-security-report [...] perl.org>
Download (untitled) / with headers
text/plain 1.4k
Hi all, Has there been any movement on this? We'd like to disclose it publicly at some point in the future. John Show quoted text
-----Original Message----- From: John Leitch Sent: Thursday, December 3, 2015 17:09 To: perl5-security-report@perl.org Subject: Re: [perl #126755] Perl 5.22 VDir::MapPathA/W Out-of-bounds Reads and Buffer Over-reads After further testing I was able to hit MapPathW, but not in a manner that allowed me to fully control pInName, so I was unable to trigger the vulnerability. Unfortunately I wasn't able to dedicate much time, so that's not to say it isn't possible, and I'm not comfortable fixing the issue without the ability to effectively confirm correctness. That said, attached is an updated patch for MapPathA that returns pInName in the event the drive letter is invalid. John
-----Original Message----- From: Tony Cook via RT Sent: Wednesday, December 2, 2015 12:02 PM To: john@autosectools.com Subject: Re: [perl #126755] Perl 5.22 VDir::MapPathA/W Out-of-bounds Reads and Buffer Over-reads On Wed, Dec 02, 2015 at 10:38:01AM +0100, John Leitch wrote:
> I'll take a look to see if I can hit the W functions tonight. As for > prefixing the CWD, it would also be necessary to replace the ':' with > something as it is an invalid dir/file character on Windows.
Perhaps it should just return the original filename, to avoid confusion in error messages when the caller gets around to using the returned value in an API call. Tony
RT-Send-CC: rt-deliver-to-perl5-security-report [...] rt.perl.org
Download (untitled) / with headers
text/plain 593b
On Thu Dec 03 08:10:42 2015, john@autosectools.com wrote: Show quoted text
> After further testing I was able to hit MapPathW, but not in a manner > that > allowed me to fully control pInName, so I was unable to trigger the > vulnerability. Unfortunately I wasn't able to dedicate much time, so > that's > not to say it isn't possible, and I'm not comfortable fixing the issue > without the ability to effectively confirm correctness. > > That said, attached is an updated patch for MapPathA that returns > pInName in > the event the drive letter is invalid.
I was thinking something like the attached. Tony
Subject: 0001-perl-126755-avoid-invalid-memory-access-in-MapPath-A.patch
From 23863274c685ccdd4ed05c44d0db2e6dbba6a161 Mon Sep 17 00:00:00 2001 From: Tony Cook <tony@develop-help.com> Date: Mon, 14 Dec 2015 16:27:53 +1100 Subject: [perl #126755] avoid invalid memory access in MapPath[AW] --- MANIFEST | 1 + ext/XS-APItest/APItest.xs | 9 +++++++++ ext/XS-APItest/t/win32.t | 34 ++++++++++++++++++++++++++++++++++ ext/XS-APItest/typemap | 12 ++++++++++++ win32/vdir.h | 22 +++++++++++++++------- 5 files changed, 71 insertions(+), 7 deletions(-) create mode 100644 ext/XS-APItest/t/win32.t diff --git a/MANIFEST b/MANIFEST index 2a5a6a3..5d33307 100644 --- a/MANIFEST +++ b/MANIFEST @@ -4020,6 +4020,7 @@ ext/XS-APItest/t/utf16_to_utf8.t Test behaviour of utf16_to_utf8{,reversed} ext/XS-APItest/t/utf8.t Tests for code in utf8.c ext/XS-APItest/t/weaken.t XS::APItest: tests for sv_rvweaken() and sv_get_backrefs() ext/XS-APItest/t/whichsig.t XS::APItest: tests for whichsig() and variants +ext/XS-APItest/t/win32.t Test Win32 specific APIs ext/XS-APItest/t/xs_special_subs_require.t for require too ext/XS-APItest/t/xs_special_subs.t Test that XS BEGIN/CHECK/INIT/END work ext/XS-APItest/t/xsub_h.t Tests for XSUB.h diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs index ebdef68..e91bf5a 100644 --- a/ext/XS-APItest/APItest.xs +++ b/ext/XS-APItest/APItest.xs @@ -5517,3 +5517,12 @@ has_backrefs(SV *sv) OUTPUT: RETVAL +#if defined(WIN32) && defined(PERL_IMPLICIT_SYS) + +const char * +PerlDir_mapA(const char *path) + +const WCHAR * +PerlDir_mapW(const WCHAR *wpath) + +#endif diff --git a/ext/XS-APItest/t/win32.t b/ext/XS-APItest/t/win32.t new file mode 100644 index 0000000..edc82a1 --- /dev/null +++ b/ext/XS-APItest/t/win32.t @@ -0,0 +1,34 @@ +#!perl -w +use strict; +use Test::More; +use XS::APItest; +use Config; + +plan skip_all => "Tests only apply on MSWin32" + unless $^O eq "MSWin32"; + +SKIP: +{ + # [perl #126755] previous the bad drive tests would crash + $Config{ccflags} =~ /(?:\A|\s)-DPERL_IMPLICIT_SYS\b/ + or skip "need implicit_sys for this test", 1; + eval "use Encode; 1" + or skip "Can't load Encode", 1; + my $good_drive = "C:"; + my $result = PerlDir_mapA($good_drive); + like($result, qr/^C:\\/i, "check a good drive"); + my $bad_drive = "]:"; + $result = PerlDir_mapA($bad_drive); + is($result, $bad_drive, "check a bad drive"); + + my $wgood_drive = encode("UTF-16LE", $good_drive . "\0"); + $result = PerlDir_mapW($wgood_drive); + like(decode("UTF16-LE", $result), qr/^c:\\/i, + "check a good drive (wide)"); + my $wbad_drive = encode("UTF-16LE", $bad_drive . "\0"); + $result = PerlDir_mapW($wbad_drive); + is(decode("UTF16-LE", $result), "$bad_drive\0", + "check a bad drive (wide)"); +} + +done_testing(); diff --git a/ext/XS-APItest/typemap b/ext/XS-APItest/typemap index 035f882..ed86a37 100644 --- a/ext/XS-APItest/typemap +++ b/ext/XS-APItest/typemap @@ -1 +1,13 @@ XS::APItest::PtrTable T_PTROBJ + +const WCHAR * WPV + +INPUT + +WPV + $var = ($type)SvPV_nolen($arg); + +OUTPUT + +WPV + sv_setpvn($arg, (const char *)($var), sizeof(WCHAR) * (1+wcslen($var))); diff --git a/win32/vdir.h b/win32/vdir.h index 42c306b..5ab7764 100644 --- a/win32/vdir.h +++ b/win32/vdir.h @@ -383,6 +383,7 @@ char *VDir::MapPathA(const char *pInName) * possiblities -- relative path or absolute path with or without drive letter * OR UNC name */ + int driveIndex; char szBuffer[(MAX_PATH+1)*2]; char szlBuf[MAX_PATH+1]; int length = strlen(pInName); @@ -402,15 +403,18 @@ char *VDir::MapPathA(const char *pInName) } /* strlen(pInName) is now <= MAX_PATH */ - if (pInName[1] == ':') { + if (length > 1 && pInName[1] == ':') { /* has drive letter */ - if (IsPathSep(pInName[2])) { + if (length > 2 && IsPathSep(pInName[2])) { /* absolute with drive letter */ DoGetFullPathNameA((char*)pInName, sizeof(szLocalBufferA), szLocalBufferA); } else { /* relative path with drive letter */ - strcpy(szBuffer, GetDirA(DriveIndex(*pInName))); + driveIndex = DriveIndex(*pInName); + if (driveIndex < 0 || driveIndex > driveCount) + return (char *)pInName; + strcpy(szBuffer, GetDirA(driveIndex)); strcat(szBuffer, &pInName[2]); if(strlen(szBuffer) > MAX_PATH) szBuffer[MAX_PATH] = '\0'; @@ -420,7 +424,7 @@ char *VDir::MapPathA(const char *pInName) } else { /* no drive letter */ - if (IsPathSep(pInName[1]) && IsPathSep(pInName[0])) { + if (length > 1 && IsPathSep(pInName[1]) && IsPathSep(pInName[0])) { /* UNC name */ DoGetFullPathNameA((char*)pInName, sizeof(szLocalBufferA), szLocalBufferA); } @@ -611,6 +615,7 @@ WCHAR* VDir::MapPathW(const WCHAR *pInName) * possiblities -- relative path or absolute path with or without drive letter * OR UNC name */ + int driveIndex; WCHAR szBuffer[(MAX_PATH+1)*2]; WCHAR szlBuf[MAX_PATH+1]; int length = wcslen(pInName); @@ -630,7 +635,7 @@ WCHAR* VDir::MapPathW(const WCHAR *pInName) } /* strlen(pInName) is now <= MAX_PATH */ - if (pInName[1] == ':') { + if (length > 1 && pInName[1] == ':') { /* has drive letter */ if (IsPathSep(pInName[2])) { /* absolute with drive letter */ @@ -638,7 +643,10 @@ WCHAR* VDir::MapPathW(const WCHAR *pInName) } else { /* relative path with drive letter */ - wcscpy(szBuffer, GetDirW(DriveIndex((char)*pInName))); + driveIndex = DriveIndex(*pInName); + if (driveIndex < 0 || driveIndex > driveCount) + return (WCHAR *)pInName; + wcscpy(szBuffer, GetDirW(driveIndex)); wcscat(szBuffer, &pInName[2]); if(wcslen(szBuffer) > MAX_PATH) szBuffer[MAX_PATH] = '\0'; @@ -648,7 +656,7 @@ WCHAR* VDir::MapPathW(const WCHAR *pInName) } else { /* no drive letter */ - if (IsPathSep(pInName[1]) && IsPathSep(pInName[0])) { + if (length > 1 && IsPathSep(pInName[1]) && IsPathSep(pInName[0])) { /* UNC name */ DoGetFullPathNameW((WCHAR*)pInName, (sizeof(szLocalBufferW)/sizeof(WCHAR)), szLocalBufferW); } -- 1.9.5.msysgit.0
Date: Mon, 14 Dec 2015 17:54:13 -0500
Subject: Re: [perl #126755] Perl 5.22 VDir::MapPathA/W Out-of-bounds Reads and Buffer Over-reads
CC: ;, rt-deliver-to-perl5-security-report [...] rt.perl.org
From: Ricardo Signes <perl.security [...] rjbs.manxome.org>
To: Tony Cook via RT <perl5-security-report [...] perl.org>
Download (untitled) / with headers
text/plain 442b
* Tony Cook via RT <perl5-security-report@perl.org> [2015-12-14T00:44:28] Show quoted text
> I was thinking something like the attached.
I'd appreciate some more eyes on this. Getting this rolled out to vendors won't (necessarily) be too much of a pain since we only have two Win32 vendors, but nonetheless there's more to releasing this fix than publishing the patch. The sooner the patch is favorably reviewed, the sooner we can move forward. -- rjbs
Download signature.asc
application/pgp-signature 473b

Message body not shown because it is not plain text.

Date: Tue, 15 Dec 2015 18:42:07 +0100
Subject: Re: [perl #126755] Perl 5.22 VDir::MapPathA/W Out-of-bounds Reads and Buffer Over-reads
To: <perl5-security-report [...] perl.org>
From: "John Leitch" <john [...] autosectools.com>
Download (untitled) / with headers
text/plain 779b
I'm testing this now and I'm still experiencing crashes with the attached repro. Digging in now to figure it out. Show quoted text
-----Original Message----- From: Ricardo Signes via RT Sent: Monday, December 14, 2015 23:54 To: john@autosectools.com Subject: Re: [perl #126755] Perl 5.22 VDir::MapPathA/W Out-of-bounds Reads and Buffer Over-reads * Tony Cook via RT <perl5-security-report@perl.org> [2015-12-14T00:44:28]
> I was thinking something like the attached.
I'd appreciate some more eyes on this. Getting this rolled out to vendors won't (necessarily) be too much of a pain since we only have two Win32 vendors, but nonetheless there's more to releasing this fix than publishing the patch. The sooner the patch is favorably reviewed, the sooner we can move forward. -- rjbs

Message body is not shown because sender requested not to inline it.

Subject: Re: [perl #126755] Perl 5.22 VDir::MapPathA/W Out-of-bounds Reads and Buffer Over-reads
Date: Tue, 15 Dec 2015 19:42:07 +0100
To: <perl5-security-report [...] perl.org>
From: "John Leitch" <john [...] autosectools.com>
Attached is an updated patch. The issue was the driveIndex comparison, which should have been GTE rather than GT. Show quoted text
-----Original Message----- From: John Leitch Sent: Tuesday, December 15, 2015 18:42 To: perl5-security-report@perl.org Subject: Re: [perl #126755] Perl 5.22 VDir::MapPathA/W Out-of-bounds Reads and Buffer Over-reads I'm testing this now and I'm still experiencing crashes with the attached repro. Digging in now to figure it out.
-----Original Message----- From: Ricardo Signes via RT Sent: Monday, December 14, 2015 23:54 To: john@autosectools.com Subject: Re: [perl #126755] Perl 5.22 VDir::MapPathA/W Out-of-bounds Reads and Buffer Over-reads * Tony Cook via RT <perl5-security-report@perl.org> [2015-12-14T00:44:28]
> I was thinking something like the attached.
I'd appreciate some more eyes on this. Getting this rolled out to vendors won't (necessarily) be too much of a pain since we only have two Win32 vendors, but nonetheless there's more to releasing this fix than publishing the patch. The sooner the patch is favorably reviewed, the sooner we can move forward. -- rjbs

Message body is not shown because sender requested not to inline it.

RT-Send-CC: rt-deliver-to-perl5-security-report [...] rt.perl.org
Download (untitled) / with headers
text/plain 392b
On Tue Dec 15 10:42:33 2015, john@autosectools.com wrote: Show quoted text
> Attached is an updated patch. The issue was the driveIndex comparison, > which > should have been GTE rather than GT.
Actually >= driveCount is incorrect too, though it doesn't allow a crash. driveCount is 27 ('Z'-'A')+1+1 The attached patch fixes that and adds more extensive tests, including testing for fencepost errors. Tony
Subject: 0001-perl-126755-avoid-invalid-memory-access-in-MapPath-A.patch
From 15ea5c11597394535969bdb10aaa5952e47c6b37 Mon Sep 17 00:00:00 2001 From: Tony Cook <tony@develop-help.com> Date: Wed, 16 Dec 2015 11:13:30 +1100 Subject: [perl #126755] avoid invalid memory access in MapPath[AW] --- MANIFEST | 1 + ext/XS-APItest/APItest.xs | 9 +++++++++ ext/XS-APItest/t/win32.t | 39 +++++++++++++++++++++++++++++++++++++++ ext/XS-APItest/typemap | 12 ++++++++++++ win32/vdir.h | 23 ++++++++++++++++------- 5 files changed, 77 insertions(+), 7 deletions(-) create mode 100644 ext/XS-APItest/t/win32.t diff --git a/MANIFEST b/MANIFEST index 2a5a6a3..5d33307 100644 --- a/MANIFEST +++ b/MANIFEST @@ -4020,6 +4020,7 @@ ext/XS-APItest/t/utf16_to_utf8.t Test behaviour of utf16_to_utf8{,reversed} ext/XS-APItest/t/utf8.t Tests for code in utf8.c ext/XS-APItest/t/weaken.t XS::APItest: tests for sv_rvweaken() and sv_get_backrefs() ext/XS-APItest/t/whichsig.t XS::APItest: tests for whichsig() and variants +ext/XS-APItest/t/win32.t Test Win32 specific APIs ext/XS-APItest/t/xs_special_subs_require.t for require too ext/XS-APItest/t/xs_special_subs.t Test that XS BEGIN/CHECK/INIT/END work ext/XS-APItest/t/xsub_h.t Tests for XSUB.h diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs index ebdef68..e91bf5a 100644 --- a/ext/XS-APItest/APItest.xs +++ b/ext/XS-APItest/APItest.xs @@ -5517,3 +5517,12 @@ has_backrefs(SV *sv) OUTPUT: RETVAL +#if defined(WIN32) && defined(PERL_IMPLICIT_SYS) + +const char * +PerlDir_mapA(const char *path) + +const WCHAR * +PerlDir_mapW(const WCHAR *wpath) + +#endif diff --git a/ext/XS-APItest/t/win32.t b/ext/XS-APItest/t/win32.t new file mode 100644 index 0000000..a8905c2 --- /dev/null +++ b/ext/XS-APItest/t/win32.t @@ -0,0 +1,39 @@ +#!perl -w +use strict; +use Test::More; +use XS::APItest; +use Config; + +plan skip_all => "Tests only apply on MSWin32" + unless $^O eq "MSWin32"; + +SKIP: +{ + # [perl #126755] previous the bad drive tests would crash + $Config{ccflags} =~ /(?:\A|\s)-DPERL_IMPLICIT_SYS\b/ + or skip "need implicit_sys for this test", 1; + eval "use Encode; 1" + or skip "Can't load Encode", 1; + for my $letter ("A" .. "Z", "a" .. "z") { + my $good_drive = $letter . ":"; + my $result = PerlDir_mapA($good_drive); + like($result, qr/^$letter:\\/i, "check good drive $letter"); + + my $wgood_drive = encode("UTF-16LE", $good_drive . "\0"); + $result = PerlDir_mapW($wgood_drive); + like(decode("UTF16-LE", $result), qr/^$letter:\\/i, + "check a good drive (wide)"); + } + for my $bad ('@', '[', '!', '~', '`', '{') { + my $bad_drive = "$bad:"; + my $result = PerlDir_mapA($bad_drive); + is($result, $bad_drive, "check bad drive $bad:"); + + my $wbad_drive = encode("UTF-16LE", $bad_drive . "\0"); + $result = PerlDir_mapW($wbad_drive); + is(decode("UTF16-LE", $result), "$bad_drive\0", + "check bad drive $bad: (wide)"); + } +} + +done_testing(); diff --git a/ext/XS-APItest/typemap b/ext/XS-APItest/typemap index 035f882..ed86a37 100644 --- a/ext/XS-APItest/typemap +++ b/ext/XS-APItest/typemap @@ -1 +1,13 @@ XS::APItest::PtrTable T_PTROBJ + +const WCHAR * WPV + +INPUT + +WPV + $var = ($type)SvPV_nolen($arg); + +OUTPUT + +WPV + sv_setpvn($arg, (const char *)($var), sizeof(WCHAR) * (1+wcslen($var))); diff --git a/win32/vdir.h b/win32/vdir.h index 42c306b..b5c6bc6 100644 --- a/win32/vdir.h +++ b/win32/vdir.h @@ -15,6 +15,7 @@ * and one additional slot for a UNC name */ const int driveCount = ('Z'-'A')+1+1; +const int driveLetterCount = ('Z'-'A')+1; class VDir { @@ -383,6 +384,7 @@ char *VDir::MapPathA(const char *pInName) * possiblities -- relative path or absolute path with or without drive letter * OR UNC name */ + int driveIndex; char szBuffer[(MAX_PATH+1)*2]; char szlBuf[MAX_PATH+1]; int length = strlen(pInName); @@ -402,15 +404,18 @@ char *VDir::MapPathA(const char *pInName) } /* strlen(pInName) is now <= MAX_PATH */ - if (pInName[1] == ':') { + if (length > 1 && pInName[1] == ':') { /* has drive letter */ - if (IsPathSep(pInName[2])) { + if (length > 2 && IsPathSep(pInName[2])) { /* absolute with drive letter */ DoGetFullPathNameA((char*)pInName, sizeof(szLocalBufferA), szLocalBufferA); } else { /* relative path with drive letter */ - strcpy(szBuffer, GetDirA(DriveIndex(*pInName))); + driveIndex = DriveIndex(*pInName); + if (driveIndex < 0 || driveIndex >= driveLetterCount) + return (char *)pInName; + strcpy(szBuffer, GetDirA(driveIndex)); strcat(szBuffer, &pInName[2]); if(strlen(szBuffer) > MAX_PATH) szBuffer[MAX_PATH] = '\0'; @@ -420,7 +425,7 @@ char *VDir::MapPathA(const char *pInName) } else { /* no drive letter */ - if (IsPathSep(pInName[1]) && IsPathSep(pInName[0])) { + if (length > 1 && IsPathSep(pInName[1]) && IsPathSep(pInName[0])) { /* UNC name */ DoGetFullPathNameA((char*)pInName, sizeof(szLocalBufferA), szLocalBufferA); } @@ -611,6 +616,7 @@ WCHAR* VDir::MapPathW(const WCHAR *pInName) * possiblities -- relative path or absolute path with or without drive letter * OR UNC name */ + int driveIndex; WCHAR szBuffer[(MAX_PATH+1)*2]; WCHAR szlBuf[MAX_PATH+1]; int length = wcslen(pInName); @@ -630,7 +636,7 @@ WCHAR* VDir::MapPathW(const WCHAR *pInName) } /* strlen(pInName) is now <= MAX_PATH */ - if (pInName[1] == ':') { + if (length > 1 && pInName[1] == ':') { /* has drive letter */ if (IsPathSep(pInName[2])) { /* absolute with drive letter */ @@ -638,7 +644,10 @@ WCHAR* VDir::MapPathW(const WCHAR *pInName) } else { /* relative path with drive letter */ - wcscpy(szBuffer, GetDirW(DriveIndex((char)*pInName))); + driveIndex = DriveIndex(*pInName); + if (driveIndex < 0 || driveIndex >= driveLetterCount) + return (WCHAR *)pInName; + wcscpy(szBuffer, GetDirW(driveIndex)); wcscat(szBuffer, &pInName[2]); if(wcslen(szBuffer) > MAX_PATH) szBuffer[MAX_PATH] = '\0'; @@ -648,7 +657,7 @@ WCHAR* VDir::MapPathW(const WCHAR *pInName) } else { /* no drive letter */ - if (IsPathSep(pInName[1]) && IsPathSep(pInName[0])) { + if (length > 1 && IsPathSep(pInName[1]) && IsPathSep(pInName[0])) { /* UNC name */ DoGetFullPathNameW((WCHAR*)pInName, (sizeof(szLocalBufferW)/sizeof(WCHAR)), szLocalBufferW); } -- 1.9.5.msysgit.0
From: "John Leitch" <john [...] autosectools.com>
Date: Wed, 16 Dec 2015 17:30:22 +0100
To: <perl5-security-report [...] perl.org>
Subject: Re: [perl #126755] Perl 5.22 VDir::MapPathA/W Out-of-bounds Reads and Buffer Over-reads
As an outsider looking in, this seems good to me. Show quoted text
-----Original Message----- From: Tony Cook via RT Sent: Wednesday, December 16, 2015 01:17 To: john@autosectools.com Subject: [perl #126755] Perl 5.22 VDir::MapPathA/W Out-of-bounds Reads and Buffer Over-reads On Tue Dec 15 10:42:33 2015, john@autosectools.com wrote:
> Attached is an updated patch. The issue was the driveIndex comparison, > which > should have been GTE rather than GT.
Actually >= driveCount is incorrect too, though it doesn't allow a crash. driveCount is 27 ('Z'-'A')+1+1 The attached patch fixes that and adds more extensive tests, including testing for fencepost errors. Tony From 15ea5c11597394535969bdb10aaa5952e47c6b37 Mon Sep 17 00:00:00 2001 From: Tony Cook <tony@develop-help.com> Date: Wed, 16 Dec 2015 11:13:30 +1100 Subject: [perl #126755] avoid invalid memory access in MapPath[AW] --- MANIFEST | 1 + ext/XS-APItest/APItest.xs | 9 +++++++++ ext/XS-APItest/t/win32.t | 39 +++++++++++++++++++++++++++++++++++++++ ext/XS-APItest/typemap | 12 ++++++++++++ win32/vdir.h | 23 ++++++++++++++++------- 5 files changed, 77 insertions(+), 7 deletions(-) create mode 100644 ext/XS-APItest/t/win32.t diff --git a/MANIFEST b/MANIFEST index 2a5a6a3..5d33307 100644 --- a/MANIFEST +++ b/MANIFEST @@ -4020,6 +4020,7 @@ ext/XS-APItest/t/utf16_to_utf8.t Test behaviour of utf16_to_utf8{,reversed} ext/XS-APItest/t/utf8.t Tests for code in utf8.c ext/XS-APItest/t/weaken.t XS::APItest: tests for sv_rvweaken() and sv_get_backrefs() ext/XS-APItest/t/whichsig.t XS::APItest: tests for whichsig() and variants +ext/XS-APItest/t/win32.t Test Win32 specific APIs ext/XS-APItest/t/xs_special_subs_require.t for require too ext/XS-APItest/t/xs_special_subs.t Test that XS BEGIN/CHECK/INIT/END work ext/XS-APItest/t/xsub_h.t Tests for XSUB.h diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs index ebdef68..e91bf5a 100644 --- a/ext/XS-APItest/APItest.xs +++ b/ext/XS-APItest/APItest.xs @@ -5517,3 +5517,12 @@ has_backrefs(SV *sv) OUTPUT: RETVAL +#if defined(WIN32) && defined(PERL_IMPLICIT_SYS) + +const char * +PerlDir_mapA(const char *path) + +const WCHAR * +PerlDir_mapW(const WCHAR *wpath) + +#endif diff --git a/ext/XS-APItest/t/win32.t b/ext/XS-APItest/t/win32.t new file mode 100644 index 0000000..a8905c2 --- /dev/null +++ b/ext/XS-APItest/t/win32.t @@ -0,0 +1,39 @@ +#!perl -w +use strict; +use Test::More; +use XS::APItest; +use Config; + +plan skip_all => "Tests only apply on MSWin32" + unless $^O eq "MSWin32"; + +SKIP: +{ + # [perl #126755] previous the bad drive tests would crash + $Config{ccflags} =~ /(?:\A|\s)-DPERL_IMPLICIT_SYS\b/ + or skip "need implicit_sys for this test", 1; + eval "use Encode; 1" + or skip "Can't load Encode", 1; + for my $letter ("A" .. "Z", "a" .. "z") { + my $good_drive = $letter . ":"; + my $result = PerlDir_mapA($good_drive); + like($result, qr/^$letter:\\/i, "check good drive $letter"); + + my $wgood_drive = encode("UTF-16LE", $good_drive . "\0"); + $result = PerlDir_mapW($wgood_drive); + like(decode("UTF16-LE", $result), qr/^$letter:\\/i, + "check a good drive (wide)"); + } + for my $bad ('@', '[', '!', '~', '`', '{') { + my $bad_drive = "$bad:"; + my $result = PerlDir_mapA($bad_drive); + is($result, $bad_drive, "check bad drive $bad:"); + + my $wbad_drive = encode("UTF-16LE", $bad_drive . "\0"); + $result = PerlDir_mapW($wbad_drive); + is(decode("UTF16-LE", $result), "$bad_drive\0", + "check bad drive $bad: (wide)"); + } +} + +done_testing(); diff --git a/ext/XS-APItest/typemap b/ext/XS-APItest/typemap index 035f882..ed86a37 100644 --- a/ext/XS-APItest/typemap +++ b/ext/XS-APItest/typemap @@ -1 +1,13 @@ XS::APItest::PtrTable T_PTROBJ + +const WCHAR * WPV + +INPUT + +WPV + $var = ($type)SvPV_nolen($arg); + +OUTPUT + +WPV + sv_setpvn($arg, (const char *)($var), sizeof(WCHAR) * (1+wcslen($var))); diff --git a/win32/vdir.h b/win32/vdir.h index 42c306b..b5c6bc6 100644 --- a/win32/vdir.h +++ b/win32/vdir.h @@ -15,6 +15,7 @@ * and one additional slot for a UNC name */ const int driveCount = ('Z'-'A')+1+1; +const int driveLetterCount = ('Z'-'A')+1; class VDir { @@ -383,6 +384,7 @@ char *VDir::MapPathA(const char *pInName) * possiblities -- relative path or absolute path with or without drive letter * OR UNC name */ + int driveIndex; char szBuffer[(MAX_PATH+1)*2]; char szlBuf[MAX_PATH+1]; int length = strlen(pInName); @@ -402,15 +404,18 @@ char *VDir::MapPathA(const char *pInName) } /* strlen(pInName) is now <= MAX_PATH */ - if (pInName[1] == ':') { + if (length > 1 && pInName[1] == ':') { /* has drive letter */ - if (IsPathSep(pInName[2])) { + if (length > 2 && IsPathSep(pInName[2])) { /* absolute with drive letter */ DoGetFullPathNameA((char*)pInName, sizeof(szLocalBufferA), szLocalBufferA); } else { /* relative path with drive letter */ - strcpy(szBuffer, GetDirA(DriveIndex(*pInName))); + driveIndex = DriveIndex(*pInName); + if (driveIndex < 0 || driveIndex >= driveLetterCount) + return (char *)pInName; + strcpy(szBuffer, GetDirA(driveIndex)); strcat(szBuffer, &pInName[2]); if(strlen(szBuffer) > MAX_PATH) szBuffer[MAX_PATH] = '\0'; @@ -420,7 +425,7 @@ char *VDir::MapPathA(const char *pInName) } else { /* no drive letter */ - if (IsPathSep(pInName[1]) && IsPathSep(pInName[0])) { + if (length > 1 && IsPathSep(pInName[1]) && IsPathSep(pInName[0])) { /* UNC name */ DoGetFullPathNameA((char*)pInName, sizeof(szLocalBufferA), szLocalBufferA); } @@ -611,6 +616,7 @@ WCHAR* VDir::MapPathW(const WCHAR *pInName) * possiblities -- relative path or absolute path with or without drive letter * OR UNC name */ + int driveIndex; WCHAR szBuffer[(MAX_PATH+1)*2]; WCHAR szlBuf[MAX_PATH+1]; int length = wcslen(pInName); @@ -630,7 +636,7 @@ WCHAR* VDir::MapPathW(const WCHAR *pInName) } /* strlen(pInName) is now <= MAX_PATH */ - if (pInName[1] == ':') { + if (length > 1 && pInName[1] == ':') { /* has drive letter */ if (IsPathSep(pInName[2])) { /* absolute with drive letter */ @@ -638,7 +644,10 @@ WCHAR* VDir::MapPathW(const WCHAR *pInName) } else { /* relative path with drive letter */ - wcscpy(szBuffer, GetDirW(DriveIndex((char)*pInName))); + driveIndex = DriveIndex(*pInName); + if (driveIndex < 0 || driveIndex >= driveLetterCount) + return (WCHAR *)pInName; + wcscpy(szBuffer, GetDirW(driveIndex)); wcscat(szBuffer, &pInName[2]); if(wcslen(szBuffer) > MAX_PATH) szBuffer[MAX_PATH] = '\0'; @@ -648,7 +657,7 @@ WCHAR* VDir::MapPathW(const WCHAR *pInName) } else { /* no drive letter */ - if (IsPathSep(pInName[1]) && IsPathSep(pInName[0])) { + if (length > 1 && IsPathSep(pInName[1]) && IsPathSep(pInName[0])) { /* UNC name */ DoGetFullPathNameW((WCHAR*)pInName, (sizeof(szLocalBufferW)/sizeof(WCHAR)), szLocalBufferW); } -- 1.9.5.msysgit.0
From: Ricardo Signes <perl.security [...] rjbs.manxome.org>
To: Tony Cook via RT <perl5-security-report [...] perl.org>
CC: ;, rt-deliver-to-perl5-security-report [...] rt.perl.org
Date: Thu, 17 Dec 2015 19:51:26 -0500
Subject: Re: [perl #126755] Perl 5.22 VDir::MapPathA/W Out-of-bounds Reads and Buffer Over-reads
Download (untitled) / with headers
text/plain 1.1k
* Tony Cook via RT <perl5-security-report@perl.org> [2015-12-15T19:17:52] Show quoted text
> From: Tony Cook <tony@develop-help.com> > Date: Wed, 16 Dec 2015 11:13:30 +1100 > Subject: [perl #126755] avoid invalid memory access in MapPath[AW]
I have assigned this issue CVE-2015-8608. I will notify the Win32 vendors, Strawberry and ActiveState, writing: Perl 5.22 suffers from two out-of-bounds read and multiple small buffer over-read vulnerabilities in the VDir::MapPathA and VDir::MapPathW functions that could potentially be exploited to achieve arbitrary code execution. These defects have been present since perl-5.005_02-2346-g7766f13, circa 1999. These defects were found and reported by John Leitch of AutoSec Tools. It was unclear to me whether the patch is the product of Tony Cook, or Tony's refinement of John's patch. I'll move this ticket to the perl5 queue when the embargo expires. I was going to call it two weeks, because it's only two vendors... but it's also Christmas and New Year's. I'm putting the release date on January 11, unless there are objections between now and tomorrow at (my) lunchtime, when I plan to send the above, with patch, to the vendors. -- rjbs
Download signature.asc
application/pgp-signature 473b

Message body not shown because it is not plain text.

Subject: Re: [perl #126755] Perl 5.22 VDir::MapPathA/W Out-of-bounds Reads and Buffer Over-reads
Date: Fri, 18 Dec 2015 02:50:19 +0100
To: <perl5-security-report [...] perl.org>
From: "John Leitch" <john [...] autosectools.com>
Download (untitled) / with headers
text/plain 1.4k
If I'm not mistaken, it is a refinement of my patch. Also, if possible, please also credit Bryce Darling. Show quoted text
-----Original Message----- From: Ricardo Signes via RT Sent: Friday, December 18, 2015 01:52 To: john@autosectools.com Subject: Re: [perl #126755] Perl 5.22 VDir::MapPathA/W Out-of-bounds Reads and Buffer Over-reads * Tony Cook via RT <perl5-security-report@perl.org> [2015-12-15T19:17:52]
> From: Tony Cook <tony@develop-help.com> > Date: Wed, 16 Dec 2015 11:13:30 +1100 > Subject: [perl #126755] avoid invalid memory access in MapPath[AW]
I have assigned this issue CVE-2015-8608. I will notify the Win32 vendors, Strawberry and ActiveState, writing: Perl 5.22 suffers from two out-of-bounds read and multiple small buffer over-read vulnerabilities in the VDir::MapPathA and VDir::MapPathW functions that could potentially be exploited to achieve arbitrary code execution. These defects have been present since perl-5.005_02-2346-g7766f13, circa 1999. These defects were found and reported by John Leitch of AutoSec Tools. It was unclear to me whether the patch is the product of Tony Cook, or Tony's refinement of John's patch. I'll move this ticket to the perl5 queue when the embargo expires. I was going to call it two weeks, because it's only two vendors... but it's also Christmas and New Year's. I'm putting the release date on January 11, unless there are objections between now and tomorrow at (my) lunchtime, when I plan to send the above, with patch, to the vendors. -- rjbs
CC: perl5-security-report [...] perl.org
From: Ricardo Signes <perl.security [...] rjbs.manxome.org>
To: John Leitch <john [...] autosectools.com>
Date: Fri, 18 Dec 2015 10:31:31 -0500
Subject: Re: [perl #126755] Perl 5.22 VDir::MapPathA/W Out-of-bounds Reads and Buffer Over-reads
Download (untitled) / with headers
text/plain 209b
* John Leitch <john@autosectools.com> [2015-12-17T20:50:19] Show quoted text
> If I'm not mistaken, it is a refinement of my patch. Also, if possible, > please also credit Bryce Darling.
Happy to. Also of AutoSec? -- rjbs
Download signature.asc
application/pgp-signature 473b

Message body not shown because it is not plain text.

Date: Fri, 18 Dec 2015 16:43:22 +0100
Subject: Re: [perl #126755] Perl 5.22 VDir::MapPathA/W Out-of-bounds Reads and Buffer Over-reads
From: "John Leitch" <john [...] autosectools.com>
To: <perl5-security-report [...] perl.org>
Download (untitled) / with headers
text/plain 434b
Yup Show quoted text
-----Original Message----- From: Ricardo Signes via RT Sent: Friday, December 18, 2015 16:32 To: john@autosectools.com Subject: Re: [perl #126755] Perl 5.22 VDir::MapPathA/W Out-of-bounds Reads and Buffer Over-reads * John Leitch <john@autosectools.com> [2015-12-17T20:50:19]
> If I'm not mistaken, it is a refinement of my patch. Also, if possible, > please also credit Bryce Darling.
Happy to. Also of AutoSec? -- rjbs
Date: Fri, 18 Dec 2015 12:55:08 -0500
Subject: Re: [perl #126755] Perl 5.22 VDir::MapPathA/W Out-of-bounds Reads and Buffer Over-reads
From: Ricardo Signes <perl.security [...] rjbs.manxome.org>
To: Dave Mitchell <davem [...] iabyn.com>
CC: perl5-security-report [...] perl.org
Download (untitled) / with headers
text/plain 545b
* Dave Mitchell <davem@iabyn.com> [2015-12-01T13:07:52] Show quoted text
> My gut feeling is that this is a "CVE, create immediate maint releases" > -level issue.
I got the CVE. It makes sense to apply the patch to maint branches, and to urge ActiveState and Strawberry to issue new releases. Do we *also* want to make a new (say v5.18.5) release? It will help users building from tarball source releases on Win32, which I imagine is quite a small number. I'm not strongly opposed, but I'm also not convinced it's worth the effort. Anybody else? -- rjbs
Download signature.asc
application/pgp-signature 473b

Message body not shown because it is not plain text.

CC: perl5-security-report [...] perl.org
To: Ricardo Signes <perl.security [...] rjbs.manxome.org>
Subject: Re: [perl #126755] Perl 5.22 VDir::MapPathA/W Out-of-bounds Reads and Buffer Over-reads
From: Dave Mitchell <davem [...] iabyn.com>
Date: Mon, 21 Dec 2015 11:25:51 +0000
Download (untitled) / with headers
text/plain 998b
On Fri, Dec 18, 2015 at 12:55:08PM -0500, Ricardo Signes wrote: Show quoted text
> * Dave Mitchell <davem@iabyn.com> [2015-12-01T13:07:52]
> > My gut feeling is that this is a "CVE, create immediate maint releases" > > -level issue.
> > I got the CVE. It makes sense to apply the patch to maint branches, and to > urge ActiveState and Strawberry to issue new releases. > > Do we *also* want to make a new (say v5.18.5) release? It will help users > building from tarball source releases on Win32, which I imagine is quite a > small number. > > I'm not strongly opposed, but I'm also not convinced it's worth the effort.
I don't have any particularly strong opinions. I don't know much about how ActiveState and the Stawberry Guys do their stuff. Would they push out patched versions of maint releases? -- Wesley Crusher gets beaten up by his classmates for being a smarmy git, and consequently has a go at making some friends of his own age for a change. -- Things That Never Happen in "Star Trek" #18
To: Dave Mitchell <davem [...] iabyn.com>
From: Ricardo Signes <perl.security [...] rjbs.manxome.org>
CC: perl5-security-report [...] perl.org
Subject: Re: [perl #126755] Perl 5.22 VDir::MapPathA/W Out-of-bounds Reads and Buffer Over-reads
Date: Tue, 22 Dec 2015 18:40:46 -0500
Download (untitled) / with headers
text/plain 508b
* Dave Mitchell <davem@iabyn.com> [2015-12-21T06:25:51] Show quoted text
> I don't have any particularly strong opinions. I don't know much about how > ActiveState and the Stawberry Guys do their stuff. Would they push out > patched versions of maint releases?
Strawberry will, but had trouble applying the patch to maint. I'm going to have a look at giving them combined patches, although I may need to ask for an assist. Expect that in the next few hours. I'd think AS would on their own, but I'll follow up. -- rjbs
Download signature.asc
application/pgp-signature 473b

Message body not shown because it is not plain text.

Subject: Re: [perl #126755] Perl 5.22 VDir::MapPathA/W Out-of-bounds Reads and Buffer Over-reads
Date: Tue, 22 Dec 2015 18:56:46 -0500
To: Tony Cook via RT <perl5-security-report [...] perl.org>
From: Ricardo Signes <perl.security [...] rjbs.manxome.org>
CC: rt-deliver-to-perl5-security-report [...] rt.perl.org
Download (untitled) / with headers
text/plain 646b
* Ricardo Signes <perl.security@rjbs.manxome.org> [2015-12-17T19:51:26] Show quoted text
> I have assigned this issue CVE-2015-8608. > > I will notify the Win32 vendors, Strawberry and ActiveState, writing: > [ blah blah blah ]
kmx, maintainer of Strawyberry Perl, notes that this patch does not apply cleanly to 5.20. I had a look, but the conflicts are beyond what I am confident in my ability to resolve. (The patch for CVE-2015-8608 also does not apply, but I can sort that one out myself.) kmx has asked me to provide jumbo combined patches for these two issues, which I am happy to do, if a patch for maint-5.20 can be provided to me ASAP. -- rjbs
Download signature.asc
application/pgp-signature 473b

Message body not shown because it is not plain text.

RT-Send-CC: rt-deliver-to-perl5-security-report [...] rt.perl.org
Download (untitled) / with headers
text/plain 243b
On Tue Dec 22 15:57:33 2015, perl.security@rjbs.manxome.org wrote: Show quoted text
> kmx has asked me to provide jumbo combined patches for these two > issues, which > I am happy to do, if a patch for maint-5.20 can be provided to me > ASAP.
Attached. Tony
Subject: 0001-perl-126755-avoid-invalid-memory-access-in-MapPath-A.patch
From e3857c2d31d15c3eb06b1f4348a5a4bdfc3d6b46 Mon Sep 17 00:00:00 2001 From: Tony Cook <tony@develop-help.com> Date: Wed, 23 Dec 2015 14:58:26 +1100 Subject: [perl #126755] avoid invalid memory access in MapPath[AW] --- MANIFEST | 1 + ext/XS-APItest/APItest.pm | 2 +- ext/XS-APItest/APItest.xs | 10 ++++++++++ ext/XS-APItest/t/win32.t | 39 +++++++++++++++++++++++++++++++++++++++ ext/XS-APItest/typemap | 12 ++++++++++++ win32/vdir.h | 23 ++++++++++++++++------- 6 files changed, 79 insertions(+), 8 deletions(-) create mode 100644 ext/XS-APItest/t/win32.t diff --git a/MANIFEST b/MANIFEST index da8a493..2fbc0fc 100644 --- a/MANIFEST +++ b/MANIFEST @@ -4000,6 +4000,7 @@ ext/XS-APItest/t/underscore_length.t Test find_rundefsv() ext/XS-APItest/t/utf16_to_utf8.t Test behaviour of utf16_to_utf8{,reversed} ext/XS-APItest/t/utf8.t Tests for code in utf8.c ext/XS-APItest/t/whichsig.t XS::APItest: tests for whichsig() and variants +ext/XS-APItest/t/win32.t Test Win32 specific APIs ext/XS-APItest/t/xs_special_subs_require.t for require too ext/XS-APItest/t/xs_special_subs.t Test that XS BEGIN/CHECK/INIT/END work ext/XS-APItest/t/xsub_h.t Tests for XSUB.h diff --git a/ext/XS-APItest/APItest.pm b/ext/XS-APItest/APItest.pm index 63ea858..ec8bc9e 100644 --- a/ext/XS-APItest/APItest.pm +++ b/ext/XS-APItest/APItest.pm @@ -5,7 +5,7 @@ use strict; use warnings; use Carp; -our $VERSION = '0.60_01'; +our $VERSION = '0.60_02'; require XSLoader; diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs index 8e78736..79c2264 100644 --- a/ext/XS-APItest/APItest.xs +++ b/ext/XS-APItest/APItest.xs @@ -4792,3 +4792,13 @@ test_toTITLE_utf8(SV * p) RETVAL = av; OUTPUT: RETVAL + +#if defined(WIN32) && defined(PERL_IMPLICIT_SYS) + +const char * +PerlDir_mapA(const char *path) + +const WCHAR * +PerlDir_mapW(const WCHAR *wpath) + +#endif diff --git a/ext/XS-APItest/t/win32.t b/ext/XS-APItest/t/win32.t new file mode 100644 index 0000000..a8905c2 --- /dev/null +++ b/ext/XS-APItest/t/win32.t @@ -0,0 +1,39 @@ +#!perl -w +use strict; +use Test::More; +use XS::APItest; +use Config; + +plan skip_all => "Tests only apply on MSWin32" + unless $^O eq "MSWin32"; + +SKIP: +{ + # [perl #126755] previous the bad drive tests would crash + $Config{ccflags} =~ /(?:\A|\s)-DPERL_IMPLICIT_SYS\b/ + or skip "need implicit_sys for this test", 1; + eval "use Encode; 1" + or skip "Can't load Encode", 1; + for my $letter ("A" .. "Z", "a" .. "z") { + my $good_drive = $letter . ":"; + my $result = PerlDir_mapA($good_drive); + like($result, qr/^$letter:\\/i, "check good drive $letter"); + + my $wgood_drive = encode("UTF-16LE", $good_drive . "\0"); + $result = PerlDir_mapW($wgood_drive); + like(decode("UTF16-LE", $result), qr/^$letter:\\/i, + "check a good drive (wide)"); + } + for my $bad ('@', '[', '!', '~', '`', '{') { + my $bad_drive = "$bad:"; + my $result = PerlDir_mapA($bad_drive); + is($result, $bad_drive, "check bad drive $bad:"); + + my $wbad_drive = encode("UTF-16LE", $bad_drive . "\0"); + $result = PerlDir_mapW($wbad_drive); + is(decode("UTF16-LE", $result), "$bad_drive\0", + "check bad drive $bad: (wide)"); + } +} + +done_testing(); diff --git a/ext/XS-APItest/typemap b/ext/XS-APItest/typemap index 035f882..ed86a37 100644 --- a/ext/XS-APItest/typemap +++ b/ext/XS-APItest/typemap @@ -1 +1,13 @@ XS::APItest::PtrTable T_PTROBJ + +const WCHAR * WPV + +INPUT + +WPV + $var = ($type)SvPV_nolen($arg); + +OUTPUT + +WPV + sv_setpvn($arg, (const char *)($var), sizeof(WCHAR) * (1+wcslen($var))); diff --git a/win32/vdir.h b/win32/vdir.h index a4186a1..b922130 100644 --- a/win32/vdir.h +++ b/win32/vdir.h @@ -15,6 +15,7 @@ * and one additional slot for a UNC name */ const int driveCount = ('Z'-'A')+1+1; +const int driveLetterCount = ('Z'-'A')+1; class VDir { @@ -383,6 +384,7 @@ char *VDir::MapPathA(const char *pInName) * possiblities -- relative path or absolute path with or without drive letter * OR UNC name */ + int driveIndex; char szBuffer[(MAX_PATH+1)*2]; char szlBuf[MAX_PATH+1]; int length = strlen(pInName); @@ -402,15 +404,18 @@ char *VDir::MapPathA(const char *pInName) } /* strlen(pInName) is now <= MAX_PATH */ - if (pInName[1] == ':') { + if (length > 1 && pInName[1] == ':') { /* has drive letter */ - if (IsPathSep(pInName[2])) { + if (length > 2 && IsPathSep(pInName[2])) { /* absolute with drive letter */ DoGetFullPathNameA((char*)pInName, sizeof(szLocalBufferA), szLocalBufferA); } else { /* relative path with drive letter */ - strcpy(szBuffer, GetDirA(DriveIndex(*pInName))); + driveIndex = DriveIndex(*pInName); + if (driveIndex < 0 || driveIndex >= driveLetterCount) + return (char *)pInName; + strcpy(szBuffer, GetDirA(driveIndex)); strcat(szBuffer, &pInName[2]); if(strlen(szBuffer) > MAX_PATH) szBuffer[MAX_PATH] = '\0'; @@ -420,7 +425,7 @@ char *VDir::MapPathA(const char *pInName) } else { /* no drive letter */ - if (IsPathSep(pInName[1]) && IsPathSep(pInName[0])) { + if (length > 1 && IsPathSep(pInName[1]) && IsPathSep(pInName[0])) { /* UNC name */ DoGetFullPathNameA((char*)pInName, sizeof(szLocalBufferA), szLocalBufferA); } @@ -611,6 +616,7 @@ WCHAR* VDir::MapPathW(const WCHAR *pInName) * possiblities -- relative path or absolute path with or without drive letter * OR UNC name */ + int driveIndex; WCHAR szBuffer[(MAX_PATH+1)*2]; WCHAR szlBuf[MAX_PATH+1]; int length = wcslen(pInName); @@ -630,7 +636,7 @@ WCHAR* VDir::MapPathW(const WCHAR *pInName) } /* strlen(pInName) is now <= MAX_PATH */ - if (pInName[1] == ':') { + if (length > 1 && pInName[1] == ':') { /* has drive letter */ if (IsPathSep(pInName[2])) { /* absolute with drive letter */ @@ -638,7 +644,10 @@ WCHAR* VDir::MapPathW(const WCHAR *pInName) } else { /* relative path with drive letter */ - wcscpy(szBuffer, GetDirW(DriveIndex((char)*pInName))); + driveIndex = DriveIndex(*pInName); + if (driveIndex < 0 || driveIndex >= driveLetterCount) + return (WCHAR *)pInName; + wcscpy(szBuffer, GetDirW(driveIndex)); wcscat(szBuffer, &pInName[2]); if(wcslen(szBuffer) > MAX_PATH) szBuffer[MAX_PATH] = '\0'; @@ -648,7 +657,7 @@ WCHAR* VDir::MapPathW(const WCHAR *pInName) } else { /* no drive letter */ - if (IsPathSep(pInName[1]) && IsPathSep(pInName[0])) { + if (length > 1 && IsPathSep(pInName[1]) && IsPathSep(pInName[0])) { /* UNC name */ DoGetFullPathNameW((WCHAR*)pInName, (sizeof(szLocalBufferW)/sizeof(WCHAR)), szLocalBufferW); } -- 1.7.3.1.msysgit.0
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 135b
This ticket has been moved to the public queue, the embargo has expired, and patches have been pushed to the main repository. -- rjbs
Download (untitled) / with headers
text/plain 252b
Thank you for submitting this report. You have helped make Perl better. With the release of Perl 5.24.0 on May 9, 2016, this and 149 other issues have been resolved. Perl 5.24.0 may be downloaded via https://metacpan.org/release/RJBS/perl-5.24.0


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

For issues related to this RT instance (aka "perlbug"), please contact perlbug-admin at perl.org