// 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)
]