// IfsMailMisc.bcpl - Mail related Miscellaneous service requests
// Copyright Xerox Corporation 1979, 1980, 1981
// Last modified November 18, 1981  9:30 AM by Taft

get "Pup0.decl"
get "Pup1.decl"
get "IfsSystemInfo.decl"
get "IfsFiles.decl"
get ecUserName, ecUserPassword, ecFilesOnly from "IfsDirs.decl"
get "IfsMisc.decl"
get "IfsMail.decl"

external
[
// outgoing procedures
MailMiscServ; CheckLocalRegistry

// incoming procedures
ExchangePorts; AppendStringToPup; CompletePup; ReleasePBI
LockTransferLeaderPage; GetDIF; Password; LookupErrorCode
GetBufferForFD; DestroyFD
CheckName; AppendRegistry
SysFree; FreePointer; Zero; Dequeue

// incoming statics
]

structure MesaStr:
[
length word
maxLength word
char↑1,1 byte
]

//----------------------------------------------------------------------------
let MailMiscServ(pbi) be
//----------------------------------------------------------------------------
[
if pbi>>PBI.pup.dPort.host eq 0 then [ ReleasePBI(pbi); return ]

ExchangePorts(pbi)
switchon pbi>>PBI.pup.type into
   [
   case typeUserAuthenticate:
      UserAuthenticate(pbi); endcase
   case typeLaurelMailCheck:
   case typeMsgMailCheck:
      MailCheck(pbi); endcase
   case typeValidateRecipient:
      ValidateRecipient(pbi); endcase
   ]
]

//----------------------------------------------------------------------------
and UserAuthenticate(pbi) be
//----------------------------------------------------------------------------
[
let name = lv pbi>>PBI.pup.words  //Achtung! order is important.
let psw = name + offset MesaStr.char/16 + (name>>MesaStr.maxLength+1)/2
name = MesaToBcpl(name, pbi)
psw = MesaToBcpl(psw, pbi)

let ec = name? (psw? 0, ecUserPassword), ecUserName
if ec eq 0 then CheckLocalRegistry(name, lv ec, false)
if ec eq 0 then
   [
   for i = name>>String.length to 1 by -1 do  // strip registry
      if name>>String.char↑i eq $. then
         [ name>>String.length = i-1; break ]
   let dif = GetDIF(name)
   ec = dif eq 0? ecUserName, (dif>>DIF.filesOnly? ecFilesOnly, (
    Password(psw, lv dif>>DIF.password, false)? 0, ecUserPassword))
   FreePointer(lv dif)
   ]

test ec eq 0
   ifso CompletePup(pbi, typeUserAuthenticateYes, pupOvBytes)
   ifnot CompleteError(pbi, typeUserAuthenticateNo, ec)
]

//----------------------------------------------------------------------------
and MailCheck(pbi) be
//----------------------------------------------------------------------------
[
let name = lv pbi>>PBI.pup.words
let length = (pbi>>PBI.pup.length-pupOvBytes) & 177b  //leave some room
for i = length to 1 by -1 do
   name>>String.char↑i = name>>String.char↑(i-1)  //end with String.char↑0!
name>>String.length = length

let ec, type = nil, nil
let fd = CheckLocalRegistry(name, lv ec, true)
if fd ne 0 then
   [
   let ild = GetBufferForFD(fd)
   type = LockTransferLeaderPage(fd, ild) eq 0 &
    (ild>>ILD.hintLastPageFa.pageNumber gr 1 %
     ild>>ILD.hintLastPageFa.charPos ne 0)? typeMailCheckYes, typeMailCheckNo
   SysFree(ild)
   DestroyFD(fd)
   ]

test ec eq 0
   ifso CompletePup(pbi, type, pupOvBytes)
   ifnot CompleteError(pbi, typeMailCheckError, ec)
]

//----------------------------------------------------------------------------
and ValidateRecipient(pbi) be
//----------------------------------------------------------------------------
[
let type = typeValidateRecipientNo
let name = MesaToBcpl(lv pbi>>PBI.pup.words, pbi)
if name ne 0 then
   [
   let ec = nil
   let fd = CheckLocalRegistry(name, lv ec, true)
   if fd ne 0 then
      [
      DestroyFD(fd)
      type = typeValidateRecipientYes
      ]
   ]
CompletePup(pbi, type, pupOvBytes)
]

//----------------------------------------------------------------------------
and MesaToBcpl(ms, pbi) = valof
//----------------------------------------------------------------------------
// Converts a Mesa string to Bcpl format "in place".
// Checks consistancy of the Mesa string.
// Returns a pointer to the Bcpl string or 0 if bad format.
[
// Max length must be le actual length.
if ms>>MesaStr.length gr ms>>MesaStr.maxLength resultis 0

// Max length must be le 128 (AppendRegistry might lengthen it).
if ms>>MesaStr.length gr 128 resultis 0

// The string must not extend beyond the end of the Pup.
let preBytes = (ms-lv pbi>>PBI.pup.words)*2
let strBytes = offset MesaStr.char/8 + ((ms>>MesaStr.maxLength+1) & -2)
let pupBytes = pbi>>PBI.pup.length - pupOvBytes
if (preBytes+strBytes) gr pupBytes resultis 0

// Mesa format ok.  Convert to Bcpl format.
ms>>String.length = ms>>MesaStr.length
for i = 1 to ms>>String.length do
   ms>>String.char↑i = ms>>MesaStr.char↑i
resultis ms
]

//----------------------------------------------------------------------------
and CheckLocalRegistry(name, lvEc, lookupMailbox) = valof
//----------------------------------------------------------------------------
// Attempts to accept name as a local recipient name.
// If lookupMailbox is true,
// returns:	0 if name is illegal in any way; error code in @lvEc
//		fd for the mailbox if it exists locally
// If lookupMailbox is false,
// returns:	0 if name is illegal in any way; error code in @lvEc
//		-2 if name specifies a local registry
[
let msg = vec lenMsg; Zero(msg, lenMsg)
let fd = CheckName(name, msg, lvEc, lookupMailbox)
if fd eq -1 then
   [ fd = 0; @lvEc = ecRegistryNotLocal ]
while msg>>Msg.hostQ.head ne 0 do
   SysFree(Dequeue(lv msg>>Msg.hostQ))
resultis fd
]

//----------------------------------------------------------------------------
and CompleteError(pbi, type, ec) be
//----------------------------------------------------------------------------
[
let errRec = LookupErrorCode(ec)
AppendStringToPup(pbi, 1, lv errRec>>ErrRec.errorString)
SysFree(errRec)
CompletePup(pbi, type)
]