// IfsMailUtil.bcpl -- Mail system utility code // Copyright Xerox Corporation 1980, 1981 // Last modified November 14, 1981 12:20 PM by Taft get "Pup0.decl" get "Pup1.decl" get "Ifs.decl" get "IfsSystemInfo.decl" get "IfsRs.decl" get "IfsDirs.decl" get "IfsMail.decl" get "IfsName.decl" external [ // outgoing procedures CheckName; AppendRegistry; MailStat; MailStatDelay // incoming procedures StringCompare; ExtractSubstring; ConcatenateStrings; CopyString LockCell; UnlockCell; VFileWritePage; VFileReadPage DoubleAdd; DoubleIncrement; MultEq; DoubleSubtract Enqueue; Unqueue; SysAllocateZero; SysFree; ReadCalendar EnumeratePupAddresses; PrintPort; ExpandTemplate LookupIFSFile // incoming statics mail; ndbQ; infoVMD; CtxRunning ] //---------------------------------------------------------------------------- let CheckName(name, msg, lvEc, lookupMailbox) = valof //---------------------------------------------------------------------------- // Attempts to accept name as a valid recipient name, and appends HQIs to // msg.hostQ for any new registry names that are seen. // If lookupMailbox is true, // returns: 0 if name is illegal in any way; error code in @lvEc // -1 if name is remote but can be forwarded to // fd for the mailbox if it exists locally // If lookupMailbox is false, does not attempt to look up mailbox, but simply // returns: 0 if name is illegal in any way; error code in @lvEc // -1 if name specifies remote registry // -2 if name specifies local registry // As a side-effect, appends HQIs for MS.registry and MS.gvName if // those names are non-null and such HQIs haven't already been appended. // Also, before returning -1, marks the HQI.used bit of the HQI for the // ultimate forwarding host. [ // Search for "." introducing registry, and append local registry name // if none is present. let dot = 0 for i = name>>String.length to 1 by -1 do if name>>String.char^i eq $. then [ dot = i; break ] test dot eq 0 // name is always allocated; it should always be freed ifso [ dot = name>>String.length +1; name = AppendRegistry(name) ] ifnot name = ExtractSubstring(name) // If this is the first name being looked up for this msg, create // HQIs for MS.registry and MS.gvName if they are non-null. if msg>>Msg.hostQ.head eq 0 then [ let ms = VFileReadPage(infoVMD, msPage) LockCell(lv ms) if (lv ms>>MS.registry)>>String.length ne 0 then CreateHQI(lv ms>>MS.registry, msg, true) if lookupMailbox & mail>>Mail.forward & (lv ms>>MS.gvName)>>String.length ne 0 then msg>>Msg.gvHQI = CreateHQI(lv ms>>MS.gvName, msg, false) UnlockCell(lv ms) ] // Now search for registry name in hostQ, and append a new HQI if not found. let hqi = msg>>Msg.hostQ.head; while hqi ne 0 do [ if StringCompare(name, lv hqi>>HQI.name, dot+1) eq 0 break hqi = hqi>>HQI.link ] if hqi eq 0 then [ //not in the cache let registry = ExtractSubstring(name, dot+1) hqi = CreateHQI(registry, msg, false) SysFree(registry) ] // CheckName (cont'd) // Now it's finally time to decide whether to accept the recipient name. // This logic is quite tricky and took many tries to get right. let fd, ec = 0, hqi>>HQI.ec if ec eq 0 then ec = valof [ // If we are not to look up the mailbox, simply return a successful // result based on the locality of the registry name. unless lookupMailbox do [ fd = hqi>>HQI.isLocal? -2, -1; resultis 0 ] // If name specifies a local registry, see if mailbox exists locally. if hqi>>HQI.isLocal then [ let mlbxName = ConcatenateStrings("Box>", ExtractSubstring(name, 1, dot-1), false, true) fd = LookupIFSFile(mlbxName, lcVHighest) SysFree(mlbxName) // If found local mailbox then indicate success (ec = 0). if fd ne 0 resultis 0 // If mailbox not found, fail now if no GV name exists (or if // forwarding is disabled altogether). if msg>>Msg.gvHQI eq 0 resultis ecCantLocate ] // At this point we know that the mailbox does not exist locally, // and that one of these conditions holds: // (1) name specifies a non-local registry; or // (2) name specifies a local registry, mailbox does not exist locally, // but a GV forwarding name exists. // If forwarding is not enabled, reject the recipient unconditionally. unless mail>>Mail.forward resultis ecNotResident // If a GV name exists, forward mail to it unconditionally; // otherwise forward to the registry actually specified in name. if msg>>Msg.gvHQI ne 0 then hqi = msg>>Msg.gvHQI // If we would forward back to the host giving us this message, // or would forward to ourselves (because of some goof in gvName), // reject the recipient to prevent looping. if hqi>>HQI.isPartner % hqi>>HQI.isLocal resultis ecFwdLoop // If hqi is ok, accept the recipient for forwarding. if hqi>>HQI.ec eq 0 then [ fd = -1; hqi>>HQI.used = true ] resultis hqi>>HQI.ec ] SysFree(name) @lvEc = ec resultis fd ] //---------------------------------------------------------------------------- and CreateHQI(registry, msg, isLocal) = valof //---------------------------------------------------------------------------- // Appends a HQI to msg for registry. // If isLocal is false, looks up registry as a NLS mail registry, and sets // HQI.isLocal or HQI.isPartner if registry maps to this machine or to the // machine we are currently talking to, respectively. Puts an error code // in HQI.ec if registry is not a legal registry name. // If isLocal is true, simply sets HQI.isLocal and does not perform the // NLS lookup. // Returns the HQI that was created. [ let length = lenHQI + registry>>String.length rshift 1 +1 let hqi = SysAllocateZero(length) CopyString(lv hqi>>HQI.name, registry) Enqueue(lv msg>>Msg.hostQ, hqi) hqi>>HQI.isLocal = isLocal unless isLocal do [ let ec = EnumeratePupAddresses(lv hqi>>HQI.name, CheckRegPort, hqi, true) if ec ne 0 & ec ne ecNoServerResponded then hqi>>HQI.ec = ecNameToAddress // reject ] resultis hqi ] //---------------------------------------------------------------------------- and CheckRegPort(port, hqi) = valof //---------------------------------------------------------------------------- [ unless port>>Port.host ne 0 & MultEq(lv port>>Port.socket, table [ 0; socketMail ]) do hqi>>HQI.ec = ecIllegalRegistry if port>>Port.net eq (ndbQ!0)>>NDB.localNet & port>>Port.host eq (ndbQ!0)>>NDB.localHost then hqi>>HQI.isLocal = true // host is us let storePort = lv CtxRunning>>RSCtx.bspSoc>>PupSoc.frnPort if CtxRunning>>RSCtx.type eq jobTypeMTP & port>>Port.net eq storePort>>Port.net & port>>Port.host eq storePort>>Port.host then hqi>>HQI.isPartner = true // host is guy now connected to us resultis false ] //---------------------------------------------------------------------------- and AppendRegistry(name) = valof //---------------------------------------------------------------------------- // Appends our registry (or mail server address if no registry) to name. // It is the caller's responsibility to free the result. [ let fullName = nil let ms = VFileReadPage(infoVMD, msPage) test (lv ms>>MS.registry)>>String.length ne 0 ifso [ LockCell(lv ms) fullName = ExpandTemplate("$S.$S", name, lv ms>>MS.registry) UnlockCell(lv ms) ] ifnot [ let port = vec lenPort port>>Port.net = (ndbQ!0)>>NDB.localNet port>>Port.host = (ndbQ!0)>>NDB.localHost port>>Port.socket^1 = 0 port>>Port.socket^2 = socketMail fullName = ExpandTemplate("$S.$P", name, PrintPort, port) ] resultis fullName ] //---------------------------------------------------------------------------- and MailStat(msType, lvValue) be //---------------------------------------------------------------------------- // Records a mail statistic [ let ms = VFileWritePage(infoVMD, msPage) // msPage not locked in core because MailStat is atomic. let mse = nil switchon msType into [ case msTypeDiscard: [ DoubleIncrement(lv ms>>MS.discard); endcase ] case msTypeLen: [ mse = lv ms>>MS.mseLen; docase -1 ] case msTypeMlbx: [ mse = lv ms>>MS.mseMlbx; docase -1 ] case msTypeSort: [ mse = lv ms>>MS.mseSort; docase -1 ] case msTypeRetr: [ mse = lv ms>>MS.mseRetr; docase -1 ] case msTypeFwd: [ mse = lv ms>>MS.mseFwd; docase -1 ] case -1: [ // increment call counter DoubleIncrement(lv mse>>MSE.calls) // scale value and add to total. let scale = mse>>MSE.scaleTotal let valHi = lvValue!0 rshift scale let valLo = lvValue!0 lshift (16-scale) + lvValue!1 rshift scale DoubleAdd(lv mse>>MSE.total, lv valHi) // update histogram scale = mse>>MSE.scale valHi = lvValue!0 rshift scale valLo = lvValue!0 lshift (16-scale) + lvValue!1 rshift scale let max = mse>>MSE.max if max ne 0 then [ let grain = mse>>MSE.grain let log = 0 until log eq max % (valHi eq 0 & valLo eq 0) do [ valLo = valHi lshift (16-grain) + valLo rshift grain valHi = valHi rshift grain log = log +1 ] DoubleIncrement(lv mse>>MSE.histogram^log) ] endcase ] ] ] //---------------------------------------------------------------------------- and MailStatDelay(msType, lvTime) be //---------------------------------------------------------------------------- // Records a mail statistic which is the time between @lvTime and now. [ let time = vec 1; ReadCalendar(time) DoubleSubtract(time, lvTime) MailStat(msType, time) ]