From fc003d4b0d731bb670adb07e168c683339ec57e7 Mon Sep 17 00:00:00 2001 From: "Michael G. Schwern" Date: Sun, 31 Jan 2010 03:22:08 -0800 Subject: [PATCH] Don't try to calculate a time over the conservative failure boundary. Otherwise gmtime(2**66) will cause a very, very, very long loop and DOS Perl. Add a test that very, very large times don't send gmtime and localtime into a loop Had to fix some revealed mistakes in op/time.t when warnings were turned on. Fix Time::gmtime and Time::localtime tests to match the new limits of gm/localtime. --- MANIFEST | 1 + lib/Time/gmtime.t | 5 +++-- lib/Time/localtime.t | 5 +++-- pod/perldiag.pod | 27 ++++++++++++++++++++++----- pp_sys.c | 29 +++++++++++++++++++++++++---- t/op/time.t | 46 ++++++++++++++++++++++++++++++++++++---------- t/op/time_loop.t | 16 ++++++++++++++++ 7 files changed, 106 insertions(+), 23 deletions(-) create mode 100644 t/op/time_loop.t diff --git a/MANIFEST b/MANIFEST index 7339570..9c779e2 100644 --- a/MANIFEST +++ b/MANIFEST @@ -4487,6 +4487,7 @@ t/op/threads.t Misc. tests for perl features with threads t/op/tiearray.t See if tie for arrays works t/op/tiehandle.t See if tie for handles works t/op/tie.t See if tie/untie functions work +t/op/time_loop.t Test that very large values don't hang gmtime and localtime. t/op/time.t See if time functions work t/op/tr.t See if tr works t/op/undef.t See if undef works diff --git a/lib/Time/gmtime.t b/lib/Time/gmtime.t index 9c77f81..b784096 100644 --- a/lib/Time/gmtime.t +++ b/lib/Time/gmtime.t @@ -9,10 +9,10 @@ BEGIN { my(@times, @methods); BEGIN { - @times = (-2**62, -2**50, -2**33, -2**31-1, -1, 0, 1, 2**31-1, 2**33, 2**50, 2**62, time); + @times = (-2**55, -2**50, -2**33, -2**31-1, -1, 0, 1, 2**31-1, 2**33, 2**50, 2**55, time); @methods = qw(sec min hour mday mon year wday yday isdst); - plan tests => (@times * @methods) + 1; + plan tests => (@times * (@methods + 1)) + 1; use_ok Time::gmtime; } @@ -21,6 +21,7 @@ for my $time (@times) { my $gmtime = gmtime $time; # This is the OO gmtime. my @gmtime = CORE::gmtime $time; # This is the gmtime function + is @gmtime, 9, "gmtime($time)"; for my $method (@methods) { is $gmtime->$method, shift @gmtime, "gmtime($time)->$method"; } diff --git a/lib/Time/localtime.t b/lib/Time/localtime.t index f300343..0b020fc 100644 --- a/lib/Time/localtime.t +++ b/lib/Time/localtime.t @@ -9,10 +9,10 @@ BEGIN { my(@times, @methods); BEGIN { - @times = (-2**62, -2**50, -2**33, -2**31-1, -1, 0, 1, 2**31-1, 2**33, 2**50, 2**62, time); + @times = (-2**55, -2**50, -2**33, -2**31-1, -1, 0, 1, 2**31-1, 2**33, 2**50, 2**55, time); @methods = qw(sec min hour mday mon year wday yday isdst); - plan tests => (@times * @methods) + 1; + plan tests => (@times * (@methods + 1)) + 1; use_ok Time::localtime; } @@ -21,6 +21,7 @@ for my $time (@times) { my $localtime = localtime $time; # This is the OO localtime. my @localtime = CORE::localtime $time; # This is the localtime function + is @localtime, 9, "localtime($time)"; for my $method (@methods) { is $localtime->$method, shift @localtime, "localtime($time)->$method"; } diff --git a/pod/perldiag.pod b/pod/perldiag.pod index f80bdcd..5436042 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -1851,9 +1851,17 @@ earlier in the line, and you really meant a "less than". =item gmtime(%.0f) too large -(W overflow) You called C with an number that was beyond the 64-bit -range that it accepts, and some rounding resulted. This warning is also -triggered with nan (the special not-a-number value). +(W overflow) You called C with an number that was larger than +it can reliably handle and C probably returned the wrong +date. This warning is also triggered with nan (the special +not-a-number value). + +=item gmtime(%.0f) too small + +(W overflow) You called C with an number that was smaller than +it can reliably handle and C probably returned the wrong +date. This warning is also triggered with nan (the special +not-a-number value). =item Got an error from DosAllocMem @@ -2289,8 +2297,17 @@ L. =item localtime(%.0f) too large -(W overflow) You called C with an number that was beyond the -64-bit range that it accepts, and some rounding resulted. This warning is also triggered with nan (the special not-a-number value). +(W overflow) You called C with an number that was larger +than it can reliably handle and C probably returned the +wrong date. This warning is also triggered with nan (the special +not-a-number value). + +=item localtime(%.0f) too small + +(W overflow) You called C with an number that was smaller +than it can reliably handle and C probably returned the +wrong date. This warning is also triggered with nan (the special +not-a-number value). =item Lookbehind longer than %d not implemented in regex m/%s/ diff --git a/pp_sys.c b/pp_sys.c index 8b5fccb..e7cdb59 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -4485,6 +4485,15 @@ PP(pp_tms) #endif /* HAS_TIMES */ } +/* The 32 bit int year limits the times we can represent to these + boundaries with a few days wiggle room to account for time zone + offsets +*/ +/* Sat Jan 3 00:00:00 -2147481748 */ +#define TIME_LOWER_BOUND -67768100567755200.0 +/* Sun Dec 29 12:00:00 2147483647 */ +#define TIME_UPPER_BOUND 67767976233316800.0 + PP(pp_gmtime) { dVAR; @@ -4513,10 +4522,22 @@ PP(pp_gmtime) } } - if (PL_op->op_type == OP_LOCALTIME) - err = S_localtime64_r(&when, &tmbuf); - else - err = S_gmtime64_r(&when, &tmbuf); + if ( TIME_LOWER_BOUND > when ) { + Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW), + "%s(%.0f) too small", opname, when); + err = NULL; + } + else if( when > TIME_UPPER_BOUND ) { + Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW), + "%s(%.0f) too large", opname, when); + err = NULL; + } + else { + if (PL_op->op_type == OP_LOCALTIME) + err = S_localtime64_r(&when, &tmbuf); + else + err = S_gmtime64_r(&when, &tmbuf); + } if (err == NULL) { /* XXX %lld broken for quads */ diff --git a/t/op/time.t b/t/op/time.t index 5515634..84eaf75 100644 --- a/t/op/time.t +++ b/t/op/time.t @@ -1,4 +1,4 @@ -#!./perl +#!./perl -w BEGIN { chdir 't' if -d 't'; @@ -6,7 +6,7 @@ BEGIN { require './test.pl'; } -plan tests => 56; +plan tests => 62; # These tests make sure, among other things, that we don't end up # burning tons of CPU for dates far in the future. @@ -36,9 +36,9 @@ ok($i >= 2_000_000, 'very basic times test'); ($xsec,$foo) = localtime($now); $localyday = $yday; -isnt($sec, $xsec), 'localtime() list context'; -ok $mday, ' month day'; -ok $year, ' year'; +isnt($sec, $xsec, 'localtime() list context'); +ok $mday, ' month day'; +ok $year, ' year'; ok(localtime() =~ /^(Sun|Mon|Tue|Wed|Thu|Fri|Sat)[ ] (Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)[ ] @@ -66,9 +66,9 @@ ok($hour != $hour2, 'changes to $ENV{TZ} respected') ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($beg); ($xsec,$foo) = localtime($now); -isnt($sec, $xsec), 'gmtime() list conext'; -ok $mday, ' month day'; -ok $year, ' year'; +isnt($sec, $xsec, 'gmtime() list conext'); +ok $mday, ' month day'; +ok $year, ' year'; my $day_diff = $localyday - $yday; ok( grep({ $day_diff == $_ } (0, 1, -1, 364, 365, -364, -365)), @@ -142,12 +142,12 @@ ok(gmtime() =~ /^(Sun|Mon|Tue|Wed|Thu|Fri|Sat)[ ] { eval { $SIG{__WARN__} = sub { die @_; }; - localtime(1.23); + is( (localtime(1296000.23))[5] + 1900, 1970 ); }; is($@, '', 'Ignore fractional time'); eval { $SIG{__WARN__} = sub { die @_; }; - gmtime(1.23); + is( (gmtime(1.23))[5] + 1900, 1970 ); }; is($@, '', 'Ignore fractional time'); } @@ -174,3 +174,29 @@ ok(gmtime() =~ /^(Sun|Mon|Tue|Wed|Thu|Fri|Sat)[ ] is $have, $want, "year check, localtime($time)"; } } + + +# Test that Perl warns properly when it can't handle a time. +{ + my $warning; + local $SIG{__WARN__} = sub { $warning .= join "\n", @_; }; + + my $big_time = 2**60; + my $small_time = -2**60; + + $warning = ''; + my $date = gmtime($big_time); + like $warning, qr/^gmtime(.*) too large/; + + $warning = ''; + $date = localtime($big_time); + like $warning, qr/^localtime(.*) too large/; + + $warning = ''; + $date = gmtime($small_time); + like $warning, qr/^gmtime(.*) too small/; + + $warning = ''; + $date = localtime($small_time); + like $warning, qr/^localtime(.*) too small/; +} diff --git a/t/op/time_loop.t b/t/op/time_loop.t new file mode 100644 index 0000000..6f4acdc --- /dev/null +++ b/t/op/time_loop.t @@ -0,0 +1,16 @@ +#!perl -w + +# d95a2ea538e6c332f36c34ca45b78d6ad93c3a1f allowed times greater than +# 2**63 to be handed to gm/localtime() which caused an internal overflow +# and an excessively long loop. Test this does not happen. + +use strict; + +BEGIN { require './test.pl'; } + +plan tests => 2; +watchdog(2); + +local $SIG{__WARN__} = sub {}; +is gmtime(2**69), undef; +is localtime(2**69), undef; -- 2.7.4