$! ------------------ CUT HERE -----------------------

$ v='f$verify(f$trnlnm("SHARE_UNPACK_VERIFY"))'

$!

$! This archive created:

$!  Name : GETQUO

$!  By   : Andy Harper <udaa055@bay.cc.kcl.ac.uk>

$!  Date : 14-NOV-1994 18:34:49.15

$!  Using: VMS_SHARE 8.5-1, (C) 1993 Andy Harper, Kings College London UK

$!

$! Credit is due to these people for their original ideas:

$!    James Gray, Michael Bednarek 

$!

$! To unpack this archive:

$!    Minimum of VMS 4.4 (VAX) / OpenVMS 1.0 (Alpha) is required.

$!    Remove the headers of the first part, up to `cut here' line.

$!    Execute file as a command procedure.

$!

$! The following file(s) will be created after unpacking:

$!       1. [.GETQUO]BUILD.COM;1

$!       2. [.GETQUO]BUILDD.COM;1

$!       3. [.GETQUO]GETQUO.FOR;4

$!       4. [.GETQUO]GETQUO.HLP;2

$!       5. [.GETQUO]GETQUO_TABLE.CLD;1

$!

$ set="set"

$ set symbol/scope=(nolocal,noglobal)

$ f="SYS$SCRATCH:."+f$getjpi("","PID")+";"

$ if f$trnlnm("SHARE_UNPACK") .nes. "" then $ -

 f=f$parse("SHARE_UNPACK_TEMP",f)

$ e="write sys$error  ""%UNPACK"", "

$ w="write sys$output ""%UNPACK"", "

$ if .not. f$trnlnm("SHARE_UNPACK_LOG") then $ w = "!"

$ if f$getsyi("CPU") .gt. 127 then $ goto start

$ ve=f$getsyi("version")

$ if ve-f$extract(0,1,ve) .ges. "4.4" then $ goto start

$ e "-E-OLDVER, Must run at least VMS 4.4"

$ v=f$verify(v)

$ exit 44

$unpack:subroutine!P1=file,P2=chksum,P3=attrib,P4=size,P5=fileno,P6=filetotal

$ if f$parse(P1) .nes. "" then $ goto dirok

$ dn=f$parse(P1,,,"DIRECTORY")

$ w "-I-CREDIR, Creating directory ''dn'"

$ create/dir 'dn'

$ if $status then $ goto dirok

$ e "-E-CREDIRFAIL, Unable to create ''dn' File skipped"

$ delete 'f'*

$ exit

$dirok:

$ x=f$search(P1)

$ if x .eqs. "" then $ goto file_absent

$ e "-W-EXISTS, File ''P1' exists. Skipped"

$ delete 'f'*

$ exit

$file_absent:

$ w "-I-UNPACK, Unpacking ", P5, " of ", P6, " - ", P1, " - ", P4, " Blocks"

$ n=P1

$ if P3 .nes. "" then $ n=f

$ if .not. f$verify() then $ define/user sys$output nl:

$ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT/NOJOURNAL 'f'/OUT='n'

PROCEDURE GetHex(s,p)LOCAL x1,x2;x1:=INDEX(t,SUBSTR(s,p,1))-1;x2:=INDEX(t,

SUBSTR(s,p+1,1))-1;RETURN 16*x1+x2;ENDPROCEDURE;PROCEDURE SkipPartsep LOCAL m;

LOOP m:=MARK(NONE);EXITIF m=END_OF(CURRENT_BUFFER);DELETE(m);EXITIF INDEX(

ERASE_LINE,"-+-+-+-+-+-+-+-+")=1;ENDLOOP;ENDPROCEDURE;

PROCEDURE ProcessLine LOCAL c,s,l,b,n,p;s := ERASE_LINE;EDIT(s,TRIM);c :=

 SUBSTR(s,1,1);s := s-c;IF c = "X" THEN SPLIT_LINE; ENDIF;MOVE_HORIZONTAL(-1);

l := LENGTH(s);p := 1;LOOP EXITIF p > l;c := SUBSTR(s,p,1);p := p+1;

CASE c FROM ' ' TO '`' ['\']: b:=GetHex(s,p); n:=GetHex(s,p+2); p:=p+4;

 COPY_TEXT( SUBSTR(CURRENT_LINE,CURRENT_OFFSET-b+1,n));['&']: b:=GetHex(s,p);

 n:=GetHex(s,p+2); p:=p+4; COPY_TEXT(ASCII(n)*b);['`']: COPY_TEXT(ASCII(GetHex(

s,p))); p:=p+2;[INRANGE,OUTRANGE]: COPY_TEXT(c);ENDCASE;ENDLOOP;ENDPROCEDURE;

