[comp.os.vms] Updating VMSMAIL

rlb@rtpark.rtp.ge.COM (Bob Boyd 8*565-3627 17-Dec-1987 1151) (12/18/87)

We have incorporated calls to our customized copy of MAILUAF.COM in our
ADDUSER and REMOVE_USER procedures.  

Since the original is DEC supplied DCL code, I am only 
distributing our edits to that code.

I will ship the procedure used to build this kit under separate cover.
You may find it useful for putting things on DECUS tapes or distribution
over the Internetwork.

If you have any questions, contact me at one of these addresses:

-----------------------------------------------------------------
 Bob Boyd                     Usenet:    rlb@rtpark.rtp.ge.com
 GE Microelectronics Ctr.     Voice:     (919)549-3627
 POB 13049, MS 7T3-01         GE DIALCOMM:  8*565-3627
 RTP, NC 27709-3049           GE DECnet: RTPARK::RLB

....................... Cut between dotted lines and save ......................
$!..............................................................................
$! VAX/VMS archive file created by VMS_SHAR V-5.01 01-Oct-1987
$! which was written by Michael Bednarek (U3369429@ucsvc.dn.mu.oz.au)
$! To unpack, simply save and execute (@) this file.
$!
$! This archive was created by RLB
$! on Thursday 17-DEC-1987 11:31:42.38
$!
$! ATTENTION: To keep each article below 15872 bytes, this program
$! has been transmitted in 2 parts.
$! You should concatenate ALL parts to ONE file and execute (@) that file.
$!
$! It contains the following 1 file:
$! MAILUAF.PACKAGE
$!==============================================================================
$ Set Symbol/Scope=(NoLocal,NoGlobal)
$ Version=F$GetSYI("VERSION") ! See what VMS version we have here:
$ If Version.ges."V4.4" then goto Version_OK
$ Write SYS$Output "Sorry, you are running VMS ",Version, -
                ", but this procedure requires V4.4 or higher."
$ Exit 44
$Version_OK: CR[0,8]=13
$ Pass_or_Failed="failed!,passed."
$ Goto Start
$Convert_File:
$ Read/Time_Out=0/Error=No_Error1/Prompt="creating ''File_is'" SYS$Command ddd
$No_Error1: Define/User_Mode SYS$Output NL:
$ Edit/TPU/NoSection/NoDisplay/Command=SYS$Input/Output='File_is' -
        VMS_SHAR_DUMMY.DUMMY
f:=Get_Info(Command_Line,"File_Name");b:=Create_Buffer("",f);
o:=Get_Info(Command_Line,"Output_File");Set(Output_File,b,o);
Position(Beginning_of(b));Loop x:=Erase_Character(1);Loop ExitIf x<>"V";
Move_Vertical(1);x:=Erase_Character(1);Append_Line;
Move_Horizontal(-Current_Offset);EndLoop;Move_Vertical(1);
ExitIf Mark(None)=End_of(b) EndLoop;Position(Beginning_of(b));Loop
x:=Search("`",Forward,Exact);ExitIf x=0;Position(x);Erase_Character(1);
If Current_Character='`' then Move_Horizontal(1);else
Copy_Text(ASCII(INT(Erase_Character(3))));EndIf;EndLoop;Exit;
$ Delete VMS_SHAR_DUMMY.DUMMY;*
$ Checksum 'File_is
$ Success=F$Element(Check_Sum_is.eq.CHECKSUM$CHECKSUM,",",Pass_or_Failed)+CR
$ Read/Time_Out=0/Error=No_Error2/Prompt=" CHECKSUM ''Success'" SYS$Command ddd
$No_Error2: Return
$Start:
$ Goto Part2
$Part2:
$ File_is="MAILUAF.PACKAGE"
$ Check_Sum_is=923495456
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
V$! Procedure to convert SYS$EXAMPLES:MAILUAF.COM to SYS$COMMON:[SYSMGR.UAF]MAIL
XUAF.COM;
X$! p1 -- output file name
X$!
X$! Execute this file with @<file> <target_filename>
X$! generated by RLB          at 17-DEC-1987 11:31:38.64
X$!
X$ set noon
X$ if p1.eqs."" then inquire p1 "Output file name"
X$ write sys$Output "Updating SYS$EXAMPLES:MAILUAF.COM to produce ",p1,"
X$ edit/sum SYS$EXAMPLES:MAILUAF.COM/update=sys$Input:/output='p1'
X$ DECK/dollars="$*EOD*SUM"
X-    1,   34
X$ vfl = f$VERIFY(0+f$TRNLNM("debug$dcl"))
X$! documentation at the end of this mess
X$ on control_y then $ goto DONE
X$ on error then $ goto DONE
X$ status = $status
X$ if = "IF"
X$ null = ""
X$ at = "@"
X$ b = " "
X$ eql = "="
X$ remove_options = "#NOUSER"
X$ command_set = "#ADD#CANCEL#LIST#MODIFY#REMOVE#SHOW#HELP#EXIT#VERIFY"
X$ modify_options = "#DIRECTORY#FORWARD#PERSONAL_NAME"
X$ inquire = "INQUIRE"
X$! format:
X$!  USERNAME...flags...
X$!`009mail_dir_len/personal_name_len/forward_addr_len/
X$!`009[forward_address/][personal_name/][mail_directory]
X$ user_len = 31
X$ user_len_bits = 8*user_len
X$ message_cnt_ptr = 2+user_len
X$ message_cnt_bits = 8*message_cnt_ptr
X$ addr_max = 255
X$ addr_ptr = 68
X$ addr_len_ptr = 67
X$ addr_len_bits = addr_len_ptr*8
X$ pnm_len_ptr = 66
X$ pnm_len_bits = pnm_len_ptr*8
X$ dir_len_ptr = 65
X$ dir_len_bits = 8*dir_len_ptr
X-   43,  116
X$ mail_list = 0
X$ get = "read sys$command/prompt="
X$ ask = "inquire/nopunctuation"
X$ say = "write sys$output"
X$ prev_priv = f$SETPRV("SYSPRV")
X$ sysmai = f$PARSE("vmsmail","sys$system:vmsmail.dat")
X$ line = p1+b+p2+b+p3+b+p4+b+p5+b+p6+b+p7+b+p8
X$ line=f$EDIT(line,"trim,uncomment,compress")
X$!
X$! if parameters are supplied we'll execute once - straight thru - no questions
X$!
X$ once_flag = line.nes.null
X$ open /share=write /read /write /error=NO_FILE f1 'sysmai'
X$FILE_OPEN:
X$ if once_flag then $ goto GOT_LINE
X$ on control_y then goto DONE
X$!
X$! Main loop.  Get command and username then dispatch
X$!
X$DO_COMMAND:
X$ if .not.mail_list then $ goto NEXT_COMMAND
X$ gosub USER_READ
X$ if .$status then -
X$`009goto USER_DO
X$NEXT_COMMAND:
X$ if once_flag then $ goto DONE
X$ get "MAILUAF> " line
X$GOT_LINE:
X$ line=f$EDIT(line,"trim,uncomment,compress")
X$ if line .eqs. null then goto DONE
X$ command = f$ELEMENT(0," ",line)
X$ user = f$ELEMENT(1," ",line)
X$ mail_list = 0
X$ check_val = command
X$ check_set = command_set
X$ gosub in_set
X$ status = $status
X$ if .not.$status then $ goto COMMAND_ERROR
X$ if check_val.eqs."LIST" then $ goto LIST_USERS
X$ if check_val.eqs."EXIT" then $ goto DONE
X$ if check_val.eqs."HELP" then $ goto HELP_USER
X$ if user .eqs. null then goto SYNTAXERR
X$ fulluser[0,'user_len']:='user'
X$ if f$LOC(at,user).eq.0 then $ gosub USER_OPEN
X$USER_DO:
X$ goto 'check_val'_USER
X$COMMAND_ERROR:
X$ say "MAILUAF-E-INVCOMMND, invalid command: ",command
X$ goto HELP_USER
X$VERIFY_USER:
X$ vfl = f$verify(1-vfl)
X$ goto DO_COMMAND
X$ADD_USER:
X$ read /index=0 /err=ADD_10 /key="''fulluser'" f1 record
X$ status = %X000184ec ! rms-duprec
X$ say "User ",user," record already exists"
X$ say "Use REMOVE first, or MODIFY instead of ADD"
X$ goto DO_COMMAND
X$ADD_10:
X$ address = null
X$ if f$type(record).nes.null then $ delete/symbol record
X$ record[0,'user_len']:='user'
X$ record['user_len_bits',288]=0
X$ if .not.once_flag then $ get "Forwarding address? " address
X$ t1 = f$LENGTH(address)
X$ record['addr_len_bits',8]='t1'
X$ record['addr_ptr','t1']:='address'
X$ write f1 record
X$ say "Added MAILUAF entry for ",user," @ ",f$time()
X$! see if they added name, forward, or directory
X$ goto MODIFY_USER
X$CANCEL_USER:
X$ gosub DISPLAY_USER
X$ status = $status
X$ if .not.$status then $ goto DO_COMMAND
X$ t2 = f$LENGTH(address)
X$ t2 = t2 - 'addr_length'
X$ if addr_length .eq. 0 then goto DO_COMMAND
X$ if once_flag then $ goto CANCEL_DO
X$ get "Cancel mail forwarding? " yn
X$ if .not. yn then goto DO_COMMAND
X$CANCEL_DO:
X$ record['addr_len_bits',8]=0
V$ record['addr_ptr','addr_max'] := "''f$EXTRACT(addr_ptr+addr_length,addr_max-a
Xddr_length,record)'"
X$ record = f$EXTRACT(0,addr_ptr+'t2',record)
X$ write /update f1 record
X$ say "Cancelled mail forwarding for ",user," @ ",f$time()
X$ goto DO_COMMAND
X$LIST_USERS:
X$ close f1
X$ if f$VER() then $ show symbol line
X$ rem_flag = f$LOC(user,"REMOVE").eq.0
X$ comp_flag = rem_flag .or. (f$LOC(user,"NOUSER").eq.0)
X$ list_fmt = "!''user_len'AS !AS"
X$ open /share=write /read /write f1 'sysmai'
X$ sysuaf = f$PARSE("sysuaf","sys$system:sysuaf.dat")
X$ if comp_flag then $ open/share=write/read f2 'sysuaf'
X$ say null
X$ say f$FAO(list_fmt,"Username","Forwarding address")
X$ say f$FAO(list_fmt,"--------","------------------")
X$LIST_10:
X$ read/nolock /end=DO_COMMAND f1 record
X$ user = f$EXTRACT(0,user_len,record)
X$ addr_length = f$CVUI(addr_len*8,8,record)
X$ address = f$EXTRACT(addr_ptr,addr_max,record)
X$ address = f$EDIT(address,"trim")
X$ address = f$EXTRACT(0,addr_length,address)
X$ if .not. comp_flag then $ goto LIST_20 ! see if it is in sysuaf
X$ trim_user = f$EDIT(user,"trim,compress,upcase")
X$ read/index=0/key="''trim_user'" f2/error=LIST_15 sysuaf_rec/nolock/time=5
X$ goto LIST_10 ! it is so skip this one
X$LIST_15:
X$ if (.not.rem_flag) .or. (addr_length.gt.0) then $ goto LIST_20
X$ if f$EDIT(address,"trim").nes.null then $ goto LIST_20
X$ read /index=0 /err=LIST_10/DELETE /key="''user'" f1 record
X$ say "Removed ",user
X$LIST_20:
X$ say f$FAO(list_fmt,user,address)
X$ goto LIST_10
X$!
X$MODIFY_USER:
X$! options:`009directory=<dir_spec>
X$! `009`009forward=<forward_address>
X$!`009`009personal_name=<name string>
X$ directory_flag = 0
X$ forward_flag = 0
X$ personal_name_flag = 0
X$ check_set = modify_options
X$ par_cnt = 2
X$MODIFY_LOOP:
X$ option = f$element(par_cnt,b,line)
X$ if par_cnt.eq.2 .and. option.eqs.b .and. once_flag then $ goto MODIFY_NOPAR
X$ if option.eqs.b  then $ goto MODIFY_END
X$ par_cnt = 1+par_cnt
X$ if option.eqs."" then $ goto MODIFY_LOOP
X$ check_val = f$element(0,eql,option)
X$ gosub IN_SET
X$ status = $status
X$ if .not.$status then $ goto MODIFY_ERROR
X$ 'check_val'_flag = 1
X$ 'check_val'_val = f$element(1,eql,option)
X$ goto MODIFY_LOOP
X$MODIFY_END:
X$MODIFY_PROCESS:
X$  gosub GET_USER_RECORD
X$! put code here to handle updating based on flags
X$ if once_flag then $ goto MODIFY_DO
X$
X$ if.not.forward_flag then -
X$`009get "New forwarding address? " forward_val
X$ forward_flag = forward_val.nes.null
X$ if.not.directory_flag then -
X$`009get "New MAIL subdirectory? " directory_val
X$ directory_flag = directory_val.nes.null
X$ if.not.personal_name_flag then -
X$`009get "New personal name ? " personal_name_val
X$ personal_name_flag = personal_name_val.nes.null
X$MODIFY_DO:
X$ if .not.(forward_flag .or. directory_flag .or. personal_name_flag) then -
X$`009goto DO_COMMAND
X$MODIFY_ADDRESS:
X$ if .not.forward_flag then $ goto MODIFY_PERSONAL_NAME
X$ address = f$EXTRACT(addr_length,t2-addr_length,forward_val)
X$ t1 = f$LENGTH(forward_val)
X$ addr_length=t1
X$ record['addr_len_bits',8]='t1'
X$ record['addr_ptr','addr_max']:="''forward_val'''address'"
X$ record = f$EXTRACT(0,addr_ptr+t1+t2,record)
X$MODIFY_PERSONAL_NAME:
X$ personal_name_ptr = addr_ptr+addr_length
X$ personal_name_len = 0
X$ if .not.personal_name_flag then $ goto MODIFY_DIRECTORY
X$ personal_name_len = f$length(personal_name_val)
X$ record['pnm_len_bits',8]='personal_name_len'
X$ record['personal_name_ptr','personal_name_len']:="''personal_name_val'"
X$MODIFY_DIRECTORY:
X$ directory_ptr = personal_name_ptr+personal_name_len
X$ if .not.directory_flag then $ goto MODIFY_WRITE
X$ t1 = f$length(directory_val)
X$ record['dir_len_bits',8]='t1'
X$ record['directory_ptr','t1']:="''directory_val'"
X$MODIFY_WRITE:
X$ write /update f1 record
X$ say "MAILUAF-I-MOD, Modified User ",user," @ ",f$time()
X$ gosub DISPLAY_USER
X$ goto DO_COMMAND
X$MODIFY_NOPAR:
X$ if command.nes."MODIFY" then $ goto DO_COMMAND
X$ status = %X00038150 ! missing required value
X$ say "MAILUAF-F-MISSINGPAR, missing modify parameters"
X$ goto DO_COMMAND
X$MODIFY_ERROR:
X$ status = %X00038240 ! DCL- UNREC qualifiers
X$ say "MAILUAF-E-INVMODIFY, invalid modify command(s): ",line
X$ goto DO_COMMAND
X$REMOVE_USER:
X$ gosub DISPLAY_USER
X$ status = $status
X$ if .not.status then $ goto DO_COMMAND
X$ if once_flag then $ goto REMOVE_IT
X$ ask yn "Remove? "
X$ if .not. yn then goto DO_COMMAND
X$REMOVE_IT:
X$ read/err=DO_COMMAND /index=0/key="''fulluser'" /delete f1 record
X$ say "Removed MAIL record for ",user," @ ",f$time()
X$ goto DO_COMMAND
X$SHOW_USER:
X$ say "MAILUAF-I-TIME, ",f$time()
X$ gosub DISPLAY_USER
X$ status = $status
X$ goto DO_COMMAND
X$SYNTAXERR:
X$ status = %X00038150 ! missing required value
X$ say "Command syntax error"
X$ goto DO_COMMAND
X$DONE:
X$EXIT:
X$ if .not.$status then $ status = $status
X$ if f$TRNLNM("f1","lnm$process").nes.null then $ close f1
X$ if f$TRNLNM("f2","lnm$process").nes.null then $ close f2
X$ prev_priv = f$SETPRV(prev_priv)+f$VER(vfl)
X$ exit status
X$!
X$! Subroutine section
X$!
X$USER_OPEN:
X$ user_file = f$EXTRACT(1,999,user)
X$ if f$TRNLNM("user_file","lnm$process").eqs.null then -
X$`009open/read/share=read/error=USER_END user_file 'user_file'
X$ mail_list = 1
X$USER_READ:
X$ read/end=USER_END/err=USER_END user_file user
X$ fulluser[0,'user_len']:= 'user'
X$ if fulluser.eqs.null then $ goto USER_READ
X$ return
X$USER_END:
X$ status = $status
X$ mail_list = 0
X$ if f$TRNLNM("user_file","lnm$process").nes.null then $ close user_file
X$ return status
X$!
X$GET_USER_RECORD:
X$ no_display = 1
X$ goto DISP_READ_USER
X$DISPLAY_USER:
X$ no_display = 0
X$DISP_READ_USER:
X$ read /index=0 /err=DISP_NOSUCHUSER /key="''fulluser'" f1 record
X$! if f$ver() then $ write sys$output/symbol record
X$ message_cnt = f$cvui(message_cnt_ptr*8,8,record)
X$ addr_length = f$CVUI(addr_len_ptr*8,8,record)
X$ address = f$EXTRACT(addr_ptr,addr_max,record)
X$ naddress = f$EXTRACT(0,addr_length,address)
X$ personal_name_len=f$CVUI(pnm_len_ptr*8,8,record)
X$ dir_len=f$CVUI(dir_len_ptr*8,8,record)
X$ personal_name_ptr = addr_ptr+addr_length
X$ directory_ptr = personal_name_ptr+personal_name_len
X$ address = f$edit(address,"trim,compress")
X$ full_name = f$EXTRACT(personal_name_ptr,personal_name_len,record)
X$ dir_spec  = f$EXTRACT(directory_ptr,dir_len,record)
X$ t2 = f$LENGTH(address)
X$ if no_display then $ return
X$ addr_mess = "User "+user+" does not have forwarding enabled"
X$ if addr_length .ne. 0 then -
X$`009addr_mess = "Current forwarding address is: "+naddress
X$ dir_mess = "User "+user+" does not have a mail directory set"
X$ if dir_len.ne. 0 then -
X$`009dir_mess = "Current mail directory: "+dir_spec
X$ name_mess = "User "+user+" does not have a personal name set"
X$ if personal_name_len.ne. 0 then -
X$`009name_mess = "Current personal name: "+full_name
X$ say name_mess
X$ say dir_mess
X$ say addr_mess
X$ say f$fao("with !UL unread messages.",message_cnt)
X$ return
X$DISP_NOSUCHUSER:
X$ status = $status
X$ say  "MAILUAF-E-NOSUCHUSER, User ",user," record does not exist"
X$ return status
X$!
X$IN_SET:  ! see if check_val is in check_set
X$  n = 1 + f$LOCATE("#"+f$EDIT(check_val,"UPCASE,TRIM"), -
X`009f$EDIT(check_set,"UPCASE,TRIM") )
X$  if n .gt. f$LENGTH(check_set) then $ return %X08040000
X$  check_val = f$ELEMENT(0,"#",f$EXTRACT(n,999,check_set))
X$  return
X$!
X$HELP_USER:
X-  128,  253
X$ goto DO_COMMAND
X$!
X$NO_FILE:
X$ say sysmai," not found...creating new file"
X$ create /fdl=sys$input 'sysmai'`009!Create new VMSMAIL.DAT
XIDENT`009VMS MAIL Information data file
X
XFILE
X`009ALLOCATION              10
X`009BEST_TRY_CONTIGUOUS     yes
X`009BUCKET_SIZE             2
X`009CONTIGUOUS              no
X`009EXTENSION               10
X`009GLOBAL_BUFFER_COUNT     0
X`009ORGANIZATION            indexed
X`009OWNER                   [001,004]
X`009PROTECTION              (system:RWE, owner:RWE, group:, world:)
X
XRECORD
X`009BLOCK_SPAN              yes
X`009CARRIAGE_CONTROL        none
X`009FORMAT                  variable
X`009SIZE                    0
X
XAREA 0
X`009ALLOCATION              10
X`009BEST_TRY_CONTIGUOUS     yes
X`009BUCKET_SIZE             2
X`009CONTIGUOUS              no
X`009EXTENSION               10
X
XKEY 0
X`009CHANGES                 no
X`009DATA_KEY_COMPRESSION    yes
X`009DATA_RECORD_COMPRESSION yes
X`009DATA_AREA               0
X`009DATA_FILL               100
X`009DUPLICATES              no
X`009INDEX_AREA              0
X`009INDEX_COMPRESSION       yes
X`009INDEX_FILL              100
X`009LEVEL1_INDEX_AREA       0
X`009NULL_KEY                no
X`009PROLOGUE                3
X`009SEG0_LENGTH             31
X`009SEG0_POSITION           0
X`009TYPE                    string
X$ open /share=read /read /write f1 'sysmai'
X$ goto FILE_OPEN
X$!++
X$!
X$!  MAILUAF.COM - Modify SYS$SYSTEM:VMSMAIL.DAT
X$!
X$!
X$!  ABSTRACT:`009Sample command procedure to modify
X$!`009`009VMSMAIL.DAT file. Default location is SYS$SYSTEM
X$!`009`009but can be altered by defining/system/exec VMSMAIL <your_file>
X$!
X$!`009`009This command procedure will prompt
X$!`009`009the user for a command.  The valid
X$!`009`009commands are:
X$!
X$!`009`009ADD username`009- Add a new user to VMSMAIL
X$!`009`009CANCEL username - Cancel mail forwarding for username
X$!`009`009EXIT`009`009- Exit from this procedure
X$!`009`009HELP`009`009- Type help message
X$!`009`009MODIFY username - Modify mail forwarding address for username
X$!`009`009`009forward="string" directory=[.dir]
X$!`009`009`009personal_name="string"
X$!`009`009example
X$!  @MAILUAF MODIFY bambi dir=[.forest] forw="nm%THUMPER" Per="Twitterpated!"
X$!
X$!`009`009REMOVE username - Remove username from VMSMAIL
X$!`009`009REMOVE NOUSER`009- remove MAIL users not in SYSUAF
X$!`009`009`009`009  that do not have a forwarding address
X$!`009`009SHOW username `009- Display mail information about username
X$!`009`009LIST`009`009- List forwarding addresses for all users
X$!
X$!
X$!  REQUIRED PRIVILEGES:
X$!`009`009BYPASS
X$!
X$!`009`009
X$!  IMPLICIT OUTPUT:
X$!`009`009SYS$SYSTEM:VMSMAIL.DAT will be created if it does
X$!`009`009not exsist.
X$!
X$!
X$!--
X$!Last Modified:  17-DEC-1987 11:31:04.51, By: RLB
X/
X$*EOD*SUM
X$ write sys$output "Completed Conversion"
$ GoSub Convert_File
$ Exit

rlb@rtpark.rtp.ge.COM (Bob Boyd 8*565-3627 17-Dec-1987 1159) (12/18/87)

----------------------------------cut here and append to part 1 ---------------
$Part2:
$ File_is="MAILUAF.PACKAGE"
$ Check_Sum_is=923495456
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
V$! Procedure to convert SYS$EXAMPLES:MAILUAF.COM to SYS$COMMON:[SYSMGR.UAF]MAIL
XUAF.COM;
X$! p1 -- output file name
X$!
X$! Execute this file with @<file> <target_filename>
X$! generated by RLB          at 17-DEC-1987 11:31:38.64
X$!
X$ set noon
X$ if p1.eqs."" then inquire p1 "Output file name"
X$ write sys$Output "Updating SYS$EXAMPLES:MAILUAF.COM to produce ",p1,"
X$ edit/sum SYS$EXAMPLES:MAILUAF.COM/update=sys$Input:/output='p1'
X$ DECK/dollars="$*EOD*SUM"
X-    1,   34
X$ vfl = f$VERIFY(0+f$TRNLNM("debug$dcl"))
X$! documentation at the end of this mess
X$ on control_y then $ goto DONE
X$ on error then $ goto DONE
X$ status = $status
X$ if = "IF"
X$ null = ""
X$ at = "@"
X$ b = " "
X$ eql = "="
X$ remove_options = "#NOUSER"
X$ command_set = "#ADD#CANCEL#LIST#MODIFY#REMOVE#SHOW#HELP#EXIT#VERIFY"
X$ modify_options = "#DIRECTORY#FORWARD#PERSONAL_NAME"
X$ inquire = "INQUIRE"
X$! format:
X$!  USERNAME...flags...
X$!`009mail_dir_len/personal_name_len/forward_addr_len/
X$!`009[forward_address/][personal_name/][mail_directory]
X$ user_len = 31
X$ user_len_bits = 8*user_len
X$ message_cnt_ptr = 2+user_len
X$ message_cnt_bits = 8*message_cnt_ptr
X$ addr_max = 255
X$ addr_ptr = 68
X$ addr_len_ptr = 67
X$ addr_len_bits = addr_len_ptr*8
X$ pnm_len_ptr = 66
X$ pnm_len_bits = pnm_len_ptr*8
X$ dir_len_ptr = 65
X$ dir_len_bits = 8*dir_len_ptr
X-   43,  116
X$ mail_list = 0
X$ get = "read sys$command/prompt="
X$ ask = "inquire/nopunctuation"
X$ say = "write sys$output"
X$ prev_priv = f$SETPRV("SYSPRV")
X$ sysmai = f$PARSE("vmsmail","sys$system:vmsmail.dat")
X$ line = p1+b+p2+b+p3+b+p4+b+p5+b+p6+b+p7+b+p8
X$ line=f$EDIT(line,"trim,uncomment,compress")
X$!
X$! if parameters are supplied we'll execute once - straight thru - no questions
X$!
X$ once_flag = line.nes.null
X$ open /share=write /read /write /error=NO_FILE f1 'sysmai'
X$FILE_OPEN:
X$ if once_flag then $ goto GOT_LINE
X$ on control_y then goto DONE
X$!
X$! Main loop.  Get command and username then dispatch
X$!
X$DO_COMMAND:
X$ if .not.mail_list then $ goto NEXT_COMMAND
X$ gosub USER_READ
X$ if .$status then -
X$`009goto USER_DO
X$NEXT_COMMAND:
X$ if once_flag then $ goto DONE
X$ get "MAILUAF> " line
X$GOT_LINE:
X$ line=f$EDIT(line,"trim,uncomment,compress")
X$ if line .eqs. null then goto DONE
X$ command = f$ELEMENT(0," ",line)
X$ user = f$ELEMENT(1," ",line)
X$ mail_list = 0
X$ check_val = command
X$ check_set = command_set
X$ gosub in_set
X$ status = $status
X$ if .not.$status then $ goto COMMAND_ERROR
X$ if check_val.eqs."LIST" then $ goto LIST_USERS
X$ if check_val.eqs."EXIT" then $ goto DONE
X$ if check_val.eqs."HELP" then $ goto HELP_USER
X$ if user .eqs. null then goto SYNTAXERR
X$ fulluser[0,'user_len']:='user'
X$ if f$LOC(at,user).eq.0 then $ gosub USER_OPEN
X$USER_DO:
X$ goto 'check_val'_USER
X$COMMAND_ERROR:
X$ say "MAILUAF-E-INVCOMMND, invalid command: ",command
X$ goto HELP_USER
X$VERIFY_USER:
X$ vfl = f$verify(1-vfl)
X$ goto DO_COMMAND
X$ADD_USER:
X$ read /index=0 /err=ADD_10 /key="''fulluser'" f1 record
X$ status = %X000184ec ! rms-duprec
X$ say "User ",user," record already exists"
X$ say "Use REMOVE first, or MODIFY instead of ADD"
X$ goto DO_COMMAND
X$ADD_10:
X$ address = null
X$ if f$type(record).nes.null then $ delete/symbol record
X$ record[0,'user_len']:='user'
X$ record['user_len_bits',288]=0
X$ if .not.once_flag then $ get "Forwarding address? " address
X$ t1 = f$LENGTH(address)
X$ record['addr_len_bits',8]='t1'
X$ record['addr_ptr','t1']:='address'
X$ write f1 record
X$ say "Added MAILUAF entry for ",user," @ ",f$time()
X$! see if they added name, forward, or directory
X$ goto MODIFY_USER
X$CANCEL_USER:
X$ gosub DISPLAY_USER
X$ status = $status
X$ if .not.$status then $ goto DO_COMMAND
X$ t2 = f$LENGTH(address)
X$ t2 = t2 - 'addr_length'
X$ if addr_length .eq. 0 then goto DO_COMMAND
X$ if once_flag then $ goto CANCEL_DO
X$ get "Cancel mail forwarding? " yn
X$ if .not. yn then goto DO_COMMAND
X$CANCEL_DO:
X$ record['addr_len_bits',8]=0
V$ record['addr_ptr','addr_max'] := "''f$EXTRACT(addr_ptr+addr_length,addr_max-a
Xddr_length,record)'"
X$ record = f$EXTRACT(0,addr_ptr+'t2',record)
X$ write /update f1 record
X$ say "Cancelled mail forwarding for ",user," @ ",f$time()
X$ goto DO_COMMAND
X$LIST_USERS:
X$ close f1
X$ if f$VER() then $ show symbol line
X$ rem_flag = f$LOC(user,"REMOVE").eq.0
X$ comp_flag = rem_flag .or. (f$LOC(user,"NOUSER").eq.0)
X$ list_fmt = "!''user_len'AS !AS"
X$ open /share=write /read /write f1 'sysmai'
X$ sysuaf = f$PARSE("sysuaf","sys$system:sysuaf.dat")
X$ if comp_flag then $ open/share=write/read f2 'sysuaf'
X$ say null
X$ say f$FAO(list_fmt,"Username","Forwarding address")
X$ say f$FAO(list_fmt,"--------","------------------")
X$LIST_10:
X$ read/nolock /end=DO_COMMAND f1 record
X$ user = f$EXTRACT(0,user_len,record)
X$ addr_length = f$CVUI(addr_len*8,8,record)
X$ address = f$EXTRACT(addr_ptr,addr_max,record)
X$ address = f$EDIT(address,"trim")
X$ address = f$EXTRACT(0,addr_length,address)
X$ if .not. comp_flag then $ goto LIST_20 ! see if it is in sysuaf
X$ trim_user = f$EDIT(user,"trim,compress,upcase")
X$ read/index=0/key="''trim_user'" f2/error=LIST_15 sysuaf_rec/nolock/time=5
X$ goto LIST_10 ! it is so skip this one
X$LIST_15:
X$ if (.not.rem_flag) .or. (addr_length.gt.0) then $ goto LIST_20
X$ if f$EDIT(address,"trim").nes.null then $ goto LIST_20
X$ read /index=0 /err=LIST_10/DELETE /key="''user'" f1 record
X$ say "Removed ",user
X$LIST_20:
X$ say f$FAO(list_fmt,user,address)
X$ goto LIST_10
X$!
X$MODIFY_USER:
X$! options:`009directory=<dir_spec>
X$! `009`009forward=<forward_address>
X$!`009`009personal_name=<name string>
X$ directory_flag = 0
X$ forward_flag = 0
X$ personal_name_flag = 0
X$ check_set = modify_options
X$ par_cnt = 2
X$MODIFY_LOOP:
X$ option = f$element(par_cnt,b,line)
X$ if par_cnt.eq.2 .and. option.eqs.b .and. once_flag then $ goto MODIFY_NOPAR
X$ if option.eqs.b  then $ goto MODIFY_END
X$ par_cnt = 1+par_cnt
X$ if option.eqs."" then $ goto MODIFY_LOOP
X$ check_val = f$element(0,eql,option)
X$ gosub IN_SET
X$ status = $status
X$ if .not.$status then $ goto MODIFY_ERROR
X$ 'check_val'_flag = 1
X$ 'check_val'_val = f$element(1,eql,option)
X$ goto MODIFY_LOOP
X$MODIFY_END:
X$MODIFY_PROCESS:
X$  gosub GET_USER_RECORD
X$! put code here to handle updating based on flags
X$ if once_flag then $ goto MODIFY_DO
X$
X$ if.not.forward_flag then -
X$`009get "New forwarding address? " forward_val
X$ forward_flag = forward_val.nes.null
X$ if.not.directory_flag then -
X$`009get "New MAIL subdirectory? " directory_val
X$ directory_flag = directory_val.nes.null
X$ if.not.personal_name_flag then -
X$`009get "New personal name ? " personal_name_val
X$ personal_name_flag = personal_name_val.nes.null
X$MODIFY_DO:
X$ if .not.(forward_flag .or. directory_flag .or. personal_name_flag) then -
X$`009goto DO_COMMAND
X$MODIFY_ADDRESS:
X$ if .not.forward_flag then $ goto MODIFY_PERSONAL_NAME
X$ address = f$EXTRACT(addr_length,t2-addr_length,forward_val)
X$ t1 = f$LENGTH(forward_val)
X$ addr_length=t1
X$ record['addr_len_bits',8]='t1'
X$ record['addr_ptr','addr_max']:="''forward_val'''address'"
X$ record = f$EXTRACT(0,addr_ptr+t1+t2,record)
X$MODIFY_PERSONAL_NAME:
X$ personal_name_ptr = addr_ptr+addr_length
X$ personal_name_len = 0
X$ if .not.personal_name_flag then $ goto MODIFY_DIRECTORY
X$ personal_name_len = f$length(personal_name_val)
X$ record['pnm_len_bits',8]='personal_name_len'
X$ record['personal_name_ptr','personal_name_len']:="''personal_name_val'"
X$MODIFY_DIRECTORY:
X$ directory_ptr = personal_name_ptr+personal_name_len
X$ if .not.directory_flag then $ goto MODIFY_WRITE
X$ t1 = f$length(directory_val)
X$ record['dir_len_bits',8]='t1'
X$ record['directory_ptr','t1']:="''directory_val'"
X$MODIFY_WRITE:
X$ write /update f1 record
X$ say "MAILUAF-I-MOD, Modified User ",user," @ ",f$time()
X$ gosub DISPLAY_USER
X$ goto DO_COMMAND
X$MODIFY_NOPAR:
X$ if command.nes."MODIFY" then $ goto DO_COMMAND
X$ status = %X00038150 ! missing required value
X$ say "MAILUAF-F-MISSINGPAR, missing modify parameters"
X$ goto DO_COMMAND
X$MODIFY_ERROR:
X$ status = %X00038240 ! DCL- UNREC qualifiers
X$ say "MAILUAF-E-INVMODIFY, invalid modify command(s): ",line
X$ goto DO_COMMAND
X$REMOVE_USER:
X$ gosub DISPLAY_USER
X$ status = $status
X$ if .not.status then $ goto DO_COMMAND
X$ if once_flag then $ goto REMOVE_IT
X$ ask yn "Remove? "
X$ if .not. yn then goto DO_COMMAND
X$REMOVE_IT:
X$ read/err=DO_COMMAND /index=0/key="''fulluser'" /delete f1 record
X$ say "Removed MAIL record for ",user," @ ",f$time()
X$ goto DO_COMMAND
X$SHOW_USER:
X$ say "MAILUAF-I-TIME, ",f$time()
X$ gosub DISPLAY_USER
X$ status = $status
X$ goto DO_COMMAND
X$SYNTAXERR:
X$ status = %X00038150 ! missing required value
X$ say "Command syntax error"
X$ goto DO_COMMAND
X$DONE:
X$EXIT:
X$ if .not.$status then $ status = $status
X$ if f$TRNLNM("f1","lnm$process").nes.null then $ close f1
X$ if f$TRNLNM("f2","lnm$process").nes.null then $ close f2
X$ prev_priv = f$SETPRV(prev_priv)+f$VER(vfl)
X$ exit status
X$!
X$! Subroutine section
X$!
X$USER_OPEN:
X$ user_file = f$EXTRACT(1,999,user)
X$ if f$TRNLNM("user_file","lnm$process").eqs.null then -
X$`009open/read/share=read/error=USER_END user_file 'user_file'
X$ mail_list = 1
X$USER_READ:
X$ read/end=USER_END/err=USER_END user_file user
X$ fulluser[0,'user_len']:= 'user'
X$ if fulluser.eqs.null then $ goto USER_READ
X$ return
X$USER_END:
X$ status = $status
X$ mail_list = 0
X$ if f$TRNLNM("user_file","lnm$process").nes.null then $ close user_file
X$ return status
X$!
X$GET_USER_RECORD:
X$ no_display = 1
X$ goto DISP_READ_USER
X$DISPLAY_USER:
X$ no_display = 0
X$DISP_READ_USER:
X$ read /index=0 /err=DISP_NOSUCHUSER /key="''fulluser'" f1 record
X$! if f$ver() then $ write sys$output/symbol record
X$ message_cnt = f$cvui(message_cnt_ptr*8,8,record)
X$ addr_length = f$CVUI(addr_len_ptr*8,8,record)
X$ address = f$EXTRACT(addr_ptr,addr_max,record)
X$ naddress = f$EXTRACT(0,addr_length,address)
X$ personal_name_len=f$CVUI(pnm_len_ptr*8,8,record)
X$ dir_len=f$CVUI(dir_len_ptr*8,8,record)
X$ personal_name_ptr = addr_ptr+addr_length
X$ directory_ptr = personal_name_ptr+personal_name_len
X$ address = f$edit(address,"trim,compress")
X$ full_name = f$EXTRACT(personal_name_ptr,personal_name_len,record)
X$ dir_spec  = f$EXTRACT(directory_ptr,dir_len,record)
X$ t2 = f$LENGTH(address)
X$ if no_display then $ return
X$ addr_mess = "User "+user+" does not have forwarding enabled"
X$ if addr_length .ne. 0 then -
X$`009addr_mess = "Current forwarding address is: "+naddress
X$ dir_mess = "User "+user+" does not have a mail directory set"
X$ if dir_len.ne. 0 then -
X$`009dir_mess = "Current mail directory: "+dir_spec
X$ name_mess = "User "+user+" does not have a personal name set"
X$ if personal_name_len.ne. 0 then -
X$`009name_mess = "Current personal name: "+full_name
X$ say name_mess
X$ say dir_mess
X$ say addr_mess
X$ say f$fao("with !UL unread messages.",message_cnt)
X$ return
X$DISP_NOSUCHUSER:
X$ status = $status
X$ say  "MAILUAF-E-NOSUCHUSER, User ",user," record does not exist"
X$ return status
X$!
X$IN_SET:  ! see if check_val is in check_set
X$  n = 1 + f$LOCATE("#"+f$EDIT(check_val,"UPCASE,TRIM"), -
X`009f$EDIT(check_set,"UPCASE,TRIM") )
X$  if n .gt. f$LENGTH(check_set) then $ return %X08040000
X$  check_val = f$ELEMENT(0,"#",f$EXTRACT(n,999,check_set))
X$  return
X$!
X$HELP_USER:
X-  128,  253
X$ goto DO_COMMAND
X$!
X$NO_FILE:
X$ say sysmai," not found...creating new file"
X$ create /fdl=sys$input 'sysmai'`009!Create new VMSMAIL.DAT
XIDENT`009VMS MAIL Information data file
X
XFILE
X`009ALLOCATION              10
X`009BEST_TRY_CONTIGUOUS     yes
X`009BUCKET_SIZE             2
X`009CONTIGUOUS              no
X`009EXTENSION               10
X`009GLOBAL_BUFFER_COUNT     0
X`009ORGANIZATION            indexed
X`009OWNER                   [001,004]
X`009PROTECTION              (system:RWE, owner:RWE, group:, world:)
X
XRECORD
X`009BLOCK_SPAN              yes
X`009CARRIAGE_CONTROL        none
X`009FORMAT                  variable
X`009SIZE                    0
X
XAREA 0
X`009ALLOCATION              10
X`009BEST_TRY_CONTIGUOUS     yes
X`009BUCKET_SIZE             2
X`009CONTIGUOUS              no
X`009EXTENSION               10
X
XKEY 0
X`009CHANGES                 no
X`009DATA_KEY_COMPRESSION    yes
X`009DATA_RECORD_COMPRESSION yes
X`009DATA_AREA               0
X`009DATA_FILL               100
X`009DUPLICATES              no
X`009INDEX_AREA              0
X`009INDEX_COMPRESSION       yes
X`009INDEX_FILL              100
X`009LEVEL1_INDEX_AREA       0
X`009NULL_KEY                no
X`009PROLOGUE                3
X`009SEG0_LENGTH             31
X`009SEG0_POSITION           0
X`009TYPE                    string
X$ open /share=read /read /write f1 'sysmai'
X$ goto FILE_OPEN
X$!++
X$!
X$!  MAILUAF.COM - Modify SYS$SYSTEM:VMSMAIL.DAT
X$!
X$!
X$!  ABSTRACT:`009Sample command procedure to modify
X$!`009`009VMSMAIL.DAT file. Default location is SYS$SYSTEM
X$!`009`009but can be altered by defining/system/exec VMSMAIL <your_file>
X$!
X$!`009`009This command procedure will prompt
X$!`009`009the user for a command.  The valid
X$!`009`009commands are:
X$!
X$!`009`009ADD username`009- Add a new user to VMSMAIL
X$!`009`009CANCEL username - Cancel mail forwarding for username
X$!`009`009EXIT`009`009- Exit from this procedure
X$!`009`009HELP`009`009- Type help message
X$!`009`009MODIFY username - Modify mail forwarding address for username
X$!`009`009`009forward="string" directory=[.dir]
X$!`009`009`009personal_name="string"
X$!`009`009example
X$!  @MAILUAF MODIFY bambi dir=[.forest] forw="nm%THUMPER" Per="Twitterpated!"
X$!
X$!`009`009REMOVE username - Remove username from VMSMAIL
X$!`009`009REMOVE NOUSER`009- remove MAIL users not in SYSUAF
X$!`009`009`009`009  that do not have a forwarding address
X$!`009`009SHOW username `009- Display mail information about username
X$!`009`009LIST`009`009- List forwarding addresses for all users
X$!
X$!
X$!  REQUIRED PRIVILEGES:
X$!`009`009BYPASS
X$!
X$!`009`009
X$!  IMPLICIT OUTPUT:
X$!`009`009SYS$SYSTEM:VMSMAIL.DAT will be created if it does
X$!`009`009not exsist.
X$!
X$!
X$!--
X$!Last Modified:  17-DEC-1987 11:31:04.51, By: RLB
X/
X$*EOD*SUM
X$ write sys$output "Completed Conversion"
$ GoSub Convert_File
$ Exit