$! ACCT_REMUSER.COM
$! 
$! Author: L Baldwin 10-Jun-93
$! Desc:
$!	Command procedure to remove and existing user account
$ on controly then goto bad_message
$ SET NOON
$ UAF_DSK_REC = 117
$ UAF_DSK_LEN = 31
$ UAF_DIR_REC = 149
$ UAF_DIR_LEN = 63
$ DIR_NOT_EMPTY = %X109311F0
$ @TASM$COM:TASM_MENUSYM		! Get common symbols
$MAIN_MENU:
$!
$!  on warning then goto cleanup
$ prevpriv = f$setprv("SYSPRV")
$ if .not. f$priv("SYSPRV") then goto nopriv
$GET_USERNAME:
$ say ""
$ inquire username "Username to delete"
$ if username .eqs. "" then goto GET_USERNAME
$!
$!
$! Open SYSUAF.DAT, see if user exists,
$!	extract disk and directory name delete him
$!
$ if f$trnlnm("SYSUAF") .eqs. ""
$ then
$ 	open/read/share=write inp SYS$SYSTEM:SYSUAF.DAT
$ else
$	open/read/share=write inp SYSUAF
$ endif
$!
$ read/key='username'/error=NO_USER inp line
$ close inp
$ username_fnd = f$extract(4,12,line)
$ username_fnd = f$edit(username_fnd,"COLLAPSE")
$ if username_fnd .nes. username then goto NO_USER
$ dsk = f$extract(UAF_DSK_REC,UAF_DSK_LEN,line)
$ dsk = f$edit(dsk,"COLLAPSE")
$ dir = f$extract(UAF_DIR_REC,UAF_DIR_LEN,line)
$ dir = f$edit(dir,"COLLAPSE")
$ del_spec = dsk+dir-"]"+"...]*.*;*"
$ dir_spec = dir-"["-"]"
$ if f$search("''dsk'[000000]''dir_spec'.dir") .eqs. ""
$ then
$   SAY "The directory for that user does not exist and thus can"
$   SAY "not be deleted.  Perhaps the directory has already been deleted."
$   SAY " "
$   inquire/nopun dummy "Press <Return> to Continue."
$   goto NO_DEL_DIR
$ endif
$!
$ inquire ques "Are you Sure you want to archive ''del_spec' (Y/N)" 
$ ques = f$edit(ques,"UPCASE")
$ if ques .nes. "Y" then exit
$! Archive files to TASM$ARCHIVE and delete directory tree
$ backup/delete/log 'del_spec' TASM$ARCHIVE:'username'.SAV/SAVE_SET
$ if $severity .ne. 2 then goto DELETE_IT
$ say "An error occurred trying to archive account, aborting."
$ goto DONE
$DELETE_IT:
$ set message/nof/noi/nos/not			! Turn msgs off
$ delete/log 'del_spec'
$ if $status .eq. DIR_NOT_EMPTY then goto DELETE_IT
$ set message/f/i/s/t				! Turn msgs on
$!
$ on warning then continue
$ delete/conf 'dsk'[000000]'dir_spec'.dir;
$ SAY "Home directory for ''username' has been deleted."
$ SAY " "
$NO_DEL_DIR:
$ inquire ques -
  "Are you Sure you want to remove the account ''username' (Y/N)"
$ ques = f$edit(ques,"UPCASE")
$ if ques .nes. "Y" then exit
$ uaf remove 'username'
$ SAY "The account, ''username', has been completely removed."
$ goto DONE
$bad_message:
$ say ""
$ say "Program halted by control_y, account has not yet been deleted."
$ say ""
$ goto cleanup
$nopriv:
$ say "You need SETPRV or SYSPRV privilege to run this procedure"
$ goto cleanup
$NO_USER:
$ SAY "The account ''username' does not exist."
$ inquire/nopun dummy "Press <Return> to Continue."
$CLEANUP:
$DONE: