diff mbox series

[Ada] T'Class'Input reading corrupted data

Message ID 20170908101824.GA49329@adacore.com
State New
Headers show
Series [Ada] T'Class'Input reading corrupted data | expand

Commit Message

Arnaud Charlet Sept. 8, 2017, 10:18 a.m. UTC 
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  <duff@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.
diff mbox series

Patch

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);