home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1992 March / Source_Code_CD-ROM_Walnut_Creek_March_1992.iso / usenet / altsrcs / 3 / 3978 < 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 4 of 18
  5. Message-ID: <1991Sep5.074241.548@nrlvx1.nrl.navy.mil>
  6. Date: 5 Sep 91 11:42:41 GMT
  7. Organization: NRL SPACE SYSTEMS DIVISION
  8. Lines: 370
  9.  
  10. -+-+-+-+-+-+-+-+ START OF PART 4 -+-+-+-+-+-+-+-+
  11. X        Itemlist(19).retlen = %loc(wsextent_len)
  12. X        Itemlist(20).buflen = 4
  13. X        Itemlist(20).code = uai$_wsquota
  14. X        Itemlist(20).addr = %loc(wsquo)
  15. X        Itemlist(20).retlen = %loc(wsquo_len)
  16. X        Itemlist(21).buflen = 3
  17. X        Itemlist(21).code = uai$_batch_access_p
  18. X        Itemlist(21).addr = %loc(batch_p)
  19. X        Itemlist(21).retlen = %loc(batch_p_len)
  20. X        Itemlist(22).buflen = 3
  21. X        Itemlist(22).code = uai$_batch_access_s
  22. X        Itemlist(22).addr = %loc(batch_s)
  23. X        Itemlist(22).retlen = %loc(batch_s_len)
  24. X        Itemlist(23).buflen = 3
  25. X        Itemlist(23).code = uai$_dialup_access_p
  26. X        Itemlist(23).addr = %loc(dialup_p)
  27. X        Itemlist(23).retlen = %loc(dialup_p_len)
  28. X        Itemlist(24).buflen = 3
  29. X        Itemlist(24).code = uai$_dialup_access_s
  30. X        Itemlist(24).addr = %loc(dialup_s)
  31. X        Itemlist(24).retlen = %loc(dialup_s_len)
  32. X        Itemlist(25).buflen = 3
  33. X        Itemlist(25).code = uai$_local_access_p
  34. X        Itemlist(25).addr = %loc(local_p)
  35. X        Itemlist(25).retlen = %loc(local_p_len)
  36. X        Itemlist(26).buflen = 3
  37. X        Itemlist(26).code = uai$_local_access_s
  38. X        Itemlist(26).addr = %loc(local_s)
  39. X        Itemlist(26).retlen = %loc(local_s_len)
  40. X        Itemlist(27).buflen = 3
  41. X        Itemlist(27).code = uai$_network_access_p
  42. X        Itemlist(27).addr = %loc(network_p)
  43. X        Itemlist(27).retlen = %loc(network_p_len)
  44. X        Itemlist(28).buflen = 3
  45. X        Itemlist(28).code = uai$_network_access_s
  46. X        Itemlist(28).addr = %loc(network_s)
  47. X        Itemlist(28).retlen = %loc(network_s_len)
  48. X        Itemlist(29).buflen = 3
  49. X        Itemlist(29).code = uai$_remote_access_p
  50. X        Itemlist(29).addr = %loc(remote_p)
  51. X        Itemlist(29).retlen = %loc(remote_p_len)
  52. X        Itemlist(30).buflen = 3
  53. X        Itemlist(30).code = uai$_remote_access_s
  54. X        Itemlist(30).addr = %loc(remote_s)
  55. X        Itemlist(30).retlen = %loc(remote_s_len)
  56. X        Itemlist(31).buflen = 4
  57. X        Itemlist(31).code = uai$_bytlm
  58. X        Itemlist(31).addr = %loc(bytlm)
  59. X        Itemlist(31).retlen = %loc(bytlm_len)
  60. X        Itemlist(32).buflen = 4
  61. X        Itemlist(32).code = uai$_jtquota
  62. X        Itemlist(32).addr = %loc(jtquota)
  63. X        Itemlist(32).retlen = %loc(jtquota_len)
  64. X        Itemlist(33).buflen = 4
  65. X        Itemlist(33).code = uai$_cputim
  66. X        Itemlist(33).addr = %loc(cpu)
  67. X        Itemlist(33).retlen = %loc(cpu_len)
  68. X        Itemlist(34).buflen = 4
  69. X        Itemlist(34).code = uai$_flags
  70. X        Itemlist(34).addr = %loc(flags)
  71. X        Itemlist(34).retlen = %loc(flags_len)
  72. X        Itemlist(35).buflen = 8
  73. X        Itemlist(35).code = uai$_pwd_lifetime
  74. X        Itemlist(35).addr = %loc(pwd_life)
  75. X        Itemlist(35).retlen = %loc(pwd_life_len)
  76. X        Itemlist(36).buflen = 8
  77. X        Itemlist(36).code = uai$_expiration
  78. X        Itemlist(36).addr = %loc(expir)
  79. X        Itemlist(36).retlen = %loc(expir_len)
  80. X        Itemlist(37).buflen = 8
  81. X        Itemlist(37).code = uai$_def_priv
  82. X        Itemlist(37).addr = %loc(def_priv)
  83. X        Itemlist(37).retlen = %loc(def_priv_len)
  84. X        Itemlist(38).buflen = 8
  85. X        Itemlist(38).code = uai$_priv
  86. X        Itemlist(38).addr = %loc(auth_priv)
  87. X        Itemlist(38).retlen = %loc(auth_priv_len)
  88. X        Itemlist(39).buflen = 4
  89. X        Itemlist(39).code = uai$_uic
  90. X        Itemlist(39).addr = %loc(uic_value)
  91. X        Itemlist(39).retlen = %loc(uic_value_len)
  92. X        Itemlist(40).buflen = 32         ! 9 for V4.7
  93. X        Itemlist(40).code = uai$_account
  94. X        Itemlist(40).addr = %loc(account)
  95. X        Itemlist(40).retlen = %loc(account_len)
  96. X        Itemlist(41).buflen = 64
  97. X        Itemlist(41).code = uai$_lgicmd
  98. X        Itemlist(41).addr = %loc(cmd_str)
  99. X        Itemlist(41).retlen = %loc(lgicmd_len)
  100. X        Itemlist(42).buflen = 32
  101. X        Itemlist(42).code = uai$_clitables
  102. X        Itemlist(42).addr = %loc(tables_str)
  103. X        Itemlist(42).retlen = %loc(tables_len)
  104. X        Itemlist(43).buflen = 32
  105. X        Itemlist(43).code = uai$_defcli
  106. X        Itemlist(43).addr = %loc(cli_str)
  107. X        Itemlist(43).retlen = %loc(defcli_len)
  108. X        Itemlist(44).buflen = 32
  109. X        Itemlist(44).code = uai$_defdev
  110. X        Itemlist(44).addr = %loc(dev_str)
  111. X        Itemlist(44).retlen = %loc(defdev_len)
  112. X        Itemlist(45).buflen = 64
  113. X        Itemlist(45).code = uai$_defdir
  114. X        Itemlist(45).addr = %loc(dir_str)
  115. X        Itemlist(45).retlen = %loc(defdir_len)
  116. X        Itemlist(46).buflen = 32
  117. X        Itemlist(46).code = uai$_owner
  118. X        Itemlist(46).addr = %loc(own_str)
  119. X        Itemlist(46).retlen = %loc(owner_len)
  120. X
  121. X        itemlist(47).end_list = 0
  122. X
  123. X        other_itemlist(01).buflen = 8
  124. X        other_itemlist(01).code = uai$_lastlogin_i
  125. X        other_itemlist(01).addr = %loc(last_login_i(1))
  126. X        other_itemlist(01).retlen = %loc(lastlogi)
  127. X        other_itemlist(02).buflen = 8
  128. X        other_itemlist(02).code = uai$_lastlogin_n
  129. X        other_itemlist(02).addr = %loc(last_login_n(1))
  130. X        other_itemlist(02).retlen = %loc(lastlogn)
  131. X        other_itemlist(03).buflen = 8
  132. X        other_itemlist(03).code = uai$_pwd_date
  133. X        other_itemlist(03).addr = %loc(pwd_date(1))
  134. X        other_itemlist(03).retlen = %loc(change_date_len)
  135. X
  136. X        other_itemlist(04).end_list = 0
  137. X
  138. X`09def_Priv (1)  = 0
  139. X`09def_Priv (2)  = 0
  140. X`09auth_priv (1) = 0
  141. X`09auth_priv (2) = 0
  142. XC
  143. XC First determine if the terminal type is ansicrt.
  144. XC
  145. X        sts = lib$getdvi ( dvi$_tt_ansicrt ,, 'tt:', value )
  146. X        if (.not.value) stop 'SYS$INPUT must be an ANSI CRT'
  147. XC
  148. XC Make a call to LIB$GETJPI to find out process privileges. $GETUAI
  149. XC can actually be run by any user, as long as the account being
  150. XC examined is owned by the user, so we will cause the program to exit
  151. XC at this point. If a user wants to look at his own profile, let
  152. XC him write his own program!
  153. XC
  154. X        priv_mask = prv$m_sysprv.or.prv$m_setprv
  155. X
  156. X        sts = lib$getjpi ( jpi$_authpriv ,,, my_privs )
  157. X        if (.not.sts) call lib$signal ( %val(sts) )
  158. XC
  159. XC If the user has SYSPRV, then set it (in case it is not already
  160. XC set). If the user does not have privileges, have the program end
  161. XC at this point.
  162. XC
  163. X        if ((jiand(priv_mask,my_privs(1))).ne.0) then
  164. X           priv_mask = prv$m_sysprv
  165. X           sts = sys$setprv ( %val(enbflg), priv_mask ,, )
  166. X           if (.not.sts) call lib$signal ( %val(sts) )
  167. X        else
  168. X           write (6,*) 'Insufficient privilege'
  169. X`09   call AST
  170. X           call exit
  171. X        endif
  172. XC
  173. XC Get the foreign command line.
  174. XC
  175. X        call lib$get_foreign ( u, 'PROFILE> ', u_len )
  176. X        if (u_len.eq.0) call AST
  177. XC
  178. XC Make the call to the system service $GETUAI to gather all information.
  179. XC If the username does not exist, a second call to $GETUAI will be made,
  180. XC using the DEFAULT template, and the significant fields altered to match
  181. XC the new user.
  182. XC
  183. X10      sts = sys$getuai ( ,, u(1:u_len), itemlist ,,, )
  184. X        sts = sys$getuai ( ,, u(1:u_len), other_itemlist ,,, )
  185. X        if (.not.sts) then    ! user does not exist: use DEFAULT
  186. X           user_exists = .false.
  187. X           sts = sys$getuai ( ,, 'DEFAULT', itemlist ,,, )
  188. X           username = u
  189. X           u_len = index(username,' ')-1
  190. X           owner = '(none)'
  191. X           defdir = '`5B'//username(1:u_len)//'`5D'
  192. X           password = username
  193. X        else                  ! user exists: use given user record
  194. X           own_str(1) = index(owner,'  ')-1
  195. X           if (own_str(1).eq.-1) own_str(1) = 32  ! to remove the
  196. X           dir_str(1) = index(defdir,'  ')-1      ! byte prefix
  197. X           if (dir_str(1).eq.-1) dir_str(1) = 64  ! from the
  198. X           user_exists = .true.                   ! returned
  199. X           orig_uname = u                         ! strings
  200. X           username = u
  201. X           uname_len = index(u,' ')-1
  202. X           password = '(unknown)'
  203. X        endif
  204. XC
  205. XC Remove byte prefix from returned strings.
  206. XC
  207. X        dev_str(1) = index(defdev,'  ')-1
  208. X        if (dev_str(1) .eq. -1) dev_str(1) = 32
  209. X        tables_str(1) = index(tables,'  ')-1
  210. X        if (tables_str(1).eq.-1) tables_str(1) = 32
  211. X        cli_str(1) = index(defcli,'  ')-1
  212. X        if (cli_str(1).eq.-1) cli_str(1) = 40
  213. X        cmd_str(1) = index(lgicmd,'  ')-1
  214. X        if (cmd_str(1).eq.-1) cmd_str(1) = 64
  215. XC
  216. XC Find out what the uic is and format the string using LIB$SYS_FAO.
  217. XC
  218. X        sts = lib$sys_fao ( '!%U', len, uic, %val(uic_value) )
  219. X        if (.not.sts) call lib$signal ( %val(sts) )
  220. XC
  221. XC Find out what time fields (password expiration, account expiration,
  222. XC etc.) the user has.
  223. XC
  224. X        sts = sys$asctim ( , pwd_lifetime, pwd_life, 0 )
  225. X        if (.not.sts) call lib$signal ( %val(sts) )
  226. X        if (pwd_lifetime(1:10).eq.'17-NOV-185') then
  227. Xd`09   write (66,*) 'pwd_Lifetime = ',pwd_lifetime
  228. Xd`09   write (66,'(1x,2(z8,2x))' ) pwd_life(1),pwd_life(2)
  229. X`09   pwd_lifetime = '    (none)'
  230. X`09endif
  231. X        sts = sys$asctim ( , exprdate, expir, 0 )
  232. X        if (.not.sts) call lib$signal ( %val(sts) )
  233. X        if (exprdate(1:10).eq.'17-NOV-185') then
  234. Xd`09   write (66,*) 'exprdate = ',exprdate
  235. Xd`09   write (66,'(1x,2(z8,2x))' ) expir(1),expir(2)
  236. X`09   exprdate = '    (none)'
  237. X`09endif
  238. XC
  239. XC Convert last login date/time to ascii strings
  240. XC
  241. X        sts = sys$asctim ( , char_last_login_i, last_Login_i(1), 0 )
  242. X        if (.not.sts) call lib$signal ( %val(sts) )
  243. X        sts = sys$asctim ( , char_last_login_n, last_Login_n(1), 0 )
  244. X        if (.not.sts) call lib$signal ( %val(sts) )
  245. Xd`09write (66,*) 'last non-inter = ',char_last_Login_n
  246. X        sts = sys$asctim ( , password_change_date, pwd_date(1), 0 )
  247. X        if (.not.sts) call lib$signal ( %val(sts) )
  248. X        if (index(password_change_date,'0 00:00:00.00') .ne. 0) then
  249. Xd`09   write (66,*) 'password pre-expired'
  250. X`09else
  251. Xd`09   write (66,*) 'last pword change: ',password_change_date
  252. X`09endif
  253. XC
  254. XC Convert the decimal value for cputime to a string in the format
  255. XC X XX:XX:XX (day hour:minute:second).
  256. XC
  257. X        size = 2
  258. X        if (cpu.ne.0) then
  259. X           days = (cpu / 360000) / 24
  260. X           cpu = cpu - days * 360000 * 24
  261. X           hours = cpu / 360000
  262. X           cpu = cpu - hours * 360000
  263. X           hours = mod (hours, 1000 )
  264. X           minutes = cpu / 6000
  265. X           cpu = cpu - minutes * 6000
  266. X           seconds = cpu /100
  267. X           sts = ots$cvt_l_ti ( days, dummy )
  268. X           cpu_string = dummy
  269. X           str_len = index(cpu_string,'  ')-1
  270. X           sts = ots$cvt_l_ti ( hours, dummy, %val(size) )
  271. X           cpu_string = cpu_string(1:str_len)//' '//dummy
  272. X           str_len = index(cpu_string,'  ')-1
  273. X           sts = ots$cvt_l_ti ( minutes, dummy, %val(size) )
  274. X           cpu_string = cpu_string(1:str_len)//':'//dummy
  275. X           str_len = index(cpu_string,'  ')-1
  276. X           sts = ots$cvt_l_ti ( seconds, dummy, %val(size) )
  277. X           cpu_string = cpu_string(1:str_len)//':'//dummy
  278. X        else
  279. X           cpu_string = '    (none)'
  280. X        endif
  281. XC
  282. XC CONVERT function converts integer to ascii string representing the integer
  283. V.
  284. XC
  285. X        sts = convert ( maxjobs, maxjobs_string )
  286. X        sts = convert ( fillm, fillm_string )
  287. X        sts = convert ( maxacctjobs, maxacctjobs_string )
  288. X        sts = convert ( shrfillm, shrfillm_string )
  289. X        sts = convert ( pbytlm, pbytlm_string )
  290. X        sts = convert ( maxdetach, maxdetach_string )
  291. X        sts = convert ( biolm, biolm_string )
  292. X        sts = convert ( prclm, prclm_string )
  293. X        sts = convert ( diolm, diolm_string )
  294. X        sts = convert ( wsdef, wsdef_string )
  295. X        sts = convert ( astlm, astlm_string )
  296. X        sts = convert ( wsquo, wsquo_string )
  297. X        sts = convert ( tqelm, tqelm_string )
  298. X        sts = convert ( wsextent, wsextent_string )
  299. X        sts = convert ( enqlm, enqlm_string )
  300. X        sts = convert ( pgflquo, pgflquo_string )
  301. X        sts = convert ( pwd_length, pwd_length_string )
  302. X        sts = convert ( queprio, queprio_string )
  303. X        sts = convert ( prio, prio_string )
  304. X        sts = convert ( jtquota, jtquota_string )
  305. X        sts = convert ( bytlm, bytlm_string )
  306. XC
  307. XC Create the virtual keyboard
  308. XC
  309. X        call smg$create_virtual_keyboard ( keyboard )
  310. XC
  311. XC Create the virtual display displays
  312. XC
  313. X        call smg$create_virtual_display ( 24, 80, main )
  314. X        call smg$create_virtual_display ( 3, 80, message ,,
  315. X     .   smg$m_bold )
  316. X        call smg$create_virtual_display ( 2, 50, error_message,
  317. X     .   smg$m_border )
  318. X        call smg$create_virtual_display ( 3, 60, login_board,
  319. X     .   smg$m_border )
  320. X        call smg$create_virtual_display ( 1, 80, prompt )
  321. X        call smg$create_virtual_display ( 24, 80, priv_board )
  322. X        call smg$create_virtual_display ( 24, 80, flags_board )
  323. X        call smg$create_virtual_display ( 24, 80, access_board )
  324. X        call smg$create_virtual_display ( 24, 80, days_board )
  325. X        call smg$create_pasteboard ( pasteboard ,,,,,)
  326. Xd`09write (66,*) 'pasteboard = ',pasteboard
  327. XC
  328. XC Call the subroutine BOARD to put everything on the screen
  329. XC
  330. X        call board ( owner, tables, defcli, defdev, defdir,
  331. X     .   lgicmd )
  332. XC
  333. XC Call the subroutine SELECT to pick and choose items on the screen.
  334. XC
  335. X        call select ( owner, tables, defcli, defdev,
  336. X     .   defdir, lgicmd )
  337. XC
  338. XC Redefine some string lengths
  339. XC
  340. X        own_str(1) = index(owner,'  ')-1
  341. X        if (own_str(1).eq.-1) own_str(1) = 32
  342. X
  343. X        tables_str(1) = index(tables,'  ')-1
  344. X        if (tables_str(1).eq.-1) tables_str(1) = 32
  345. X
  346. X        cli_str(1) = index(defcli,'  ')-1
  347. X        if (cli_str(1).eq.-1) cli_str(1) = 40
  348. X
  349. X        dev_str(1) = index(defdev,'  ')-1
  350. X        if (dev_str(1).eq.-1) dev_str(1) = 32
  351. X
  352. X        dir_str(1) = index(defdir,'  ')-1
  353. X        if (dir_str(1).eq.-1) dir_str(1) = 64
  354. X
  355. X        cmd_str(1) = index(lgicmd,'  ')-1
  356. X        if (cmd_str(1).eq.-1) cmd_str(1) = 64
  357. X
  358. X        call string_lengths ( owner, tables, defcli, defdev,
  359. X     .   defdir, lgicmd )
  360. XC
  361. XC Check to see if any changes were made. Exit program if no changes
  362. XC made.
  363. XC
  364. X        if (.not.change) go to 20
  365. XC
  366. XC Confirm that the user wants to save the changes. Exit if response
  367. XC is negative.
  368. XC
  369. X        call smg$set_cursor_abs ( main, 22, 1 )
  370. X        call smg$read_string ( keyboard, confirm,
  371. X     .   'Save changes? `5BY`5D ', 2 ,,,, length )
  372. X        if (length.ne.0) then
  373. +-+-+-+-+-+-+-+-  END  OF PART 4 +-+-+-+-+-+-+-+-
  374. -- 
  375. \/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/
  376. < Joe Koffley                        KOFFLEY@NRLVAX.NRL.NAVY.MIL             >
  377. < Naval Research Laboratory          KOFFLEY@CCF.NRL.NAVY.MIL                >
  378. < Space Systems Division             AT&T  :  202-767-0894                   >
  379. \/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/
  380.