From: HENRY::IN%"[email-masked]" 7-SEP-1986 07:59
To: [email-masked]

It's been a while since I've posted any sample code, so, heres
a short program I threw together that gets disk quota information, performs
a lookup in the authorization file, and prints out a line showing all the
usefull info. UAF.REC contains a fortran record definition of the authorization
file, DQF.REC contains a record definition of QUOTA.SYS, although I don't
directly read the QUOTA file in this example (I use a QIO function).
	I hope this answers a few peoples questions about how to access these
things.. I haven't updated to 4.4 yet, so I don't use the SYS$GETUAI service
in this code, but I plan on upgrading to it so I can provide an example of
it in the future.

	Anyway, move to a nice fresh directory and execute the following
procedure if you want to. I call it QUOTA.

	Cheers,
	Joe Meadows Jr		[email-masked]

$ say := write sys$output
$ say "Creating diskquota.mar"
$ create diskquota.mar
$ deck
	.title diskquota
	.library 'sys$share:lib'
$iodef
$fibdef
$dqfdef
 
fib_desc:
	.long	fib$k_length
	.long	fib
fib:	.blkb	fib$k_length
 
iosb:	.quad
chan:	.blkw	1
 
	.entry next_quota,^m<r2,r3,r4,r5,r6>

	tstw	chan
	bneq	10$

	$assign_s-
		devnam=@4(ap),-
		chan=chan
	blbc	r0,20$

10$:	movw	#fib$c_exa_quota,fib+fib$w_cntrlfunc
	movl	#fib$m_all_mem!fib$m_all_grp,fib+fib$l_cntrlval
	movl	@8(ap),fib+fib$l_wcc

	$qiow_s	func=#io$_acpcontrol,-
		iosb=iosb,-
		chan=chan,-
		p1=fib_desc,-
		p2=12(ap),-
		p3=16(ap),-
		p4=12(ap)

	blbc	r0,20$
	movl	iosb,r0
	blbc	r0,20$

	movl	fib+fib$l_wcc,@8(ap)

20$:	ret
	.end
$ eod
$ say "Creating DQF.REC"
$ create dqf.rec
	parameter DQF$M_ACTIVE	= 1
	parameter DQF$K_LENGTH	= 32
	parameter DQF$C_LENGTH	= 32
	parameter DQF$S_DQFDEF	= 32

	structure /dqfdef/
	 union
	   map
		integer*4 DQF$L_FLAGS
		parameter DQF$V_ACTIVE = 0
		integer*4 DQF$L_UIC
		integer*4 DQF$L_USAGE
		integer*4 DQF$L_PERMQUOTA
		integer*4 DQF$L_OVERDRAFT
	   end map
	   map
		character*32 t_full
	   end map
	 end union
	end structure
$ eod
$ say "Creating UAF.REC
$ create uaf.rec
$ deck
!*** MODULE $UAFDEF ***
! ++
!  User authorization file format
!  Note: With the exception of the username and account name,
!  all strings are blank padded counted strings. Username and
!  account name are uncounted, blank padded.
! --
	STRUCTURE /UAF/
	  union
	    map
	      character*1412 t_full
	    end map
	    map
		BYTE B_RTYPE		!  UAF record type
		BYTE B_VERSION		!  UAF format version
		INTEGER*2 W_USRDATOFF	!  offset of counted string of user data

		! username
		UNION
		 MAP
		  CHARACTER*32 T_USERNAME	! username
		 END MAP
		 MAP
		  CHARACTER*31 %FILL
		  CHARACTER*1 T_USERNAME_TAG	!  tag to differentiate records
		 END MAP
		END UNION

		! uic
		UNION
		 MAP
		  INTEGER*4 L_UIC
		 END MAP
		 MAP
		  INTEGER*2 W_MEM	!  member subfield
		  INTEGER*2 W_GRP	!  group subfield
		 END MAP
		END UNION

		INTEGER*4 L_SUB_ID	!  user sub-identifier
		INTEGER*4 Q_PARENT_ID(2)	!  identifier of owner of this account
		CHARACTER*32 T_ACCOUNT		!  account name
		CHARACTER*32 T_OWNER		!  owner's name
		CHARACTER*32 T_DEFDEV		!  default device
		CHARACTER*64 T_DEFDIR		!  default directory
		CHARACTER*64 T_LGICMD		!  login command file
		CHARACTER*32 T_DEFCLI		!  default command interpreter
		CHARACTER*32 T_CLITABLES	!  user CLI tables

		! Password
		UNION
		 MAP
		  INTEGER*4 Q_PWD(2)
		 END MAP
		 MAP
		  INTEGER*4 L_PWD		!  32 bit subfield
		 END MAP
		END UNION

		INTEGER*4 Q_PWD2(2)		!  second password
		INTEGER*2 W_LOGFAILS		!  count of login failures
		INTEGER*2 W_SALT		!  random password salt
		BYTE B_ENCRYPT			!  encryption algorithm
		BYTE B_ENCRYPT2			!  encryption algorithm for 2nd pwd
		BYTE B_PWD_LENGTH		!  minimum password length
		BYTE %FILL
		INTEGER*4 Q_EXPIRATION(2)	!  expiration date for account
		INTEGER*4 Q_PWD_LIFETIME(2)	!  password lifetime
		INTEGER*4 Q_PWD_DATE(2)		!  date of password change
		INTEGER*4 Q_PWD2_DATE(2)	!  date of 2nd password change
		INTEGER*4 Q_LASTLOGIN_I(2)	!  date of last interactive login
		INTEGER*4 Q_LASTLOGIN_N(2)	!  date of last non-interactive login
		INTEGER*4 Q_PRIV(2)		!  process privilege vector
		INTEGER*4 Q_DEF_PRIV(2)		!  default process privileges
		CHARACTER*20 R_MIN_CLASS	!  minimum security class
		CHARACTER*20 R_MAX_CLASS	!  maximum security class
		INTEGER*4 L_FLAGS
