-- Copyright (C) 1981, 1984 by Xerox Corporation. All rights reserved.
-- file: [Igor]<Emerson>STP>STPsA.mesa - Simple/Stream Transfer Protocol
-- Initialization and Error stuff in here
-- Edited by:
-- SXW , 16-Jul-81 14:54:32
-- PXK , 9-Dec-81 18:23:36
-- SXE , Nov 14, 1980 9:35 AM
-- BJD , 26-Mar-84 11:42:39
-- AOF, 17-Jan-85 9:04:42
DIRECTORY
Format USING [Octal, StringProc],
Heap USING [systemZone],
String USING [AppendString, AppendStringAndGrow, EmptyString, StringLength],
STP USING [Error, ErrorCode, FileInfoObject],
STPOps USING [
CollectCode, CollectString, ErrorIfNextNotEOC, GetCommand, GetServerType,
Handle, markComment, markIAmVersion, markNo, maxStringLength, Object,
PList, PListArray, ProtocolError, PutCommand, UserProperties, ValidProperties],
STPReplyCode USING [ReplyCode],
PupStream USING [
CloseReason, GetPupAddress, PupAddress, PupByteStreamCreate, PupNameTrouble,
PupPackageDestroy, PupPackageMake, StreamClosing, veryLongWait],
PupTypes USING [fillInHostID, fillInNetID],
Stream USING [
GetProcedure, GetSSTProcedure, Handle, InputOptions, PutProcedure,
SetSSTProcedure, SubSequenceType, WaitAttentionProcedure];
STPsA: PROGRAM
IMPORTS Format, Heap, PupStream, String, STP, STPOps
EXPORTS STP, STPOps =
BEGIN OPEN PupStream, STPOps;
-- Global Data
Error: PUBLIC SIGNAL [
stp: STPOps.Handle, code: STP.ErrorCode, error: LONG STRING, reply: CHARACTER ← 0C] = CODE;
Object: PUBLIC TYPE = STPOps.Object;
z: UNCOUNTED ZONE = Heap.systemZone;
-- Public Interface Routines
Close: PUBLIC PROCEDURE [stp: STPOps.Handle] =
BEGIN
nilByteStream: BOOLEAN;
IF stp = NIL THEN RETURN;
nilByteStream ← stp.byteStream = NIL;
CloseInternal[stp];
IF nilByteStream THEN
ERROR Error[stp: stp, code: noConnection, error: "Attempt to Close a NIL connection"L];
END;
CloseInternal: PUBLIC PROCEDURE [stp: STPOps.Handle] =
BEGIN
IF stp = NIL THEN RETURN;
stp.plist ← DestroyPList[stp.plist];
z.FREE[@stp.info];
z.FREE[@stp.remoteString];
IF stp.byteStream # NIL THEN
BEGIN
s: Stream.Handle = stp.byteStream;
stp.byteStream ← NIL;
s.delete[s ! PupStream.StreamClosing => CONTINUE];
END;
END;
Create: PUBLIC PROCEDURE RETURNS [stp: STPOps.Handle] =
BEGIN OPEN PupTypes;
ENABLE UNWIND => z.FREE[@stp];
stp ← z.NEW[STPOps.Object];
[] ← PupStream.PupPackageMake[];
stp↑ ← STPOps.Object[];
RETURN[stp];
END;
Destroy: PUBLIC PROCEDURE [stp: STPOps.Handle] RETURNS [Handle] =
BEGIN
IF stp = NIL THEN RETURN[NIL];
IF stp.byteStream # NIL THEN Close[stp];
z.FREE[@stp.host];
FOR i: STPOps.UserProperties IN STPOps.UserProperties DO
z.FREE[@stp.userState[i]]; ENDLOOP;
z.FREE[@stp];
PupStream.PupPackageDestroy[];
RETURN[NIL];
END;
Open: PUBLIC PROCEDURE [stp: STPOps.Handle, host: LONG STRING]
RETURNS [herald: LONG STRING] =
BEGIN
reason: PupStream.CloseReason;
IF stp = NIL THEN RETURN[NIL];
IF stp.byteStream # NIL THEN
ERROR Error[stp, alreadyAConnection, "You already have a connection?"L];
BEGIN
shortHost: STRING ← [40];
server: PupStream.PupAddress ← [PupTypes.fillInNetID, PupTypes.fillInHostID, [0, 3]];
stpOptions: Stream.InputOptions = [
signalAttention: TRUE,
terminateOnEndRecord: FALSE,
signalLongBlock: FALSE,
signalShortBlock: FALSE,
signalSSTChange: TRUE,
signalEndOfStream: TRUE];
server.socket ← [0, 3];
String.AppendString[shortHost, host];
PupStream.GetPupAddress[
@server, shortHost !
PupStream.PupNameTrouble => GenerateErrorString[stp, noSuchHost, e]];
stp.byteStream ← PupStream.PupByteStreamCreate[
server, PupStream.veryLongWait !
PupStream.StreamClosing => {reason ← why; GOTO streamClosing}];
stp.byteStream.options ← stpOptions;
stp.remoteString ← z.NEW[StringBody[maxStringLength]];
stp.plist ← MakePList[];
stp.info ← z.NEW[STP.FileInfoObject];
stp.info↑ ← [];
stp.gotMark ← FALSE;
stp.serverType ← GetServerType[host];
PutCommand[stp, markIAmVersion, 1C, "STP calling"L !
PupStream.StreamClosing => {reason ← why; GOTO streamClosing}];
herald ← z.NEW[StringBody[80]];
BEGIN ENABLE UNWIND => z.FREE[@herald];
code: CHARACTER;
mark: Stream.SubSequenceType;
[mark, code] ← GetCommand[stp, @herald !
PupStream.StreamClosing => {reason ← why; GOTO streamClosing}];
IF mark # markIAmVersion THEN GenerateProtocolError[stp, badVersion, mark, code];
ErrorIfNextNotEOC[stp];
END;
RETURN[herald];
EXITS streamClosing => {CloseInternal[stp]; GenerateStreamClosingError[stp, reason]};
END;
END;
-- PList Utilities
DestroyPList: PUBLIC PROCEDURE [plist: PList] RETURNS [PList] =
BEGIN
i: STPOps.ValidProperties;
IF plist # NIL THEN
BEGIN
FOR i IN STPOps.ValidProperties DO z.FREE[@plist[i]]; ENDLOOP;
z.FREE[@plist];
END;
RETURN[NIL]
END;
MakePList: PUBLIC PROCEDURE RETURNS [plist: PList] =
BEGIN
i: STPOps.ValidProperties;
plist ← z.NEW[PListArray];
FOR i IN STPOps.ValidProperties DO plist[i] ← NIL; ENDLOOP;
END;
-- Error generation routines
ErrorCodeToSTPErrorCode: PUBLIC PROCEDURE [
errorCode: STP.ErrorCode, code: CHARACTER]
RETURNS [STP.ErrorCode] = {
replyCode: STPReplyCode.ReplyCode = LOOPHOLE[code];
RETURN[SELECT replyCode FROM
null => errorCode,
badCommand => protocolError,
noUserName => illegalUserName,
illegalCommand => protocolError,
badPList => protocolError,
illegalServerFilename => illegalFileName,
illegalDirectory => illegalFileName,
illegalNameBody => illegalFileName,
illegalVersion => illegalFileName,
illegalType => accessError,
illegalCharacterSize => accessError,
illegalEOLConversion => accessError,
illegalUserName => illegalUserName,
illegalUserPassword => illegalUserPassword,
illegalUserAccount => illegalUserAccount,
illegalConnectName => illegalConnectName,
illegalConnectPassword => illegalConnectPassword,
illegalCreationDate => illegalFileName,
illegalWriteDate => illegalFileName,
illegalReadDate => illegalFileName,
illegalAuthor => illegalFileName,
illegalDevice => illegalFileName,
fileNotFound => noSuchFile,
accessDenied => accessDenied,
inconsistent => protocolError,
fileDataError => errorCode,
tooLong => errorCode,
dontSend => errorCode,
notCompleted => errorCode,
transientError => errorCode,
permanentError => errorCode,
fileBusy => errorCode,
ENDCASE => errorCode] -- can't do any better--};
GenerateErrorString: PUBLIC PROCEDURE [
stp: STPOps.Handle, errorCode: STP.ErrorCode, string: LONG STRING , code: CHARACTER ← 0C] =
BEGIN
ERROR Error[stp,
ErrorCodeToSTPErrorCode[errorCode, code],
IF String.StringLength[string] # 0 THEN string
ELSE
SELECT errorCode FROM
noSuchHost => "No such host"L,
noRouteToNetwork => "No route to network"L,
noNameLookupResponse => "Name lookup server is not responding"L,
alreadyAConnection => "You already have a connection"L,
noConnection => "Please open a connection"L,
connectionClosed => "Connection closed (local or remote)"L,
connectionRejected => "Connection rejected by remote host"L,
connectionTimedOut => "Connection timed out"L,
accessDenied => "Access denied by remote server"L,
illegalUserName => "Invalid or illegal UserName"L,
illegalUserPassword => "Invalid or illegal UserPassword"L,
illegalUserAccount => "Invalid or illegal UserAccount"L,
illegalConnectName => "Invalid or illegal ConnectName"L,
illegalConnectPassword => "Invalid or illegal ConnectPassword"L,
credentailsMissing => "Name and/or Password not supplied"L,
protocolError => "Internal FTP protocol error"L,
illegalFileName => "Illegal filename"L,
noSuchFile => "File not found"L,
requestRefused => "Request refused by remote host"L,
accessError => "Illegal access attempt on remote stream"L,
undefinedError => "Undefined error"L,
ENDCASE => ERROR, code];
END;
GenerateStreamClosingError: PUBLIC PROCEDURE [stp: STPOps.Handle, why: PupStream.CloseReason] =
BEGIN
GenerateErrorString[stp,
SELECT why FROM
localClose, remoteClose => connectionClosed,
noRouteToNetwork => noRouteToNetwork,
transmissionTimeout => connectionTimedOut,
remoteReject => connectionRejected,
ENDCASE => ERROR, NIL];
END;
GenerateProtocolError: PUBLIC PROCEDURE [
stp: STPOps.Handle, type: ProtocolError, mark: Stream.SubSequenceType, code: CHARACTER ← 0C] =
BEGIN
string: LONG STRING ← NIL;
MyAppend: Format.StringProc =
BEGIN String.AppendStringAndGrow[to: @string, from: s, z: z]; END;
String.AppendStringAndGrow[
to: @string,
from:
SELECT type FROM
badVersion => "Incompatable protocol version"L,
badMark => "Invalid or undefined mark byte"L,
badPList => "Invalid or malformed property list"L,
eocExpected => "End-Of-Command mark byte expected"L,
noCode => "error code is required after error mark byte"L,
ENDCASE => ERROR,
z: z];
String.AppendStringAndGrow[to: @string, from: ", mark ="L, z: z];
Format.Octal[MyAppend, mark];
String.AppendStringAndGrow[to: @string, from: ", code ="L, z: z];
Format.Octal[MyAppend, code];
ERROR Error[stp,
protocolError, string, code ! UNWIND => z.FREE[@string]];
END;
SelectError: PUBLIC PROCEDURE [
stp: STPOps.Handle, s: LONG STRING , mark: Stream.SubSequenceType] =
BEGIN
code: CHARACTER ← 0C;
IF mark = markNo OR mark = markComment THEN
BEGIN
IF mark # markComment THEN code ← CollectCode[stp];
CollectString[stp, @stp.remoteString];
GenerateErrorString[
stp, requestRefused,
IF String.EmptyString[stp.remoteString] THEN s ELSE stp.remoteString,
code];
END
ELSE GenerateProtocolError[stp, badMark, mark, code];
END;
-- NOP and ERROR Stream routines
GetError: PUBLIC Stream.GetProcedure = {
ERROR STP.Error[NIL, accessError, "Attempt to Get from a store stream"L]};
PutError: PUBLIC Stream.PutProcedure = {
ERROR STP.Error[NIL, accessError, "Attempt to Put on a retrieve stream"L]};
SetSSTNop: PUBLIC Stream.SetSSTProcedure = BEGIN END;
GetSSTNop: PUBLIC Stream.GetSSTProcedure = BEGIN RETURN[0B] END;
WaitAttentionNop: PUBLIC Stream.WaitAttentionProcedure = BEGIN RETURN[0B] END;
END. -- of STPsA