From:	CRDGW2::CRDGW2::MRGATE::"SMTP::YMIR.CLAREMONT.EDU::POSTMAST" 13-JUL-1990 07:21:21.05
To:	MRGATE::"ARISIA::EVERHART"
CC:	
Subj:	Fix for a bug I found in DELIVER

Received:  by crdgw1.ge.com (5.57/GE 1.70)
	 id AA10983; Fri, 13 Jul 90 06:44:59 EDT
Resent-From: postmast@YMIR.CLAREMONT.EDU
Resent-Message-Id:  <9007131044.AA10983@crdgw1.ge.com>
Received: from KSUVM.KSU.EDU by YMIR.CLAREMONT.EDU; Fri, 13 Jul 1990 02:41 PDT
Received: from KSUVM by KSUVM.KSU.EDU (Mailer R2.07) with BSMTP id 7242; Fri,
 13 Jul 90 02:00:12 CDT
Received: from ksuvax1.cis.ksu.edu by KSUVM.KSU.EDU (IBM VM SMTP R1.2.2MX) with
 TCP; Fri, 13 Jul 90 02:00:11 CDT
Received: by ksuvax1.cis.ksu.edu (5.59++/CIS1.1) id AA02590; Fri, 13 Jul 90
 02:00:07 CDT
Resent-Date: Fri, 13 Jul 1990 03:01 PDT
Date: 13 Jul 90 19:19:46 GMT
From: timcc@csv.viccol.edu.au (Tim Cook)
Subject: Fix for a bug I found in DELIVER
To: ipmdf@YMIR.CLAREMONT.EDU
Errors-To: postmast@YMIR.CLAREMONT.EDU
Message-Id: <6308.269dd883@csv.viccol.edu.au>
X-Vms-To: ipmdf@YMIR.CLAREMONT.EDU
Organization: Computer Services, Victoria College, Melbourne

