From:	CRDGW2::CRDGW2::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX" 13-FEB-1992 11:28:19.49
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 AA22656; Thu, 13 Feb 92 11:02:12 EST
Received: From DANPOST.UNI-C.DK by CRVAX.SRI.COM with TCP; Thu, 13 FEB 92 07:52:25 PST
Received: from vms2.uni-c.dk by danpost.uni-c.dk (5.65/1.34)
	id AA24309; Thu, 13 Feb 92 15:51:28 GMT
Date: Thu, 13 Feb 92 16:52 +0100
From: ISIS08@ecostat.aau.dk
Subject: Re: ACL's in Pascal (or any hints)
To: STUBRBEE@EKU.BITNET, INFO-VAX@SRI.COM
Message-Id: <9E52F95E10FF00A115@vms2.uni-c.dk>
X-Envelope-To: STUBRBEE@EKU.BITNET, INFO-VAX@SRI.COM
X-Vms-To: UNIL63::IN%"STUBRBEE@EKU.BITNET"
X-Vms-Cc: IN::"INFO-VAX@SRI.COM"


Someone asked:

> >    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.

And I replied:

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

Sorry, but my code did contain one serious programming error in routine GETACL
and the original poster also wanted to delete one ACL entry (and not the
entire ACL).

Here is a corrected version of the MACRO code and the example programs:

        .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
;********************
;
;  DELONEACL ( FNM , ID , ACCESS )
;
; delete one ACL
;
;********************
        .entry  deloneacl,^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_DELACLENT,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
;********************
;
;  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_FNDACETYP,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
        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

      PROGRAM ZZ
      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 PUTACL('TST.DAT','ECOPETER',AC)
      CALL TEST
      CALL DELONEACL('TST.DAT','ECOAV',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

program zz(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 deloneacl(%STDESCR fnm:fstring;%STDESCR un:fstring;
                               %REF ac:actyp); 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;
   putacl('tst.dat','ecopeter    ',ac);
   test;
   deloneacl('tst.dat','ecoav       ',ac);
   test;
   delacl('tst.dat');
   test;
end.

I hope I have got it rigth this time (probably not) !

                                                          Arne Vajhxj

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