c		  PARAMETER UAF$V_DISCTLY = 0		!  no user control-y
c		  PARAMETER UAF$V_DEFCLI = 1		!  only allow user default CLI
c		  PARAMETER UAF$V_LOCKPWD = 2		!  disable SET PASSWORD command
c		  PARAMETER UAF$V_CAPTIVE = 3		!  captive account (no overrides)
c		  PARAMETER UAF$V_DISACNT = 4		!  no interactive login
c		  PARAMETER UAF$V_DISWELCOM = 5		!  skip welcome message
c		  PARAMETER UAF$V_DISMAIL = 6		!  skip new mail message
c		  PARAMETER UAF$V_NOMAIL = 7		!  disable mail delivery
c		  PARAMETER UAF$V_GENPWD = 8		!  passwords must be generated
c		  PARAMETER UAF$V_PWD_EXPIRED = 9	!  password has expired
c		  PARAMETER UAF$V_PWD2_EXPIRED = 10	!  2nd password has expired
c		  PARAMETER UAF$V_AUDIT = 11		!  audit all actions
c		  PARAMETER UAF$V_DISREPORT = 12	!  skip last login messages
c		  PARAMETER UAF$V_DISRECONNECT = 13	!  inhibit reconnections
c		  PARAMETER UAF$V_AUTOLOGIN = 14	!  auto-login only
		BYTE B_NETWORK_ACCESS_P(3)	!  hourly network access, primary
		BYTE B_NETWORK_ACCESS_S(3)	!  hourly network access, secondary
		BYTE B_BATCH_ACCESS_P(3)	!  hourly batch access, primary
		BYTE B_BATCH_ACCESS_S(3)	!  hourly batch access, secondary
		BYTE B_LOCAL_ACCESS_P(3)	!  hourly local access, primary
		BYTE B_LOCAL_ACCESS_S(3)	!  hourly local access, secondary
		BYTE B_DIALUP_ACCESS_P(3)	!  hourly dialup access, primary
		BYTE B_DIALUP_ACCESS_S(3)	!  hourly dialup access, secondary
		BYTE B_REMOTE_ACCESS_P(3)	!  hourly remote access, primary
		BYTE B_REMOTE_ACCESS_S(3)	!  hourly remote access, secondary
		CHARACTER*12 %FILL
		BYTE B_PRIMEDAYS