PROCEDURE Decode(b)LOCAL m;POSITION(BEGINNING_OF(b));LOOP m:=MARK(NONE);

EXITIF m=END_OF(b);DELETE(m);IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+-")=

1 THEN SkipPartSep;ELSE ProcessLine;MOVE_HORIZONTAL(1);ENDIF;ENDLOOP;

ENDPROCEDURE;SET(FACILITY_NAME,"UNPACK");SET(SUCCESS,OFF);SET(INFORMATIONAL,

OFF);t:="0123456789ABCDEF";f:=GET_INFO(COMMAND_LINE,"file_name");o:=

CREATE_BUFFER(f,f);Decode(o);WRITE_FILE(o,GET_INFO(COMMAND_LINE,"output_file"))

;QUIT;

$ if p3 .eqs. "" then $ goto dl

$ open/write fdl &f

$ write fdl "RECORD"

$ write fdl P3

$ close fdl

$ w "-I-CONVRFM, Converting record format to ", P3

$ convert/fdl='f' 'f'-1 'f'

$ fa=f$getdvi(f$parse(f),"ALLDEVNAM")

$ Pa=f$getdvi(f$parse(P1),"ALLDEVNAM")

$ if fa .eqs. Pa then $ rename &f 'f$parse(P1)'

$ if fa .nes. Pa then $ copy &f 'f$parse(P1)'

$dl: delete 'f'*

$ checksum 'P1'

$ if checksum$checksum .nes. P2 then $ -

  e "-E-CHKSMFAIL, Checksum of ''P1' failed."

$ exit

$ endsubroutine

$start:

$!

$ create 'f'

X$ fortran /extend getquo

X$ set command /object getquo_table

X$ link/notraceback getquo,\0706_table

$ call unpack [.GETQUO]BUILD.COM;1 1920284882 "" 1 1 5

$!

$ create 'f'

X$ fortran /extend /noopt /debug getquo

X$ set command /object getquo_table

X$ link/debug getquo,\0706_table

$ call unpack [.GETQUO]BUILDD.COM;1 2034575114 "" 1 2 5

$!

$ create 'f'

XC ========\0808\1010\2020\400C

XC   GETQUO - Get information about disk quotas for a given user and return

XC`09     details in DCL symbols.

XC

XC   Author:

XC`09Andy Harper,  Kings College London, \0808England

XC

XC   Version:

XC`091.0`09Andy Harper`0915-APR-1992`09First version

XC`091.1`09Andy Harper`0914-nov-1994`09Fix error returns in init_cli

XC

XC   Privileges:

XC`09SYSNAM or SYSPRV to get information about other users; none for

XC`09info about self.

XC

XC   Usage:

XC`09$ GETQUO == "$dev:`5Bdir`5D\1506"

XC`09$ GETQUO `5Busername`5D `5B/qual=symbol`5D `5B...`5D

XC

XC       Acceptable qualifiers are:

XC`09  /ENABLED=symbol`09`09Specify \1006 to receive enabled status

XC`09  /UIC=symbol`09`09`09Specify \1106 to receive user's UIC

XC`09  /DEVICE=symbol`09`09Specify \1006 to receive user's

XC`09`09&0209`09default device (login\0E07).

XC`09  /PERMANENT_QUOTA=symbol`09Specify \0F06 to receive perm. quota

XC`09  /OVERDRAFT=symbol`09`09Specify \1006 to receive overdraft quota

XC`09  /USAGE=symbol`09`09`09Specify symbo, to receive current usage

XC

XC Copyright:

XC`09(C) Andy Harper, Kings College London, \0808UK.

XC

XC`09This program is offered with no explicit guarantees or warranties as

