home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1992 March / Source_Code_CD-ROM_Walnut_Creek_March_1992.iso / usenet / altsrcs / 3 / 3984 < prev    next >
Encoding:
Internet Message Format  |  1991-09-09  |  14.8 KB
  1. Path: wupost!cs.utexas.edu!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 10 of 18
  5. Message-ID: <1991Sep5.074519.554@nrlvx1.nrl.navy.mil>
  6. Date: 5 Sep 91 11:45:19 GMT
  7. Organization: NRL SPACE SYSTEMS DIVISION
  8. Lines: 435
  9.  
  10. -+-+-+-+-+-+-+-+ START OF PART 10 -+-+-+-+-+-+-+-+
  11. X           elseif (term.eq.smg$k_trm_left.or.
  12. X     .      term.eq.smg$k_trm_uppercase_h.or.
  13. X     .      term.eq.smg$k_trm_lowercase_h) then
  14. X              if (line.eq.11.and.col.eq.50) then
  15. X                 line = 3
  16. X                 col = 25
  17. X              elseif (line.eq.3.and.col.eq.25) then
  18. X                 line = 11
  19. X                 col = 50
  20. X              elseif (col.eq.25) then
  21. X                 line = line - 1
  22. X                 col = 50
  23. X              elseif (col.eq.50) then
  24. X                 col = 25
  25. X              endif
  26. X              call smg$set_cursor_abs ( flags_board, line, col )
  27. XC
  28. XC Down arrow, or carriage return, or letter 'j' - move to next field below
  29. XC
  30. X           elseif (term.eq.smg$k_trm_down.or.
  31. X     .      term.eq.smg$k_trm_cr.or.
  32. X     .      term.eq.smg$k_trm_uppercase_j.or.
  33. X     .      term.eq.smg$k_trm_lowercase_j) then
  34. X              if (line.eq.11.and.col.eq.25) then
  35. X                 line = 3
  36. X              elseif (line.eq.11.and.col.eq.50) then
  37. X`09         line = 3
  38. X`09      else
  39. X                 line = line + 1
  40. X              endif
  41. X              call smg$set_cursor_abs ( flags_board, line, col )
  42. XC
  43. XC Up arrow, or letter 'k' - move to previous field above
  44. XC
  45. X           elseif (term.eq.smg$k_trm_up.or.
  46. X     .      term.eq.smg$k_trm_uppercase_k.or.
  47. X     .      term.eq.smg$k_trm_lowercase_k) then
  48. X              if (line.eq.3.and.col.eq.25) then
  49. X                 line = 11
  50. X              elseif (line.eq.3.and.col.eq.50) then
  51. X                 line = 11
  52. X              else
  53. X                 line = line - 1
  54. X              endif
  55. X              call smg$set_cursor_abs ( flags_board, line, col )
  56. XC
  57. XC Select or keypad period (.) key - change flag attribute
  58. XC
  59. X           elseif (term.eq.smg$k_trm_select.or.
  60. X     .      term.eq.smg$k_trm_period.or.
  61. X     .      term.eq.smg$k_trm_uppercase_t.or.
  62. X     .      term.eq.smg$k_trm_lowercase_t) then
  63. X              change = .true.
  64. X              call smg$read_from_display ( flags_board, string )
  65. X              call read_flag ( string(1:12) )
  66. XC
  67. XC PF2 - go to primary and secondary days screen
  68. XC
  69. X           elseif (term.eq.smg$k_trm_pf2) then
  70. X              call smg$unpaste_virtual_display ( flags_board,
  71. X     .         pasteboard )
  72. X              call show_days ( owner, tables, defcli, defdev,
  73. X     .         defdir, lgicmd )
  74. X              bogus_key = .false.
  75. XC
  76. XC PF3 - go to access times screen
  77. XC
  78. X           elseif (term.eq.smg$k_trm_pf3) then
  79. X              call smg$unpaste_virtual_display ( flags_board,
  80. X     .         pasteboard )
  81. X              call show_access ( owner, tables, defcli, defdev,
  82. X     .         defdir, lgicmd )
  83. X              bogus_key = .false.
  84. XC
  85. XC PF4 - go to privilege screen
  86. XC
  87. X           elseif (term.eq.smg$k_trm_pf4) then
  88. X              call smg$unpaste_virtual_display ( flags_board,
  89. X     .         pasteboard )
  90. X              call show_privs ( owner, tables, defcli, defdev,
  91. X     .         defdir, lgicmd )
  92. X              bogus_key = .false.
  93. XC
  94. XC CtrlW - repaint screen
  95. XC
  96. X           elseif (term.eq.smg$k_trm_ctrlw) then
  97. X              call smg$repaint_screen ( pasteboard )
  98. XC
  99. XC CtrlZ - exit to main display
  100. XC
  101. X           elseif (term.eq.smg$k_trm_ctrlz) then
  102. X              bogus_key = .false.
  103. X           endif
  104. X        enddo
  105. X
  106. X        call smg$unpaste_virtual_display ( flags_board, pasteboard )
  107. X
  108. X        end
  109. X
  110. XC************************************************************************
  111. X
  112. X        Subroutine READ_FLAG ( flag )
  113. XC
  114. XC The purpose of this subroutine is to read the flag displayed under the
  115. XC cursor and change it to either true (flag enabled) or false (flag
  116. XC disabled).
  117. XC
  118. X        Include 'uaf.cmn'
  119. X        Include '($uaidef)'
  120. X        Integer*4 i, flag_types(18)
  121. X        Character*12 flag_names(18)
  122. X        Character*(*) flag
  123. X
  124. X        data flag_types
  125. X     .  / uai$v_AUDIT, uai$v_RESTRICTED, uai$v_DEFCLI,
  126. X     .    uai$v_DISCTLY, uai$v_DISMAIL, uai$v_DISRECONNECT,
  127. X     .    uai$v_DISREPORT, uai$v_DISWELCOM, uai$v_GENPWD,
  128. X     .    uai$v_LOCKPWD, uai$v_NOMAIL, uai$v_DISACNT,
  129. X     .    uai$v_AUTOLOGIN, uai$v_PWD_EXPIRED, uai$v_PWD2_EXPIRED,
  130. X     .    uai$v_DISFORCE_PWD_CHANGE, uai$v_CAPTIVE, uai$v_DISIMAGE /
  131. X
  132. X        data flag_names
  133. X     .  /'Audit       ','Restricted  ','Defcli      ',
  134. X     .   'Disctly     ','Disnewmail  ','Disreconnect',
  135. X     .   'Disreport   ','Diswelcome  ','Genpwd      ',
  136. X     .   'Lockpwd     ','Dismail     ','Disuser     ',
  137. X     .   'Autolog     ','Pwdexpired  ','Pwd2_expired',
  138. X     .   'Disforce_pwd','Captive     ','Disimage    '/
  139. XC
  140. XC Read the string at the cursor and reverse the flag.
  141. XC
  142. X        do i = 1,18
  143. X           if (flag.eq.flag_names(i)) then
  144. X              if (btest(flags,flag_types(i))) then
  145. X                 call lib$bbcci ( flag_types(i), flags )
  146. X              else
  147. X                 call lib$bbssi ( flag_types(i), flags )
  148. X              endif
  149. X           endif
  150. X        enddo
  151. XC
  152. XC Call subroutine SCAN_FLAG to determine new flag values.
  153. XC
  154. X        call scan_flag
  155. X
  156. X        end
  157. X
  158. XC************************************************************************
  159. X
  160. X        Subroutine SCAN_FLAG
  161. XC
  162. XC The purpose of this subroutine is to determine which flags are
  163. XC enabled or disabled and change the video rendition accordingly.
  164. XC
  165. X        Include 'uaf.cmn'
  166. X        Include '($smgdef)'
  167. X        Include '($uaidef)'
  168. X        Integer*4 line, col, i, j, rend_mask
  169. X        Integer*4 flag_types(18)
  170. X
  171. X        data flag_types
  172. X     .  / uai$v_AUDIT, uai$v_RESTRICTED, uai$v_DEFCLI,
  173. X     .    uai$v_DISCTLY, uai$v_DISMAIL, uai$v_DISRECONNECT,
  174. X     .    uai$v_DISREPORT, uai$v_DISWELCOM, uai$v_GENPWD,
  175. X     .    uai$v_LOCKPWD, uai$v_NOMAIL, uai$v_DISACNT,
  176. X     .    uai$v_AUTOLOGIN, uai$v_PWD_EXPIRED, uai$v_PWD2_EXPIRED,
  177. X     .    uai$v_DISFORCE_PWD_CHANGE, uai$v_CAPTIVE, uai$v_DISIMAGE /
  178. X
  179. X        rend_mask = smg$m_bold.or.smg$m_underline
  180. XC
  181. XC Find the appropriate flags and highlight the ones held.
  182. XC
  183. X        line = 3
  184. X        col = 25
  185. X
  186. X        do j = 1,18,2
  187. X           do i = j,j+1
  188. X              if (btest(flags,flag_types(i))) then
  189. X                 call smg$change_rendition ( flags_board,
  190. X     .            line, col, 1, 12, rend_mask )
  191. X              else
  192. X                 call smg$change_rendition ( flags_board,
  193. X     .            line, col, 1, 12, 0 )
  194. X              endif
  195. X              col = col + 25
  196. X           enddo
  197. X           line = line + 1
  198. X           col = 25
  199. X        enddo
  200. X
  201. X        end
  202. X
  203. XC************************************************************************
  204. X
  205. X        Subroutine SHOW_PRIVS ( owner, tables, defcli, defdev,
  206. X     .   defdir, lgicmd )
  207. XC
  208. XC The purpose of this subroutine is to find the privileges and paste
  209. XC them to the screen in order to allow the cursor to move to each
  210. XC privilege and allow or disallow them as desired.
  211. XC
  212. X        Include 'uaf.cmn'
  213. X        Include '($smgdef)'
  214. X        Integer*4 line, col
  215. X        Character*25 string
  216. X        Character*(*)  owner, tables, defcli, defdev, defdir, lgicmd
  217. X
  218. X        bogus_key = .true.
  219. X        line = 2
  220. XC
  221. XC Paste information to the screen, including all privileges
  222. XC
  223. X        call smg$begin_pasteboard_update ( pasteboard )
  224. X        call smg$erase_display ( message )
  225. X        call smg$put_chars ( priv_board, ' Privileges: ',
  226. X     .   1, 34 ,, smg$m_bold )
  227. X        call smg$put_chars_wide ( priv_board, '  Default:   ',
  228. X     .   line+1, 29, smg$m_reverse )
  229. X
  230. X        line = line + 3
  231. X        col = 5
  232. XC
  233. XC Call the subroutine LIST_PRIVS to write the names of the
  234. XC default privileges to the board.
  235. XC
  236. X        call list_privs ( line, col )
  237. X
  238. X        line = line + 2
  239. X        call smg$put_chars_wide ( priv_board, ' Authorized: ',
  240. X     .   line, 29, smg$m_reverse )
  241. X        line = line + 2
  242. X        col = 5
  243. XC
  244. XC Call the subroutine LIST_PRIVS to write the names of the
  245. XC authorized privileges to the board.
  246. XC
  247. X        call list_privs ( line, col )
  248. XC
  249. XC Call the subroutine SCAN_PRIVS to determine which privileges
  250. XC are enabled.
  251. XC
  252. X        call scan_privs
  253. XC
  254. XC Reset the values for line and column.
  255. XC
  256. X        line = 5
  257. X        col = 5
  258. XC
  259. XC Put instructions to the message window
  260. XC
  261. X        call smg$put_chars ( message,
  262. X     .   'Use arrow keys to move to desired field.', 1, 2 )
  263. X        call smg$put_chars ( message,
  264. X     .   'Hit SELECT, PERIOD, or T to change privilege.
  265. X     .   A - All privs  N - Normal privs', 2, 2 )
  266. X        call smg$put_chars ( message,
  267. X     .   'PF keys: go to another screen.
  268. X     .   ControlZ: exit to main display.',
  269. X     .   3, 2 )
  270. XC
  271. XC Paste the displays to the screen, end the pasteboard update, and
  272. XC set the cursor to the first position
  273. XC
  274. X        call smg$paste_virtual_display ( priv_board, pasteboard, 1, 1 )
  275. X        call smg$paste_virtual_display ( message, pasteboard, 22, 1 )
  276. X        call smg$end_pasteboard_update ( pasteboard )
  277. X        call smg$set_cursor_abs ( priv_board, line, col )
  278. XC
  279. XC Read a keystroke and loop until exit is called
  280. XC
  281. X        do while (bogus_key)
  282. X           call smg$read_keystroke ( keyboard, term )
  283. XC
  284. XC Right arrow, or letter 'l' - right to next field
  285. XC
  286. X           if (term.eq.smg$k_trm_right.or.
  287. X     .      term.eq.smg$k_trm_uppercase_l.or.
  288. X     .      term.eq.smg$k_trm_lowercase_l) then
  289. X              if (line.eq.10.and.col.eq.53) then
  290. X                 line = 14
  291. X                 col = 5
  292. X              elseif (line.eq.19.and.col.eq.53) then
  293. X                 line = 5
  294. X                 col = 5
  295. X              elseif (col.eq.65) then
  296. X                 line = line + 1
  297. X                 col = 5
  298. X              else
  299. X                 col = col + 12
  300. X              endif
  301. X              call smg$set_cursor_abs ( priv_board, line, col )
  302. XC
  303. XC Left arrow, or letter 'h' - left to previous field
  304. XC
  305. X           elseif (term.eq.smg$k_trm_left.or.
  306. X     .      term.eq.smg$k_trm_uppercase_h.or.
  307. X     .      term.eq.smg$k_trm_lowercase_h) then
  308. X              if (line.eq.5.and.col.eq.5) then
  309. X                 line = 19
  310. X                 col = 53
  311. X              elseif (line.eq.14.and.col.eq.5) then
  312. X                 line = 10
  313. X                 col = 53
  314. X              elseif (col.eq.5) then
  315. X                 line = line - 1
  316. X                 col = 65
  317. X              else
  318. X                 col = col - 12
  319. X              endif
  320. X              call smg$set_cursor_abs ( priv_board, line, col )
  321. XC
  322. XC Up arrow, or letter 'k' - up to previous field
  323. XC
  324. X           elseif (term.eq.smg$k_trm_up.or.
  325. X     .      term.eq.smg$k_trm_uppercase_k.or.
  326. X     .      term.eq.smg$k_trm_lowercase_k) then
  327. X              if (line.eq.14.and.col.eq.65) then
  328. X                 line = 9
  329. X              elseif (line.eq.14) then
  330. X                 line = 10
  331. X              elseif (line.eq.5.and.col.eq.65) then
  332. X                 line = 18
  333. X              elseif (line.eq.5) then
  334. X                 line = 19
  335. X              else
  336. X                 line = line - 1
  337. X              endif
  338. X              call smg$set_cursor_abs ( priv_board, line, col )
  339. XC
  340. XC Down arrow, or carriage return, or letter 'j' - down to lower field
  341. XC
  342. X           elseif (term.eq.smg$k_trm_down.or.
  343. X     .      term.eq.smg$k_trm_cr.or.
  344. X     .      term.eq.smg$k_trm_uppercase_j.or.
  345. X     .      term.eq.smg$k_trm_lowercase_j) then
  346. X              if ((line.eq.10).or.(line.eq.9.and.col.eq.65)) then
  347. X                 line = 14
  348. X              elseif ((line.eq.19).or.(line.eq.18.and.col.eq.65)) then
  349. X                 line = 5
  350. X              else
  351. X                 line = line + 1
  352. X              endif
  353. X              call smg$set_cursor_abs ( priv_board, line, col )
  354. XC
  355. XC 'a' key to set all privileges
  356. XC
  357. X           elseif (term.eq.smg$k_trm_uppercase_a.or.
  358. X     .      term.eq.smg$k_trm_lowercase_a) then
  359. X              call all_priv
  360. XC
  361. XC 'n' key to set normal privileges
  362. XC
  363. X           elseif (term.eq.smg$k_trm_uppercase_n.or.
  364. X     .      term.eq.smg$k_trm_lowercase_n) then
  365. X              call normal_priv
  366. XC
  367. XC Select or keypad period (.) key to toggle privileges
  368. XC
  369. X           elseif (term.eq.smg$k_trm_select.or.
  370. X     .      term.eq.smg$k_trm_period.or.
  371. X     .      term.eq.smg$k_trm_uppercase_t.or.
  372. X     .      term.eq.smg$k_trm_lowercase_t) then
  373. X              change = .true.
  374. X              call smg$read_from_display ( priv_board, string )
  375. X              call read_priv ( string(1:8), line )
  376. XC
  377. XC PF1 - go to flags screen
  378. XC
  379. X           elseif (term.eq.smg$k_trm_pf1) then
  380. X              call smg$unpaste_virtual_display ( priv_board,
  381. X     .         pasteboard )
  382. X              call show_flags ( owner, tables, defcli, defdev,
  383. X     .         defdir, lgicmd )
  384. X              bogus_key = .false.
  385. XC
  386. XC PF2 - go to primary and secondary days screen
  387. XC
  388. X           elseif (term.eq.smg$k_trm_pf2) then
  389. X              call smg$unpaste_virtual_display ( priv_board,
  390. X     .         pasteboard )
  391. X              call show_days ( owner, tables, defcli, defdev,
  392. X     .         defdir, lgicmd )
  393. X              bogus_key = .false.
  394. XC
  395. XC PF3 - go to access times screen
  396. XC
  397. X           elseif (term.eq.smg$k_trm_pf3) then
  398. X              call smg$unpaste_virtual_display ( priv_board,
  399. X     .         pasteboard )
  400. X              call show_access ( owner, tables, defcli, defdev,
  401. X     .         defdir, lgicmd )
  402. X              bogus_key = .false.
  403. XC
  404. XC CtrlW - repaint screen
  405. XC
  406. X           elseif (term.eq.smg$k_trm_ctrlw) then
  407. X              call smg$repaint_screen ( pasteboard )
  408. XC
  409. XC CtrlZ - exit to main screen
  410. XC
  411. X           elseif (term.eq.smg$k_trm_ctrlz) then
  412. X              bogus_key = .false.
  413. X           endif
  414. X        enddo
  415. X
  416. X        call smg$unpaste_virtual_display ( priv_board, pasteboard )
  417. X
  418. X        end
  419. X
  420. XC***************************************************************************
  421. V****
  422. X
  423. X        Subroutine SCAN_PRIVS
  424. XC
  425. XC The purpose of this subroutine is to determine which privileges
  426. XC are enabled and set the video rendition accordingly.
  427. XC
  428. X        Include 'uaf.cmn'
  429. X        Include '($smgdef)'
  430. X        Include '($prvdef)'
  431. X        Integer*4 i, j, line, col, rend_mask
  432. X        Integer*4 privs(35)
  433. X
  434. X        data privs
  435. X     .   /prv$v_CMKRNL, prv$v_CMEXEC, prv$v_SYSNAM,
  436. X     .   prv$v_GRPNAM, prv$v_ALLSPOOL, prv$v_DETACH, prv$v_DIAGNOSE,
  437. X     .   prv$v_LOG_IO, prv$v_GROUP, prv$v_PRMCEB, prv$v_PSWAPM,
  438. +-+-+-+-+-+-+-+-  END  OF PART 10 +-+-+-+-+-+-+-+-
  439. -- 
  440. \/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/
  441. < Joe Koffley                        KOFFLEY@NRLVAX.NRL.NAVY.MIL             >
  442. < Naval Research Laboratory          KOFFLEY@CCF.NRL.NAVY.MIL                >
  443. < Space Systems Division             AT&T  :  202-767-0894                   >
  444. \/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/
  445.