home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #16 / NN_1992_16.iso / spool / comp / os / vms / 12973 < prev    next >
Encoding:
Text File  |  1992-07-30  |  7.2 KB  |  184 lines
  1. Newsgroups: comp.os.vms
  2. Path: sparky!uunet!cis.ohio-state.edu!zaphod.mps.ohio-state.edu!caen!batcomputer!munnari.oz.au!manuel!news
  3. From: bear@nuc.anu.edu.au (Bernhard Fabricius)
  4. Subject: Re: Can I change quota entries from DCL or a program?
  5. Message-ID: <1992Jul30.003607.27794@newshost.anu.edu.au>
  6. Lines: 171
  7. Sender: news@newshost.anu.edu.au
  8. Reply-To: BEAR@NUC.ANU.EDU.AU
  9. Organization: Nuclear Physics, ANU
  10. References:  <112125@muvms3.bitnet>
  11. Date: Thu, 30 Jul 92 00:36:07 GMT
  12.  
  13.  
  14. In article <112125@muvms3.bitnet>, boag@muvms3.bitnet (Bob Boag) writes:
  15. ||>Does anyone know of a EASY way to read and modify the entries in the QUOTA
  16. |>file?
  17. |>
  18. Bob,
  19.  
  20. Unfortunately there is no F$QUOTA lexical function, but below you'll find a
  21. program I wrote only yesterday (before I even saw your post!) which will do
  22. pretty much what the F$QUOTA lexical would have done, except the resulting
  23. values are written to four logical names which you may then translate with
  24. F$TRNLNM (F$LOG for Ye Olde VMS Hacks).
  25.  
  26. To avoid doing a SHOW QUOTA to a file, you just read the QUOTA.SYS file in the
  27. root ([000000]) directory of the disk in question. This file contain 32 byte
  28. records, ie 8 longwords per line. The entries of interest are:
  29. #2:    Owner UIC identifier in longword form
  30. #3:    Blocks in use (Integer*4)
  31. #4:    Permanent quota (Integer*4)
  32. #5:    Permitted overdraft (Integer*4)
  33. The remaining fields are of no interest to this program.
  34. The program keeps reading until it finds a Owner UIC which matches the one
  35. you called with. It is neither elegant, nor fast, but it works.
  36.  
  37. WARNING: I use /extend_source (132 column mode) when I write FORTRAN!
  38.  
  39.  
  40.     options /extend_source
  41.     program f$quota
  42.  
  43. c    (c) Bernhard Fabricius, 29 July 1992
  44. c    This program may be used, copied and modified freely by anyone as long as the original author is
  45. c    acknowledged in redistributed versions.
  46.  
  47. c    Program to read the quota files (Primitive interface to emulate the missing F$QUOTA lexical function).
  48. c    Will set the process logical names F$QUOTA_INUSE, F$QUOTA_QUOTA, F$QUOTA_OVERD and F$QUOTA_FREEQ.
  49. c    Set QUOTA.SYS to world read (if you dare), or run only from privileged account.
  50. c    Define F$QUOTA as a foreign command (or run with MCR)
  51. c    Specify USERUIC as (optional) first parameter. Default is current process.
  52. c    Specify DEVICE as (optional) second parameter. Default is current device.
  53. c    Externally: Translate the logical names in DCL with F$TRNLNM().
  54.  
  55.     implicit    none
  56.     character*132    foreign
  57.     character*80    retname, user, device
  58.     character*12    value
  59.     integer*4    sys$idtoasc, retlen, f(8), userlen, flen, devlen, id, idr, status, vlen
  60.     integer*4    inuse, quota, overd, freeq, comma, str$position
  61.     include        '($jpidef)'
  62.     include        '($ssdef)'
  63.  
  64. c    Get the foreign command
  65.     call lib$get_foreign(foreign,,flen,)
  66. c    First element is the USER UIC
  67.     call str$element(user,0,' ',foreign)
  68. c    Get the length 
  69.     call lentrim(user,userlen)
  70. c    Second element is the DEVICE
  71.     call str$element(device,1,' ',foreign)
  72.     call lentrim(device,devlen)
  73.  
  74.     if(userlen.eq.0)then                    !No user specified
  75.       call lib$GETJPI(jpi$_uic,,,,user,userlen)        !Get user uic from lib$GETJPI
  76.       user(1:userlen)=user(2:userlen-1)//'  '        ![NUCLEAR,GAMMA]   or [MUG]
  77.       userlen=userlen-2                    !NUCLEAR,GAMMA     or MUG    
  78.       comma=str$position(user,',', )            !       8             0
  79.       if(comma.ne.0)then                    !There was a comma - remove first identifier
  80.         call str$element(user,1,',',user)            !Get element no 1 (second) from comma list
  81.         call lentrim(user,userlen)                !Restore length
  82.       end if                        !GAMMA             or MUG
  83.     end if
  84.  
  85. c    Initialize the values. (See labels 200, 201 and 202 for error codes).
  86.     inuse =  0
  87.     quota =  0
  88.     overd =  0
  89.     freeq =  0
  90.  
  91. c    Open the QUOTA.SYS file on the ROOT directory of the called DEVICE as a SHARED, UNFORMATTED READONLY unit
  92.     open(unit=1,file=DEVICE(1:devlen),defaultfile='[000000]QUOTA.SYS',status='old',readonly,shared,form='unformatted',err=200)
  93.  
  94. c    Read the entries in the quota file
  95. 100    continue                        !Main loop
  96.     read(1,err=201,end=202)f                !Read 32 bytes
  97.     id=f(2)                            !Longword id is the second field
  98.     status=sys$idtoasc(%val(id),retlen,retname,idr,,)    !Translate to names UIC identifier
  99.     if(status.ne.1)go to 100                !Must be SS$NORMAL, else read next
  100.     if(retname(1:retlen).eq.user(1:userlen))then        !Just read the one we're after  ?
  101.       inuse =  f(3)                        !3rd field is blocks in use
  102.       quota =  f(4)                        !4th field is permanent quota
  103.       overd =  f(5)                        !5th field is permitted overdraft
  104.       freeq =  quota - inuse                !Free quota is (quota - inuse)
  105.       go to 300                        !Skip the loop
  106.     end if
  107.     goto 100                        !Next entry
  108.  
  109.     
  110. c    A negative F$QUOTA_QUOTA value is used to signal a failure in F$QUOTA. The code returned are muck-ups of 
  111. c    the $ SHOW QUOTA STATUS codes (but set negative). Calling DCL may use F$MESSAGE on the absolute value:
  112. c    $WRITE SYS$OUTPUT F$MESSAGE(-F$TRNLNM("F$QUOTA_QUOTA"))
  113. 200    continue                        !OPEN error
  114.     quota=-SS$_QFNOTACT                    !%SYSTEM-F-QFNOTACT, disk quotas not enabled on this volume
  115.     go to 300                        !Set logical names
  116. 201    continue                        !READ error
  117.     quota=-SS$_BADQFILE                    !%SYSTEM-F-BADQFILE, invalid disk quota file format
  118.     go to 300                        !Set logical names
  119. 202    continue                        !UIC not found
  120.     quota=-SS$_NODISKQUOTA                    !%SYSTEM-F-NODISKQUOTA, no disk quota entry for this UIC
  121.  
  122. c    Set the logical names F$QUOTA_INUSE, F$QUOTA_QUOTA, F$QUOTA_OVERD and F$QUOTA_FREEQ.
  123. 300    continue
  124.     write(value(1:12),*)inuse                !Write inuse to value string
  125.     vlen=0                            !Reset search length
  126.     call lentrim(value,vlen)                !Trim the string (left-align)
  127.     call lib$set_logical('F$QUOTA_INUSE',value(1:vlen),,,)    !Set logical
  128.     write(value(1:12),*)quota                !Write quota to value string
  129.     vlen=0                            !Reset search length
  130.     call lentrim(value,vlen)                !Trim the string (left-align)
  131.     call lib$set_logical('F$QUOTA_QUOTA',value(1:vlen),,,)    !Set logical
  132.     write(value(1:12),*)overd                !Write overd to value string
  133.     vlen=0                            !Reset search length
  134.     call lentrim(value,vlen)                !Trim the string (left-align)
  135.     call lib$set_logical('F$QUOTA_OVERD',value(1:vlen),,,)    !Set logical
  136.     write(value(1:12),*)freeq                !Write freeq to value string
  137.     vlen=0                            !Reset search length
  138.     call lentrim(value,vlen)                !Trim the string (left-align)
  139.     call lib$set_logical('F$QUOTA_FREEQ',value(1:vlen),,,)    !Set logical
  140.  
  141.     end
  142.  
  143.  
  144. c    ----------------------------------------------------------------------------------------------------
  145.  
  146.  
  147.     options    /extend_source
  148.     subroutine lentrim(text,leng)
  149.  
  150. c    subroutine to remove (right-shift) spaces and nulls from a text string
  151. c    text        string to trim
  152. c    leng        On call: number of characters to search (0 for whatever's found)
  153. c            on return: actual number of non-space characters 
  154.  
  155.     implicit    none
  156.     character    text*(*)
  157.     integer*4    leng, i, found, ic
  158.  
  159.     if(leng.eq.0)leng=len(text)
  160.     
  161.     found=0
  162.     
  163.     do i=leng,1,-1
  164.       ic=ichar(text(i:i))
  165.       if(ic.eq.32.or.ic.eq.0)then
  166.         found=found+1
  167.         text(i:leng-1)=text(i+1:leng)
  168.         text(leng:leng)=' '
  169.       end if
  170.     end do
  171.     leng=leng-found
  172.     return
  173.     end
  174.  
  175. --------------------------------------------------------------------------------
  176. Dr Bernhard Fabricius              |
  177. Academic VAX/VMS Support           |  "I am a Bear of Very Little Brain,
  178. Department of Nuclear Physics      |           and long words Bother me."
  179. Australian National University     |
  180.                                    |                           - A.A. Milne
  181. InterNet: BEAR@NUC.ANU.EDU.AU      |
  182.     POSTMASTER@NUC.ANU.EDU.AU      |
  183.  
  184.