!***********************************************************************
!*
!* Program to change the mail delivery host to the current host
!*
!* Copyright (C) R.D. Eager University of Kent MCMLXXXV
!*
!***********************************************************************
!
!
!***********************************************************************
!*
!* Constants
!*
!***********************************************************************
!
constantinteger no = 0, yes = 1
constantinteger name file header = 160
constantstring (18) snamefile = "MAILER.NAMEFIL"
constantstring (18) addrfile = "MAILER.ADDRFILE"
constantstring (11) profile file = "M#PROFILE"
constantstring (11) reportfile = "M#DREPORT"
constantinteger max rnames = 10000
constantinteger max mailer flag = 530
constantstring (28)array mailer flags(501:max mailer flag) = c
"Invalid parameters",
"Duplicate component:",
"Unknown component",
"Invalid command",
"No valid recipients",
"Too many recipients",
"Addr table full",
"Name table full",
"Illegal name",
"Mail service closed",
"Recipient offline",
"Message too long",
"",
"Missing component:",
"No free message descriptors",
"Invalid component:",
"Total message kb exceeded",
"Cannot return report file",
"Message stored",
"Forbidden component",
"Create file fails",
"User not accredited",
"Invalid password",
"Name not accredited",
"Name already accredited",
"Name belongs to another user",
"Uncollected mail for R-name",
"Invalid date/time after",
"Not allowed in student procs",
"Invalid Rname option"
constantstring (1) snl = "
"
constantinteger maxhelp = 7
constantinteger maxhelp1 = 13
constantstring (72)array help1(1:maxhelp1) = c
"",
"Called with no parameters, or with a parameter of =, this command",
"displays the host which is to be treated as your mail delivery host; all",
"mail for you will be delivered there.",
"",
" Example: Command:MAILHOST =",
" Command:MAILHOST",
"",
"The only other valid parameter is the letter C; this indicates that you",
"wish your mail delivery host to be changed to this machine. It may take",
"up to a day to take effect on some systems.",
"",
" Example: Command:MAILHOST C"
constantinteger maxhelp2 = 3
constantstring (72)array help2(1:maxhelp2) = c
"You are about to change your mail delivery host so that all mail for you",
"will be sent to this machine. Are you certain you wish to do this?",
""
constantinteger maxhelp3 = 3
constantstring (72)array help3(1:maxhelp3) = c
"Answer Y if you want all your mail delivered to this machine in future.",
"Answer N to leave things as they are.",
""
constantinteger maxhelp4 = 9
constantstring (72)array help4(1:maxhelp4) = c
"",
"Your mail aliases point to more than one machine. You are strongly",
"advised to run the appropriate program on your preferred delivery",
"machine to ensure that all mail is directed to that machine. Currently,",
"these programs (and the appropriate parameters) are:",
"",
" EMAS -- MAILHOST(C) or MAILHOST C",
" UNIX -- mailhost -c",
""
constantinteger maxhelp5 = 11
constantstring (72)array help5(1:maxhelp5) = c
"",
"You have selected a special, hidden option in MAILHOST. Its purpose is",
"to change the host name associated with just ONE of the names by which",
"you are known to the mail system. This option should NOT be used unless",
"you understand the full implications of what you are doing.",
"",
"If you are sure you wish to go ahead, please type Y. If you are not",
"absolutely sure, type N and seek help.",
"",
"Do you wish to go ahead?",
""
constantinteger maxhelp6 = 4
constantstring (72)array help6(1:maxhelp6) = c
"",
"Answer Y if you wish to change the host associated with just one of the",
"names by which you are known to the mail system; otherwise answer N.",
""
constantinteger maxhelp7 = 6
constantstring (72)array help7(1:maxhelp7) = c
"",
"You should enter the name, known to the mail system, for which you wish",
"all mail to be sent to this machine in the future. Remember that only",
"one name is processed; generally you would wish to use the C parameter",
"to MAILHOST in order to have ALL names processed.",
""
!
!
!***********************************************************************
!*
!* Record and array formats
!*
!***********************************************************************
!
recordformat addr entry f(string (31) rname,department,string (7) password,
string (15) server,managr,integer timestamp,
options,dt last told,fsys,dlist index,link)
recordformat ad file f(integer end,start,size,type,free hole,datetime,
entries,version,anon link)
recordformat name entry f(string (31) rname,integer soundex)
recordformat name file f(integer end,start,size,type,free,datetime,
sp0,version,integerarray startchar('A':'['),
integer extrastart,extraend,sp1,sp2,sp3)
recordformat pe(integer dest,srce,p1,p2,p3,p4,p5,p6)
recordformat pf(integer end,start,size,filetype,checksum,datetime,format,spare,
marker,version,list size,alias head,free list,string (15) v editor,
string (79) accept,byte integer l list console,l list file,
autofile,autoaccept,overwrite,return new,b1,b2)
recordformat rf(integer conad,filetype,datastart,dataend)
!
!
!***********************************************************************
!*
!* Subsystem references
!*
!***********************************************************************
!
externalroutinespec connect alias "S#CONNECT"(string (31) file,
integer mode,hole,prot,
record (rf)name r,integername flag)
externalroutinespec destroy alias "S#DESTROY"(string (31) file,
integername flag)
externalroutinespec disconnect alias "S#DISCONNECT"(string (31) file,
integername flag)
externalstringfunctionspec failuremessage alias "S#FAILUREMESSAGE"(integer mess)
externalintegerfunctionspec parmap alias "S#PARMAP"
externalroutinespec prompt(string (255) s)
externalroutinespec setfname alias "S#SETFNAME"(string (63) s)
externalroutinespec setpar alias "S#SETPAR"(string (255) s)
externalroutinespec set return code(integer i)
externalstringfunctionspec spar alias "S#SPAR"(integer n)
externalroutinespec uctranslate alias "S#UCTRANSLATE"(integer ad,len)
externalstringfunctionspec uinfs(integer entry)
!
!
!***********************************************************************
!*
!* Director references
!*
!***********************************************************************
!
externalstringfunctionspec derrs(integer n)
externalintegerfunctionspec dmail(record (pe)name p,integer len,adr)
!
!
!***********************************************************************
!*
!* Forward references
!*
!***********************************************************************
!
routinespec printhelp(integer n)
routinespec readline(stringname s)
!
!
!***********************************************************************
!*
!* Own variables
!*
!***********************************************************************
!
owninteger multiple
ownstring (15) last host
ownstring (255) rname list
!
!
!***********************************************************************
!*
!* Service routines
!*
!***********************************************************************
!
integerfunction change mail delivery host(record (addr entry f)name addr entry,
stringname user)
! Requests MAILER to alter the directory entry specified by 'addr entry'
! so that it points to this host, and is the preferred entry for
! subsequent updates. Also alters the mail profile entry for auto
! accept, to include all the new rnames.
integer flag
string (255) s
record (pe) p
!
if addr entry_managr # user then start
destroy(reportfile,flag)
p = 0
s = "NAMESERVER MAILHERE ".addr entry_rname
flag = dmail(p,length(s),addr(s)+1)
flag = p_p1 if flag = 0
finish else flag = 0
!
if flag = 0 then start
rname list = rname list."+" unless rname list = ""
rname list = rname list.addr entry_rname
finish
!
result = flag
end ; ! of change mail delivery host
!
!-----------------------------------------------------------------------
!
integerfunction change selective rname(stringname user)
! This function is for specialised use only. It asks the user for a
! single rname, and changes the current mail delivery host for that
! rname so that it points to this host.
integer flag
string (255) s
record (addr entry f) addr entry
!
prompt("Recipient name: ")
cycle
readline(s)
exit unless s = "?"
printhelp(7)
repeat
!
length(s) = 31 if length(s) > 31
addr entry_rname = s
addr entry_managr = "ZZZZZZ"
result = change mail delivery host(addr entry,user)
end ; ! of change selective rname
!
!-----------------------------------------------------------------------
!
routine check consistency
! Checks that all the hosts were the same, and outputs suitable advisory
! messages.
if last host = "" then start ; ! No directory entries
printstring("You do not appear to have any mail directory entries".snl)
else
if multiple = no then start
printstring("All your mail aliases point to ".last host.snl)
else
printhelp(4)
finish
finish
end ; ! of check consistency
!
!-----------------------------------------------------------------------
!
routine check host(stringname server)
! Records the first host name passed as 'server', and sets the flag
! 'multiple' if subsequent host names are not the same.
if last host = "" then start
last host = server
else
if server # last host then multiple = yes
finish
end ; ! of check host
!
!-----------------------------------------------------------------------
!
integerfunction display mail delivery host(record (addr entry f)name addr entry,
stringname user)
! Displays details of the recipient name specified in 'addr entry', and
! sets up for checking host consistency.
printstring(addr entry_rname.snl)
!
check host(addr entry_server)
!
result = 0
end ; ! of display mail delivery host
!
!-----------------------------------------------------------------------
!
integerfunction do user(integerfunction r(record (addr entry f)name addr entry,stringname user),
stringname user)
! Calls the service function 'r' once for each recipient name associated
! with the current user.
integer flag,i,name file conad,addr file conad,ad entry size
string (15) sysidstr
record (rf) rr
record (ad file f)name ad file
record (addr entry f)name addr entry
record (name file f)name name file
record (name entry f)arrayname ntable
record (name entry f)arrayformat name table arf(1:max rnames)
!
connect(snamefile,9,0,0,rr,flag)
if flag = 0 then start
name file conad = rr_conad
connect(addrfile,9,0,0,rr,flag)
if flag = 0 then start
addr file conad = rr_conad
name file == record(name file conad)
flag = 233 if name file_datetime = 0
! MAILER is housekeeping
finish
finish
if flag # 0 then start
disconnect(snamefile,flag)
disconnect(addrfile,flag)
flag = 233; ! General error
setfname("Mail directory not available")
-> err
finish
!
ad file == record(addr file conad)
ntable == array(name file conad+name file header,name table arf)
!
sysidstr = "__sysid__".user
ad entry size = sizeof(addr entry)
for i = 1,1,ad file_entries cycle
addr entry == record(addr file conad+i*ad entry size)
if addr entry_managr = user or addr entry_department = sysidstr then start
flag = r(addr entry,user)
-> err if flag # 0
finish
repeat
!
flag = 0
!
err:
!
result = flag
end ; ! of do user
!
!-----------------------------------------------------------------------
!
string (40)function message(integer flag)
! Returns the string associated with 'flag'. The flag may originate in
! Director, MAILER or the Subsystem.
if flag < 100 then result = derrs(flag).snl else c
if 500 < flag < max mailer flag then result = " ".mailer flags(flag).snl else c
result = failuremessage(flag)
end ; ! of message
!
!-----------------------------------------------------------------------
!
routine printhelp(integer n)
! Prints suitable help information according to the context given by
! 'n'.
integer i,max
stringarrayname help
switch sw(1:maxhelp)
!
unless 1 <= n <= maxhelp then start
printstring("Sorry - no help available here".snl)
return
finish
!
-> sw(n)
!
sw(1):
max = maxhelp1
help == help1
-> all
!
sw(2):
max = maxhelp2
help == help2
-> all
!
sw(3):
max = maxhelp3
help == help3
-> all
!
sw(4):
max = maxhelp4
help == help4
-> all
!
sw(5):
max = maxhelp5
help == help5
-> all
!
sw(6):
max = maxhelp6
help == help6
-> all
!
sw(7):
max = maxhelp7
help == help7
-> all
!
all:
!
for i = 1,1,max cycle
printstring(help(i))
newline
repeat
!
end ; ! of printhelp
!
!-----------------------------------------------------------------------
!
routine readline(stringname s)
! Reads one line of input from the currently selected input stream into
! 's'. Spaces and null lines are ignored, and the string is converted
! to upper case. The calling code should set the prompt.
integer c
!
s = ""
cycle
cycle
readsymbol(c)
exit if c = nl
s <- s.tostring(c)
repeat
while length(s) > 0 and charno(s,length(s)) = ' ' cycle
length(s) = length(s) - 1
repeat
exit unless s = ""
repeat
uctranslate(addr(s)+1,length(s))
end ; ! of readline
!
!-----------------------------------------------------------------------
!
integerfunction read yes or no(integer helpa,helpb)
! Prints the help message 'helpa', then asks the user to reply with Y or
! N. If the reply is '?', then help message 'helpb' is displayed and
! the request is repeated. The function returns the character actually
! read.
integer c
string (255) s
!
printhelp(helpa)
prompt("Please answer Y or N: ")
cycle
readline(s)
c = charno(s,1)
exit if c = 'Y' or c = 'N'
printhelp(helpb) if c = '?'
repeat
!
result = c
end ; ! of read yes or no
!
!-----------------------------------------------------------------------
!
integerfunction set accept rnames(stringname rname list)
! Sets the auto-accept rname list in the mail profile file to 'rname
! list'.
integer flag
record (pf)name p
record (rf) rr
!
connect(profile file,3,0,0,rr,flag)
-> err if flag # 0
p == record(rr_conad)
if p_version # 4 then start
setfname("Wrong version of ".profile file)
flag = 233; ! General error
-> err
finish
!
length(rname list) = 79 if length(rname list) > 79
p_accept = rname list
disconnect(profile file,flag); ! Ignore flag
flag = 0
!
err:
!
result = flag
end ; ! of set rname list
!
!
!***********************************************************************
!*
!* M A I L H O S T
!*
!***********************************************************************
!
externalroutine mailhost(string (255) parms)
integer flag,c
string (6) user
string (255) s
!
setpar(parms)
!
if parmap = 1 and spar(1) = "?" then start
printhelp(1)
set return code(0)
return
finish
!
if parmap > 1 then start
flag = 263; ! Wrong number of parameters
-> err
finish
!
last host = ""
rname list = ""
multiple = no
user = uinfs(1); ! Current username
s = spar(1)
s = "=" if s = ""; ! Default to display action
!
if s = "=" then start ; ! Display mail delivery host
flag = do user(display mail delivery host,user)
check consistency
else
if s = "C" or s = "-C" then start
c = read yes or no(2,3)
!
if c = 'N' then start
printstring("Mail delivery host not changed".snl)
flag = 0
else
flag = do user(change mail delivery host,user)
if flag = 0 then start
uctranslate(addr(rname list)+1,length(rname list))
flag = set accept rnames(rname list)
finish
finish
else
if s = "FIXNAME" then start
c = read yes or no(5,6)
!
if c = 'N' then start
printstring("No action has been taken".snl)
flag = 0
else
flag = change selective rname(user)
finish
else
setfname(spar(1))
flag = 202; ! Invalid parameter
finish
finish
finish
-> err if flag # 0
!
set return code(0)
return
!
err:
!
printstring(snl."MAILHOST fails -".message(flag))
set return code(flag)
stop
end ; ! of mailhost
endoffile