From:	CRDGW2::CRDGW2::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX" 11-FEB-1992 09:04:00.31
To:	ARISIA::EVERHART
CC:	
Subj:	Re: ACL's in Pascal (or any hints)

From:	RELAY-INFO-VAX@CRVAX.SRI.COM@SMTP@CRDGW2
To:	Everhart@Arisia@MRGATE

Received:  by crdgw1.ge.com (5.57/GE 1.123)
	 id AA14694; Tue, 11 Feb 92 08:34:22 EST
Received: From DANPOST.UNI-C.DK by CRVAX.SRI.COM with TCP; Tue, 11 FEB 92 05:29:11 PST
Received: from vms2.uni-c.dk by danpost.uni-c.dk (5.65/1.34)
	id AA05928; Tue, 11 Feb 92 12:45:56 GMT
Date: Tue, 11 Feb 92 13:46 +0100
From: ISIS08@ecostat.aau.dk
Subject: Re: ACL's in Pascal (or any hints)
To: STUBRBEE%EKU.bitnet@CUNYVM.CUNY.EDU, INFO-VAX@SRI.COM
Message-Id: <9FFF376BF35F010A04@vms2.uni-c.dk>
X-Envelope-To: STUBRBEE%EKU.bitnet@CUNYVM.CUNY.EDU, INFO-VAX@SRI.COM
X-Vms-To: UNIL63::IN%"STUBRBEE%EKU.bitnet@CUNYVM.CUNY.EDU"
X-Vms-Cc: IN::"INFO-VAX@SRI.COM"

>    I posted a note about a month back on ACL's in pascal.  I have yet to get
> a reply.  If any of you have any sample code on how to do ACL's in any high
> level language (pascal preferred) i would LOVE to see it.  Hints are definitly
> most welcome....anything to get me going.

The following piece of MACRO contains 3 routines, which can be called
from FORTRAN (and PASCAL).

        .title  acl
        $ACLDEF
        $ACEDEF
;
; readonly data section
;
        .psect  $PDATA quad,pic,con,lcl,shr,noexe,nowrt
objtyp: .long   ACL$C_FILE 
;
; writeread data section
;
        .psect  $LOCAL quad,pic,con,lcl,noshr,noexe,wrt
argl_asctoid:                           ; argumentlist SYS$ASCTOID
        .long   3
        .blkl   1                       ; mame
        .address uic                    ; id
        .long   0                       ; attributes
argl_idtoasc:                           ; argumetlist SYS$IDTOASC
        .long   6
        .blkl   1                       ; id
        .blkl   1                       ; namelength
        .blkl   1                       ; name
        .long   0                       ; resultant-id
        .long   0                       ; attribute
        .long   0                       ; context
argl_changeacl:                         ; argumentlist SYS$CHANGE_ACL
        .long   9
        .long   0                       ; channel
        .address objtyp                 ; object-type
        .blkl   1                       ; object-name
        .address itmlst                 ; item-list
        .long   0                       ; access-mode
        .long   0                       ; null
        .address cntx                   ; context
        .long   0                       ; null
        .long   0                       ; null
itmlst: .blkl   1
        .blkw   1
        .blkl   1
        .long   0
        .long   0
aceblk: .byte   12
        .byte   ACE$C_KEYID
        .word   0
        .blkl   1                       ; access
        .blkl   1                       ; identifier
uic:    .blkl   1
cntx:   .blkl   1
dumdes: .blkq   1
;
; code section
;
        .psect  $CODE quad,pic,con,lcl,shr,exe,nowrt
;********************
;
;  DELACL ( FNM )
;
;  delete ACL
;
;********************
        .entry  delacl,^m<iv>
        movl    B^4(ap),argl_changeacl+12
        movw    #0,itmlst
        movw    #ACL$C_DELETEACL,itmlst+2
        movl    #0,itmlst+4
        movl    #0,cntx
        callg   argl_changeacl,G^SYS$CHANGE_ACL
        ret
;********************
;
;  GETACL ( FNM , N , ID , IDLEN , ACCESS )
;
;  get ACL
;
;********************
        .entry  getacl,^m<iv,r2,r3>
        movq    @B^12(ap),dumdes
        movl    B^16(ap),r2
        movl    B^20(ap),r3
        movl    B^4(ap),argl_changeacl+12
        movw    #12,itmlst
        movw    #ACL$C_READACE,itmlst+2
        moval   aceblk,itmlst+4
        movl    #0,cntx
        movl    #0,@B^8(ap)
50$:    clrl    aceblk+8
        clrl    aceblk+4
        callg   argl_changeacl,G^SYS$CHANGE_ACL
        cmpl    r0,#SS$_NORMAL
        beql    75$
        brw     600$
75$:    incl    @B^8(ap)
        movl    aceblk+8,argl_idtoasc+4
        movl    r2,argl_idtoasc+8
        moval   dumdes,argl_idtoasc+12
        callg   argl_idtoasc,G^SYS$IDTOASC
        clrl    (r3)
        cmpzv   #ACE$V_READ,#1,aceblk+4,#1
        bneq    100$
        movl    #-1,(r3)
100$:   addl2   #4,r3
        clrl    (r3)
        cmpzv   #ACE$V_WRITE,#1,aceblk+4,#1
        bneq    200$
        movl    #-1,(r3)