XC`09to suitability of purpose.  Any errors or loss arising from its use

XC`09are the sole responsibility of the user.

XC

XC`09The unmodifed source and the executables may be freely distributed,

XC`09but all ownership and copyrights remain with the\2906.

XC

XC ========\0808\1010\2020\400C

X`09program getquo

X`09implicit NONE

X

X`09integer suppress

X`09parameter (suppress = '10000000'X)

X`09external getquo_table

X

X`09character username*12, exists*255

X`09integer N, username_len, defdev_len

X`09integer status, init_cli

XC

XC .. These are the variables which hold integer values from the UAI record

X`09integer uic`09`09`09! UIC

X

XC

XC .. These are the variables which hold string values from the UAI record

X`09character defdev*32`09`09! DEVICE

XC

XC

XC .. These are the variables which hold integer values from the quota record

X`09integer perm`09`09`09! PERMANENT_QUOTA

X`09integer over`09`09`09! OVERDRAFT

X`09integer usage`09`09`09! USAGE

XC

XC .. These are the variables which hold boolean values from the quota record

X`09logical enab`09`09`09! ENABLED

X

XC

XC

XC ........\0808\1010\2020.....

XC    Do some general initialization.

XC`09.. Initialize the CLI parser so we can be used as DCL or a `60foreign' cmd

V

XC`09.. Get any username parameter or substitute the current user if none

XC ........\0808\1010\2020.....

X`09call function( init_cli(getquo_table,'GETQUO') .or.suppress)

X`09call get_qual('P1', username\0A0A_len)

X`09if (username_len .eq. 0) call get_user\2309, \2D0C)

XC

XC

XC ........\0808\1010\2020.....

XC    Obtain the Quota values from the system

XC`09.. Get the named user's default device and UIC code

XC`09.. Get the status of quotas on the volume (enabled or not)

XC`09.. Get the permanent, overdraft and usage quotas for them

XC ........\0808\1010\2020.....

X`09call get_disk_defaults(username(1:\0B08_len), uic, defdev\0808_len)

X`09call get_quota(uic, defdev(1:\0906_len), enab, perm, over, usage)

XC

XC

XC ........\0808\1010\2020.....

XC   What we do now is to find out which qualifiers the user specified

XC   and, for each one, store the corresponding detail into the

XC   symbol given as the value of the qualifier.

XC ........\0808\1010\2020.....

X`09call store_bool('ENABLED',        enab)

X`09call store_int ('USAGE',          usage)

X`09call store_int ('PERMANENT_QUOTA',perm)

X`09call store_int ('OVERDRAFT',      over)

X`09call store_str ('DEVICE',         defdev,  \0906_len)

X`09call store_uic ('UIC',            uic)

X`09call exit

X`09end

X

X

X

XC ========\0808\1010\2020\400C

XC   GET DISK DEFAULTS - Get default UIC and login device

XC

XC   Inputs:

XC       username`09The user for whom info is required

XC

XC   Outputs:

XC`09uic`09`09The UIC code, as a longword

XC`09defdev`09`09The default device, as a string

XC`09defdev_len`09The length, in chars, of \2406

XC  `20

XC ========\0808\1010\2020\400C

X`09subroutine get_disk_defaults (username, uic, defdev\0808_len)

X`09implicit NONE

X`09character *(*) username, defdev

X`09integer uic, uic_len, defdev_len

X

X`09include '($UAIDEF)'

X

X`09integer N, uai_itmlst(20)

X`09integer sys$getuai,ichar

X

XC

XC .. Build a GETUAI item list and get the user's default device and UIC

X`09N=0

X`09call put_itm(uai_itmlst,n,len(defdev), UAI$_DEFDEV, %loc\1B0A\0E0B_len))

X        call put_itm(uai_itmlst,n,4,\2408   UAI$_UIC,    %loc(uic)\0E0D_len))

V

X        uai_itmlst(N) = 0

X`09call function(  sys$getuai(,,username,uai_itmlst,,,) )

XC

XC

XC .. GETUAI returns the device as a counted ASCII string; so strip off the

XC .. count and set the length accordingly.

