%constant %string (1) snl=" " %constant %integer yes= 1 %constant %integer no= 0 %constant %integer max mailer flags= 530 %constant %integer max filenames= 800 %constant %string (255) alert file= "MANAGR:ALERTINF" %constant %string (255) information base= "EDNEWS:INFORMATION." !! MAILER FLAGS %constant %string (28) %array mailer flags(501:max mailer flags)= %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" %record %format frecf(%string (11) name, %integer sp12, kbytes, %byte %integer arch, codes, cct, ownp, eep, codes2, ssbyte, flags, sp29, sp30, sp31) %record %format paf(%integer dest, srce, flag, message count, secs, ident, bad bitcomp, p6) %record %format rf(%integer conad, filetype, datastart, dataend) %external %routine %spec move %alias "S#MOVE"(%integer length, from, to) %external %integer %function %spec current packed dt %alias "S#CURRENTPACKEDDT" %external %string %function %spec unpack date %alias "S#UNPACKDATE"(%integer d) %external %string %function %spec unpack time %alias "S#UNPACKTIME"(%integer t) %external %integer %function %spec same bytes %alias "S#SAMEBYTES"(%integer %c len, addr1, addr2) ! Compares L bytes at A1 with L bytes at A2. Returns count of ! bytes which match at start of the two areas: zero if the first ! bytes are not the same, and L if the two areas are exactly the ! same. %record %format pdheadf(%integer de, ds, size, type, sp, dt, ind, mems) %record %format indmemf(%integer offs, %string (11) name, %string (15) sp) %external %integer %function %spec pstoi %alias "S#PSTOI"(%string (255) s) %external %integer %function %spec exist %alias "S#EXIST"(%string (255) file) %external %routine %spec destroy %alias "S#DESTROY"(%string (255) nfile, %integer %name flag) %external %routine %spec disconnect %alias "S#DISCONNECT"(%string %c (255) nfile, %integer %name flag) %external %routine %spec connect %alias "S#OLDCONNECT"(%string (255) file, %integer mode, hole, prot, %record (rf) %name r, %integer %name flag) %external %string %function %spec itos %alias "S#ITOS"(%integer n) %external %routine %spec reporton {%alias "S#REPORTON"}(%integer stream) %external %routine %spec rename %alias "S#RENAME"(%string (255) file, newfile, %integer %name flag) %external %string %function %spec uinfs %alias "S#UINFS"(%integer i) %external %string %function %spec date %alias "S#DATE" %external %string %function %spec time %alias "S#TIME" %external %integer %function %spec uinfi %alias "S#UINFI"(%integer i) %external %routine %spec phex %alias "S#PHEX"(%integer i) %external %routine %spec readprofile %alias "S#READPROFILE"(%string (11) key, %name data, %integer %name version, flag) %external %routine %spec writeprofile %alias "S#WRITEPROFILE"(%string %c (11) key, %name data, %integer %name version, flag) %external %routine %spec getstring %alias "S#GETSTRING"(%string (255) vector, %string %name value) %external %routine %spec getinteger %alias "S#GETINTEGER"(%string %c (255) vector, %integer %name value) %external %routine %spec emas3(%string %name com, par, %integer %name flag) %external %integer %function %spec dpermission(%string %name file index, user, date, file, %integer %name fsys, type, adr) %external %integer %function %spec dfilenames(%string %name group, %integer %name fileno, maxrec, nfiles, fsys, type, %record (frecf) %array %name inf) %external %integer %function %spec dflag(%integer %name flag, %string %name txt) %external %integer %function %spec dmail(%record (paf) %name p, %integer %name len, adr) %external %integer %function %spec dmessage(%string %name user, %integer %name len, act, invoc, fsys, adr) %routine profile fail(%integer %name flag, %integer rw) pprofile !rw=1 if reading and 0 if writing profile %constant %string (12) %array prof function(0:1)= "Writeprofile", "Readprofile" %switch failno(0:17) %routine ps(%string (255) s); printstring(s); newline; %end %if 0 # rw # 1 %then %c ps("Profile fail routine passed bad param!!!") %and %stop %unless 0 <= flag <= 7 %start ps(prof function(rw)." fails with unknown flag ".itos(flag)) ps("Contact advisory") %stop %finish ->failno(flag + 10 * rw) failno(0): failno(10): !ie no error at all %return failno(1): ps("File SS#PROFILE Created ") flag = 0 %return failno(2): ps("Failed to create SS#PROFILE - information not stored") %return failno(3): failno(4): ps("Failed to access SS#PROFILE - information not stored") %return failno(5): ps("SS#PROFILE is full - information not stored") %return failno(6): ps("Attempt to store too large a record in SS#PROFILE ". %c "- information not stored ") ps("Contact the writer of this program!!!!") %return failno(7): failno(17): ps("Attempt to access null key in SS#PROFILE ") ps("Contact the author of this program!!!!") %return failno(8): failno(9): !should have been caught already but just in case %return failno(11): failno(12): ps("Information in SS#PROFILE was wrong size!!!!!") ps("Contact the writer of this program!!!!") flag = 0 !because some information may be vaild!!! %return failno(13): ps("SS#PROFILE does not exist - no information stored") %return failno(14): !field not found ! ps("Key not found in SS#PROFILE - no information stored") %return failno(15): ps("SS#PROFILE has been corrupted and must be destroyed") %return %end; !of profile fail %string %function derrs(%integer flag) %string (255) text %integer f f = dflag(flag, text) %result = text %end; ! of derrs %routine fail(%string (255) s) printstring("FAIL ".s) newline %end; ! of fail %external %routine set mail kick %alias "C#SETMAILKICK" %string (255) what %integer act %constant %integer max acts= 3 %switch action(0:max acts) %cycle getinteger("Set;word,=,quit,add,remove;?", act) ->action(act) action(0) {=}: printstring("Current settings are:".snl) %continue action(1) {quit}: printstring("OK".snl) %exit action(2) {add}: action(3) {remove}: printstring("Not yet".snl) %continue %repeat %end %external %routine accredit bboard %alias "C#ACCREDITBBOARD" %integer flag, count %string (255) line, rname, desc %record (paf) pa getstring("Rname;any,verbatim;?;The name of the BBoard to be accredited", rname) getstring("Description;any,verbatim,ornull;;A short descriptive string", desc) pa = 0 line <- "NAMESERVER ACCREDIT ".rname.",BBOARD,,".desc flag = dmail(pa, length(line), addr(line) + 1) %if flag = 0 %then printstring("OK".snl) %and %return line = derrs(flag) line = line." <".mailer flags(pa_flag).">" %if %c 501 <= pa_flag <= max mailer flags fail(line) %end; ! accredit bboard %external %routine discredit bboard %alias "C#DISCREDITBBOARD" %integer flag, count %string (255) line, rname %record (paf) pa getstring("Rname;any,verbatim;?;The name of the BBoard to be discredited", rname) pa = 0 line <- "NAMESERVER DISCREDIT ".rname flag = dmail(pa, length(line), addr(line) + 1) %if flag = 0 %then printstring("OK".snl) %and %return line = derrs(flag) line = line." <".mailer flags(pa_flag).">" %if %c 501 <= pa_flag <= max mailer flags fail(line) %end; ! discredit bboard %routine log(%string (255) s) printstring("DT: ".date." ".time." ") printstring(s.snl) %end %routine make mail file(%string (255) from, to, subject, in reply to, comments, body, %integer skip bytes) %integer flag %if exist(body) # yes %then %start log("Requested file ".body." does not exist") body = information base."INDEX" subject = "Information Service Index" %finish emas3("define", "3,:I#MSG", flag) %if flag # 0 %then %start log("Define 3,:I#MSG returns ".itos(flag)) %finish %else %start selectoutput(3) printstring("From: ".from.snl) %unless from = "" printstring("To: ".to.snl) %unless to = "" printstring("Subject: ".subject.snl) %unless subject = "" printstring("In-Reply-To: Your message ".in reply to.snl) %unless %c in reply to = "" printstring("Comments: ".comments.snl) %unless comments = "" newline emas3("define", "4,".body, flag) %if flag # 0 %then %start selectoutput(0) log("Define 4,".body." returns ".itos(flag)) %finish %else %start selectinput(4) %begin %on %event 9 %start ->end %finish skipsymbol %for skip bytes = skip bytes, -1, 1 printsymbol(nextsymbol) %and skipsymbol %while nextsymbol # 25 end: selectinput(0) closestream(4) %end selectoutput(0) closestream(3) %finish %finish %end %integer %function send file to mailer(%string (255) file) %record (paf) pa %record (rf) r %integer len, flag %string (255) s {* log("********"); emas3("list", file, 0); %result = 0 } destroy(":M#MSG", flag) rename(file, ":M#MSG", flag) connect(":M#MSG", 0, 0, 0, r, flag) %if flag # 0 %then %start log("Connect M#MSG returns ".itos(flag)) ->out %finish len = r_dataend - r_datastart s = "MAILSERVER POST M#MSG,".itos(r_datastart).",".itos(len).",M#REPORT" disconnect("M#MSG", flag) flag = dpermission(uinfs(1), "MAILER", "", "M#MSG", uinfi(1), 2, 3) %if flag # 0 %then %start log("DPermission M#MSG returns ".itos(flag)." ".derrs(flag)) ->out %finish pa = 0 flag = dmail(pa, length(s), addr(s) + 1) %if pa_flag # 0 %start %if pa_flag < 500 %then s = derrs(pa_flag) %else %start %if pa_flag > max mailer flags %then pa_flag = 513 s = mailer flags(pa_flag) %finish log("DMail returns ".s) %result = pa_flag %finish %else %result = 0 out: destroy(":M#MSG", 0) %result = flag %end; ! of send file to mailer %routine handle alert request(%string (255) tmps, to, id) %record (pdheadf) %name pdhead %record (indmemf) %name indmem %record (rf) r %integer flag, mems, indptr, replies %integer skip to, days back, wanted %string (11) member %string (255) title, s1, s2 %if tmps # "" %then days back = pstoi(tmps) %else days back = 0 days back = 0 %if days back < 0 %if days back <= 0 %then wanted = 0 %else %start days back = days back * 24 * 60 * 60 wanted = (current packed dt & x'7fffffff') - days back %finish log("Alert request for members changed since ".unpackdate %c (x'80000000' ! wanted)." ".unpacktime(x'80000000' ! wanted)) connect(alertfile, 1, 0, 0, r, flag) %if flag # 0 %then log("Connect ".alert file." returns ".itos(flag)) %and %c %return %if r_filetype # 6 {PD file} %then %start log(alertfile." is not a PD file!!") %return %finish pdhead == record(r_conad) log(alertfile." last updated on ".unpackdate(pdhead_dt)." at ".unpacktime %c (pdhead_dt)) replies = 0 %if pdhead_dt & x'7fffffff' >= wanted %then %start indptr = r_conad + pdhead_ind %for mems = pdhead_mems, -1, 1 %cycle indmem == record(indptr) indptr = indptr + 32 %if indmem_name = "PREFACE" %then %continue pdhead == record(r_conad + indmem_offs) %if pdhead_dt & x'7fffffff' < wanted %then %continue %if pdhead_type = 3 {character} %then %start move(255, r_conad + indmem_offs + pdhead_ds, addr(title) + 1) length(title) = 255 title -> title.(snl).s1 { only want first line } skip to = length(title) title = s2 %if title -> s1.("!TITLE").s2 %and s1 = "" title = s1." ".s2 %while title -> s1.(" ").s2 make mail file("Information @ UK.AC.EDINBURGH", to, "EMAS ALERT:".title, id, "Automatically generated message".snl. %c " In response to your request for EMAS Alert Information", alert file."_".indmem_name, skip to) flag = send file to mailer(":I#MSG") log("Send Mail file returns ".itos(flag)) destroy(":I#MSG", 0) replies = replies + 1 %finish %repeat %finish %if replies = 0 %then %start log("No new alerts in specified period") make mail file("Information @ UK.AC.EDINBURGH", to, "EMAS ALERT: no new alerts since ".unpackdate(pdhead_dt)." at ". %c unpacktime(pdhead_dt), id, "Automatically generated message".snl. %c " In response to your request for EMAS Alert Information", information base."NOALERT", 0) flag = send file to mailer(":I#MSG") log("Send Mail file returns ".itos(flag)) destroy(":I#MSG", 0) %return %finish disconnect(alertfile, flag) %end %external %routine information %alias "C#INFORMATION" %integer flag %string (255) what, to, id, s1, s2 getstring("What;any,ornull;Index;The topic information is wanted on", what) getstring("To;any,verbatim;;Who wants it (a valid mail address)", to) getstring( %c "Message Id;any,verbatim,ornull;;The ID of the requesting message", id) log("INFORMATION ".what." ".to." ".id) %if what -> s1.("ALERT").s2 %then %c handle alert request(s2, to, id) %and %return make mail file("Information @ UK.AC.EDINBURGH", to, "RE: ".what, id, "Automatically generated message", information base.what, 0) flag = send file to mailer(":I#MSG") log("Send Mail file returns ".itos(flag)) destroy(":I#MSG", 0) %end %integer %function get next mail message(%string (255) recipient, prefix) %integer flag, count %string (255) line %record (paf) pa pa = 0 line = "MAILSERVER ACCEPT ".prefix.",".recipient !! get a message from MAILER flag = dmail(pa, length(line), addr(line) + 1) ! %if flag # 0 %then log("DMail returns ".itos(flag)." ".derrs(flag)." ".%c mailer flags(flag)) %and %c %result = flag count = pa_message count %if pa_flag # 0 %start %if pa_flag = 15 %and pa_message count > 0 %then %c log("No Free File Descs!!!") %and %result = pa_flag %if pa_flag < 500 %then %c log("DMail returns ".itos(pa_flag)." ".derrs(pa_flag)) %else %c log("DMail returns ".itos(flag)." ".mailer flags(flag)) %and %c %result = pa_flag %finish %if count = 0 %then log("No more mail") %and %result = -1 %if count # 1 %then log(itos(count)." new messages from Mailer") %else %c log(itos(count)." new message from Mailer") %result = 0 %end; ! of get next mail message %routine handle mail files(%string (255) prefix, %routine %name action(%string (255) s)) %integer maxrec %string (255) tmps, file, tim, rest, savefile, filename, s1, s2 %integer flag, fileno, nfiles, type, count, tmpi, fsys, filecount, groupcount, hashcount, time, unbatch flag %record (frecf) %array inf(0:maxfilenames) log("Searching for files with prefix of ".prefix) maxrec = maxfilenames fileno = 0 nfiles = 0 type = 0 file count = 0 group count = 0 hashcount = 0 flag = dfilenames(uinfs(1), fileno, maxrec, nfiles, uinfi(1), type, inf) %if flag # 0 %then %start fail("Dfilenames returns ".itos(flag)." ".derrs(flag)) %finish %else %start tmpi = 0 %for count = 0, 1, maxrec - 1 %cycle filename = inf(count)_name %if filename -> s1.(prefix).s2 %and s1 = "" %then %c action(uinfs(1).":".filename) %repeat %finish %end; !of handle mail files %routine act on file(%string (255) file) %constant %integer from= 1, subject = 2, reply to = 3, msg id = 4 %constant %string (10) %array keywords(1:4)="From","Subject","Reply-To", "Message-ID" %string (255) %array headers(1:4) %integer flag, i %string (255) s, s1, s2 %on %event 9 %start log("EOF found when looking at header") ->out %finish log("Information request file ".file) headers(i) = "" %for i = 1, 1, 4 emas3("define", "2,".file, flag) %if flag # 0 %then %start log("define 2,".file." returns ".itos(flag)) %return %finish selectinput(2) skipsymbol %while nextsymbol = nl %cycle s = "" s = s.tostring(nextsymbol) %and skipsymbol %while nextsymbol # nl %if s -> s1.(": ").s2 %then %start %for i = 1, 1, 4 %cycle %if s1 = keywords(i) %then headers(i) = s2 %and %exit %repeat %finish skipsymbol %repeat %until s = "" out: %for i = 1, 1, 4 %cycle log(keywords(i).": ".headers(i)) %repeat %if headers(reply to) = "" %then headers(reply to) = headers(from) emas3("information", headers(subject).",".headers(from).",".headers(msg id), flag) selectinput(0) closestream(2) destroy(file, 0) %end %external %routine handle info request %alias "C#HANDLEINFOREQUEST" %integer flag emas3("define", "1,:MAILLOG-MOD", flag) reporton(1) log("Batch Job starts") flag = get next mail message("information", "I#") handle mail files("I#", act on file) log("Batch Job ends") log("--------------") reporton(0) closestream(1) emas3("clear", "1", flag) make mail file("Information @ UK.AC.EDINBURGH", uinfs(1)."@".uinfs(15).".".uinfs(16), "Batch Log from Mailkick ", "", "", ":MAILLOG", 0) flag = send file to mailer(":I#MSG") %end %external %routine mailkick %alias "C#XMAILKICK" %string (255) rname, message %integer flag, flag2 getstring( %c "Rname;any,verbatim;;The mail recipient name for whom mail is waiting", rname) message = "Mail Kick received for ".rname flag2 = dmessage(uinfs(1), length(message), 1, 0, uinfi(1), addr(message) + 1) %if rname # "information" %then %start message = "Unexpected ".message flag2 = dmessage("ERCC14", length(message), 1, 0, -1, addr(message) + 1) %return %finish emas3("handleinforequest", "", flag) %end %end %of %file