// IfsFtpUtil.bcpl -- Utility routines
// Copyright Xerox Corporation 1979, 1980, 1981, 1982
// Last modified May 11, 1982 4:26 PM by Taft
get "Pup0.decl"
get "Pup1.decl"
get "PupRTP.decl"
get "Ifs.decl"
get ErrRec, ftpEc, errorString from "IfsSystemInfo.decl"
get "IfsFiles.decl"
get "IfsDirs.decl"
get "IfsFtpProt.decl"
external
[
// outgoing procedures
FtpSMakeSFIL; FtpSSendMark
FtpSFillPLFromLD; FtpSCheckAccess; FtpSCheckConnection
// incoming procedures
ExtractSubstring; StringCompare; ExpandTemplate
IFSPrintError; Login; Connect; MoveBlock
SysFree; FreePointer
LockTransferLeaderPage; GetBufferForFD; DestroyFD
FTPM; FreePList; InitPList
LookupErrorCode
// incoming statics
CtxRunning
]
//---------------------------------------------------------------------------
let FtpSSendMark(mark, ec, arg0, arg1, arg2, arg3, arg4) = valof
//---------------------------------------------------------------------------
// Expands ec into an Ftp error code and string.
// The next step is usually to return false,
// so this routine supplies the 'false' value allowing you to say:
// unless IFSDeleteFile(...) resultis FtpSSendMark(...)
[
let errRec = LookupErrorCode(ec)
FTPM(mark, errRec>>ErrRec.ftpEc, lv errRec>>ErrRec.errorString,
false, arg0, arg1, arg2, arg3, arg4)
SysFree(errRec)
resultis false
]
//---------------------------------------------------------------------------
and FtpSCheckConnection() = valof
//---------------------------------------------------------------------------
// Do not call from MTP server; only FTP server
[
if CtxRunning>>FtpCtx.bspSoc>>RTPSoc.state ne stateOpen then
[
if CtxRunning>>FtpCtx.fd ne 0 then
CtxRunning>>FtpCtx.fd = DestroyFD(CtxRunning>>FtpCtx.fd)
resultis false
]
resultis true
]
//---------------------------------------------------------------------------
and FtpSCheckAccess(pl) = valof
//---------------------------------------------------------------------------
// Check login/connect parameters in pl.
[
let ui = CtxRunning>>FtpCtx.userInfo
// Login parameters
let ec = Login(pl>>PL.UNAM, pl>>PL.UPSW, ui)
// Connect parameters
if ec eq 0 then
ec = Connect(pl>>PL.CNAM, pl>>PL.CPSW, ui)
resultis ec eq 0? true, FtpSSendMark(markNo, ec)
]
//---------------------------------------------------------------------------
and FtpSMakeSFIL(pl) be
//---------------------------------------------------------------------------
// Builds a serverFilename from the information in pl.
// The result is left in pl>>PL.SFIL.
[
// If there is no name body, construct a blank one
if pl>>PL.NAMB eq 0 then
pl>>PL.NAMB = ExtractSubstring("")
// If there is no server filename, construct one.
// The Version property isn't correctly handled. A version supplied
// in a PL will only be used as a default if no ServerFilename was
// supplied. The proper implementation is to handle it the way
// default directories are: pass the default version from the PL to
// the directory module, where CreateFD can decide whether it is needed.
if pl>>PL.SFIL eq 0 then
pl>>PL.SFIL = ExpandTemplate((pl>>PL.VERS eq 0? "$S", "$S!$S"),
pl>>PL.NAMB, pl>>PL.VERS)
// If a directory is specified, strip off the outer < > if present
if pl>>PL.DIRE ne 0 then
[
let dir = pl>>PL.DIRE
if dir>>String.char↑(dir>>String.length) eq $> then
dir>>String.length = dir>>String.length -1
if dir>>String.char↑1 eq $< then
[
pl>>PL.DIRE = ExtractSubstring(dir, 2)
SysFree(dir)
]
]
]
//---------------------------------------------------------------------------
and FtpSFillPLFromLD(remotePL, reportDamage; numargs na) = valof
//---------------------------------------------------------------------------
// Creates and returns a PL from the properties of the file described by FtpCtx.fd.
// Returns zero if the file has gone away.
[
let dprp = remotePL>>PL.DPRP // desired properties
if dprp eq 0 then dprp = -1 // if none specified, request all properties
let pl = InitPList()
let fd = CtxRunning>>FtpCtx.fd
let dr = fd>>FD.dr
// first generate properties that can be extracted from the FD
if dprp<<DPRP.SFIL then pl>>PL.SFIL = ExtractSubstring(lv dr>>DR.pathName)
if dprp<<DPRP.DEVI then pl>>PL.DEVI = ExtractSubstring(fd>>FD.fs>>IFS.id)
if dprp<<DPRP.DIRE then pl>>PL.DIRE = ExtractSubstring(lv dr>>DR.pathName,
2, fd>>FD.lenSubDirString-1)
if dprp<<DPRP.NAMB then pl>>PL.NAMB = ExtractSubstring(lv dr>>DR.pathName,
fd>>FD.lenSubDirString+1, fd>>FD.lenBodyString-1)
if dprp<<DPRP.VERS then pl>>PL.VERS = ExtractSubstring(lv dr>>DR.pathName,
fd>>FD.lenBodyString+1)
// if no other properties desired, don't need to read the leader page
manifest requiresLeaderPage = 100000B rshift offset DPRP.TYPE %
100000B rshift offset DPRP.BYTE % 100000B rshift offset DPRP.SIZE %
100000B rshift offset DPRP.AUTH % 100000B rshift offset DPRP.CDAT %
100000B rshift offset DPRP.RDAT % 100000B rshift offset DPRP.WDAT %
100000B rshift offset DPRP.CSUM
if (dprp & requiresLeaderPage) ne 0 then
[
let ild = GetBufferForFD(fd)
let ec = LockTransferLeaderPage(fd, ild) // read
if ec ne 0 then [ SysFree(ild); resultis FreePList(pl) ]
if dprp<<DPRP.TYPE then pl>>PL.TYPE = ild>>ILD.type
if dprp<<DPRP.BYTE then pl>>PL.BYTE = ild>>ILD.byteSize
if dprp<<DPRP.AUTH then pl>>PL.AUTH = ExtractSubstring(lv ild>>ILD.author)
if dprp<<DPRP.CDAT then MoveBlock(lv pl>>PL.CDAT, lv ild>>LD.created, 2)
if dprp<<DPRP.RDAT then MoveBlock(lv pl>>PL.RDAT, lv ild>>LD.read, 2)
if dprp<<DPRP.WDAT then MoveBlock(lv pl>>PL.WDAT, lv ild>>LD.written, 2)
if dprp<<DPRP.SIZE then
[
let siz = lv pl>>PL.SIZE
let fa = lv ild>>LD.hintLastPageFa
let lnBytes = fd>>FD.fs>>IFS.logPageLength +1
let numPages = fa>>FA.pageNumber -1 // don't count leader page
unless numPages eq -1 do
[
siz!0 = numPages rshift (16-lnBytes)
siz!1 = numPages lshift lnBytes + fa>>FA.charPos
]
]
if dprp<<DPRP.CSUM then pl>>PL.CSUM = ild>>ILD.checksum
if na gr 1 & reportDamage & ild>>ILD.damaged then
FtpSSendMark(markComment, ecFileDamaged, lv dr>>DR.pathName)
SysFree(ild)
]
resultis pl
]