200$:   addl2   #4,r3
        clrl    (r3)
        cmpzv   #ACE$V_EXECUTE,#1,aceblk+4,#1
        bneq    300$
        movl    #-1,(r3)
300$:   addl2   #4,r3
        clrl    (r3)
        cmpzv   #ACE$V_DELETE,#1,aceblk+4,#1
        bneq    400$
        movl    #-1,(r3)
400$:   addl2   #4,r3
        clrl    (r3)
        cmpzv   #ACE$V_CONTROL,#1,aceblk+4,#1
        bneq    500$
        movl    #-1,(r3)
500$:   addl2   #4,r3
        movw    #ACL$C_FNDACETYP,itmlst+2
        callg   argl_changeacl,G^SYS$CHANGE_ACL
        cmpl    r0,#SS$_NORMAL
        bneq    600$
        cvtbl   dumdes,r0
        addl2   r0,dumdes+4
        addl2   #4,r2
        brw     50$
600$:   ret
;********************
;
;  PUTACL ( FNM , ID , ACCESS )
;
;  put ACL
;
;********************
        .entry  putacl,^m<iv>
        movl    B^8(ap),argl_asctoid+4
        callg   argl_asctoid,G^SYS$ASCTOID
        movl    B^4(ap),argl_changeacl+12
        movw    #12,itmlst
        movw    #ACL$C_ADDACLENT,itmlst+2
        moval   aceblk,itmlst+4
        movl    uic,aceblk+8
        movl    #0,cntx
        clrl    aceblk+4
        movl    B^12(ap),r1
        tstl    (r1)
        beql    100$
        bisl2   #ACE$M_READ,aceblk+4
100$:   addl2   #4,r1
        tstl    (r1)
        beql    200$
        bisl2   #ACE$M_WRITE,aceblk+4
200$:   addl2   #4,r1
        tstl    (r1)
        beql    300$
        bisl2   #ACE$M_EXECUTE,aceblk+4
300$:   addl2   #4,r1
        tstl    (r1)
        beql    400$
        bisl2   #ACE$M_DELETE,aceblk+4
400$:   addl2   #4,r1
        tstl    (r1)
        beql    500$
        bisl2   #ACE$M_CONTROL,aceblk+4
500$:   callg   argl_changeacl,G^SYS$CHANGE_ACL
        ret
        .end

Example in FORTRAN:

      PROGRAM TST
      LOGICAL*4 AC(5)
      DATA AC/.TRUE.,.TRUE.,.FALSE.,.FALSE.,.FALSE./
      CALL TEST
      CALL PUTACL('TST.DAT','ECOAV',AC)
      CALL TEST
      CALL PUTACL('TST.DAT','ECOAPPEL',AC)
      CALL TEST
      CALL DELACL('TST.DAT')
      CALL TEST
      END
C
      SUBROUTINE TEST
      INTEGER*4 N,UNLEN(25),I,J
      LOGICAL*4 AC(5,25)
      CHARACTER*12 UN(25)
      CALL GETACL('TST.DAT',N,UN,UNLEN,AC)
      WRITE(*,*) 'NO ACL=',N
      DO 100 I=1,N
        WRITE(*,*) UN(I)(1:UNLEN(I)),(AC(J,I),J=1,5)
100   CONTINUE
      RETURN
      END

Notes:
  - The access array is RWEDC.
  - It is the programmers responsibility to dimension the arrays for
    GETACL large enough.

Example in PASCAL:

program tst(input,output);

type
   fstring = packed array [1..12] of char;
   string  = varying [12] of char;
   actyp   = array [1..5] of integer;

type
   fstring25 = array [1..25] of fstring;
   integer25 = array [1..25] of integer;
   actyp25   = array [1..25] of actyp;

[external] procedure delacl(%STDESCR fnm:fstring); external;

[external] procedure getacl(%STDESCR fnm:fstring;%REF n:integer;
                            %STDESCR un:fstring25;%REF unlen:integer25;
                            %REF ac:actyp25); external;

[external] procedure putacl(%STDESCR fnm:fstring;%STDESCR un:fstring;
                            %REF ac:actyp); external;

procedure test;

var
   n,i,j : integer;
   un    : fstring25;
   unlen : integer25;
   ac    : actyp25;
   tmp   : string;

begin
   getacl('tst.dat     ',n,un,unlen,ac);
   writeln('NO ACL=',n);
   for i:=1 to n do begin
      tmp.body:=un[i];
      tmp.length:=unlen[i];
      write(un[i]);
      for j:=1 to 5 do write(ac[i,j]);
      writeln;
   end;
end;

var
   ac : actyp;

value
   ac := (-1,-1,0,0,0);

begin
   test;
   putacl('tst.dat','ecoav       ',ac);
   test;
   putacl('tst.dat','ecoappel    ',ac);
   test;
   delacl('tst.dat');
   test;
end.

Notes:
  - Same as for FORTRAN.
  - Usernames must be padded with spaces to maxlength.
  - True is -1 and false is 0.

I guess I could rewrite the MACRO to PASCAL, but it would take a little
time, so I hope this will do !

                                                          Arne Vajhxj

Arne Vajhxj                             Internet: ISIS08@ECOSTAT.AAU.DK
Institute of Economics and Statistics   PSI:      DATAPAX.23830211371400::ISIS08
Aarhus University
Denmark