X`09defdev_len = ichar(\1306(1:1))

X`09defdev = \0906(2:\1206_len+1)

X`09return

X`09end

X

X

X

XC ========\0808\1010\2020\400C

XC  GET QUOTA - Obtain details of a user's disk quota

XC

XC  Inputs:

XC`09uic`09The UIC code for which quota information is wanted

XC`09device`09The \0B06 name for which quota informations is wanted

XC

XC  Outputs:

XC`09enab`09TRUE if quotas are enabled, else false

XC`09perm`09Returns the permanent quota value

XC`09over`09Returns the overdraft quota value

XC`09usage`09Returns the current disk usage

XC

XC ========\0808\1010\2020\400C

X`09subroutine get_quota(uic, device, enab, perm, over, usage)

X`09implicit NONE

X`09character*(*) device

X`09integer uic, perm, over, usage

X`09logical enab

X

X`09integer FIBSIZE, DQFSIZE

X`09parameter (FIBSIZE = 16)

X`09parameter (DQFSIZE = 8)

X

X`09include '($IODEF)'

X`09include '($FIBDEF)'

X`09include '($SSDEF)'

X

X`09integer status, fib(FIBSIZE), dq_buf(DQF\1107iosb(2), efn, I

X`09integer fibdesc(2), dq\0B07

X`09integer sys$assign, sys$qiow\0A06dassgn, lib$get_ef\0C06feee_ef

X`09integer*2 chan

XC

XC .. Fill the File Information Block with info; set up a descriptor for it

X`09do 10 I=1,FIBSIZE

X   10`09fib(I) = 0

X`09fib(6)     = jishft(FIB$C_EXA_QUOTA,16)

X

X`09fibdesc(1) = 4*FIBSIZE

X`09fibdesc(2) = %loc(fib)

X

XC .. Set up a Quota File Transfer block; and a descriptor for it

X`09do 20 I=1,DQFSIZE

X   20`09dq_buf(DQFSIZE) = 0

X`09dq_buf(2)  = uic

X

X`09dqdesc(1)  = 4*DQFSIZE

X`09dqdesc(2)  = %loc(dq_buf)

XC

XC .. Initialize as though quotas are not enabled (change later if they are!)

X`09enab = .FALSE.

X`09perm = 0

X`09over = 0

X`09usage= 0

X

XC

XC .. We need an assigned channel and a unique event flag

X`09call function(  sys$assign( device, chan,, ) )

X`09call lib$get_ef(efn)

XC

XC .. Go get that quota record

X`09status =

X     +    sys$qiow(

X     +           %val(efn),`09`09`09! `5BEFN`5D

X     +           %val(chan),`09`09`09! CHAN

X     +           %val(IO$_ACPCONTROL),`09`09! FUNC

X     +           iosb,`09`09&0209! IOSB

X     +           ,`09`09&0209! `5BASTADDRESS`5D

X     +           ,`09`09&0209! `5BASTPAR`5D

X     +           fibdesc,`09`09`09! P1`09File Info Block

X     +           dqdesc,`09`09`09! P2`09Quota desc record i/p

X     +           ,`09`09&0209! `5BP3`5D

X     +           dqdesc,`09`09`09! P4`09Quota desc record o/p

X     +           ,`09`09&0209! `5BP5`5D

X     +           )`09`09&0209! `5BP6`5D

XC

XC .. Free the event flag and the channel

X`09call lib$free_ef(efn)

X`09call function( sys$dassgn( %val(chan) ))

XC

XC .. Check whether we hit a disk with no quotas active

X`09if (status .eq. SS$_QFNOTACT) return

X`09call function( status )

X`09if (iosb(1) .eq. SS$_QFNOTACT) return

X`09call function( iosb(1) )

XC

XC

XC .. Copy info out of descriptor back into parameters

X`09enab  = .true.

X`09usage = dq_buf(3)

X`09perm  = dq_buf(4)

X`09over  = dq_buf(5)`09

X

X`09return

X`09end

X

X

X

XC ========\0808\1010\2020\400C

XC   GET USER - Get the current username

XC

XC   Inputs:

XC`09NONE

XC

XC   Outputs:

XC`09Username`09Returns the current u\1D07 as a string

XC`09Username_len`09Returns the length of the u\2707 string

XC

XC ========\0808\1010\2020\400C

X`09subroutine get_user(username,\0908_len)

X`09implicit NONE

X`09character*(*) username

X`09integer username_len

X`09include '($jpidef)'

X`09integer N, jpi_itmlst(4), sys$getjpiw

X

X`09username = ' '

XC

X        N=0

X        call put_itm(jpi_itmlst,N,len(username),jpi$_\0F08,%loc\1D0B\0F0D_len)

V)

X`09jpi_itmlst(N+1) = 0

X`09call function( sys$getjpiw(,,,jpi_itmlst,,,) )

X

X`09return

X`09end

X

X

X

XC ========\0808\1010\2020\400C

XC   PUT ITM - Construct an item list 3 descriptor

XC

XC   Inputs:

XC      itm`09The item list 3 array

XC`09N`09The last offset into itm that was written

XC

XC   Outputs:

XC`09itm`09The item list 3 array with the new descriptor added

XC`09N`09The new highest offset into itm`20

XC`09W1`09Word 1 of the item descriptor (BUFLEN)    `7D Together =

XC`09W2`09Word 2 of the item descriptor (ITEM CODE) `7D    longword 1

XC`09L2`09Second longword of the item descriptor (BUFADR)

XC`09L3`09Third longword of the item descriptor (RET_BUFADDR)

XC

XC ========\0808\1010\2020\400C

X`09subroutine put_itm(itm,N,W1,W2,L2,L3)

X`09integer itm(*), N, W1, W2, L2, L3

X

X`09itm(N+1) = jishft(w2,16) + w1

X`09itm(N+2) = L2

X`09itm(N+3) = L3

X`09N=N+3

X

X`09return

X`09end

X

X

XC ========\0808\1010\2020\400C

XC   STORE UIC  - If a given qualifier exists, extract its value and treat it

XC        \0808as a DCL symbol name into which a uic code is stored

XC

XC   Inputs:

XC`09Qname`09The name of a qualifier

XC`09Value`09The integer value of the UIC to be stored

XC

XC   Outputs:

XC`09None

XC

XC   Side Effects:

XC`09A local DCL symbol will be created if the named qualifier is present

XC`09otherwise none.

XC

XC ========\0808\1010\2020\400C

X`09subroutine store_uic(qname, value)

X`09character*(*) qname

X`09integer value

X

X`09character*255 symbol

X`09integer symbol_len

X

X`09call get_qual(qname, symbol\0808_len)

X`09if (symbol_len .gt. 0) call put_uic\2007(1:\290A),value)

X

X`09return

X`09end

X

X

X

XC ========\0808\1010\2020\400C

XC   PUT_UIC:`09Convert an integer value to a formatted UIC, and store in a

XC`09`09given DCL symbol

XC

XC   Inputs:

XC`09symbol`09Name of the DCL \1706 in which to store the string

XC`09value`09The integer value to convert and store

XC

XC   Outputs:

XC`09A local DCL symbol is created

XC

XC ========\0808\1010\2020\400C

X`09subroutine put_uic( symbol, value )

X`09character*(*) symbol

X        integer value

XC

X        integer sys$fao

X`09integer*2 val_l

X`09character*20 val_b

XC

XC ... Convert integer to a string and place in symbol

X        call function( sys$fao('!%U', val_l\0706b, %val(value)) )

X`09call put_str(symbol, val_b(1:val_l))

XC

X`09return

X`09end

X

X

X

XC ========\0808\1010\2020\400C

XC   STORE BOOL - If a given qualifier exists, extract its value and treat it

XC        \0808as a DCL symbol name into which a boolean flag is stored


XC

XC   Inputs:

XC`09Qname`09The name of a qualifier

XC`09Bool`09The boolean flag to be stored (as a TRUE/FALSE string)

XC

XC   Outputs:

XC`09None

XC

XC   Side Effects:

XC`09A local DCL symbol will be created if the named qualifier is present

XC`09otherwise none.

XC

XC ========\0808\1010\2020\400C

X`09subroutine store_bool(qname, bool)

X`09character*(*) qname

X`09integer bool

X

X`09character*255 symbol

X`09integer symbol_len

X

X`09call get_qual(qname, symbol\0808_len)

X`09if (symbol_len .gt. 0) call put_bool\2107(1:\2A0A),bool)