c		  PARAMETER UAF$V_MONDAY = 0	!  bit clear means this is a primary day
c		  PARAMETER UAF$V_TUESDAY = 1	!  bit set means this is an off day
c		  PARAMETER UAF$V_WEDNESDAY = 2
c		  PARAMETER UAF$V_THURSDAY = 3
c		  PARAMETER UAF$V_FRIDAY = 4
c		  PARAMETER UAF$V_SATURDAY = 5
c		  PARAMETER UAF$V_SUNDAY = 6
		BYTE %FILL
		BYTE B_PRI		!  base process priority
		BYTE B_QUEPRI		!  maximum job queuing priority
		INTEGER*2 W_MAXJOBS	!  maximum jobs for UIC allowed
					!  0 means no limit
		INTEGER*2 W_MAXACCTJOBS	!  maximum jobs for account allowed
					!  0 means no limit
		INTEGER*2 W_MAXDETACH	!  maximum detached processes for UIC
					!  0 means no limit
		INTEGER*2 W_PRCCNT	!  subprocess creation limit
		INTEGER*2 W_BIOLM	!  buffered I/O limit
		INTEGER*2 W_DIOLM	!  direct I/O limit
		INTEGER*2 W_TQCNT	!  timer queue entry limit
		INTEGER*2 W_ASTLM	!  AST queue limit
		INTEGER*2 W_ENQLM	!  enqueue limit
		INTEGER*2 W_FILLM	!  open file limit
		INTEGER*2 W_SHRFILLM	!  shared file limit
		INTEGER*4 L_WSQUOTA	!  working set size quota
		INTEGER*4 L_DFWSCNT	!  default working set size
		INTEGER*4 L_WSEXTENT	!  working set size limit
		INTEGER*4 L_PGFLQUOTA	!  page file quota
		INTEGER*4 L_CPUTIM	!  CPU time quota
		INTEGER*4 L_BYTLM	!  buffered I/O byte count limit
		INTEGER*4 L_PBYTLM	!  paged buffer I/O byte count limit
		INTEGER*4 L_JTQUOTA	!  job-wide logical name table creation quota
		INTEGER*2 W_PROXY_LIM	!  number of proxies user can grant
		INTEGER*2 W_PROXIES	!  number of proxies granted
		INTEGER*2 W_ACCOUNT_LIM	!  number of sub-accounts allowed
		INTEGER*2 W_ACCOUNTS	!  number of sub-accounts in use
	  end map
	  end union
	END STRUCTURE
$ eod
$ say "Creating QUOTA.FOR"
$ create quota.for
$ deck
	program diskquotas

	implicit integer (a-z)
	include 'dqf.rec'
	include 'uaf.rec'

	external ss$_nodiskquota

	record /UAF/ uafrec
	record /dqfdef/ dqf
	character*80 buff,output
	integer p1(2)/'020e0000'x,0/

	call cli$get_value('p1',p1)
	call cli$get_value('output',output)

	status = lib$get_lun(uaf_lun)
	if (.not.status) call lib$signal(%val(status))
	open(unit=uaf_lun,file='sys$system:sysuaf.dat',status='old'
	1	,readonly,shared,access='keyed',form='formatted')

	binary=cli$present('binary')
	status = lib$get_lun(out_lun)
	if (.not.status) call lib$signal(%val(status))
	if (binary) then
		open(unit=out_lun,file=output,status='new'
	1		,form='unformatted',recordtype='variable')
	else
		open(unit=out_lun,file=output,status='new')
	end if

10	status = next_quota(p1,context,dqf.t_full,buflen)
	if (status.eq.%loc(ss$_nodiskquota)) goto 20
	if (.not.status) call lib$signal(%val(status))

	read(unit=uaf_lun,keyeq=dqf.dqf$l_uic,keyid=1
	1	,fmt='(q,a)',err=15,iostat=ios) length,uafrec.t_full

	call str$trim(uafrec.t_username,uafrec.t_username,userlen)

	if (dqf.dqf$l_flags) then
	   call sys$fao('!AS !SL!_!%I!_!AS',length,buff
	1		,uafrec.t_account
	2		,%val(dqf.dqf$l_usage)
	3		,%val(dqf.dqf$l_uic)
	4		,uafrec.t_username(:userlen))
	else
15	   if (ios.ne.0) then
		uafrec.t_account='error'
		uafrec.t_username='error'
		userlen=5
	   end if
	   call sys$fao('!AS !SL!_!%I!_!AS',length,buff
	1		,uafrec.t_account
	2		,%val(dqf.dqf$l_usage)
	3		,%val(dqf.dqf$l_uic)
	4		,uafrec.t_username(:userlen))
	end if

	if (binary) then
		call str$trim(uafrec.t_account,uafrec.t_account,accntlen)
		write(out_lun) dqf.dqf$l_uic
	1			,dqf.dqf$l_usage
	2			,uafrec.t_account(:accntlen)
	else
		write(out_lun,*) buff(:length)
	end if
	goto 10

20	end
$ eod
$ say "Creating QUOTA.CLD"
$ create quota.cld
$ deck
!*************************************QUOTA*************************************
define verb QUOTA
   parameter P1
      default
      value (default="SYS$DISK",type=$device)
   qualifier BINARY
   qualifier OUTPUT
      default
      value (default="SYS$OUTPUT",type=$outfile)
$ eod
$ say "Compiling DISKQUOTA.MAR"
$ macro diskquota
$ say "Compiling QUOTA.FOR
$ fortran quota
$ say "Linking QUOTA,DISKQUOTA"
$ link/notrace quota,diskquota
$ say "Defining QUOTA command"
$ set command quota
$ type sys$input
	In the future you will either need to modify QUOTA.CLD
	or add a DEFINE QUOTA device:[directory]QUOTA to your
	login command procedure.. For now I'll define it for you..
$ define quota 'f$envir("default")'QUOTA
$ say "All done, give it a try by saying QUOTA"