I discovered the other day that DELIVER fails when attempting to deliver to
a user who has a login default device longer than 15 characters (such as
our Usenet news account, which has a login default device of
"NEWS_MANAGER_DEV".
 
I have fixed this bug, and cleaned up the definitions of RTL routines that
have string descriptor parameters.
 
I also made DELIVER attempt to queue the delivery job on DELIVER_BATCH,
MAIL$BATCH then SYS$BATCH, in that order (this makes it more compatible
with the old version of DELIVER).  This last change is optional, of course.
 
The following diff listing is relative to a version of DELIVER.PAS that I
found on ymir.claremont.edu in the directory
[ANONYMOUS.MAILSERV.FILES.DELIVER] yesterday (12 July).
 
*** DELIVER.PAS-OLD
--- DELIVER.PAS
**************
*** 12,15
       feature is conditional -- the constant use_sjc_user_identification
       controls it.
 
     DELIVER provides a general-purpose MAIL delivery manager similar
--- 12,21 -----
       feature is conditional -- the constant use_sjc_user_identification
       controls it.
+    Fixed definition of string that holds the user's login default device,
+      fixed initialisation of item-list in find_user_directory, and fixed
+      defintions of external routines that have string descriptors as
+      parameters, Tim Cook, 12 Jul 1990.
+    Make DELIVER try DELIVER_BATCH, MAIL$BATCH then SYS$BATCH batch queues,
+      in that order, Tim Cook, 13 Jul 1990.
 
     DELIVER provides a general-purpose MAIL delivery manager similar
**************
*** 194,197
  var
    batch_queue : [static, readonly] string := 'DELIVER_BATCH';
    system_batch_queue : [static, readonly] string := 'SYS$BATCH';
 
--- 200,204 -----
  var
    batch_queue : [static, readonly] string := 'DELIVER_BATCH';
+   mail_batch_queue : [static, readonly] string := 'MAIL$BATCH';
    system_batch_queue : [static, readonly] string := 'SYS$BATCH';
 
**************
*** 227,231
  (* Routine to get job/process information *)
 
! function LIB$GETJPI (
    item_code : integer; var process_id : unsigned := %immed 0;
    process_name : [readonly] varying [u1] of char := %immed 0;
--- 234,238 -----
  (* Routine to get job/process information *)
 
! [external, asynchronous] function LIB$GETJPI (
    item_code : integer; var process_id : unsigned := %immed 0;
    process_name : [class_s] packed array [l1..u1:integer] of char := %immed 0;
**************
*** 229,233
  function LIB$GETJPI (
    item_code : integer; var process_id : unsigned := %immed 0;
!   process_name : [readonly] varying [u1] of char := %immed 0;
    var out_value : unsigned := %immed 0;
    var out_string : varying [u2] of char := %immed 0;
--- 236,240 -----
  [external, asynchronous] function LIB$GETJPI (
    item_code : integer; var process_id : unsigned := %immed 0;
!   process_name : [class_s] packed array [l1..u1:integer] of char := %immed 0;
    var out_value : unsigned := %immed 0;
    %DESCR out_string : varying [n1] of char := %immed 0;
**************
*** 231,235
    process_name : [readonly] varying [u1] of char := %immed 0;
    var out_value : unsigned := %immed 0;
!   var out_string : varying [u2] of char := %immed 0;
    var out_len : integer := %immed 0) : integer; external;
 
--- 238,242 -----
    process_name : [class_s] packed array [l1..u1:integer] of char := %immed 0;
    var out_value : unsigned := %immed 0;
!   %DESCR out_string : varying [n1] of char := %immed 0;
    var out_len : integer := %immed 0) : integer; external;
 
**************
*** 236,240
  (* Routine to signal errors *)
 
! procedure LIB$SIGNAL (%IMMED stat : [list, unsafe] integer); extern;
 
  (* Routine to read command line arguments *)
--- 243,248 -----
  (* Routine to signal errors *)
 
! [external, asynchronous] procedure LIB$SIGNAL (
!   %IMMED stat : [list, unsafe] integer); external;
 
  (* Routine to read command line arguments *)
**************
*** 240,245
  (* Routine to read command line arguments *)
 
! function CLI$GET_VALUE (name : varying [max1] of char;
!   var val : varying [max2] of char) : integer; extern;
 
  (* Routine to get symbol values *)
--- 248,254 -----
  (* Routine to read command line arguments *)
 
! [external, asynchronous] function CLI$GET_VALUE (
!   name : [class_s] packed array [l1..u1:integer] of char;
!   %DESCR val : varying [n1] of char) : integer; external;
 
  (* Routine to get symbol values *)
**************
*** 245,250
  (* Routine to get symbol values *)
 
! function LIB$GET_SYMBOL (name : varying [max1] of char;
!   var result : varying [max2] of char) : integer; extern;
 
  (* Routine to set symbol values *)
--- 254,260 -----
  (* Routine to get symbol values *)
 
! [external, asynchronous] function LIB$GET_SYMBOL (
!   name : [class_s] packed array [l1..u1:integer] of char;
!   %DESCR result : varying [n1] of char) : integer; external;
 
  (* Routine to set symbol values *)
**************
*** 250,255
  (* Routine to set symbol values *)
 
! function LIB$SET_SYMBOL (name : varying [max1] of char;
!   svalue : varying [max2] of char) : integer; extern;
 
  (* create_with_SYSPRV is a Pascal user-action routine for OPEN statements.
--- 260,266 -----
  (* Routine to set symbol values *)
 
! [external, asynchronous] function LIB$SET_SYMBOL (
!   name : [class_s] packed array [l1..u1:integer] of char;
!   svalue : [class_s] packed array [l2..u2:integer] of char) : integer;
 external;
 
  (* create_with_SYSPRV is a Pascal user-action routine for OPEN statements.
**************
*** 328,332
 
  var
!   device_with_prefix : packed array [1..16] of char;
    directory_with_prefix : packed array [1..64] of char;
    items : array [1..6] of item; stat : integer;
--- 339,346 -----
 
  var
!   (* Wrong!  A user's login default device (UAF$T_DEFDEV) can be up to
!      32 characters, including the count byte *)
!   device_with_prefix : packed array [1..32] of char;
! (*device_with_prefix : packed array [1..16] of char;*)
    directory_with_prefix : packed array [1..64] of char;
    items : array [1..6] of item; stat : integer;
**************
*** 341,345
    else begin
      with items[1] do begin
!       len := 4; code := UAI$_UIC; addr := iaddress (user_uic); rlen := 0;
      end; (* with *)
      with items[2] do begin
--- 355,360 -----
    else begin
      with items[1] do begin
!       code := UAI$_UIC;
!       len := size (user_uic); addr := iaddress (user_uic); rlen := 0;
      end; (* with *)
      with items[2] do begin
**************
*** 344,348
      end; (* with *)
      with items[2] do begin
!       len := 8; code := UAI$_ACCOUNT;
        addr := iaddress (user_account); rlen := 0;
      end; (* with *)
--- 359,364 -----
      end; (* with *)
      with items[2] do begin
!       code := UAI$_ACCOUNT;
!       len := size (user_account);
        addr := iaddress (user_account); rlen := 0;
      end; (* with *)
**************
*** 348,352
      end; (* with *)
      with items[3] do begin
!       len := 16; code := UAI$_DEFDEV;
        addr := iaddress (device_with_prefix); rlen := 0;
      end; (* with *)
--- 364,369 -----
      end; (* with *)
      with items[3] do begin
!       code := UAI$_DEFDEV;
!       len := size (device_with_prefix);
        addr := iaddress (device_with_prefix); rlen := 0;
      end; (* with *)
**************
*** 352,356
      end; (* with *)
      with items[4] do begin
!       len := 64; code := UAI$_DEFDIR;
        addr := iaddress (directory_with_prefix); rlen := 0;
      end; (* with *)
--- 369,374 -----
      end; (* with *)
      with items[4] do begin
!       code := UAI$_DEFDIR;
!       len := size (directory_with_prefix);
        addr := iaddress (directory_with_prefix); rlen := 0;
      end; (* with *)
**************
*** 356,360
      end; (* with *)
      with items[5] do begin
!       len := 1; code := UAI$_PRI; addr := iaddress (priority); rlen := 0;
      end; (* with *)
      with items[6] do begin
--- 374,379 -----
      end; (* with *)
      with items[5] do begin
!       code := UAI$_PRI;
!       len := size (priority); addr := iaddress (priority); rlen := 0;
      end; (* with *)
      with items[6] do begin
**************
*** 423,428
 
    [asynchronous, unbound, external (LIB$SCOPY_DXDX)]
!   function copy_string (var src : varying [max1] of char;
!     var dst : string_descriptor) : integer; extern;
 
  begin (* copy_string_to_descr *)
--- 442,448 -----
 
    [asynchronous, unbound, external (LIB$SCOPY_DXDX)]
!   function copy_string (
!     src : [class_s] packed array [l1..u1:integer] of char;
!     var dst : string_descriptor) : integer; external;
 
  begin (* copy_string_to_descr *)
**************
*** 762,766
 
  var
!   user_list_scan : user_block_ptr; onehasmatched, match, previous_bio :
 boolean;
    rules_list_scan : parameter_block_ptr; message_file : text;
    fromupstring, toupstring, subjectupstring, line : string;
--- 782,787 -----
 
  var
!   user_list_scan : user_block_ptr; onehasmatched, match, previous_bio
!     : boolean;
    rules_list_scan : parameter_block_ptr; message_file : text;
    fromupstring, toupstring, subjectupstring, line : string;
**************
*** 769,774
    items : array [1..9] of item;
 
!   function STR$MATCH_WILD (candidate : varying [l1] of char;
!     pattern : varying [l2] of char) : integer; extern;
 
    function STR$UPCASE (var dststr : varying [l1] of char;
--- 790,797 -----
    items : array [1..9] of item;
 
!   [external, asynchronous] function STR$MATCH_WILD (
!     candidate : [class_s] packed array [l1..u1:integer] of char;
!     pattern : [class_s] packed array [l2..u2:integer] of char)
!       : integer; external;
 
    [external, asynchronous] function STR$UPCASE (
**************
*** 772,777
      pattern : varying [l2] of char) : integer; extern;
 
!   function STR$UPCASE (var dststr : varying [l1] of char;
!     var srcstr : varying [l2] of char) : integer; extern;
 
    (* function to read a line from the message file *)
--- 795,802 -----
        : integer; external;
 
!   [external, asynchronous] function STR$UPCASE (
!     %DESCR dststr : varying [n1] of char;
!     srcstr : [class_s] packed array [li..u1:integer] of char)
!       : integer; external;
 
    (* function to read a line from the message file *)
**************
*** 1151,1154
      if DEBUG_OUT then writeln ('    Opening job.');
      stat := $SNDJBCW (func := SJC$_ENTER_FILE, itmlst := items, iosb := iosb);
      if (not odd (stat)) or (not odd (iosb[0])) then begin
        with items[2] do begin
--- 1176,1186 -----
      if DEBUG_OUT then writeln ('    Opening job.');
      stat := $SNDJBCW (func := SJC$_ENTER_FILE, itmlst := items, iosb := iosb);
+     if (not odd (stat)) or (not odd (iosb[0])) then begin
+       with items[2] do begin
+         len := length (mail_batch_queue);
+         addr := iaddress (mail_batch_queue) + 2;
+       end;
+       stat := $SNDJBCW (func := SJC$_ENTER_FILE, itmlst := items, iosb :=
 iosb);
+     end;
      if (not odd (stat)) or (not odd (iosb[0])) then begin
        with items[2] do begin
--
Tim Cook     Systems Administrator, Victoria College Computer Services