X

X`09return

X`09end

X

X

X

XC ========\0808\1010\2020\400C

XC   PUT_BOOL:`09Convert a boolean flag to TRUE/FALSE string and store in a

XC`09`09given DCL symbol

XC

XC   Inputs:

XC`09symbol`09Name of the DCL \1706 in which to store the string

XC`09bool`09The boolean flag to convert and store

XC

XC   Outputs:

XC`09A local DCL symbol is created

XC

XC ========\0808\1010\2020\400C

X`09subroutine put_bool( symbol, bool)

X`09character*(*) symbol

X`09integer bool

X

X`09if (bool) then

X`09  call put_str(symbol,'TRUE')

X`09else

X`09  call put_str(symbol, 'FALSE')

X`09endif

X

X`09return

X`09end

X

X

XC ========\0808\1010\2020\400C

XC   STORE INT  - If a given qualifier exists, extract its value and treat it

XC        \0808as a DCL symbol name into which an integer value is stored

XC

XC   Inputs:

XC`09Qname`09The name of a qualifier

XC`09Value`09The integer to be stored

XC

XC   Outputs:

XC`09None

XC

XC   Side Effects:

XC`09A local DCL symbol will be created if the named qualifier is present

XC`09otherwise none.

XC

XC ========\0808\1010\2020\400C

X`09subroutine store_int(qname, value)

