[open-cobol-list] gdb info from cob_inspect_tallying() segmentation violation

[Richard A. Painter]

below is the typescript of the gdb session where cob_inspect_tallying()
subsequent function calls causes a segmentation violation.

the cobol describing the calling parameters for the top-level XMLINPUT function
are:
       LINKAGE SECTION.
       01  INPUT-MESSAGE            PIC X(9999).
       01  QUEUE-MESSAGE            PIC X(4000).
       01  REPLY-MESSAGE            PIC X(1000).
           COPY XMLINPUT OF "XMLINPUT".
      /
       PROCEDURE DIVISION
                          USING INPUT-MESSAGE
                                QUEUE-MESSAGE
                                REPLY-MESSAGE
                                XMLINPUT-PARAMETERS.

i think the problem happens when inspect_internal() calls memset() to init
"mark" with a size of 9999 which is the defined size of the "INPUT-MESSAGE"
parameter.  it appears that "mark" must not be large enough and it overruns the
buffer and causes the segv.

here is a part of libcob/strings.c that it fails in:

static void
inspect_internal (struct cob_field var, va_list ap, int replacing)
{
  int type;
  char mark[COB_FIELD_LENGTH (var)];
  unsigned char *var_data = COB_FIELD_BASE (var);
  int sign = cob_get_sign (var);
  struct replace {
    unsigned char *dst;
    unsigned char *src;
    size_t size;
    struct replace *next;
  } *replace_list = NULL;

  memset (mark, 0, COB_FIELD_SIZE (var));
  while ((type = va_arg (ap, int)) != COB_INSPECT_END)

notice that "mark" is just POINTER and NOT an array since the size is not known
at compile time.  since "mark" has not been initialized when memset() tries to
write 9999 words of 0 to it, it segmentation violates.



here is the transcript of the debugging session:

GNU gdb 4.18
Copyright 1998 Free Software Foundation, Inc.
GDB is free software, covered by the GNU General Public License, and you are
welcome to change it and/or distribute copies of it under certain conditions.
Type "show copying" to see the conditions.
There is absolutely no warranty for GDB.  Type "show warranty" for details.
This GDB was configured as "i386-redhat-linux"...

(gdb) break XMLINPUT.cob:382
Breakpoint 1 at 0x804a461: file XMLINPUT.cob, line 382.
(gdb) run
Starting program: /var/src/magnum/TESTXML 

Breakpoint 1, XMLINPUT (
    f_INPUT_MESSAGE_data=0x807f160 "<?xml version=\"1.0\"
encoding=\"UTF-8\"?><!DOCTYPE Inquiry SYSTEM \"Inquiry.dtd\"><Inquiry
type=\"Credit\"><Client>0000</Client><Site>1234567890abcdefgh</Site><Reference>ZXY123-456abc</Reference><Provider><P"...,
f_QUEUE_MESSAGE_data=0x807f340 ' ' <repeats 200 times>..., 
    f_REPLY_MESSAGE_data=0x807ff00 ' ' <repeats 200 times>..., 
    f_XMLINPUT_PARAMETERS_data=0x807f300 "00") at XMLINPUT.cob:382
382                IF NOT WS-FATAL-ERROR

(gdb) step
383                   MOVE ZERO                  TO WS-SPECIAL-INPUT-COUNT

(gdb) step
cob_cmp_str (f1={desc = 0x8068908, data = 0x8069bbf " NNN\013"}, 
    data2=0x8066879 "F", len2=1) at common.c:206
206       int i, ret = 0;

(gdb) fini
Run till exit from #0  cob_cmp_str (f1={desc = 0x8068908, 
      data = 0x8069bbf " NNN\013"}, data2=0x8066879 "F", len2=1)
    at common.c:206
0x804a483 in XMLINPUT (
    f_INPUT_MESSAGE_data=0x807f160 "<?xml version=\"1.0\"
encoding=\"UTF-8\"?><!DOCTYPE Inquiry SYSTEM \"Inquiry.dtd\"><Inquiry
type=\"Credit\"><Client>0000</Client><Site>1234567890abcdefgh</Site><Reference>ZXY123-456abc</Reference><Provider><P"...,
f_QUEUE_MESSAGE_data=0x807f340 ' ' <repeats 200 times>..., 
    f_REPLY_MESSAGE_data=0x807ff00 ' ' <repeats 200 times>..., 
    f_XMLINPUT_PARAMETERS_data=0x807f300 "00") at XMLINPUT.cob:383
383                   MOVE ZERO                  TO WS-SPECIAL-INPUT-COUNT
Value returned is $1 = -38

(gdb) step
385                           FOR ALL ";"

(gdb) step
386                   IF INPUT-MESSAGE(WS-INPUT-POINTER:1) = "<"

