home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
kermit.columbia.edu
/
kermit.columbia.edu.tar
/
kermit.columbia.edu
/
archives
/
perqa.zip
/
kermitsend
< prev
next >
Wrap
Text File
|
1984-12-04
|
15KB
|
459 lines
module KermitSend ;
(* 29-Nov-83 Allow eight bit file transfer (c.f. sopen call) [pgt001] *)
EXPORTS
PROCEDURE SendPacket;
PROCEDURE SendACK((* Using *) n:Integer); (* send ACK packet *)
PROCEDURE SendNAK((* Using *) n:Integer); (* send NAK packet *)
PROCEDURE SendSwitch;
PRIVATE
IMPORTS KermitGlobals FROM KermitGlobals ;
IMPORTS KermitUtils FROM KermitUtils ;
IMPORTS Stdio FROM Stdio ;
IMPORTS KermitError FROM KermitError ;
IMPORTS KermitRecv FROM KermitRecv ; (* for receiving ACKs and NAKs *)
IMPORTS UtilProgress FROM UtilProgress ;
IMPORTS Sleep FROM Sleep ;
{$RANGE-} (* Range checks off 16-Jan-84 *)
VAR
DataSendCount: Integer ; (* counter for progress *)
PROCEDURE PutOut( p : Ppack); (* Output Packet *)
(* Use direct calls to XmtChar to send the characters -pt*)
VAR
i : Integer;
BEGIN
IF (NumPad > 0) THEN
FOR i := 1 TO NumPad DO
XmtChar( Chr(PadChar) );
WITH Buf[p] DO
BEGIN
XmtChar( Chr(mark) );
XmtChar( Chr(count) );
XmtChar( Chr(seq) );
XmtChar( Chr(ptype) );
FOR i := 1 TO ilength(data) DO
XmtChar( Chr(data[i]) );
END;
END;
PROCEDURE ReSendPacket;
(* re -sends previous packet *)
BEGIN
NumSendPacks := NumSendPacks+1;
ChInPack := ChInPack + NumPad + UnChar(Buf[LastPacket].count) + 3 ;
IF Debug
THEN DebugPacket('Re-Sending: ',LastPacket);
PutOut(LastPacket);
END;
PROCEDURE SendPacket;
(* expects count as length of data portion *)
(* and seq as number of packet *)
(* builds & sends packet *)
VAR
i,len,chksum : Integer;
temp : Ppack;
BEGIN
IF (NumTry <> 1) AND (RunType = Transmit) THEN
ReSendPacket
ELSE
BEGIN
WITH Buf[ThisPacket] DO
BEGIN
mark :=SOH; (* mark *)
len := count; (* save length *)
count := MakeChar(len+3); (* count = 3+length of data *)
seq := MakeChar(seq); (* seq number *)
chksum := count + seq + ptype;
IF (len > 0) THEN (* is there data ? *)
FOR i:= 1 TO len DO
chksum := chksum + data[i]; (* loop for data *)
chksum := CheckFunction(chksum); (* calculate checksum *)
data[len+1] := MakeChar(chksum); (* make printable & output *)
data[len+2] := SendEOL; (* EOL *)
data[len+3] := ENDSTR;
END;
NumSendPacks := NumSendPacks+1;
IF Debug
THEN DebugPacket('Sending: ',ThisPacket);
PutOut(ThisPacket);
IF (RunType = Transmit) THEN
BEGIN
ChInPack := ChInPack + NumPad + len + 6;
temp := LastPacket;
LastPacket := ThisPacket;
ThisPacket := temp;
END;
END
END;
PROCEDURE SendACK((* Using *) n:Integer); (* send ACK packet *)
BEGIN
WITH Buf[ThisPacket] DO
BEGIN
count := 0;
seq := n;
ptype := TYPEY;
END;
SendPacket;
NumACK := NumACK+1;
END;
PROCEDURE SendNAK((* Using *) n:Integer); (* send NAK packet *)
BEGIN
WITH Buf[ThisPacket] DO
BEGIN
count := 0;
seq := n;
ptype := TYPEN;
END;
SendPacket;
NumNAK := NumNAK+1;
END;
PROCEDURE GetData((* Returning *) VAR newstate:KermitStates);
(* get data from file into ThisPacket *)
VAR
(* and return next state - data & EOF *)
x,c : CharBytes;
i: Integer;
BEGIN
IF (NumTry = 1) THEN
BEGIN
i := 1;
x := ENDSTR;
WITH Buf[ThisPacket] DO
BEGIN
WHILE (i< SizeSend - 8 ) AND (x <> ENDFILE)
(* leave room for quote & NEWLINE *)
DO
BEGIN
x := getcf(c,DiskFile);
IF (x <> ENDFILE) THEN
IF IsControl(x) OR (x = SendQuote) THEN
BEGIN (* control char -- quote *)
IF (x = LF) THEN (* use proper EOL *)
BEGIN
data[i] := SendQuote;
i := i+1;
data[i] := Ctl(CR);
i := i+1;
(* LF will sent below *)
END;
data[i] := SendQuote;
i := i+1;
IF (x <> SendQuote) THEN data[i] := Ctl(x)
ELSE data[i] := SendQuote;
END
ELSE (* regular char *)
data[i] := x;
IF (x <> ENDFILE) THEN
BEGIN
i := i+1; (* increase count for next char *)
ChInFile := ChInFile + 1 ;
END;
END;
data[i] := ENDSTR; (* to terminate string *)
count := i -1; (* length *)
seq := n;
ptype := TYPED;
IF (x = ENDFILE) THEN
BEGIN
newstate := EOFile;
Sclose(DiskFile);
DiskFile := StdIOError;
END
ELSE
newstate := FileData;
SaveState := newstate; (* save state *)
END
END
ELSE
newstate := SaveState; (* get old state *)
END;
FUNCTION GetNextFile: (* Returning *) Boolean;
(* get next file to send in ThisPacket *)
(* returns true if no more *)
(* ---- -- -pt*)
VAR
result: Boolean;
BEGIN
result := True;
IF (NumTry = 1) THEN
WITH Buf[ThisPacket] DO
BEGIN
IF GetArgument(data) THEN
BEGIN (* open file *)
IF Exists(data) THEN
BEGIN
(* Initialise counter for each file to be sent *)
DataSendCount := 0 ;
IF EightBitFile THEN (* [pgt001] *)
DiskFile := Sopen(data,StdIO8Read)
ELSE
DiskFile := Sopen(data,StdIORead);
count := ilength(data);
ChInFile := ChInFile + count ;
seq := n;
ptype := TYPEF;
Write('[Sending ');
PutStr(data,stdout);
Writeln(']') ;
IF (DiskFile <= StdIOError) THEN
ErrorMsg('?Can''t open file');
result := False;
END
ELSE (* file does not exist *)
BEGIN
ErrorMsg('?Can''t find file: ') ;
ErrorStr( data ) ;
result := True (* I.e. fail: state -> abort *)
END
END;
END
ELSE
result := False; (* for saved packet *)
GetNextFile := result;
END;
PROCEDURE SendFile; (* send file name packet *)
BEGIN
Verbose( 'Sending ');
IF (NumTry > MaxTry) THEN
BEGIN
ErrorMsg ('Send file - Too Many');
State := Abort; (* too many tries, abort *)
END
ELSE
BEGIN
NumTry := NumTry+1;
IF GetNextFile THEN
BEGIN
State := Break;
NumTry := 0;
END
ELSE
BEGIN
IF Verbosity THEN
IF (NumTry = 1)
THEN ErrorStr(Buf[ThisPacket].data)
ELSE ErrorStr(Buf[LastPacket].data);
SendPacket; (* send this packet *)
IF ReceiveACK THEN
BEGIN
State := FileData;
NumTry := 0;
n := (n+1) MOD 64;
END
END;
END;
END;
PROCEDURE SendData; (* send file data packets *)
VAR
newstate: KermitStates;
BEGIN
IF (Land(DataSendCount, #03) = 0) THEN
WITH OpenList[DiskFile] DO
StreamProgress( FileVar ) ;
DataSendCount := DataSendCount + 1 ; (* next "SendData" *)
IF (NumTry > MaxTry) THEN
BEGIN
State := Abort; (* too many tries, abort *)
ErrorMsg ('Send data - Too many');
END
ELSE
BEGIN
NumTry := NumTry+1;
GetData(newstate);
SendPacket;
IF ReceiveACK THEN
BEGIN
State := newstate;
NumTry := 0;
n := (n+1) MOD 64;
END
END;
END;
PROCEDURE SendEOF; (* send EOF packet *)
BEGIN
Verbose ('Sending EOF');
IF (NumTry > MaxTry) THEN
BEGIN
State := Abort; (* too many tries, abort *)
ErrorMsg('Send EOF - Too Many');
END
ELSE
BEGIN
NumTry := NumTry+1;
IF (NumTry = 1) THEN
BEGIN
WITH Buf[ThisPacket] DO
BEGIN
ptype := TYPEZ;
seq := n;
count := 0;
END
END;
SendPacket;
IF ReceiveACK THEN
BEGIN
State := FileHeader;
NumTry := 0;
n := (n+1) MOD 64;
END
END;
END;
PROCEDURE SendBreak; (* send break packet *)
BEGIN
Verbose ('Sending break');
IF (NumTry > MaxTry) THEN
BEGIN
State := Abort; (* too many tries, abort *)
ErrorMsg('Send break -Too Many');
END
ELSE
BEGIN
NumTry := NumTry+1;
(* make up packet *)
IF (NumTry = 1) THEN
BEGIN
WITH Buf[ThisPacket] DO
BEGIN
ptype := TYPEB;
seq := n;
count := 0;
END
END;
SendPacket; (* send this packet *)
IF ReceiveACK THEN
BEGIN
State := Complete;
END
END;
END;
PROCEDURE SendInit; (* send init packet *)
BEGIN
Verbose ('Sending Init');
IF (NumTry > MaxTry) THEN
BEGIN
State := Abort; (* too many tries, abort *)
ErrorMsg('Cannot Initialize');
END
ELSE
BEGIN
NumTry := NumTry+1;
IF (NumTry = 1) THEN
BEGIN
WITH Buf[ThisPacket] DO
BEGIN
EnCodeParm(data);
count := NUMPARAM;
seq := n;
ptype := TYPES;
END
END;
SendPacket; (* send this packet *)
IF ReceiveACK THEN
BEGIN
WITH Buf[CurrentPacket] DO
BEGIN
SizeSend := UnChar(data[1]);
TheirTimeOut := UnChar(data[2]);
NumPad := UnChar(data[3]);
PadChar := Ctl(data[4]);
SendEOL := CR; (* default to CR *)
IF (ilength(data) >= 5) THEN
IF (data[5] <> 0) THEN SendEOL := UnChar(data[5]);
SendQuote := SHARP; (* default # *)
IF (ilength(data) >= 6) THEN
IF (data[6] <> 0) THEN SendQuote := data[6];
END;
State := FileHeader;
NumTry := 0;
n := (n+1) MOD 64;
END;
END;
END;
PROCEDURE SendSwitch;
(* Send-switch is the state table switcher for sending files.
* It loops until either it is finished or a fault is encountered.
* Routines called by sendswitch are responsible for changing the state.
*)
HANDLER GotErrorPacket(VAR msg: istring) ;
(* We got an error packet when trying to receive another packet. *)
(* (possibly an ACK). Write the packet data and exit SEND command *)
BEGIN
Inverse( TRUE ) ;
Writeln ;
Writeln('?SEND received an error packet from the other Host') ;
putstr(msg, STDOUT) ;
Writeln ;
Inverse( FALSE ) ;
SClose( DiskFile ) ; (* close the disk file if its open *)
State := Abort ;
EXIT( SendSwitch )
END ;
BEGIN
LoadCurs ; (* Load the progress cursors *)
State := Init; (* send initiate is the start state *)
NumTry := 0; (* say no tries yet *)
IF (Delay > 0) THEN Sleep(Delay);
REPEAT
CASE State OF
FileData: SendData; (* data-send state *)
FileHeader: SendFile; (* send file name *)
EOFile: SendEOF; (* send end-of-file *)
Init: SendInit; (* send initialize *)
Break: SendBreak; (* send break *)
Complete: (* nothing *);
Abort: (* nothing *);
END (* case *);
UNTIL ( (State = Abort) OR (State=Complete) );
QuitProgress ; (* Remove progress cursors *)
END.