X`09character*(*) qname

X`09integer value

X

X`09character*255 symbol

X`09integer symbol_len

X

X`09call get_qual(qname, symbol\0808_len)

X`09if (symbol_len .gt. 0) call put_int\2007(1:\290A),value)

X

X`09return

X`09end

X

X

X

XC ========\0808\1010\2020\400C

XC   PUT_INT:`09Convert an integer value to a string and store in a

XC`09`09given DCL symbol

XC

XC   Inputs:

XC`09symbol`09Name of the DCL \1706 in which to store the string

XC`09value`09The integer value to convert and store

XC

XC   Outputs:

XC`09A local DCL symbol is created

XC

XC ========\0808\1010\2020\400C

X`09subroutine put_int( symbol, value )

X`09character*(*) symbol

X        integer value

XC

X        integer sys$fao

X`09integer*2 val_l

X`09character*20 val_b

XC

XC ... Convert integer to a string and place in symbol

X        call function( sys$fao('!UL', val_l\0706b, %val(value)) )

X`09call put_str(symbol, val_b(1:val_l))

XC

X`09return

X`09end

X

X

X

XC ========\0808\1010\2020\400C

XC   STORE STR  - If a given qualifier exists, extract its value and treat it

XC        \0808as a DCL symbol name into which a string is stored

XC

XC   Inputs:

XC`09Qname`09The name of a qualifier

XC`09String`09The string to be stored

XC`09Length`09The length of the string to be stored (0=NULL)

XC

XC   Outputs:

XC`09None

XC

XC   Side Effects:

XC`09A local DCL symbol will be created if the named qualifier is present

XC`09otherwise none.

XC

XC   Cautions:

XC`09In order to allow null strings to be stored in the external symbols,

XC`09we have cheated a bit and not checked `60Length' for zero. Strictly

XC`09however, this is invalid and will fail if subscript checking is

XC`09active!!!!!!!  So do not compile with the /CHECK qualifier!  There

XC`09seems no easy way to pass a null string as a parameter.

XC

XC ========\0808\1010\2020\400C

X`09subroutine store_str(qname, string, length)

X`09character*(*) qname, string

X`09integer*2 length

X

X`09character*255 symbol

X`09integer symbol_len

X

X`09call get_qual(qname, symbol\0808_len)

X`09if (symbol_len .gt. 0)

X     +`09`09call put_str(symbol(1:\0906_len),string(1:length))

X

X`09return

X`09end

X

X

X

XC ========\0808\1010\2020\400C

XC   PUT_STR:`09Store a string in a given DCL symbol

XC

XC   Inputs:

