FSyntax10.Scn.FntSyntax10b.Scn.FntSyntax10i.Scn.Fntp_VersionElemsAllocBeg#Syntax10.Scn.FntPowerMac WindowsWindowsPowerMac$Syntax14b.Scn.FntPowerMacWindows Syntax14b.Scn.Fntp_VersionElemsAllocEndc8FoldElemsNew<Syntax10.Scn.FntSyntax10i.Scn.Fntab (**************************************************** Revision History: 951118: GO first release 951212: GO changed replyCodeTimeout from -1 to 900 and added reply category negativeTimeOut. 960114: GO added Synch & InterruptProcess 960114: GO fixed a bug that corrupted received files while receiving them... (remember: Riders want to be VAR paramters) 960120: GO added CompletionProc 960126: GO adapted to modifications in TCP module. (Available no longer sets TCP.res, call Connected() instead). 960301: GO extensions for Windows compatibility 960306: GO removed TCP.res from ReceiveHandler (TCP.res is n/a in WinTCP) 960326: GO added OpenOnPort 960516: GO fixed a minor bug with setting the task time, optimized ReceiveHandler 960520: GO merged modules FTPControl and FTPData into this module. 961120: GO added debugging mode (session log) 961219: GO Optimization in ReceiveHandler TCP.Available() is now called periodically as long as there is still data available. => better data transfer rates. ****************************************************) 88#Syntax10.Scn.Fnt00 TCP, T := Texts, O := Oberon, System, SYSTEM; 8<8Syntax10.Scn.FntSyntax10i.Scn.Fnt56Syntax10b.Scn.Fnt *$  4 # + #C:<...' (* FTPCntlConn *) connectTimeOut = 20000; (* in the time unit used by Oberon.Time() (= msec) *) replyTimeOut = 30000; (* in the time unit used by Oberon.Time() (= msec) *) ftpCntlPort* = 21; (* FTP Default Control Connection Port *) maxPacketSize = 256; (* max. size for command packets *) CR = 0DX; (* ASCII Carriage Return *) LF = 0AX; (* ASCII Linefeed *) IAC = 0FFX; (* Telnet "Interpret As Command" escape character *) DM = 0F2X; (* Telnet "Data Mark" character *) IP = 0F4X; (* Telnet "Interrupt Process" character *) replyCodeTimeOut* = 900; (* connection timed out *) replyCodeConnectionLost* = 901; (* connection closed by server *) replyCodeUnknown* = 0; (* received line has no reply code (maybe a continuated msg) *) positivePreliminary* = 1; (* reply categories; the first digit of the reply code *) positiveCompletion* = 2; positiveIntermediate* = 3; negativeTransient* = 4; negativePermanent* = 5; negativeConnection* = 9; (* not an "official" FTP reply code *) (* FTPDataConn *) minPort = 4096; (* lowest port # used for data connections *) maxPort = 65535; (* highest port # used for data connections *) acceptTimeOut = 20000; bufferSize = 16384; (* size of send/receive data buffer *) taskTime = 0; (* for Oberon.Task.time *) 8 8Syntax10.Scn.FntSyntax10b.Scn.Fnt O !% ! " " FTPCntlConn* = POINTER TO FTPCntlConnDesc; FTPCntlConnDesc* = RECORD(TCP.ConnectionDesc) remAddr-: TCP.IpAdr; isOpen-: BOOLEAN END; FTPDataConn* = POINTER TO FTPDataConnDesc; FTPDataConnDesc* = RECORD(TCP.ConnectionDesc) listener: TCP.Listener; lPort: INTEGER; (* listening port *) isOpen-: BOOLEAN; itsCntlConn-: FTPCntlConn END; FTPTransmission* = POINTER TO FTPTransmissionDesc; ReaderWriter* = POINTER TO ReaderWriterDesc; ReaderWriterDesc* = RECORD END; Reader* = POINTER TO ReaderDesc; ReaderDesc* = RECORD(ReaderWriterDesc) END; Writer* = POINTER TO WriterDesc; WriterDesc* = RECORD(ReaderWriterDesc) END; FTPTransmissionDesc* = RECORD(O.TaskDesc) bytesTransferred-: LONGINT; startTime-: LONGINT; itsConnection-: FTPDataConn; rw: ReaderWriter; END; 848cSyntax10.Scn.FntSyntax10i.Scn.FntSyntax10b.Scn.Fnt3j w: T.Writer; (* for debugging *) lastPort: INTEGER; (* last port number returned from GetRandomPort *) 8% 6-8CSyntax10.Scn.FntSyntax10i.Scn.Fnt (* Open a connection to the specified remote host's port. *) (* If the connection can be established, expect to receive a welcome *) (* message from the server. *) VAR res: INTEGER; BEGIN ASSERT ((conn # NIL) & (adr # TCP.AnyAdr)); TCP.Connect(conn, TCP.AnyPort, adr, port, connectTimeOut, res); conn.remAddr := adr; conn.isOpen := (res = TCP.Done); success := conn.isOpen END OpenOnPort; 8 'T8CSyntax10.Scn.FntSyntax10i.Scn.Fnt-<j (* Opens data connection on default port *) BEGIN conn.OpenOnPort(adr, ftpCntlPort, success) END Open; 8 o8CSyntax10.Scn.FntSyntax10i.Scn.FntVO (* Closes the control connection to the server. *) (* In accordance to the FTP specification, the connection *) (* should only be closed after successfully sending the server a QUIT command. *) (* The caller is responsible for doing this... *) BEGIN ASSERT (conn.isOpen); TCP.Disconnect(conn); conn.isOpen := FALSE END Close; 8 8QSyntax10.Scn.FntSyntax10i.Scn.Fnt0<JY (* Sends a TELNET-SYNCH signal to the peer. *) VAR packet: ARRAY 2 OF CHAR; BEGIN ASSERT (conn.isOpen); (* NOTE: The following packet must be sent as an urgent notification. *) packet[0] := IAC; packet[1] := DM; TCP.WriteBytesUrgent(conn, packet, 0, 2) END Synch; 8 8CSyntax10.Scn.FntSyntax10i.Scn.Fnt0 (* Sends a TELNET-IP character to the peer. *) VAR packet: ARRAY 2 OF CHAR; BEGIN ASSERT (conn.isOpen); packet[0] := IAC; packet[1] := IP; TCP.WriteBytes(conn, packet, 0, 2) END InterruptProcess; 8  8QSyntax10.Scn.FntSyntax10i.Scn.Fnt6gM (* Sends command followed by CR LF to the server. *) VAR packet: ARRAY maxPacketSize OF SYSTEM.BYTE; packetLen: INTEGER; BEGIN ASSERT (conn.isOpen); (* We pack the command string together with CR LF into one *) (* packet and send it to the server. *) (* Sending the CR LF separately would probably cause the generation of *) (* extra TCP packets which should be avoided for performance reasons. *) packetLen := 0; WHILE (packetLen < maxPacketSize) & (command[packetLen] # 0X) DO packet[packetLen] := command[packetLen]; INC(packetLen) END; ASSERT (packetLen < maxPacketSize - 1); packet[packetLen] := CR; INC(packetLen); packet[packetLen] := LF; INC(packetLen); TCP.WriteBytes(conn, packet, 0, packetLen) END SendCommand; 8M8_Syntax10.Scn.FntSyntax10i.Scn.Fnt,] y (* Read a reply character from the server. *) (* If no char is received within a replyTimeOut period *) (* the procedure returns with success = FALSE. *) VAR time: LONGINT; BEGIN time := O.Time(); (* active waiting *) WHILE (O.Time() - time < replyTimeOut) & (TCP.Available(conn) = 0) & TCP.Connected(conn) DO (* wait *) END; success := (TCP.Available(conn) > 0) & TCP.Connected(conn); IF success THEN TCP.Read(conn, ch) END END ReadChar; 8mI8Syntax10.Scn.FntSyntax10i.Scn.FntO,R9/ (* Reads a single line of a server reply. *) (* ReplyCode is either the FTP reply code from the server (the first three digits of the reply), *) (* replyCodeTimeOut in case of a time out, or replyUnknown in case of a contunation line without a reply code. *) (* Cont is TRUE if the reply is continued (the fourth char of the reply is a minus or there is no reply code). *) (* The reply is appended to replyText. *) VAR rc: ARRAY 4 OF CHAR; ch: CHAR; i: INTEGER; success: BOOLEAN; BEGIN (* read the reply code, if there is any *) conn.ReadChar(ch, success); IF success THEN IF (ch >= '1') & (ch <= '5') THEN (* we have a reply code *) i := 0; WHILE success & (i < 4) DO T.Write(replyText, ch); rc[i] := ch; conn.ReadChar(ch, success); INC(i) END; IF success THEN replyCode := (ORD(rc[0]) - ORD('0'))*100 + (ORD(rc[1]) - ORD('0'))*10 + (ORD(rc[2]) - ORD('0')); cont := (rc[3] = '-') END; ELSE (* no reply code *) replyCode := replyCodeUnknown; cont := TRUE END; (* Now read the rest of the line *) (* The following code accepts only CR LF sequence as end-of-line marker *) (* Neither a single CR nor a single LF is sufficient *) REPEAT WHILE success & (ch # CR) DO T.Write(replyText, ch); conn.ReadChar(ch, success) END; IF success THEN conn.ReadChar(ch, success) END; (* got a CR, expect LF *) UNTIL ~success OR (ch = LF); IF ~success THEN replyCode := 0 END; T.WriteLn(replyText); ELSE IF TCP.Connected(conn) THEN replyCode := replyCodeTimeOut ELSE replyCode := replyCodeConnectionLost END END END ReadLine; 8  2;8CSyntax10.Scn.FntSyntax10i.Scn.Fnt (* Waits for a reply from the server and puts it into replyText. *) (* ReplyCode is the same as for ReadALine. *) (* Multi-line replies are OK. *) VAR cont: BOOLEAN; BEGIN ASSERT (conn.isOpen); T.OpenWriter(replyText); conn.ReadLine(replyCode, replyText, cont); WHILE cont & (replyCode # replyCodeTimeOut) DO conn.ReadLine(replyCode, replyText, cont) END; END WaitForReply; 8 G"8CSyntax10.Scn.FntSyntax10i.Scn.Fnt,n (* Combines SendCommand and WaitForReply *) BEGIN ASSERT (conn.isOpen); conn.SendCommand(comm); conn.WaitForReply(replyCode, replyText) END Request; 8 8#Syntax10.Scn.Fnt77 BEGIN RETURN replyCode DIV 100 END GetReplyCategory; 8%  W8QSyntax10.Scn.FntSyntax10i.Scn.Fnt+Y (* Called upon completion of transmission*) BEGIN (* abstract method *) END Completed; 88CSyntax10.Scn.FntSyntax10i.Scn.Fnt ' BEGIN (* abstract method *) END Open; 88CSyntax10.Scn.FntSyntax10i.Scn.Fnt ( BEGIN (* abstract method *) END Close; 8 .8CSyntax10.Scn.FntSyntax10i.Scn.Fnt+ BEGIN (* abstract method *) END GetBytes; 8 .8CSyntax10.Scn.FntSyntax10i.Scn.Fnt+ BEGIN (* abstract method *) END PutBytes; 8#8CSyntax10.Scn.FntSyntax10i.Scn.Fnt@n (* Returns a random port number between minPort and maxPort. *) BEGIN INC(lastPort); IF lastPort > maxPort THEN lastPort := minPort END; RETURN lastPort END GetRandomPort; 8 .8QSyntax10.Scn.FntSyntax10i.Scn.Fnt (* Listens on a random port for a connection request from the server. *) (* The address of the server is taken from the data connection. *) VAR res: INTEGER; BEGIN ASSERT ((conn # NIL) & cntlConn.isOpen); conn.isOpen := FALSE; conn.itsCntlConn := cntlConn; NEW(conn.listener); (* find a free port *) REPEAT conn.lPort := GetRandomPort(); TCP.Listen(conn.listener, conn.lPort, cntlConn.remAddr, TCP.AnyPort, res); UNTIL res # TCP.LocalPortInUse; success := (res = TCP.Done) END Listen; 8#8QSyntax10.Scn.FntSyntax10i.Scn.FntU.& (* Waits for a connection request from the server and accepts it. *) (* Success is set to FALSE if there's no connection request *) (* from the server within acceptTimeOut, or if Accept reports an error. *) (* The listener port is closed in either case. *) VAR time: LONGINT; res: INTEGER; BEGIN ASSERT (~conn.isOpen); time := O.Time(); WHILE (O.Time() - time < acceptTimeOut) & ~TCP.Requested(conn.listener) DO (* Wait *) END; IF TCP.Requested(conn.listener) THEN TCP.Accept(conn.listener, conn, res); success := (res = TCP.Done); conn.isOpen := success ELSE success := FALSE END; (* The listener port is no longer needed. *) TCP.Close(conn.listener) END Accept; 8 8_Syntax10.Scn.FntSyntax10i.Scn.Fnt_7,  (* Closes the data connection to the server (after Open) or stops listening (after Prepare). *) BEGIN IF conn.isOpen THEN (* close connection *) TCP.Disconnect(conn); conn.isOpen := FALSE ELSE (* stop listening *) TCP.Close(conn.listener) END END Close; 8  8Syntax10.Scn.FntSyntax10i.Scn.Fnt]#"XpVersionElemsAllocBeg#Syntax10.Scn.FntPowerMac WindowsWindowsPowerMac#Syntax10.Scn.Fntrr FOR i := -3 TO 0 DO WriteShortCard (ASH (adr, 8 * i) MOD 256); IF i < 0 THEN cmdStr[j] := ","; INC(j) END END; Windows xpVersionElemsAllocEnd (* Returns a string containing the PORT command *) (* that corresponds to the current listening port *) (* Based upon TCP.AddrToNumber() *) VAR i, j: INTEGER; adr: TCP.IpAdr; res: INTEGER; PROCEDURE WriteShortCard(l: LONGINT); VAR k: INTEGER; a: ARRAY 3 OF CHAR; BEGIN k := 0; REPEAT a[k] := CHR (l MOD 10 + ORD ("0")); l := l DIV 10; INC (k) UNTIL l = 0; REPEAT DEC (k); cmdStr[j] := a[k]; INC (j) UNTIL k = 0; END WriteShortCard; BEGIN TCP.GetHostAddress(adr, res); (** res successfully ignored... **) COPY("PORT ", cmdStr); j := 5; (* we have to consider the different byte ordering on PowerMac and Windows systems *)  FOR i := -3 TO 0 DO WriteShortCard (ASH (adr, -8 * (3+i)) MOD 256); IF i < 0 THEN cmdStr[j] := ","; INC(j) END END;  cmdStr[j] := ","; INC(j); WriteShortCard(ASH(conn.lPort, -8) MOD 256); cmdStr[j] := ","; INC(j); WriteShortCard(conn.lPort MOD 256); cmdStr[j] := 0X END GetPortCmd; 88_Syntax10.Scn.FntSyntax10i.Scn.FntaT (* The task handler for receiving a file. *) (* After receiving the file, it is registered. *) VAR n, s: LONGINT; nn: INTEGER; t: FTPTransmission; buffer: ARRAY bufferSize OF CHAR; BEGIN t := O.CurTask(FTPTransmission); n := TCP.Available(t.itsConnection); IF TCP.Connected(t.itsConnection) THEN WHILE n > 0 DO IF n > LEN(buffer) THEN s := LEN(buffer) ELSE s := n END; TCP.ReadBytes(t.itsConnection, buffer, 0, s); nn := SHORT(s); t.rw(Writer).PutBytes(buffer, nn); INC(t.bytesTransferred, s); (* DEC(n, s) *) n := TCP.Available(t.itsConnection) END; t.time := O.Time() + taskTime ELSE (* end of file *) t.rw.Close(); t.rw := NIL; t.itsConnection.Close(); t.itsConnection := NIL; t.Completed(TRUE); O.Remove(O.CurTask) END END ReceiveHandler; 8Y8QSyntax10.Scn.FntSyntax10i.Scn.Fnt,4BW (* The task handler for sending a file. *) VAR n: INTEGER; t: FTPTransmission; buffer: ARRAY bufferSize OF CHAR; BEGIN t := O.CurTask(FTPTransmission); t.rw(Reader).GetBytes(buffer, n); IF TCP.Connected(t.itsConnection) & (n > 0) THEN TCP.WriteBytes(t.itsConnection, buffer, 0, n); t.bytesTransferred := t.bytesTransferred + n; t.time := O.Time() + taskTime ELSE t.itsConnection.Close(); t.itsConnection := NIL; t.rw.Close(); t.rw := NIL; System.Collect(); (* to ensure that connection gets really closed. *) t.Completed(n = 0); O.Remove(O.CurTask) END END SendHandler; 8  &8CSyntax10.Scn.FntSyntax10i.Scn.Fnt (* Starts a file transfer from the server. The data connection must be open. *) (* When the transfer is finished, the data connection is closed. *) (* Returns NIL if not successfull! *) BEGIN ASSERT(t # NIL); t.bytesTransferred := 0; t.startTime := O.Time(); t.itsConnection := conn; t.rw := writer; writer.Open(); t.handle := ReceiveHandler; t.safe := FALSE; t.time := O.Time() + taskTime; O.Install(t) END ReceiveFile; 8 &8CSyntax10.Scn.FntSyntax10i.Scn.Fnt (* Starts a file transfer to the server. The data connection must be open. *) (* When the transfer is finished, the data connection is closed. *) (* Returns NIL if not successfull! *) BEGIN ASSERT (t # NIL); t.bytesTransferred := 0; t.startTime := O.Time(); t.itsConnection := conn; t.rw := reader; reader.Open(); t.handle := SendHandler; t.safe := FALSE; t.time := O.Time() + taskTime; O.Install(t) END SendFile; 8 2MODULE FTPB; (** Implementation of the control & data connection part of FTP. **) (** By Gnter Obiltschnig (g.obiltschnig@jk.uni-linz.ac.at) **) (* Compile for Windows 3.1/95/NT *) Revision History IMPORT CONST TYPE VAR (****** FTPCntlConn Methods ******) PROCEDURE (conn: FTPCntlConn) OpenOnPort*(adr: TCP.IpAdr; port: INTEGER; VAR success: BOOLEAN); PROCEDURE (conn: FTPCntlConn) Open*(adr: TCP.IpAdr; VAR success: BOOLEAN); PROCEDURE (conn: FTPCntlConn) Close*(); PROCEDURE (conn: FTPCntlConn) Synch*(); PROCEDURE (conn: FTPCntlConn) InterruptProcess*(); PROCEDURE (conn: FTPCntlConn) SendCommand*(command: ARRAY OF CHAR); PROCEDURE (conn: FTPCntlConn) ReadChar(VAR ch: CHAR; VAR success: BOOLEAN); PROCEDURE (conn: FTPCntlConn) ReadLine(VAR replyCode: INTEGER; VAR replyText: T.Writer; VAR cont: BOOLEAN); PROCEDURE (conn: FTPCntlConn) WaitForReply*(VAR replyCode: INTEGER; VAR replyText: T.Writer); PROCEDURE (conn: FTPCntlConn) Request*(comm: ARRAY OF CHAR; VAR replyCode: INTEGER; VAR replyText: T.Writer); PROCEDURE GetReplyCategory*(replyCode: INTEGER): INTEGER; (****** FTPDataConn Methods ******) (* FTPTransmission *) PROCEDURE (t: FTPTransmission) Completed*(success: BOOLEAN); (* ReaderWriter *) PROCEDURE (rw: ReaderWriter) Open*(); PROCEDURE (rw: ReaderWriter) Close*(); PROCEDURE (r: Reader) GetBytes*(VAR buffer: ARRAY OF CHAR; VAR len: INTEGER); PROCEDURE (w: Writer) PutBytes*(VAR buffer: ARRAY OF CHAR; VAR len: INTEGER); (* FTPDataConn *) PROCEDURE GetRandomPort(): INTEGER; PROCEDURE (conn: FTPDataConn) Listen*(cntlConn: FTPCntlConn; VAR success: BOOLEAN); PROCEDURE (conn: FTPDataConn) Accept*(VAR success: BOOLEAN); PROCEDURE (conn: FTPDataConn) Close*(); PROCEDURE (conn: FTPDataConn) GetPortCmd*(VAR cmdStr: ARRAY OF CHAR); (* Transmission Control *) PROCEDURE ReceiveHandler(); PROCEDURE SendHandler(); PROCEDURE (conn: FTPDataConn) ReceiveFile*(t: FTPTransmission; writer: Writer); PROCEDURE (conn: FTPDataConn) SendFile*(t: FTPTransmission; reader: Reader); BEGIN (* Initialization *) T.OpenWriter(w); lastPort := minPort END FTPB.