If T'Class'Input is called on a stream containing data that does not
look like it comes from T'Class'Output, it could crash. This patch fixes
that bug by making sure it raises an exception.
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-09-08 Bob Duff <d...@adacore.com>
* a-tags.adb (Internal_Tag): Unsuppress checks, so we get
exceptions instead of crashes. Check for absurdly long strings
and empty strings. Empty strings cause trouble because they can
have super-null ranges (e.g. 100..10), which causes Ext_Copy to
be empty, which causes an array index out of bounds.
* s-ststop.adb (Input): Unsuppress checks, so we get exceptions
instead of crashes.
Index: a-tags.adb
===================================================================
--- a-tags.adb (revision 251863)
+++ a-tags.adb (working copy)
@@ -641,10 +641,22 @@
Header_Separator : constant Character := '#';
function Internal_Tag (External : String) return Tag is
- Ext_Copy : aliased String (External'First .. External'Last + 1);
- Res : Tag := null;
+ pragma Unsuppress (All_Checks);
+ -- To make T'Class'Input robust in the case of bad data
+ Res : Tag := null;
+
begin
+ -- Raise Tag_Error for empty strings, and for absurdly long strings.
+ -- This is to make T'Class'Input robust in the case of bad data, for
+ -- example a String(123456789..1234). The limit of 10,000 characters is
+ -- arbitrary, but is unlikely to be exceeded by legitimate external tag
+ -- names.
+
+ if External'Length not in 1 .. 10_000 then
+ raise Tag_Error;
+ end if;
+
-- Handle locally defined tagged types
if External'Length > Internal_Tag_Header'Length
@@ -731,9 +743,14 @@
else
-- Make NUL-terminated copy of external tag string
- Ext_Copy (External'Range) := External;
- Ext_Copy (Ext_Copy'Last) := ASCII.NUL;
- Res := External_Tag_HTable.Get (Ext_Copy'Address);
+ declare
+ Ext_Copy : aliased String (External'First .. External'Last + 1);
+ pragma Assert (Ext_Copy'Length > 1); -- See Length check at top
+ begin
+ Ext_Copy (External'Range) := External;
+ Ext_Copy (Ext_Copy'Last) := ASCII.NUL;
+ Res := External_Tag_HTable.Get (Ext_Copy'Address);
+ end;
end if;
if Res = null then
Index: s-ststop.adb
===================================================================
--- s-ststop.adb (revision 251863)
+++ s-ststop.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2008-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 2008-2017, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -128,17 +128,20 @@
(Strm : access Root_Stream_Type'Class;
IO : IO_Kind) return Array_Type
is
+ pragma Unsuppress (All_Checks);
+ -- To make T'Class'Input robust in the case of bad data. The
+ -- declaration of Item below could raise Storage_Error if the length
+ -- is huge.
begin
if Strm = null then
raise Constraint_Error;
end if;
declare
- Low : Index_Type;
- High : Index_Type;
-
+ Low, High : Index_Type'Base;
begin
- -- Read the bounds of the string
+ -- Read the bounds of the string. Note that they could be out of
+ -- range of Index_Type in the case of empty arrays.
Index_Type'Read (Strm, Low);
Index_Type'Read (Strm, High);