XC`09symbol`09Name of the DCL \1706 in which to store the string

XC`09string`09The \0B06 to be stored

XC

XC   Outputs:

XC`09A local DCL symbol is created

XC

XC ========\0808\1010\2020\400C

X`09subroutine put_str( symbol, string )

X`09character*(*) symbol, string

X

X`09integer lib$set_symbol

X

X`09call function( lib$set_symbol(\0706, string) )

X

X`09return

X`09end

X

X

X

XC ========\0808\1010\2020\400C

XC   INIT_CLI - Initialize the DCL parser

XC

XC   Inputs:

XC`09table`09The address of the command table which describes the various

XC`09`09qualifiers accepted.

XC

XC`09verb`09The name of the command verb

XC

XC   Outputs:

XC`09NONE

XC

XC       The return value of the function is the status \1E07call to the

XC`09CLI parser routine.

XC

XC ========\0808\1010\2020\400C

X`09integer function init_cli(table,verb)

X`09implicit NONE

X`09external table

X`09character*(*) verb

X

X`09include '($SSDEF)'

X

X`09character*1024 BUFFER

X`09integer VERBLEN, BUFLEN, I

X`09integer cli$get_value, cli$dcl_parse

XC

XC

XC .. Let's try to get the name of the VERB with which we were called

X`09init_cli = cli$get_value('$VERB', BUFFER, BUFLEN)

X`09call function( init_cli )

X`09if (BUFFER(1:BUFLEN) .eq. VERB) return

XC

XC

XC .. We weren't parsed by the CLI so lets retrieve the command line

X`09init_cli = cli$get_value('$LINE', BUFFER, BUFLEN)

X`09call function( init_cli )

XC

XC

XC .. Now lets find the end of the command verb by looking for space or /

XC .. And replace it with our `60real' command verb

X`09VERBLEN = BUFLEN

X`09i = index(BUFFER(1:VERBLEN), ' ')

X`09if (i .gt. 0) VERBLEN = i-1

X        i = index(BUFFER(1:VERBLEN), '/')

X`09if (i .gt. 0) VERBLEN = i-1

X`09BUFFER(1:VERBLEN) = verb

XC

XC .. Force a DCL parse of the reconstructed command line

X`09init_cli = cli$dcl_parse(BUFFER(1:BUFLEN), TABLE)

XC

X`09return

X`09end

X

X

X

XC ========\0808\1010\2020\400C

XC   GET QUAL   - Check the qualifier named as a parameter and, if it's present

V,

XC`09`09 return its value.

XC

XC   Inputs:

XC`09Name`09The name of a qualifier

XC

XC   Outputs:

XC`09Buffer`09Returns the value of the qualifier

XC`09Buflen`09Returns the length of the qualifier value (0=not present)

XC

XC ========\0808\1010\2020\400C

X`09subroutine get_qual(name,buffer,buflen)

X`09character*(*) name, buffer

X`09integer buflen

X

X`09integer status, cli$present\0D06get_value

X`09external cli$_absent

XC

X`09buflen = 0

X`09buffer = ' '

XC

XC .. See if a qualifier is present

X`09status = cli$present(name)

X`09if (status .eq. %loc(CLI$_ABSENT)) return

X`09call function ( status )

XC

XC .. Get and return the qualifier value (= symbol in which to store\2206)

X`09call function( cli$get_value(name, BUFFER, BUFLEN) )

X

X`09return

X`09end

X`09

XC ========\0808\1010\2020\400C

XC   FUNCTION - Deal with error returns from system calls

XC

XC   Inputs:

XC`09status`09The result of a system call

XC

XC   Outputs:

XC`09None

XC

XC   Side effects:

XC`09The routine does not return if the status indicates an error

XC`09occurred. Otherwise return and do nothing.

XC

XC   Typical usage:

XC`09The system routine to be checked should be called thus:

XC`09`09call function (  sys$xxxx( ... )   )

XC

XC ========\0808\1010\2020\400C

X`09subroutine function (  status  )

X`09integer status

X

X        if (.not. status) call lib$stop( %val(\1C08)

X

X`09return

