home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1992 March / Source_Code_CD-ROM_Walnut_Creek_March_1992.iso / usenet / altsrcs / 3 / 3985 < prev    next >
Encoding:
Internet Message Format  |  1991-09-09  |  14.9 KB
  1. Path: wupost!uunet!europa.asd.contel.com!darwin.sura.net!noc.sura.net!haven.umd.edu!mimsy!nrlvx1.nrl.navy.mil!koffley
  2. From: koffley@nrlvx1.nrl.navy.mil
  3. Newsgroups: alt.sources
  4. Subject: VMS UAF PROFILE part 11 of 18
  5. Message-ID: <1991Sep5.074543.555@nrlvx1.nrl.navy.mil>
  6. Date: 5 Sep 91 11:45:43 GMT
  7. Organization: NRL SPACE SYSTEMS DIVISION
  8. Lines: 417
  9.  
  10. -+-+-+-+-+-+-+-+ START OF PART 11 -+-+-+-+-+-+-+-+
  11. X     .   prv$v_SETPRI, prv$v_SETPRV, prv$v_TMPMBX, prv$v_WORLD,
  12. X     .   prv$v_MOUNT, prv$v_OPER, prv$v_EXQUOTA, prv$v_NETMBX,
  13. X     .   prv$v_VOLPRO, prv$v_PHY_IO, prv$v_BUGCHK, prv$v_PRMGBL,
  14. X     .   prv$v_SYSGBL, prv$v_PFNMAP, prv$v_SHMEM, prv$v_SYSPRV,
  15. X     .   prv$v_BYPASS, prv$v_SYSLCK, prv$v_SHARE, prv$v_GRPPRV,
  16. X     .   prv$v_ACNT, prv$v_ALTPRI, prv$v_READALL, prv$v_SECURITY /
  17. X
  18. X        rend_mask = smg$m_bold.or.smg$m_underline
  19. X
  20. X        call smg$begin_pasteboard_update ( pasteboard )
  21. X
  22. X        line = 5
  23. X        col = 5
  24. XC
  25. XC Find out which privileges the user holds
  26. XC
  27. X        do j = 1,35,6
  28. X           do i = j,j+5
  29. X              if (btest(def_priv(1),privs(i))) then
  30. X                 if (i .le. 35) call smg$change_rendition ( priv_board, line
  31. V,
  32. X     .            col, 1, 8, rend_mask )
  33. X              else
  34. X                 if (i .le. 35) call smg$change_rendition ( priv_board, line
  35. V,
  36. X     .            col, 1, 8, 0 )
  37. X              endif
  38. X              col = col + 12
  39. X           enddo
  40. X           line = line + 1
  41. X           col = 5
  42. X        enddo
  43. X
  44. X        col = 5
  45. X        line = 14
  46. X
  47. X        do j = 1,35,6
  48. X           do i = j,j+5
  49. X              if (btest(auth_priv(1),privs(i))) then
  50. X                 if (i .le. 35) call smg$change_rendition ( priv_board, line
  51. V,
  52. X     .            col, 1, 8, rend_mask )
  53. X              else
  54. X                 if (i .le. 35) call smg$change_rendition ( priv_board, line
  55. V,
  56. X     .            col, 1, 8, 0 )
  57. X              endif
  58. X              col = col + 12
  59. X           enddo
  60. X           line = line + 1
  61. X           col = 5
  62. X        enddo
  63. X
  64. X        line = line - 1
  65. X
  66. X        call smg$end_pasteboard_update ( pasteboard )
  67. X
  68. X        end
  69. X
  70. XC***************************************************************************
  71. V****
  72. X
  73. X        Subroutine READ_PRIV ( priv, line )
  74. XC
  75. XC The purpose of this subroutine is to read the privilege at the
  76. XC cursor and enable or disable it.
  77. XC
  78. X        Include 'uaf.cmn'
  79. X        Include '($prvdef)'
  80. X        Integer*4 i, line, privs(35)
  81. X        Character*8 priv_names(35)
  82. X        Character*(*) priv
  83. X
  84. X        data privs
  85. X     .   /prv$v_CMKRNL, prv$v_CMEXEC, prv$v_SYSNAM,
  86. X     .   prv$v_GRPNAM, prv$v_ALLSPOOL, prv$v_DETACH, prv$v_DIAGNOSE,
  87. X     .   prv$v_LOG_IO, prv$v_GROUP, prv$v_PRMCEB, prv$v_PSWAPM,
  88. X     .   prv$v_SETPRI, prv$v_SETPRV, prv$v_TMPMBX, prv$v_WORLD,
  89. X     .   prv$v_MOUNT, prv$v_OPER, prv$v_EXQUOTA, prv$v_NETMBX,
  90. X     .   prv$v_VOLPRO, prv$v_PHY_IO, prv$v_BUGCHK, prv$v_PRMGBL,
  91. X     .   prv$v_SYSGBL, prv$v_PFNMAP, prv$v_SHMEM, prv$v_SYSPRV,
  92. X     .   prv$v_BYPASS, prv$v_SYSLCK, prv$v_SHARE, prv$v_GRPPRV,
  93. X     .   prv$v_ACNT, prv$v_ALTPRI, prv$v_READALL, prv$v_SECURITY /
  94. X
  95. X        data priv_names
  96. X     .   /'CMKRNL  ','CMEXEC  ','SYSNAM  ',
  97. X     .   'GRPNAM  ','ALLSPOOL','DETACH  ','DIAGNOSE',
  98. X     .   'LOG_IO  ','GROUP   ','PRMCEB  ','PSWAPM  ',
  99. X     .   'SETPRI  ','SETPRV  ','TMPMBX  ','WORLD   ',
  100. X     .   'MOUNT   ','OPER    ','EXQUOTA ','NETMBX  ',
  101. X     .   'VOLPRO  ','PHY_IO  ','BUGCHK  ','PRMGBL  ',
  102. X     .   'SYSGBL  ','PFNMAP  ','SHMEM   ','SYSPRV  ',
  103. X     .   'BYPASS  ','SYSLCK  ','SHARE   ','GRPPRV  ',
  104. X     .   'ACNT    ','ALTPRI  ','READALL ','SECURITY' /
  105. X
  106. XC
  107. XC Read the privilege name at the cursor, determine if the cursor is in
  108. XC the default or authorized field, and reverse the privilege bit.
  109. XC
  110. X        do i = 1,35
  111. X           if (priv.eq.priv_names(i)) then
  112. X              if (line.gt.13) then
  113. X                 if (btest(auth_priv(1),privs(i))) then
  114. X                    call lib$bbcci ( privs(i), auth_priv(1) )
  115. X                 else
  116. X                    call lib$bbssi ( privs(i), auth_priv(1) )
  117. X                 endif
  118. X              else
  119. X                 if (btest(def_priv(1),privs(i))) then
  120. X                    call lib$bbcci ( privs(i), def_priv(1) )
  121. X                 else
  122. X                    call lib$bbssi ( privs(i), def_priv(1) )
  123. X                 endif
  124. X              endif
  125. X           endif
  126. X        enddo
  127. XC
  128. XC Call the subroutine SCAN_PRIVS to determine the privileges.
  129. XC
  130. X        call scan_privs
  131. X
  132. X        end
  133. X
  134. XC************************************************************************
  135. X
  136. X        Subroutine LIST_PRIVS ( line, col )
  137. XC
  138. XC The purpose of this subroutine is to write the names of the
  139. XC privileges to the board.
  140. XC
  141. X        Include '($smgdef)'
  142. X        Include 'uaf.cmn'
  143. X        Integer*4 line, col, i, j
  144. X        Character*8 priv_names(35)
  145. X
  146. X        data priv_names
  147. X     .   /'CMKRNL  ','CMEXEC  ','SYSNAM  ',
  148. X     .   'GRPNAM  ','ALLSPOOL','DETACH  ','DIAGNOSE',
  149. X     .   'LOG_IO  ','GROUP   ','PRMCEB  ','PSWAPM  ',
  150. X     .   'SETPRI  ','SETPRV  ','TMPMBX  ','WORLD   ',
  151. X     .   'MOUNT   ','OPER    ','EXQUOTA ','NETMBX  ',
  152. X     .   'VOLPRO  ','PHY_IO  ','BUGCHK  ','PRMGBL  ',
  153. X     .   'SYSGBL  ','PFNMAP  ','SHMEM   ','SYSPRV  ',
  154. X     .   'BYPASS  ','SYSLCK  ','SHARE   ','GRPPRV  ',
  155. X     .   'ACNT    ','ALTPRI  ','READALL ','SECURITY' /
  156. XC
  157. XC Write the names of the privileges to the board.
  158. XC
  159. X        do j = 1,35,6
  160. X           do i = j,j+5
  161. X              call smg$put_chars ( priv_board, priv_names(i),
  162. X     .         line, col )
  163. X              col = col + 12
  164. X           enddo
  165. X           line = line + 1
  166. X           col = 5
  167. X        enddo
  168. X
  169. X        line = line - 1
  170. X
  171. X        end
  172. X
  173. XC************************************************************************
  174. X
  175. X        Subroutine ALL_PRIV
  176. XC
  177. XC The purpose of this subroutine is to enable all privileges.
  178. XC
  179. X        Include 'uaf.cmn'
  180. X        Include '($uaidef)'
  181. X        Include '($prvdef)'
  182. X
  183. X        change = .true.
  184. XC
  185. XC Define a privilege mask to set all default privileges.
  186. XC
  187. X        def_priv(1) = prv$m_tmpmbx.or.prv$m_netmbx.or.
  188. X     .   prv$m_cmkrnl.or.prv$m_cmexec.or.prv$m_sysnam.or.
  189. X     .   prv$m_grpnam.or.prv$m_allspool.or.prv$m_detach.or.
  190. X     .   prv$m_diagnose.or.prv$m_log_io.or.prv$m_group.or.
  191. X     .   prv$m_acnt.or.prv$m_prmceb.or.prv$m_prmmbx.or.
  192. X     .   prv$m_pswapm.or.prv$m_setpri.or.prv$m_setprv.or.
  193. X     .   prv$m_world.or.prv$m_mount.or.prv$m_oper.or.
  194. X     .   prv$m_exquota.or.prv$m_volpro.or.prv$m_phy_io.or.
  195. X     .   prv$m_bugchk.or.prv$m_prmgbl.or.prv$m_sysgbl.or.
  196. X     .   prv$m_pfnmap.or.prv$m_shmem.or.prv$m_sysprv.or.
  197. X     .   prv$m_bypass.or.prv$m_syslck.or.prv$m_share.or.
  198. X     .   prv$m_altpri
  199. X        def_priv(2) = 0
  200. X        call lib$bbssi ( prv$v_security, def_priv(1) )
  201. X        call lib$bbssi ( prv$v_readall, def_priv(1) )
  202. X        call lib$bbssi ( prv$v_grpprv, def_priv(1) )
  203. XC
  204. XC Define a privilege mask to set all authorized privileges.
  205. XC
  206. X        auth_priv(1) = prv$m_tmpmbx.or.prv$m_netmbx.or.
  207. X     .   prv$m_cmkrnl.or.prv$m_cmexec.or.prv$m_sysnam.or.
  208. X     .   prv$m_grpnam.or.prv$m_allspool.or.prv$m_detach.or.
  209. X     .   prv$m_diagnose.or.prv$m_log_io.or.prv$m_group.or.
  210. X     .   prv$m_acnt.or.prv$m_prmceb.or.prv$m_prmmbx.or.
  211. X     .   prv$m_pswapm.or.prv$m_setpri.or.prv$m_setprv.or.
  212. X     .   prv$m_world.or.prv$m_mount.or.prv$m_oper.or.
  213. X     .   prv$m_exquota.or.prv$m_volpro.or.prv$m_phy_io.or.
  214. X     .   prv$m_bugchk.or.prv$m_prmgbl.or.prv$m_sysgbl.or.
  215. X     .   prv$m_pfnmap.or.prv$m_shmem.or.prv$m_sysprv.or.
  216. X     .   prv$m_bypass.or.prv$m_syslck.or.prv$m_share.or.
  217. X     .   prv$m_altpri
  218. X        auth_priv(2) = 0
  219. X        call lib$bbssi ( prv$v_security, auth_priv(1) )
  220. X        call lib$bbssi ( prv$v_readall, auth_priv(1) )
  221. X        call lib$bbssi ( prv$v_grpprv, auth_priv(1) )
  222. XC
  223. XC Call the subroutine SCAN_PRIVS to determine which privileges
  224. XC are enabled.
  225. XC
  226. X        call scan_privs
  227. X
  228. X        end
  229. X
  230. XC************************************************************************
  231. X
  232. X        Subroutine NORMAL_PRIV
  233. XC
  234. XC The purpose of this subroutine is to enable normal privileges only.
  235. XC
  236. X        Include 'uaf.cmn'
  237. X        Include '($prvdef)'
  238. X
  239. X        change = .true.
  240. XC
  241. XC Define a privilege mask to set normal default privileges.
  242. XC
  243. X        def_priv(1) = prv$m_tmpmbx.or.prv$m_netmbx
  244. X        def_priv(2) = 0
  245. XC
  246. XC Define a privilege mask to set normal authorized privileges.
  247. XC
  248. X        auth_priv(1) = prv$m_tmpmbx.or.prv$m_netmbx
  249. X        auth_priv(2) = 0
  250. XC
  251. XC Call the subroutine SCAN_PRIVS to determine which privileges are
  252. XC enabled.
  253. XC
  254. X        call scan_privs
  255. X
  256. X        end
  257. X
  258. XC************************************************************************
  259. X
  260. X        Subroutine NEXT_FREE_UIC ( string )
  261. XC
  262. XC The purpose of this subroutine is to determine the next free uic member
  263. XC in a group, if only a group entity is given, and expand the uic to
  264. XC include both group and member, or to return an error if the group is
  265. XC full.
  266. XC
  267. XC This routine was modified from a program posted to comp.os.vms
  268. XC (aka INFO-VAX).
  269. XC
  270. XC Modified 4-DEC-1989 to check for logical name RIGHTSLIST in case
  271. XC it resides somewhere other than SYS$SYSTEM:   - JMH
  272. XC
  273. X        Include '($lnmdef)'
  274. X        Integer*4 group_num, keynum, member_num, next_uic, sts
  275. X        Integer*4 group_len, len, lib$sys_trnlog
  276. X        Character*50 rights_file
  277. X        Character*6 member
  278. X        Character*(*) string
  279. X
  280. X        group_len = index(string,' ')-1
  281. X
  282. X        sts = lib$sys_trnlog ( 'RIGHTSLIST', len, rights_file,
  283. X     .   'LNM$SYSTEM_TABLE' ,, lnm$m_case_blind )
  284. X        if (sts .ne. 1) rights_file = 'SYS$SYSTEM:RIGHTSLIST.DAT'
  285. X
  286. X        open(unit=1,file=rights_file,shared,readonly,
  287. X     .   access='keyed',status='old',form='unformatted')
  288. XC
  289. XC Convert the ascii string 'group' octal
  290. XC
  291. X        call ots$cvt_to_l ( string(1:group_len), group_num )
  292. X
  293. X        keynum = group_num * '10000'x
  294. X        member_num = keynum
  295. X
  296. X        read (1,keyge=keynum,keyid=0,err=900) next_uic
  297. X
  298. X300     if ((next_uic/'10000'x) .ne. group_num) go to 900
  299. X        if (iand(next_uic,'FFFF'x) .eq. 'FFFF'x) go to 900
  300. X        member_num = next_uic
  301. X        read(1,err=900) next_uic
  302. X        go to 300
  303. X
  304. X900     member_num = member_num + 1
  305. X
  306. X        sts = lib$sys_fao ( '!%U', len, string, %val(member_num) )
  307. X        if (.not.sts) call lib$signal ( %val(sts) )
  308. X
  309. X        close (unit=1)
  310. X
  311. X        end
  312. X
  313. XC************************************************************************
  314. X
  315. X        Subroutine SPAWN_DCL ( owner, tables, defcli, defdev,
  316. X     .   defdir, lgicmd )
  317. XC
  318. XC If the user is to be added to the system, then spawn a short DCL
  319. XC command file to add the user via AUTHORIZE. Unfortunately, $SETUAI
  320. XC cannot be used to add a user. Also, we can add a diskquota entry
  321. XC for the user (defaulted at 1000 with an overdraft default at 100,
  322. XC change them to suit your purposes).
  323. XC
  324. X        Include 'uaf.cmn'
  325. X        Include '($smgdef)'
  326. X        Include '($lnmdef)'
  327. X        Include '($uaidef)'
  328. X        Include '($clidef)'
  329. X        Include '($prvdef)'
  330. X        Integer*4 sts, flag_mask, priv_mask, icontext, istat
  331. X        Integer*4 spec_len, offset, name_len
  332. X        Integer*4 lib$sys_trnlog
  333. X        Logical quotas_enabled, directory_exists
  334. X        Byte enbflg /1/
  335. X        Character*80 dcl_command, dir_spec, main_dev
  336. X        Character*8 quota /'1000'/   ! change to suit your needs
  337. X        Character*8 overdraft /'100'/! change to suit your needs
  338. X        Character*(*) owner, tables, defcli, defdev, defdir, lgicmd
  339. XC
  340. XC Set up a flag mask so that the spawn will be quick. No symbols or
  341. XC logical names will be inherited from the parent process. Note that
  342. XC it is important that you have SYSPRV or SETPRV as an authorized
  343. XC privilege in order to effectively do this. Also set up a privilege
  344. XC mask in case special privileges need to be enabled to create a
  345. XC user directory (if not run from SYSTEM account).
  346. XC
  347. X        flag_mask = cli$m_noclisym.or.cli$m_nolognam
  348. X        priv_mask = prv$m_bypass.or.prv$m_exquota.or.prv$m_sysprv
  349. XC
  350. XC Define an initial dcl command for insertion in the command file.
  351. XC
  352. XC If the account is to be added:
  353. XC
  354. X        if (.not.user_exists) then
  355. X           dcl_command = 'ADD '//username(1:username_len)//
  356. X     .      '/PASSWORD='//password(1:password_len)//
  357. X     .      '/ACCOUNT='//account(1:account_len)//'/UIC='//uic
  358. X        endif
  359. XC
  360. XC If the account already exists but the password has been changed:
  361. XC
  362. X        if (user_exists.and.pwd_change) then
  363. X           dcl_command = 'MOD '//username(1:username_len)//
  364. X     .      '/PASSWORD='//password(1:password_len)//'/NOPWDEXPIRED'
  365. X        endif
  366. XC
  367. XC If the account already exists but it has been renamed:
  368. XC
  369. X        if (user_exists.and.rename) then
  370. X           dcl_command = 'RENAME '//orig_uname(1:uname_len)//
  371. X     .      ' '//username(1:username_len)//'/PASSWORD='//
  372. X     .      password(1:password_len)
  373. X        endif
  374. XC
  375. XC Open a new temporary dcl command file and write some info to it.
  376. XC
  377. X        open (unit=1,file='DCL.TMP',status='new')
  378. X        write (1,'(a)') '$ DELETE DCL.TMP;*'
  379. X        write (1,'(a)') '$ PREVPRIV = F$SETPRV("ALL")'
  380. X        write (1,'(a)') '$ DEFINE/USER SYSUAF SYS$SYSTEM:SYSUAF'
  381. X        write (1,'(a)') '$ RUN SYS$SYSTEM:AUTHORIZE'
  382. X        write (1,'(a)') dcl_command
  383. X        write (1,'(a)') 'EXIT'
  384. XC
  385. XC If adding diskquota is not desirable, delete the following lines
  386. XC of code:
  387. XC
  388. XC First check to see if the disk has diskquotas enabled. Translate the
  389. XC device logical name in case it is a concealed device (i.e. SYS$SYSROOT).
  390. XC If the device is not concealed or the device is not a logical name, the
  391. XC translation success or failure will not matter.
  392. XC
  393. X        if (.not.user_exists) then
  394. X           call lib$sys_trnlog ( defdev(1:defdev_len), name_len,
  395. X     .      main_dev, 'LNM$SYSTEM_TABLE' ,, lnm$m_case_blind )
  396. X           offset = index(main_dev,':')
  397. X           if (offset .eq. 0) offset = index(main_dev,' ')
  398. X           inquire (file=main_dev(1:offset-1)//
  399. X     .      ':`5B0,0`5DQUOTA.SYS',exist=quotas_enabled)
  400. X           if (quotas_enabled) then
  401. X             write (1,'(a)') '$ RUN SYS$SYSTEM:DISKQUOTA'
  402. X             dcl_command = 'USE '//main_dev(1:offset)
  403. X             write (1,'(a)') dcl_command
  404. X             dcl_command = 'ADD '//uic//'/PERMQUOTA='//quota
  405. X     .        //'/OVERDRAFT='//overdraft
  406. X             write (1,'(a)') dcl_command
  407. X             write (1,'(a)') 'EXIT'
  408. X           endif
  409. X        endif
  410. XC
  411. XC Close the temporary file.
  412. XC
  413. X        close (1)
  414. XC
  415. XC Spawn a quick dcl command.
  416. XC
  417. X        sts = lib$spawn ( , 'DCL.TMP', 'NL:', flag_mask )
  418. X        if (.not.sts) call lib$signal ( %val(sts) )
  419. X
  420. +-+-+-+-+-+-+-+-  END  OF PART 11 +-+-+-+-+-+-+-+-
  421. -- 
  422. \/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/
  423. < Joe Koffley                        KOFFLEY@NRLVAX.NRL.NAVY.MIL             >
  424. < Naval Research Laboratory          KOFFLEY@CCF.NRL.NAVY.MIL                >
  425. < Space Systems Division             AT&T  :  202-767-0894                   >
  426. \/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/
  427.