!*********************************************************************** !* !* 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