mirror/perl
1
0
Fork 0
mirror of https://github.com/Perl/perl5.git synced 2026-01-26 16:39:36 +00:00
Code Issues Packages Projects Releases Wiki Activity

make generic "Out of memory!" error more specific

Browse Source 
The problem: When perl runs out of memory, it outputs a generic "Out of
memory!" error and exits. This makes it hard to track down what's
happening in a complex system, especially since the message does not
even mention perl.

This patch contains two main changes:

1. vec() in lvalue context can throw fake "Out of memory!" errors when
   it discovers that the index being assigned to is too big. Unlike real
   allocation errors, these are trappable with try {}/eval {}.

   This message has been changed to "Out of memory during vec in lvalue
   context" (and since it comes from a Perl_croak() call, it will
   generally have a script name and line number attached).

2. All other places in the source code that can emit "Out of memory!"
   errors have been changed to attach a location identifier to the
   message. For example: "Out of memory in perl:util:safesysmalloc"

   This way the error message at least mentions "perl".

Fixes #21672.
This commit is contained in:
Lukas Mai 2023-11-27 17:44:42 +01:00 committed by mauke
parent 4430315acc
commit 8fbf04a996
11 changed files with 75 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
doop.c
View File

@ -908,7 +908,7 @@ Perl_do_vecset(pTHX_ SV *sv)
assert(!(errflags & ~(LVf_NEG_OFF|LVf_OUT_OF_RANGE)));
if (errflags & LVf_NEG_OFF)
Perl_croak_nocontext("Negative offset to vec in lvalue context");
Perl_croak_nocontext("Out of memory!");
Perl_croak_nocontext("Out of memory during vec in lvalue context");
}
if (!targ)
@ -938,7 +938,7 @@ Perl_do_vecset(pTHX_ SV *sv)
else if (size > 8) {
int n = size/8;
if (offset > Size_t_MAX / n - 1) /* would overflow */
Perl_croak_nocontext("Out of memory!");
Perl_croak_nocontext("Out of memory during vec in lvalue context");
offset *= n;
}

3
embed.fnc
View File

@ -855,6 +855,9 @@ Tfprv |void |croak_caller |NULLOK const char *pat \
|...
CTrs |void |croak_memory_wrap
Tpr |void |croak_no_mem
Tpr |void |croak_no_mem_ext \
|NN const char *context \
|STRLEN len
ATdpr |void |croak_no_modify
TXpr |void |croak_popstack
Adpr |void |croak_sv |NN SV *baseex

1
embed.h
View File

@ -921,6 +921,7 @@
# define create_eval_scope(a,b,c) Perl_create_eval_scope(aTHX_ a,b,c)
# define croak_caller Perl_croak_caller
# define croak_no_mem Perl_croak_no_mem
# define croak_no_mem_ext Perl_croak_no_mem_ext
# define croak_popstack Perl_croak_popstack
# define custom_op_get_field(a,b) Perl_custom_op_get_field(aTHX_ a,b)
# define cv_clone_into(a,b) Perl_cv_clone_into(aTHX_ a,b)

6
op.c
View File

