home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1992 March / Source_Code_CD-ROM_Walnut_Creek_March_1992.iso / usenet / altsrcs / 3 / 3981 < 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 5 of 18
  5. Message-ID: <1991Sep5.074307.549@nrlvx1.nrl.navy.mil>
  6. Date: 5 Sep 91 11:43:07 GMT
  7. Organization: NRL SPACE SYSTEMS DIVISION
  8. Lines: 368
  9.  
  10. -+-+-+-+-+-+-+-+ START OF PART 5 -+-+-+-+-+-+-+-+
  11. X           call str$upcase ( confirm, confirm )
  12. X           if (confirm(1:1).eq.'N') go to 20
  13. X        endif
  14. XC
  15. XC If the account is to be added, or the password is to be changed on
  16. XC an already existing account, or the account is be renamed:
  17. XC call SPAWN_DCL.
  18. XC
  19. X        if (.not.user_exists.or.rename.or.pwd_change) then
  20. X           call spawn_dcl ( owner, tables,
  21. X     .      defcli, defdev, defdir, lgicmd )
  22. X        endif
  23. XC
  24. XC Make the call to $SETUAI to set all items (including those items
  25. XC not changed.
  26. XC
  27. X        sts = sys$setuai ( ,, username, itemlist ,,, )
  28. X        if (.not.sts) call lib$signal ( %val(sts) )
  29. XC
  30. XC If you do not want to send a mail message to the new user, remove
  31. XC the following line.
  32. XC
  33. X        if (.not. user_exists) call sendmail
  34. X
  35. X        if (user_exists) then
  36. X           call smg$put_chars ( main,
  37. X     .      'Account has been modified', 21, 1 )
  38. X        endif
  39. X
  40. X        call smg$repaint_line ( pasteboard, 22 )
  41. X
  42. X        change = .false.
  43. XC
  44. XC Ask for another user profile
  45. XC
  46. X20      call smg$set_cursor_abs ( main, 22, 1 )
  47. X        call smg$erase_line ( main, 22, 80 )
  48. X        call smg$read_string ( keyboard, u,
  49. X     .   'PROFILE> ', 20 ,,,, length )
  50. X        if (length.eq.0) call AST
  51. X        call str$upcase ( u, u )
  52. X        u_len = length
  53. X        call smg$delete_pasteboard ( pasteboard )
  54. X        go to 10
  55. X
  56. X        end
  57. X
  58. XC***************************************************************************
  59. V****
  60. X
  61. X        Integer Function CONVERT ( int, string )
  62. XC
  63. XC The purpose of this function is to convert the integer to an ascii
  64. XC string in order for SMG to use it.
  65. XC
  66. X        Character*(*) string
  67. X        Integer*4 ots$cvt_l_ti
  68. X        Integer*4 int, sts
  69. X
  70. X        sts = ots$cvt_l_ti ( int, string )
  71. X        if (.not.sts) call lib$signal ( %val(sts) )
  72. X
  73. X        end
  74. X
  75. XC************************************************************************
  76. X
  77. X        Subroutine STRING_LENGTHS ( owner, tables, defcli, defdev,
  78. X     .   defdir, lgicmd )
  79. XC
  80. XC The purpose of this subroutine is to gather the string lengths
  81. XC and pass them to the calling program.
  82. XC
  83. X        Include 'uaf.cmn'
  84. X        Character*(*) owner, tables, defcli, defdev, defdir, lgicmd
  85. XC
  86. XC Some definitions. The _len definitions locate the end of the string.
  87. XC
  88. X        uic_len = index(uic,'  ')-1
  89. X        if (uic_len.eq.-1) uic_len = 15
  90. X        owner_len = index(owner,'  ')-1
  91. X        if (owner_len.eq.-1) owner_len = 32
  92. X        username_len = index(username,' ')-1
  93. X        if (username_len.eq.-1) username_len = 12
  94. X        account_len = index(account,'  ')-1
  95. X        if (account_len.eq.-1) account_len = 8
  96. X        defdev_len = index(defdev,':')-1
  97. X        if (defdev_len.eq.-1) defdev_len = 32
  98. X        defdir_len = index(defdir,' ')-1
  99. X        if (defdir_len.eq.-1) defdir_len = 64
  100. X        lgicmd_len = index(lgicmd,' ')-1
  101. X        if (lgicmd_len.eq.-1) lgicmd_len = 32
  102. X        defcli_len = index(defcli,' ')-1
  103. X        if (defcli_len.eq.-1) defcli_len = 32
  104. X        tables_len = index(tables,'  ')-1
  105. X        if (tables_len.eq.-1) tables_len = 32
  106. X        password_len = index(password,' ')-1
  107. X        if (password_len.eq.-1) password_len = 12
  108. X        pwd_life_len = index(pwd_lifetime,')')
  109. X        if (pwd_life_len.eq.0.or.pwd_life_len.eq.-1)
  110. X     .   pwd_life_len = 10
  111. X        expir_len = index(exprdate,')')
  112. X        if (expir_len.eq.0.or.expir_len.eq.-1) expir_len = 23
  113. X
  114. X        end
  115. X
  116. XC************************************************************************
  117. X
  118. X        Subroutine BOARD ( owner, tables, defcli, defdev,
  119. X     .   defdir, lgicmd )
  120. XC
  121. XC The purpose of this subroutine is to paste all of the information from
  122. XC the $GETUAI call to the main board and call the selection process.
  123. XC
  124. X        Include 'uaf.cmn'
  125. X        Include '($smgdef)'
  126. X        Character*(*) owner, tables, defcli, defdev, defdir, lgicmd
  127. XC
  128. XC Subroutine STRING_LENGTHS gets the actual length of the strings.
  129. XC
  130. X        call string_lengths ( owner, tables, defcli, defdev,
  131. X     .   defdir, lgicmd )
  132. XC
  133. XC Create the actual displays.
  134. XC
  135. XC The main board:
  136. XC
  137. X        call smg$begin_pasteboard_update ( pasteboard )
  138. X        call smg$put_chars ( main, ' USER PROFILE ', 1, 33 ,,
  139. X     .   smg$m_reverse )
  140. X        call smg$put_chars ( main, 'Username: ', 3, 2 )
  141. X        call smg$put_chars ( main, username(1:username_len), 3, 13 ,,
  142. X     .   smg$m_underline )
  143. X        call smg$put_chars ( main, 'Owner:     ', 3, 37 )
  144. X        call smg$put_chars ( main, owner(1:owner_len), 3, 48 ,,
  145. X     .   smg$m_underline )
  146. X        call smg$put_chars ( main, 'Account:  ', 4, 2 )
  147. X        call smg$put_chars ( main, account(1:account_len),
  148. X     .   4, 13 ,, smg$m_underline )
  149. X        call smg$put_chars ( main, 'UIC:       ', 4, 37 )
  150. X        call smg$put_chars ( main, uic(1:uic_len), 4, 48 ,,
  151. X     .   smg$m_underline )
  152. X        call smg$put_chars ( main, 'CLI:      ', 5, 2 )
  153. X        call smg$put_chars ( main, defcli(1:defcli_len),
  154. X     .   5, 13 ,, smg$m_underline )
  155. X        call smg$put_chars ( main, 'Tables:    ', 5, 37 )
  156. X        call smg$put_chars ( main, tables(1:tables_len),
  157. X     .   5, 48 ,, smg$m_underline )
  158. X        call smg$put_chars ( main, 'Device:   ', 6, 2 )
  159. X        call smg$put_chars ( main, defdev(1:defdev_len),
  160. X     .   6, 13 ,, smg$m_underline )
  161. X        call smg$put_chars ( main, 'Directory: ', 6, 37 )
  162. X        call smg$put_chars ( main, defdir(1:defdir_len),
  163. X     .   6, 48 ,, smg$m_underline )
  164. X        call smg$put_chars ( main, 'LGICMD:   ', 7, 2 )
  165. X        call smg$put_chars ( main, lgicmd(1:lgicmd_len),
  166. X     .   7, 13 ,, smg$m_underline )
  167. X        call smg$put_chars ( main, 'Password:   ', 7, 37 )
  168. X        call smg$put_chars ( main, password(1:password_len),
  169. X     .   7, 48 ,, smg$m_underline )
  170. X        call smg$put_chars ( main, 'Rights Held:   ', 8, 2 )
  171. X        call smg$put_chars ( main, '<F17>', 8, 15 ,, smg$m_bold )
  172. X        call smg$put_chars ( main, 'Pre-expired:   ', 8, 37 )
  173. X        if (index(password_change_date,'0 00:00:00.00') .ne. 0) then
  174. X           call smg$put_chars ( main, 'YES',
  175. X`091                       8, 50 ,, smg$m_underline .or. smg$m_bold )
  176. Xd`09   write (66,*) 'password pre-expired'
  177. X`09else
  178. X           call smg$put_chars ( main, password_change_date(1:),
  179. X`091                       8, 50 ,, smg$m_underline )
  180. Xd`09   write (66,*) 'last pword change: ',password_change_date
  181. X`09endif
  182. X        call smg$put_chars ( main, 'Login Flags: ', 9, 2 )
  183. X        call smg$put_chars ( main, '<PF1>', 9, 15 ,, smg$m_bold )
  184. X        call smg$put_chars ( main, 'Primary and Secondary days: ',
  185. X     .   9, 37 )
  186. X        call smg$put_chars ( main, '<PF2>', 9, 65 ,, smg$m_bold )
  187. X        call smg$put_chars ( main, 'Access restrictions: ', 10, 2 )
  188. X        call smg$put_chars ( main, '<PF3>', 10, 23 ,, smg$m_bold )
  189. X        call smg$put_chars ( main, 'Expiration: ', 10, 37 )
  190. X        call smg$put_chars ( main, exprdate(1:expir_len),
  191. X     .   10, 48 ,, smg$m_underline )
  192. X        call smg$put_chars ( main, 'Pwdminimum: ', 11, 2 )
  193. X        call smg$put_chars ( main, pwd_length_string, 11, 13 ,,
  194. X     .   smg$m_underline )
  195. X        call smg$put_chars ( main, 'Pwlifetime: ', 11, 37 )
  196. X        call smg$put_chars ( main, pwd_lifetime(1:pwd_life_len),
  197. X     .   11, 48 ,, smg$m_underline )
  198. X        call smg$put_chars ( main, 'Maxjobs: ', 13, 2 )
  199. X        call smg$put_chars ( main, maxjobs_string, 13, 16 ,,
  200. X     .   smg$m_underline )
  201. X        call smg$put_chars ( main, 'Fillm: ', 13, 24 )
  202. X        call smg$put_chars ( main, fillm_string, 13, 35 ,,
  203. X     .   smg$m_underline )
  204. X        call smg$put_chars ( main, 'Bytlm: ', 13, 43 )
  205. X        call smg$put_chars ( main, bytlm_string, 13, 56 ,,
  206. X     .   smg$m_underline )
  207. X        call smg$put_chars ( main, 'Maxacctjobs: ', 14, 2 )
  208. X        call smg$put_chars ( main, maxacctjobs_string,
  209. X     .     14, 16 ,, smg$m_underline )
  210. X        call smg$put_chars ( main, 'Shrfillm: ', 14, 24 )
  211. X        call smg$put_chars ( main, shrfillm_string, 14, 35 ,,
  212. X     .   smg$m_underline )
  213. X        call smg$put_chars ( main, 'Pbytlm: ', 14, 43 )
  214. X        call smg$put_chars ( main, pbytlm_string, 14, 56 ,,
  215. X     .   smg$m_underline )
  216. X        call smg$put_chars ( main, 'Maxdetach: ', 15, 2 )
  217. X        call smg$put_chars ( main, maxdetach_string, 15, 16 ,,
  218. X     .   smg$m_underline )
  219. X        call smg$put_chars ( main, 'BIOlm: ', 15, 24 )
  220. X        call smg$put_chars ( main, biolm_string, 15, 35 ,,
  221. X     .   smg$m_underline )
  222. X        call smg$put_chars ( main, 'JTquota ', 15, 43 )
  223. X        call smg$put_chars ( main, jtquota_string, 15, 56 ,,
  224. X     .   smg$m_underline )
  225. X        call smg$put_chars ( main, 'Prclm: ', 16, 2 )
  226. X        call smg$put_chars ( main, prclm_string, 16, 16 ,,
  227. X     .   smg$m_underline )
  228. X        call smg$put_chars ( main, 'DIOlm: ', 16, 24 )
  229. X        call smg$put_chars ( main, diolm_string, 16, 35 ,,
  230. X     .   smg$m_underline )
  231. X        call smg$put_chars ( main, 'WSdef: ', 16, 43 )
  232. X        call smg$put_chars ( main, wsdef_string, 16, 56 ,,
  233. X     .   smg$m_underline )
  234. X        call smg$put_chars ( main, 'Prio: ', 17, 2 )
  235. X        call smg$put_chars ( main, prio_string, 17, 16 ,,
  236. X     .   smg$m_underline )
  237. X        call smg$put_chars ( main, 'ASTlm: ', 17, 24 )
  238. X        call smg$put_chars ( main, astlm_string, 17, 35 ,,
  239. X     .   smg$m_underline )
  240. X        call smg$put_chars ( main, 'WSquo: ', 17, 43 )
  241. X        call smg$put_chars ( main, wsquo_string, 17, 56 ,,
  242. X     .   smg$m_underline )
  243. X        call smg$put_chars ( main, 'Queprio: ', 18, 2 )
  244. X        call smg$put_chars ( main, queprio_string, 18, 16 ,,
  245. X     .   smg$m_underline )
  246. X        call smg$put_chars ( main, 'TQElm: ', 18, 24 )
  247. X        call smg$put_chars ( main, tqelm_string, 18, 35 ,,
  248. X     .   smg$m_underline )
  249. X        call smg$put_chars ( main, 'WSextent: ', 18, 43 )
  250. X        call smg$put_chars ( main, wsextent_string, 18, 56 ,,
  251. X     .   smg$m_underline )
  252. X        call smg$put_chars ( main, 'CPU: ', 19, 2 )
  253. X        call smg$put_chars ( main, cpu_string, 19, 12 ,,
  254. X     .   smg$m_underline )
  255. X        call smg$put_chars ( main, 'Enqlm: ', 19, 24 )
  256. X        call smg$put_chars ( main, enqlm_string, 19, 35 ,,
  257. X     .   smg$m_underline )
  258. X        call smg$put_chars ( main, 'Pgflquo: ', 19, 43 )
  259. X        call smg$put_chars ( main, pgflquo_string, 19, 56 ,,
  260. X     .   smg$m_underline )
  261. X        call smg$put_chars ( main,
  262. X     .   'Authorized and Default privileges: ', 20, 2 )
  263. X        call smg$put_chars ( main, '<PF4>', 20, 37 ,, smg$m_bold )
  264. X        call smg$put_chars ( main, 'Last Logins: ', 21, 2 )
  265. X        call smg$put_chars ( main, '<F18>', 21, 15 ,, smg$m_bold )
  266. XC
  267. XC The message (or help) board:
  268. XC
  269. X        call smg$put_chars ( message,
  270. X     .   'Use arrow keys to move to desired field.', 1, 2 )
  271. X        call smg$put_chars ( message,
  272. X     .   'To enter text: hit INSERT HERE, ENTER, or I followed by text.
  273. X     .                   ', 2, 2 )
  274. X        call smg$put_chars ( message,
  275. X     .   'PF keys: go to another screen. ControlZ: exit program and
  276. X     . save changes.', 3, 2 )
  277. XC
  278. XC Paste the main and message boards to the screen.
  279. XC
  280. X        call smg$paste_virtual_display ( main, pasteboard, 1, 1 )
  281. X        call smg$paste_virtual_display ( message, pasteboard, 22, 1 )
  282. X        call smg$end_pasteboard_update ( pasteboard )
  283. X
  284. X        end
  285. X
  286. XC************************************************************************
  287. X
  288. X        Subroutine SELECT ( owner, tables, defcli, defdev,
  289. X     .   defdir, lgicmd )
  290. XC
  291. XC The purpose of this subroutine is to read a keystroke and perform the
  292. XC function dictated by that keystroke. The arrow keys move the cursor
  293. XC through the various fields. The return key moves the cursor in a
  294. XC downward motion. The PF keys change the display to an alternate screen.
  295. XC The 'Insert Here' key, or the keypad 'Enter' key, places the screen in
  296. XC edit mode for entering data (terminated by the return key, or any of the
  297. XC arrow keys). CtrlZ exits the program. CtrlW repaints the screen. The
  298. XC Unix 'hjkl' scheme is also implemented for those accustomed to
  299. XC the ease of using those keys for cursor movement.
  300. XC
  301. X        Include 'uaf.cmn'
  302. X        Include '($smgdef)'
  303. X        Include '($trmdef)'
  304. X        Integer*4 cur_row, cur_column, string_len, term_addr
  305. X        Integer*4 dummy_string_length, modifiers, num_str_len
  306. X        Character*30 string, dummy_string
  307. X        Character*6 num_str
  308. X        Character*(*) owner, tables, defcli, defdev, defdir, lgicmd
  309. XC
  310. XC Set up a structure for the string terminator mask. This is done
  311. XC so that hitting an up_arrow, down_arrow, right_arrow, left_arrow,
  312. XC or carriage return will cause the string read to terminate.
  313. XC
  314. X        Structure /Trm/
  315. X           Union
  316. X              Map
  317. X                 Integer*2 blank
  318. X                 Integer*2 size
  319. X                 Integer*4 addr
  320. X              End map
  321. X           End union
  322. X        End structure
  323. X
  324. X        Record /Trm/ Term_set(1)
  325. X
  326. X        Term_set(1).blank = 0
  327. X        Term_set(1).size = 32
  328. X        Term_set(1).addr = %loc(term_addr)
  329. XC
  330. XC This is the mask for the string terminator
  331. XC
  332. X        term_addr = smg$k_trm_up.or.smg$k_trm_down.or.
  333. X     .   smg$k_trm_right.or.smg$k_trm_left.or.smg$k_trm_cr.or.
  334. X     .   smg$k_trm_ctrlm
  335. XC
  336. XC This is the mask for the terminator modifiers
  337. XC
  338. X        modifiers = trm$m_tm_norecall.or.trm$m_tm_noedit
  339. XC
  340. XC Declare the current row and column.
  341. XC
  342. X        cur_row = 3
  343. X        cur_column = 13
  344. XC
  345. XC Set the cursor to the current row and column.
  346. XC
  347. X        call smg$set_cursor_abs ( main, cur_row, cur_column )
  348. XC
  349. XC Read a keystroke and make a decision based on which key is hit.
  350. XC
  351. X10      call smg$read_keystroke ( keyboard, term )
  352. XC
  353. XC PF1 - subroutine SHOW_FLAGS
  354. XC
  355. X        if (term.eq.smg$k_trm_pf1) then
  356. X           call smg$unpaste_virtual_display ( main, pasteboard )
  357. X           call show_flags ( owner, tables, defcli, defdev,
  358. X     .      defdir, lgicmd )
  359. X           call board ( owner, tables, defcli, defdev,
  360. X     .      defdir, lgicmd )
  361. X           call smg$set_cursor_abs ( main, cur_row, cur_column )
  362. XC
  363. XC PF2 - subroutine SHOW_DAYS
  364. XC
  365. X        elseif (term.eq.smg$k_trm_pf2) then
  366. X           call smg$unpaste_virtual_display ( main, pasteboard )
  367. X           call show_days ( owner, tables, defcli, defdev,
  368. X     .      defdir, lgicmd )
  369. X           call board ( owner, tables, defcli, defdev,
  370. X     .      defdir, lgicmd )
  371. +-+-+-+-+-+-+-+-  END  OF PART 5 +-+-+-+-+-+-+-+-
  372. -- 
  373. \/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/
  374. < Joe Koffley                        KOFFLEY@NRLVAX.NRL.NAVY.MIL             >
  375. < Naval Research Laboratory          KOFFLEY@CCF.NRL.NAVY.MIL                >
  376. < Space Systems Division             AT&T  :  202-767-0894                   >
  377. \/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/
  378.