X`09end

$ call unpack [.GETQUO]GETQUO.FOR;4 1613684321 "" 39 3 5

$!

$ create 'f'

X1 GETQUO

XObtains disk quota information about a user and writes it into user

Xspecified DCL symbols.

X

XFormat:

X   $ GETQUO `5B/qual=symbol`5D `5B...`5D  `5BUsername`5D

X2 Errors

XError returns from a number of system services can potentially be

Xreturned in the $STATUS symbol.

X

XThe only exception is the QFNOTACT status indicating that quotas are

Xnot active.  The status of this (TRUE or FALSE) can be returned to

Xthe user with the /ENABLED qualifier but the status is never

Xsignalled as an error.

X

XThe most common errors are these:

X3 RNF

X%RMS-F-RNF, record not found

X

XIndicates that a username was specified\1E06is not valid on the

Xsystem.

X3 DEVNOTMOUNT

X%SYSTEM-E-DEVNOTMOUNT, Device not mounted

X

XThe user's default device has not been mounted and so the quota

Xrecord cannot be read.

X3 DEVOFFLINE

X%SYSTEM-E-DEVOFFLINE, Device off-line

X

XThe user's default device is off-line and so the quota record cannot

Xbe read.

X2 Examples

X   $ GETQUO /USAGE=DISK_IN_USE

X        Obtains the disk quota usage information about the current

X        user and stores it in the local DCL symbol called

X        `60DISK_IN_USE'.

X

X   $ GETQUO SYSTEM /USAGE=USAGE /PERMANENT_QUOTA=PERM

X        Obtains the disk quota usage and permanent allocation

X        information for the user `60SYSTEM' and stores it in the

X        symbols `60USAGE' and `60PERM'.

X2 Operation

XThe utility locates the default login device and UIC code for the

Xspecified user, then picks up the qualifier corresponding to this UIC

Xon the device.  If quotas are not enabled, zero value\1D06returned

Xand the enabled flag is set to false (if specified - see the /ENABLED

Xqualifier).

X

XPrivileges (SYSPRV or SYSNAM) are required to see the quotas for

Xanother user.

X

XThis version of the utility will not return values for arbitrary UIC

Xcodes on arbitrary volumes. This will be included in a future

Xenhancement.

X2 Parameters

XThe single parameter specifies the user for whom disk quota

Xinformation is required.  It defaults to the current user.

X

XPrivileges (SYSPRV or SYSNAM) are required to see the quotas for

Xanother user.

X2 Qualifiers

X

X/DEVICE

X

X  /DEVICE=symbol

X

X  Returns the user's default device in the specified symbol.  This is

X  the device selected at initial login.

X

X/ENABLED

X

X  /ENABLED=symbol

X

X  Returns the string "TRUE" or "FALSE" in\2006pecified symbol,

X  depending on whether quotas are enabled on the volume. Note that, if

X  quotas are not enabled, any\1C06 value requested by other

X  qualifiers will be returned as 0.

X

X/OVERDRAFT

X

X  /OVERDRAFT=symbol

X

X  Returns the user's overdraft limit in the specified symbol.

X

X/PERMANENT_QUOTA

X

X  /PERMANENT_QUOTA=symbol

X

X  Returns the user's permanent quota limit in the specified symbol.

X

X/UIC

X

X  /UIC=symbol

X

X  Returns the user's default UIC code in the specified symbol.

X

X/USAGE

X

X  /USAGE=symbol

X

X  Returns the user's current disk usage in the specified symbol.

$ call unpack [.GETQUO]GETQUO.HLP;2 1025078459 "" 6 4 5

$!

$ create 'f'

XMODULE GETQUO_TABLE

XDEFINE VERB GETQUO

X  parameter  P1

X  qualifier  DEVICE,nonnegatable,value(required)

X  qualifier  ENABLED,nonnegatable,value(required)

X  qualifier  OVERDRAFT,nonnegatable,value(required)

X  qualifier  PERMANENT_QUOTA,nonnegatable,value(required)

X  qualifier  UIC,nonnegatable,value(required)

X  qualifier  USAGE,nonnegatable,value(required)

$ call unpack [.GETQUO]GETQUO_TABLE.CLD;1 675112564 "" 1 5 5

$ v=f$verify(v)

$ exit