@ -284,7 +284,7 @@ S_link_freed_op(pTHX_ OPSLAB *slab, OP *o) {
slab->opslab_freed = (OP**)PerlMemShared_calloc((slab->opslab_freed_size), sizeof(OP*));
if (!slab->opslab_freed)
croak_no_mem();
croak_no_mem_ext(STR_WITH_LEN("op:link_freed_op"));
}
else if (index >= slab->opslab_freed_size) {
/* It's probably not worth doing exponential expansion here, the number of op sizes
@ -295,7 +295,7 @@ S_link_freed_op(pTHX_ OPSLAB *slab, OP *o) {
OP **p = (OP **)PerlMemShared_realloc(slab->opslab_freed, newsize * sizeof(OP*));
if (!p)
croak_no_mem();
croak_no_mem_ext(STR_WITH_LEN("op:link_freed_op"));
Zero(p+slab->opslab_freed_size, newsize - slab->opslab_freed_size, OP *);
@ -15832,7 +15832,7 @@ Perl_rcpv_new(pTHX_ const char *pv, STRLEN len, U32 flags) {
rcpv = (RCPV *)PerlMemShared_malloc(sizeof(struct rcpv) + len);
if (!rcpv)
croak_no_mem();
croak_no_mem_ext(STR_WITH_LEN("op:rcpv_new"));
rcpv->len = len; /* store length including null,
RCPV_LEN() subtracts 1 to account for this */

3
os2/os2ish.h
View File

@ -192,7 +192,8 @@ extern int rc;
# define pthread_setspecific(k,v) (*(k)=(v),0)
# define pthread_key_create(keyp,flag) \
( DosAllocThreadLocalMemory(1,(unsigned long**)keyp) \
? Perl_croak_nocontext("Out of memory!"), 1 \
/* diag_listed_as: Out of memory in perl:%s */ \
? Perl_croak_nocontext("Out of memory in perl:os2:pthread_key_create"), 1 \
: 0 \
)
#endif /* USE_SLOW_THREAD_SPECIFIC */

2
perlio.c
View File

@ -2697,7 +2697,7 @@ S_more_refcounted_fds(pTHX_ const int new_fd)
if (!new_array) {
MUTEX_UNLOCK(&PL_perlio_mutex);
croak_no_mem();
croak_no_mem_ext(STR_WITH_LEN("perlio:more_refcounted_fds"));
}
PL_perlio_fd_refcnt_size = new_max;

16
pod/perldiag.pod
View File

@ -4892,12 +4892,28 @@ where the failed request happened.
is most likely to be caused by a typo in the Perl program. e.g.,
C<$arr[time]> instead of C<$arr[$time]>.
=item Out of memory during vec in lvalue context
(F) An attempt was made to extend a string beyond the largest possible memory
allocation by assigning to C<vec()> called with a large second argument.
=item Out of memory for yacc stack
(F) The yacc parser wanted to grow its stack so it could continue
parsing, but realloc() wouldn't give it more memory, virtual or
otherwise.
=item Out of memory in perl:%s
(X) A low-level memory allocation routine failed, indicating there was
insufficient remaining (virtual) memory to satisfy the request. Perl has no
option but to exit immediately.
At least in Unix you may be able to get past this by increasing your process
datasize limits: in csh/tcsh use C<limit> and C<limit datasize n> (where C<n>
is the number of kilobytes) to check the current limits and change them, and in
ksh/bash/zsh use C<ulimit -a> and C<ulimit -d n>, respectively.
=item '.' outside of string in pack
(F) The argument to a '.' in your template tried to move the working

7
proto.h generated
View File

@ -624,6 +624,13 @@ Perl_croak_no_mem(void)
__attribute__visibility__("hidden");
#define PERL_ARGS_ASSERT_CROAK_NO_MEM
PERL_CALLCONV_NO_RET void
Perl_croak_no_mem_ext(const char *context, STRLEN len)
__attribute__noreturn__
__attribute__visibility__("hidden");
#define PERL_ARGS_ASSERT_CROAK_NO_MEM_EXT \
assert(context)
PERL_CALLCONV_NO_RET void
Perl_croak_no_modify(void)
__attribute__noreturn__;

20
t/op/vec.t
View File

@ -152,12 +152,12 @@ like($@, qr/^Modification of a read-only value attempted at /,
# partially duplicates some tests above, but those cases are repeated
# here for completeness.
#
# Note that all the 'Out of memory!' errors trapped eval {} are 'fake'
# croaks generated by pp_vec() etc when they have detected something
# that would have otherwise overflowed. The real 'Out of memory!'
# error thrown by safesysrealloc() etc is not trappable. If it were
# accidentally triggered in this test script, the script would exit at
# that point.
# Note that all the 'Out of memory during vec in lvalue context' errors
# trapped by eval {} are 'fake' croaks generated by pp_vec() etc when they
# have detected something that would have otherwise overflowed. The real
# 'Out of memory!' error thrown by safesysrealloc() etc is not trappable.
# If it were accidentally triggered in this test script, the script would
# exit at that point.
my $s = "abcdefghijklmnopqrstuvwxyz";
@ -168,7 +168,7 @@ like($@, qr/^Modification of a read-only value attempted at /,
$x = vec($s, ~0, 8);
is($x, 0, "RT 130915: UV_MAX rval");
eval { vec($s, ~0, 8) = 1 };
like($@, qr/^Out of memory!/, "RT 130915: UV_MAX lval");
like($@, qr/^Out of memory during vec in lvalue context/, "RT 130915: UV_MAX lval");
# offset is negative
@ -190,7 +190,7 @@ like($@, qr/^Modification of a read-only value attempted at /,
$x = vec($s, $sm2, 8);
is($x, 0, "RT 130915: size_max*2 rval");
eval { vec($s, $sm2, 8) = 1 };
like($@, qr/^Out of memory!/, "RT 130915: size_max*2 lval");
like($@, qr/^Out of memory during vec in lvalue context/, "RT 130915: size_max*2 lval");
}
# (offset * num-bytes) could overflow
@ -204,7 +204,7 @@ like($@, qr/^Modification of a read-only value attempted at /,
$x = vec($s, $offset, $bytes*8);
is($x, 0, "large offset: bytes=$bytes biglog2=$biglog2 i=$i: rval");
eval { vec($s, $offset, $bytes*8) = 1; };
like($@, qr/^Out of memory!/,
like($@, qr/^Out of memory during vec in lvalue context/,
"large offset: bytes=$bytes biglog2=$biglog2 i=$i: rval");
}
}
@ -247,7 +247,7 @@ like($@, qr/^Modification of a read-only value attempted at /,
$v = RT131083(0, vec($s, $off, 8));
is($v, 0, "RT131083 rval ~0");
$v = eval { RT131083(1, vec($s, $off, 8)); };
like($@, qr/Out of memory!/, "RT131083 lval ~0");
like($@, qr/Out of memory during vec in lvalue context/, "RT131083 lval ~0");
}
{

29
util.c
View File

@ -205,7 +205,7 @@ Perl_safesysmalloc(MEM_SIZE size)
if (PL_nomemok)
ptr = NULL;
else
croak_no_mem();
croak_no_mem_ext(STR_WITH_LEN("util:safesysmalloc"));
}
}
return ptr;
@ -340,7 +340,7 @@ Perl_safesysrealloc(Malloc_t where,MEM_SIZE size)
if (PL_nomemok)
ptr = NULL;
else
croak_no_mem();
croak_no_mem_ext(STR_WITH_LEN("util:safesysrealloc"));
}
}
}
@ -512,7 +512,7 @@ Perl_safesyscalloc(MEM_SIZE count, MEM_SIZE size)
#endif
if (PL_nomemok)
return NULL;
croak_no_mem();
croak_no_mem_ext(STR_WITH_LEN("util:safesyscalloc"));
}
}
@ -1342,7 +1342,7 @@ Perl_savesharedpv(pTHX_ const char *pv)
pvlen = strlen(pv)+1;
newaddr = (char*)PerlMemShared_malloc(pvlen);
if (!newaddr) {
croak_no_mem();
croak_no_mem_ext(STR_WITH_LEN("util:savesharedpv"));
}
return (char*)memcpy(newaddr, pv, pvlen);
}
@ -1365,7 +1365,7 @@ Perl_savesharedpvn(pTHX_ const char *const pv, const STRLEN len)
/* PERL_ARGS_ASSERT_SAVESHAREDPVN; */
if (!newaddr) {
croak_no_mem();
croak_no_mem_ext(STR_WITH_LEN("util:savesharedpvn"));
}
newaddr[len] = '\0';
return (char*)memcpy(newaddr, pv, len);
@ -1970,20 +1970,35 @@ Perl_croak_no_modify(void)
This is typically called when malloc returns NULL.
*/
void
Perl_croak_no_mem(void)
Perl_croak_no_mem_ext(const char *context, STRLEN len)
{
dTHX;
PERL_ARGS_ASSERT_CROAK_NO_MEM_EXT;
int fd = PerlIO_fileno(Perl_error_log);
if (fd < 0)
SETERRNO(EBADF,RMS_IFI);
else {
/* Can't use PerlIO to write as it allocates memory */
PERL_UNUSED_RESULT(PerlLIO_write(fd, PL_no_mem, sizeof(PL_no_mem)-1));
static const char oomp[] = "Out of memory in perl:";
if (
PerlLIO_write(fd, oomp, sizeof oomp - 1) >= 0
&& PerlLIO_write(fd, context, len) >= 0
&& PerlLIO_write(fd, "\n", 1) >= 0
) {
/* nop */
}
}
my_exit(1);
}
void
Perl_croak_no_mem(void)
{
croak_no_mem_ext(STR_WITH_LEN("???"));
}
/* does not return, used only in POPSTACK */
void
Perl_croak_popstack(void)