(gdb) step
cob_inspect_tallying (var={desc = 0x8069478, 
      data = 0x807f160 "<?xml version=\"1.0\" encoding=\"UTF-8\"?><!DOCTYPE
Inquiry SYSTEM \"Inquiry.dtd\"><Inquiry
type=\"Credit\"><Client>0000</Client><Site>1234567890abcdefgh</Site><Reference>ZXY123-456abc</Reference><Provider><P"...})
    at strings.c:197
197       va_start (ap, var);

(gdb) step
198       inspect_internal (var, ap, 0);

(gdb) step
inspect_internal (var={desc = 0x8069478, 
      data = 0x807f160 "<?xml version=\"1.0\" encoding=\"UTF-8\"?><!DOCTYPE
Inquiry SYSTEM \"Inquiry.dtd\"><Inquiry
type=\"Credit\"><Client>0000</Client><Site>1234567890abcdefgh</Site><Reference>ZXY123-456abc</Reference><Provider><P"...},
 
    ap=0xbffff7b4, replacing=0) at strings.c:97
97        int type;

(gdb) step
99        unsigned char *var_data = COB_FIELD_BASE (var);

(gdb) step
100       int sign = cob_get_sign (var);

(gdb) step
cob_get_sign (f={desc = 0x8069478, 
      data = 0x807f160 "<?xml version=\"1.0\" encoding=\"UTF-8\"?><!DOCTYPE
Inquiry SYSTEM \"Inquiry.dtd\"><Inquiry
type=\"Credit\"><Client>0000</Client><Site>1234567890abcdefgh</Site><Reference>ZXY123-456abc</Reference><Provider><P"...})
    at common.c:362
362       if (f.desc->have_sign)

(gdb) fini
Run till exit from #0  cob_get_sign (f={desc = 0x8069478, 
      data = 0x807f160 "<?xml version=\"1.0\" encoding=\"UTF-8\"?><!DOCTYPE
Inquiry SYSTEM \"Inquiry.dtd\"><Inquiry
type=\"Credit\"><Client>0000</Client><Site>1234567890abcdefgh</Site><Reference>ZXY123-456abc</Reference><Provider><P"...})
    at common.c:362
0x40022215 in inspect_internal (var={desc = 0x8069478, 
      data = 0x807f160 "<?xml version=\"1.0\" encoding=\"UTF-8\"?><!DOCTYPE
Inquiry SYSTEM \"Inquiry.dtd\"><Inquiry
type=\"Credit\"><Client>0000</Client><Site>1234567890abcdefgh</Site><Reference>ZXY123-456abc</Reference><Provider><P"...},
 
    ap=0xbffff7b4, replacing=0) at strings.c:100
100       int sign = cob_get_sign (var);
Value returned is $2 = 0

(gdb) step
106       } *replace_list = NULL;



(gdb) step
108       memset (mark, 0, COB_FIELD_SIZE (var));



(gdb) print mark
$3 = (char (*)[0]) 0xbfffd020

(gdb) print var.desc->size
$4 = 9999



(gdb) step

Program received signal SIGSEGV, Segmentation fault.
0x40022387 in inspect_internal (var={desc = 0x8069478, 
      data = 0x807f160 "<?xml version=\"1.0\" encoding=\"UTF-8\"?><!DOCTYPE
Inquiry SYSTEM \"Inquiry.dtd\"><Inquiry
type=\"Credit\"><Client>0000</Client><Site>1234567890abcdefgh</Site><Reference>ZXY123-456abc</Reference><Provider><P"...},
 
    ap=0xbffff7cc, replacing=0) at strings.c:150
150                         if (match (var_data + offset + i, data, size))


(gdb) quit

-- 

+---------------------------------------------------------------+
| Richard A. Painter            Phone 719 495 7054              |
| Painter Engineering, Inc.     Mailto:address@hidden       |
| 8470 Swan Rd.                                                 |
| Black Forest, CO 80908                                        |
|                                                               |
| Visit our Web site:         http://painter.inc                |
|         http://home.earthlink.net/~painterengineering         |
|                                                               |
| Systems & Software Engineering + LAN WAN Networking + X.25    |
| INTERNET TCP-IP + Real-time Transaction Processing            |
| System & Software Integration, Testing, Verification & Audits |
| Web Hosting & Design + Apache + PHP + modSSL + cURL           |
| Database Design & Applications + Oracle                       |
| Benchmarks + Course & Workshop Development & Delivery         |
| Financial and Medical Software Integration + Security         |
| Middleware + EDI + Cryptography + Firewalls                   |
| UNIX + Linux + Windows                                        |
|                                                               |
| What is popular is not always right and what is right is not  |
| always popular.     - Howard Cosell                           |
|                                                               |
| Chance favors the prepared mind!   Illegitima non carborundum |
+---------------------------------------------------------------+