// IfsMailAnonAccess.bcpl -- Distribution list retrieval kludge
// Copyright Xerox Corporation 1979, 1980, 1981
// Last modified November 14, 1981  10:41 AM by Taft

get "IfsFtpProt.decl"
get "IfsMail.decl"
get "Ifs.decl"
get "IfsSystemInfo.decl"

external
[
// outgoing procedures
MtpSAnonymousAccess

// incoming procedures
FtpSSendMark
VFileReadPage; LockCell; UnlockCell
Login; CheckLocalRegistry
ExpandTemplate; Free

// incoming statics
infoVMD; mail; CtxRunning; sysZone
]

//---------------------------------------------------------------------------
let MtpSAnonymousAccess(remotePL) = valof
//---------------------------------------------------------------------------
// Called from FtpSRetrieve when the current server is a Mail server
//  rather than an FTP server.
// If permitted, login as "Mail" and force the server-filename to
//  include the standard directory for distribution lists and
//  the extension ".dl".
[
// See if "Distribution-lists" mail system parameter specified
let nameDirDL = lv VFileReadPage(infoVMD, msPage)>>MS.nameDirDL
unless mail>>Mail.enabled & nameDirDL>>String.length ne 0 do
   resultis FtpSSendMark(markNo, ecAnonRetrieve)

// Force login as "Mail" (fails only if no Mail directory exists)
let sfil = remotePL>>PL.SFIL
let ec = nil
CheckLocalRegistry(sfil, lv ec, false)
if ec eq 0 then
   ec = Login("Mail", nil, CtxRunning>>FtpCtx.userInfo, true)
if ec ne 0 resultis FtpSSendMark(markNo, ec)

// Force filename to have standard directory and extension
for i = sfil>>String.length to 1 by -1 do  // strip off trailing ".xxx"
   if sfil>>String.char↑i eq $. then
      [ sfil>>String.length = i-1; break ]
if sfil>>String.char↑(sfil>>String.length) eq $↑ then 
   sfil>>String.length = sfil>>String.length-1  // strip off trailing "↑"
nameDirDL = lv VFileReadPage(infoVMD, msPage)>>MS.nameDirDL
LockCell(lv nameDirDL)
remotePL>>PL.SFIL = ExpandTemplate("<$S>$S.dl", nameDirDL, sfil)
UnlockCell(lv nameDirDL)
Free(sysZone, sfil)
resultis true
]