// 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("<Mail>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)
]