{"id":811480,"url":"http://patchwork.ozlabs.org/api/patches/811480/?format=json","web_url":"http://patchwork.ozlabs.org/project/gcc/patch/20170908101824.GA49329@adacore.com/","project":{"id":17,"url":"http://patchwork.ozlabs.org/api/projects/17/?format=json","name":"GNU Compiler Collection","link_name":"gcc","list_id":"gcc-patches.gcc.gnu.org","list_email":"gcc-patches@gcc.gnu.org","web_url":null,"scm_url":null,"webscm_url":null,"list_archive_url":"","list_archive_url_format":"","commit_url_format":""},"msgid":"<20170908101824.GA49329@adacore.com>","list_archive_url":null,"date":"2017-09-08T10:18:24","name":"[Ada] T'Class'Input reading corrupted data","commit_ref":null,"pull_url":null,"state":"new","archived":false,"hash":"8e26f9d1e6a07ac8879f01dde64d29a6acab2fce","submitter":{"id":4418,"url":"http://patchwork.ozlabs.org/api/people/4418/?format=json","name":"Arnaud Charlet","email":"charlet@adacore.com"},"delegate":null,"mbox":"http://patchwork.ozlabs.org/project/gcc/patch/20170908101824.GA49329@adacore.com/mbox/","series":[{"id":2174,"url":"http://patchwork.ozlabs.org/api/series/2174/?format=json","web_url":"http://patchwork.ozlabs.org/project/gcc/list/?series=2174","date":"2017-09-08T10:18:24","name":"[Ada] T'Class'Input reading corrupted data","version":1,"mbox":"http://patchwork.ozlabs.org/series/2174/mbox/"}],"comments":"http://patchwork.ozlabs.org/api/patches/811480/comments/","check":"pending","checks":"http://patchwork.ozlabs.org/api/patches/811480/checks/","tags":{},"related":[],"headers":{"Return-Path":"","X-Original-To":"incoming@patchwork.ozlabs.org","Delivered-To":["patchwork-incoming@bilbo.ozlabs.org","mailing list gcc-patches@gcc.gnu.org"],"Authentication-Results":["ozlabs.org;\n\tspf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org\n\t(client-ip=209.132.180.131; helo=sourceware.org;\n\tenvelope-from=gcc-patches-return-461720-incoming=patchwork.ozlabs.org@gcc.gnu.org;\n\treceiver=)","ozlabs.org; dkim=pass (1024-bit key;\n\tunprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org\n\theader.b=\"Kn0/xIia\"; dkim-atps=neutral","sourceware.org; auth=none"],"Received":["from sourceware.org (server1.sourceware.org [209.132.180.131])\n\t(using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256\n\tbits)) (No client certificate requested)\n\tby ozlabs.org (Postfix) with ESMTPS id 3xpYFL6lGzz9s71\n\tfor ;\n\tFri, 8 Sep 2017 20:18:46 +1000 (AEST)","(qmail 16686 invoked by alias); 8 Sep 2017 10:18:32 -0000","(qmail 16541 invoked by uid 89); 8 Sep 2017 10:18:31 -0000","from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by\n\tsourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP;\n\tFri, 08 Sep 2017 10:18:26 +0000","from localhost (localhost.localdomain [127.0.0.1])\tby\n\tfiltered-rock.gnat.com (Postfix) with ESMTP id CACDE56261;\n\tFri, 8 Sep 2017 06:18:24 -0400 (EDT)","from rock.gnat.com ([127.0.0.1])\tby localhost (rock.gnat.com\n\t[127.0.0.1]) (amavisd-new, port 10024)\twith LMTP id\n\t4yzPHVRPqbHQ; Fri, 8 Sep 2017 06:18:24 -0400 (EDT)","from tron.gnat.com (tron.gnat.com\n\t[IPv6:2620:20:4000:0:46a8:42ff:fe0e:e294])\tby rock.gnat.com\n\t(Postfix) with ESMTP id BA4F856126;\n\tFri, 8 Sep 2017 06:18:24 -0400 (EDT)","by tron.gnat.com (Postfix, from userid 4192)\tid B963A505;\n\tFri, 8 Sep 2017 06:18:24 -0400 (EDT)"],"DomainKey-Signature":"a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id\n\t:list-unsubscribe:list-archive:list-post:list-help:sender:date\n\t:from:to:cc:subject:message-id:mime-version:content-type; q=dns;\n\ts=default; b=W6wbc6DKvagbcod0kTXuoxLi//IT/Kml6b8g6oC3Vcg09YghSf\n\tbb6+5+DkZSv/d/Cyi9yBjreMproIqdypWH7GSxTVY7lkzW8tYuOwgpfoXejXB6Tj\n\t8CRDULt7DAUHpqYP9WPgS5OEh05IjxbB530+Yamz/kIHvR06cdE1cSN1I=","DKIM-Signature":"v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id\n\t:list-unsubscribe:list-archive:list-post:list-help:sender:date\n\t:from:to:cc:subject:message-id:mime-version:content-type; s=\n\tdefault; bh=w7sQ9k6yzBIq779TchYAchVYn2M=; b=Kn0/xIiarqhRtY2eUBbz\n\tjQmXgg7EWA0NVeBEtjSp2aAe7jvgcrNVtv6MXOLJPfUFoeiVbji+iJ18Frr+zCfo\n\tUh0ZyD2ZcGEMjOR50yl+DFSLUqXIr+rj/4BxDsrxCJf1cDON5Pv0tY83nbKd9bGV\n\tQOue025nb8teY/9GAfTuUUs=","Mailing-List":"contact gcc-patches-help@gcc.gnu.org; run by ezmlm","Precedence":"bulk","List-Id":"","List-Unsubscribe":"","List-Archive":"","List-Post":"","List-Help":"","Sender":"gcc-patches-owner@gcc.gnu.org","X-Virus-Found":"No","X-Spam-SWARE-Status":"No, score=-16.1 required=5.0 tests=BAYES_00, GIT_PATCH_1,\n\tGIT_PATCH_2, GIT_PATCH_3, KAM_ASCII_DIVIDERS,\n\tRCVD_IN_DNSWL_NONE,\n\tSPF_PASS autolearn=ham version=3.3.2 spammy=7319","X-HELO":"rock.gnat.com","Date":"Fri, 8 Sep 2017 06:18:24 -0400","From":"Arnaud Charlet ","To":"gcc-patches@gcc.gnu.org","Cc":"Bob Duff ","Subject":"[Ada] T'Class'Input reading corrupted data","Message-ID":"<20170908101824.GA49329@adacore.com>","MIME-Version":"1.0","Content-Type":"multipart/mixed; boundary=\"1yeeQ81UyVL57Vl7\"","Content-Disposition":"inline","User-Agent":"Mutt/1.5.23 (2014-03-12)"},"content":"If T'Class'Input is called on a stream containing data that does not\nlook like it comes from T'Class'Output, it could crash. This patch fixes\nthat bug by making sure it raises an exception.\n\nTested on x86_64-pc-linux-gnu, committed on trunk\n\n2017-09-08 Bob Duff \n\n\t* a-tags.adb (Internal_Tag): Unsuppress checks, so we get\n\texceptions instead of crashes. Check for absurdly long strings\n\tand empty strings. Empty strings cause trouble because they can\n\thave super-null ranges (e.g. 100..10), which causes Ext_Copy to\n\tbe empty, which causes an array index out of bounds.\n\t* s-ststop.adb (Input): Unsuppress checks, so we get exceptions\n\tinstead of crashes.","diff":"Index: a-tags.adb\n===================================================================\n--- a-tags.adb\t(revision 251863)\n+++ a-tags.adb\t(working copy)\n@@ -641,10 +641,22 @@\n Header_Separator : constant Character := '#';\n \n function Internal_Tag (External : String) return Tag is\n- Ext_Copy : aliased String (External'First .. External'Last + 1);\n- Res : Tag := null;\n+ pragma Unsuppress (All_Checks);\n+ -- To make T'Class'Input robust in the case of bad data\n \n+ Res : Tag := null;\n+\n begin\n+ -- Raise Tag_Error for empty strings, and for absurdly long strings.\n+ -- This is to make T'Class'Input robust in the case of bad data, for\n+ -- example a String(123456789..1234). The limit of 10,000 characters is\n+ -- arbitrary, but is unlikely to be exceeded by legitimate external tag\n+ -- names.\n+\n+ if External'Length not in 1 .. 10_000 then\n+ raise Tag_Error;\n+ end if;\n+\n -- Handle locally defined tagged types\n \n if External'Length > Internal_Tag_Header'Length\n@@ -731,9 +743,14 @@\n else\n -- Make NUL-terminated copy of external tag string\n \n- Ext_Copy (External'Range) := External;\n- Ext_Copy (Ext_Copy'Last) := ASCII.NUL;\n- Res := External_Tag_HTable.Get (Ext_Copy'Address);\n+ declare\n+ Ext_Copy : aliased String (External'First .. External'Last + 1);\n+ pragma Assert (Ext_Copy'Length > 1); -- See Length check at top\n+ begin\n+ Ext_Copy (External'Range) := External;\n+ Ext_Copy (Ext_Copy'Last) := ASCII.NUL;\n+ Res := External_Tag_HTable.Get (Ext_Copy'Address);\n+ end;\n end if;\n \n if Res = null then\nIndex: s-ststop.adb\n===================================================================\n--- s-ststop.adb\t(revision 251863)\n+++ s-ststop.adb\t(working copy)\n@@ -6,7 +6,7 @@\n -- --\n -- B o d y --\n -- --\n--- Copyright (C) 2008-2013, Free Software Foundation, Inc. --\n+-- Copyright (C) 2008-2017, Free Software Foundation, Inc. --\n -- --\n -- GNAT is free software; you can redistribute it and/or modify it under --\n -- terms of the GNU General Public License as published by the Free Soft- --\n@@ -128,17 +128,20 @@\n (Strm : access Root_Stream_Type'Class;\n IO : IO_Kind) return Array_Type\n is\n+ pragma Unsuppress (All_Checks);\n+ -- To make T'Class'Input robust in the case of bad data. The\n+ -- declaration of Item below could raise Storage_Error if the length\n+ -- is huge.\n begin\n if Strm = null then\n raise Constraint_Error;\n end if;\n \n declare\n- Low : Index_Type;\n- High : Index_Type;\n-\n+ Low, High : Index_Type'Base;\n begin\n- -- Read the bounds of the string\n+ -- Read the bounds of the string. Note that they could be out of\n+ -- range of Index_Type in the case of empty arrays.\n \n Index_Type'Read (Strm, Low);\n Index_Type'Read (Strm, High);\n","prefixes":["Ada"]}