16
win32/win32.c
View File

@ -131,7 +131,7 @@ static void remove_dead_process(long child);
static int terminate_process(DWORD pid, HANDLE process_handle, int sig);
static int my_killpg(int pid, int sig);
static int my_kill(int pid, int sig);
static void out_of_memory(void);
static void out_of_memory(const char *context, STRLEN len);
static char* wstr_to_str(const wchar_t* wstr);
static long filetime_to_clock(PFILETIME ft);
static BOOL filetime_from_time(PFILETIME ft, time_t t);
@ -2227,11 +2227,11 @@ win32_longpath(char *path)
}
static void
out_of_memory(void)
out_of_memory(const char *context, STRLEN len)
{
if (PL_curinterp)
croak_no_mem();
croak_no_mem_ext(context, len);
exit(1);
}
@ -2255,7 +2255,7 @@ wstr_to_str(const wchar_t* wstr)
NULL, 0, NULL, NULL);
char* str = (char*)malloc(len);
if (!str)
out_of_memory();
out_of_memory(STR_WITH_LEN("win32:wstr_to_str"));
WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, wstr, wlen,
str, len, NULL, &used_default);
return str;
@ -2288,7 +2288,7 @@ win32_ansipath(const WCHAR *widename)
NULL, 0, NULL, NULL);
name = (char*)win32_malloc(len);
if (!name)
out_of_memory();
out_of_memory(STR_WITH_LEN("win32:win32_ansipath"));
WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, widename, widelen,
name, len, NULL, &use_default);
@ -2297,14 +2297,14 @@ win32_ansipath(const WCHAR *widename)
if (shortlen) {
WCHAR *shortname = (WCHAR*)win32_malloc(shortlen*sizeof(WCHAR));
if (!shortname)
out_of_memory();
out_of_memory(STR_WITH_LEN("win32:win32_ansipath"));
shortlen = GetShortPathNameW(widename, shortname, shortlen)+1;
len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, shortname, shortlen,
NULL, 0, NULL, NULL);
name = (char*)win32_realloc(name, len);
if (!name)
out_of_memory();
out_of_memory(STR_WITH_LEN("win32:win32_ansipath"));
WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, shortname, shortlen,
name, len, NULL, NULL);
win32_free(shortname);
@ -2337,7 +2337,7 @@ win32_getenvironmentstrings(void)
lpWStr, wenvstrings_len, NULL, 0, NULL, NULL);
lpTmp = lpStr = (char *)win32_calloc(aenvstrings_len, sizeof(char));
if(!lpTmp)
out_of_memory();
out_of_memory(STR_WITH_LEN("win32:win32_getenvironmentstrings"));
/* Convert the string from UTF-16 encoding to ACP encoding */
WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, lpWStr, wenvstrings_len, lpStr,