This problem only happens intermittently and so makes it a bit more
difficult to debug.

Cobol mainline calls a Pascal sub that will change user or acct or group
password via the AIF intrinsic "AIFACCTPUT".

Sometimes the Pascal sub can't change the password and returns a +1 in the
overall status field.

For the time being, I made a mod to the Cobol mainline when the sub returns
a +1 in the overall status I will re-execute the password change.
Thankfully, it always succeeds the second time around!

I understand that the +1 is pointing to the first field in the item num
array (which happens to be the password field for the user or acct or group
field). However, I don't understand what the problem could be. The password
field always has a value in it when the sub returns to the Cobol mainline.

Here is part of the Cobol source:

 WORKING-STORAGE SECTION.

 01  WS-USER-GROUP-ACCT-TABLE              VALUE SPACES.
     05  WS-UGAT-USER     PIC  X(16).
     05  WS-UGAT-GROUP    PIC  X(16).
     05  WS-UGAT-ACCT     PIC  X(16).

 01  WS-PASSWORD          PIC  X(16)       VALUE SPACES.
 01  WS-PASSWORD-TYPE     PIC  X(01)       VALUE SPACES.

 01  WS-ERROR-CODE        PIC S9(04) COMP  VALUE ZEROES.
 01  WS-OVERALL-STATUS               COMP.
     05  WS-OS-1          PIC S9(04) COMP  VALUE ZEROES.
         88 UNKNOWN-UGA                    VALUE -32.
     05  WS-OS-2          PIC S9(04) COMP  VALUE ZEROES.

 A400-UPDATE-USER-PASS.

     MOVE SPACES TO WS-PASSWORD.
     CALL "create_password" USING WS-PASSWORD.
     MOVE ZEROES TO WS-OVERALL-STATUS.
     MOVE "U"    TO WS-PASSWORD-TYPE.
     CALL "change_the_password" USING WS-OVERALL-STATUS,
                                      WS-USER-GROUP-ACCT-TABLE,
                                      WS-PASSWORD-TYPE,
                                      WS-PASSWORD,
                                      WS-ERROR-CODE
     END-CALL.
     IF WS-OS-1 NOT = ZEROES THEN
        IF UNKNOWN-UGA THEN
           DISPLAY "Unknown User :=>" DB-PDB-USER-ACCT-GROUP "<"
        ELSE
            IF WS-OS-1 > ZEROES THEN
               DISPLAY 'REDO USER PASS AGAIN=>'
                         DB-PDB-USER-ACCT-GROUP "<"
                        'AIF OVERALL STATUS ERROR CODES=>'
                     WS-OS-1 ">" WS-OS-2 " PASS=>" WS-PASSWORD "<"
               GO TO A400-UPDATE-USER-PASS
            ELSE
                DISPLAY 'USER PASS CHANGE FAILED=>'
                         DB-PDB-USER-ACCT-GROUP "<"
                        'AIF OVERALL STATUS ERROR CODES=>'
                     WS-OS-1 ">" WS-OS-2 " PASS=>" WS-PASSWORD "<"
            END-IF
        END-IF
        GO TO A400-EXIT
     END-IF.
     IF WS-ERROR-CODE NOT = ZEROES THEN
        DISPLAY "INVALID PASSWORD TYPE, PASSWORD NOT CHANGED"
        GO TO A400-EXIT
     END-IF.
     GO TO A400-EXIT.

 A400-EXIT.
     EXIT.

Pascal here:

$standard_level 'hp_modcal'$
$optimize on$
$global$
$assume 'LOCAL_GOTOS_ONLY'$
$assume 'LOCAL_ESCAPES_ONLY'$
$assume 'NO_HEAP_CHANGES'$
$SUBPROGRAM 'change_the_password'$
program change_the_password_X;
const maximum_pids = 1000;
type directory_name_type = record
                             user   : packed array[1..16] of char;
                             group  : packed array[1..16] of char;
                             account: packed array[1..16] of char;
                           end;

     pac1                = packed array[1..1]  of char;
     pac16               = packed array[1..16] of char;
     HPE_status          = record
                             case boolean of
                             true : (all   :integer);
                             false: (info  :shortint;
                             subsys:shortint);
                           end;
     status_2_type       = array [1..maximum_pids] of HPE_status;

const
   init_item_status_array=status_2_type
                          [maximum_pids of HPE_status [info  :0,
                                                       subsys:0]];
var
   item_array       : packed array [1..maximum_pids] of globalanyptr;
   item_num_array   : packed array [1..maximum_pids] of integer;
   item_status_array: status_2_type;
   overall_status   : HPE_status;
$sysintr 'sysintr.pub.sys'$
procedure GETPRIVMODE ; intrinsic;
procedure GETUSERMODE ; intrinsic;
$sysintr 'aifintr.pub.sys'$
procedure AIFACCTPUT  ; intrinsic;
PROCEDURE change_the_password(var overall_status    :HPE_status;
                              var the_directory_info:directory_name_type;
                              var password_type     :pac1;
                              var the_password      :pac16;
                              var the_error         :shortint);
label 999;

begin

   overall_status.all   := 0;
   the_error            := 0;
   item_num_array[2]    := 0;
   item_array    [1]    := addr(the_password);
   item_status_array    := init_item_status_array;

   if password_type = 'U' then
      item_num_array[1] := 6002
   else
       if password_type = 'G' then
          item_num_array[1] := 6102
       else
           if password_type = 'A' then
              item_num_array[1] := 6202
           else
             begin
               the_error := 666;
               goto 999;
             end;

   GETPRIVMODE;
   AIFACCTPUT(overall_status,
            item_num_array,
            item_array,
            item_status_array,
            the_directory_info);
   if overall_status.all <> 0 then
      goto 999;

   goto 999;

999:
   GETUSERMODE;
end;

begin
end.


Anybody know what is causing the +1 error code?

TIA,
Brian.

* To join/leave the list, search archives, change list settings, *
* etc., please visit http://raven.utc.edu/archives/hp3000-l.html *