Oberon/ETH Oberon/FTP.Mod

(* ETH Oberon, Copyright (c) 1990-present Computer Systems Institute, ETH Zurich, CH-8092 Zurich. License at https:&#47;/en.m.wikibooks.org/wiki/Oberon#ETH_Oberon_License . *) MODULE FTP; (** portable *)	(* ejz, 02.04.21 07:57:37 *) IMPORT Files, Strings, Input, Display, Fonts, Texts, Oberon, NetSystem; (** A simple single session FTP Tool using commands. Useful for transfering many files to or from the 		same server. *) CONST MaxLine = 1024; BufLen = MaxLine; Tab = 9X; Esc = 01BX; BreakChar = Esc; Done = 0; NotReady = 1; NotConnected = 2; WrongUser = 3; WrongPassword = 4; TimedOut = 5; LocFileNotFound = 6; Interrupted = 7; Disconnected = 8; Failed = MAX(INTEGER); MinDataPort = 1100; MaxDataPort = 1500; Unknown = -1; UNIX = 0; VMS = 1; DefConPort = 21; TYPE Session = POINTER TO SessionDesc; SessionDesc = RECORD C: NetSystem.Connection; dataC: NetSystem.Connection; reply: ARRAY MaxLine OF CHAR; usr, passw, host, portIPAddress: ARRAY 64 OF CHAR; dataIP: NetSystem.IPAdr; dataPort, status, system, res: INTEGER; ack: BOOLEAN END; EnumProc = PROCEDURE (entry: ARRAY OF CHAR); VAR S: Session; W: Texts.Writer; log: Texts.Text; line: ARRAY MaxLine OF CHAR; buffer: ARRAY BufLen OF CHAR; timeOut: LONGINT; dataPort, col: INTEGER; PROCEDURE Connected(C: NetSystem.Connection; mode: INTEGER): BOOLEAN; VAR state: INTEGER; BEGIN state := NetSystem.State(C); RETURN state IN {mode, NetSystem.inout} END Connected; PROCEDURE Disconnect(VAR C: NetSystem.Connection); BEGIN IF C # NIL THEN NetSystem.CloseConnection(C) END; C := NIL END Disconnect; PROCEDURE Connect(VAR C: NetSystem.Connection; port: INTEGER; host: ARRAY OF CHAR): BOOLEAN; VAR adr: NetSystem.IPAdr; res: INTEGER; BEGIN NetSystem.GetIP(host, adr); IF adr = NetSystem.anyIP THEN C := NIL; RETURN FALSE END; NetSystem.OpenConnection(C, NetSystem.anyport, adr, port, res); IF res # NetSystem.done THEN C := NIL END; RETURN res = NetSystem.done END Connect; PROCEDURE UserBreak: BOOLEAN; VAR ch: CHAR; BEGIN IF Input.Available > 0 THEN Input.Read(ch); IF ch = BreakChar THEN Texts.WriteString(W, "interrupted"); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); RETURN TRUE END END; RETURN FALSE END UserBreak; PROCEDURE ReadResponse(S: Session; VAR sline: ARRAY OF CHAR); VAR time, i, j, cpos: LONGINT; code: ARRAY 8 OF CHAR; line: ARRAY MaxLine OF CHAR; BEGIN IF ~Connected(S.C, NetSystem.in) THEN COPY("Connection closed by server.", sline); COPY(sline, S.reply); S.status := 0; S.res := Disconnected; RETURN END; time := NetSystem.Available(S.C); NetSystem.ReadString(S.C, line); IF log # NIL THEN Texts.WriteString(W, line); Texts.WriteLn(W); Texts.Append(log, W.buf) END; Strings.StrToInt(line, time); S.status := SHORT(time); Strings.IntToStr(time, code); cpos := 0; WHILE code[cpos] # 0X DO 			INC(cpos) END; i := cpos+1; j := 0; WHILE line[i] # 0X DO 			sline[j] := line[i]; INC(j); INC(i) END; sline[j] := 0X; time := Input.Time; IF line[cpos] = "-" THEN LOOP IF NetSystem.Available(S.C) > 0 THEN line[cpos] := 0X; NetSystem.ReadString(S.C, line); IF log # NIL THEN Texts.WriteString(W, line); Texts.WriteLn(W); Texts.Append(log, W.buf) END; IF line[cpos] # "-" THEN line[cpos] := 0X; IF line = code THEN EXIT END END; time := Input.Time ELSIF (Input.Time-time) >= timeOut THEN S.res := TimedOut; RETURN ELSIF UserBreak THEN S.res := Interrupted; RETURN END END END; S.ack := TRUE END ReadResponse; PROCEDURE SendString(C: NetSystem.Connection; str: ARRAY OF CHAR); VAR i: LONGINT; BEGIN i := 0; WHILE str[i] # 0X DO 			INC(i) END; NetSystem.WriteBytes(C, 0, i, str) END SendString; PROCEDURE SendLine(C: NetSystem.Connection; VAR str: ARRAY OF CHAR); BEGIN SendString(C, str); NetSystem.WriteBytes(C, 0, 2, Strings.CRLF) END SendLine; PROCEDURE SendCmd(S: Session; str: ARRAY OF CHAR); BEGIN IF ~S.ack THEN ReadResponse(S, line) ELSE S.ack := FALSE END; SendLine(S.C, str) END SendCmd; PROCEDURE CloseS(S: Session); BEGIN S.ack := TRUE; SendCmd(S, "QUIT"); ReadResponse(S, S.reply); Disconnect(S.dataC); Disconnect(S.C); S.res := Done END CloseS; PROCEDURE Close2(S: Session); BEGIN S.ack := TRUE; SendCmd(S, "QUIT"); Disconnect(S.dataC); Disconnect(S.C) 	END Close2; PROCEDURE QuerySystem(S: Session); VAR pos: LONGINT; BEGIN S.system := UNIX; SendCmd(S, "SYST"); ReadResponse(S, line); IF (S.status >= 200) & (S.status < 300) THEN pos := 0; Strings.Search("VMS", line, pos); IF pos >= 0 THEN S.system := VMS END END END QuerySystem; PROCEDURE QueryString(key: ARRAY OF CHAR; VAR s: ARRAY OF CHAR): BOOLEAN; VAR S: Texts.Scanner; lKey: ARRAY 32 OF CHAR; BEGIN lKey := "NetSystem."; Strings.Append(lKey, key); Oberon.OpenScanner(S, lKey); IF S.class IN {Texts.Name, Texts.String} THEN COPY(S.s, s) 		ELSE COPY("", s) 		END; RETURN s # "" END QueryString; PROCEDURE GetLogin(VAR host, usr, passw: ARRAY OF CHAR); BEGIN IF (usr = "ftp") OR (usr = "anonymous") OR (usr = "") THEN IF ~QueryString("EMail", passw) OR (passw[0] = "<") THEN COPY("anonymous@host.nowhere", passw) END; IF usr = "" THEN COPY("anonymous", usr) END ELSIF passw = "" THEN NetSystem.GetPassword("ftp", host, usr, passw) END END GetLogin; PROCEDURE OpenS(server, user, passwd: ARRAY OF CHAR; port: INTEGER; VAR S: Session); BEGIN NEW(S); S.dataC := NIL; COPY(server, S.host); S.dataPort := -1; COPY(user, S.usr); COPY(passwd, S.passw); GetLogin(server, S.usr, S.passw); IF NetSystem.hostIP = NetSystem.anyIP THEN S.C := NIL; S.reply := "invalid NetSystem.hostIP"; S.res := Failed; RETURN END; S.system := Unknown; S.reply := "connecting failed"; S.portIPAddress := ""; S.ack := TRUE; IF (S.usr = "") OR (S.passw = "") THEN S.res := Failed; S.reply := "no password or username specified"; RETURN END; IF Connect(S.C, port, server) THEN ReadResponse(S, S.reply); IF (S.status >= 200) & (S.status < 300) THEN line := "USER "; Strings.Append(line, S.usr); SendCmd(S, line); ReadResponse(S, line); IF (S.status = 330) OR (S.status = 331) THEN line := "PASS "; Strings.Append(line, S.passw); SendCmd(S, line); ReadResponse(S, line); IF (S.status = 230) OR (S.status= 330) THEN S.res := Done ELSE S.res := WrongPassword; COPY(line, S.reply); Close2(S) END ELSIF S.status # 230 THEN S.res := WrongUser; COPY(line, S.reply); Close2(S) ELSE S.res := Done END; IF S.res # Done THEN NetSystem.DelPassword("ftp", S.usr, server) END ELSE S.res := NotReady; Close2(S) END ELSE S.res := NotConnected END; IF S.res = Done THEN SendCmd(S, "TYPE I"); ReadResponse(S, line); IF S.status # 200 THEN (* should not happen *) END; QuerySystem(S); S.res := Done END END OpenS; PROCEDURE ChangeDirS(S: Session; newDir: ARRAY OF CHAR); BEGIN S.reply := "CWD "; Strings.Append(S.reply, newDir); SendCmd(S, S.reply); ReadResponse(S, S.reply); IF S.status = 250 THEN S.res := Done ELSE S.res := Failed END END ChangeDirS; PROCEDURE SetDataPort(S: Session); VAR str: ARRAY 4 OF CHAR; p0, p1: LONGINT; i, j, k: INTEGER; done: BOOLEAN; BEGIN SendCmd(S, "PASV"); ReadResponse(S, line); IF (S.status >= 200) & (S.status < 300) THEN S.res := Interrupted; i := 0; WHILE (line[i] # 0X) & ~Strings.IsDigit(line[i]) DO INC(i) END; j := 0; k := 0; WHILE (line[i] # 0X) & (k < 4) DO 				IF line[i] # "," THEN S.portIPAddress[j] := line[i] ELSE S.portIPAddress[j] := "."; INC(k) END; INC(i); INC(j) END; IF (j <= 0) & (k < 4) THEN RETURN END; S.portIPAddress[j-1] := 0X; NetSystem.ToHost(S.portIPAddress, S.dataIP, done); IF ~done THEN RETURN END; WHILE (line[i] # 0X) & ((line[i] <= " ") OR (line[i] = ",")) DO INC(i) END; Strings.StrToIntPos(line, p0, i); WHILE (line[i] # 0X) & ((line[i] <= " ") OR (line[i] = ",")) DO INC(i) END; Strings.StrToIntPos(line, p1, i); S.dataPort := SHORT(256*p0+p1); S.res := Done ELSE S.dataIP := NetSystem.anyIP; S.dataPort := dataPort; REPEAT IF S.dataPort >= MaxDataPort THEN S.dataPort := MinDataPort END; INC(S.dataPort); (* not 100% safe *) NetSystem.OpenConnection(S.dataC, S.dataPort, NetSystem.anyIP, NetSystem.anyport, S. res) UNTIL (S.res = NetSystem.done) OR UserBreak; IF S.res = NetSystem.done THEN dataPort := S.dataPort; S.res := Failed; NetSystem.ToNum(NetSystem.hostIP, S.portIPAddress); i := 0; WHILE S.portIPAddress[i] # 0X DO IF S.portIPAddress[i] = "." THEN S.portIPAddress[i] := "," END; INC(i) END; Strings.AppendCh(S.portIPAddress, ","); Strings.IntToStr(S.dataPort DIV 256, str); Strings.Append(S.portIPAddress, str); Strings.AppendCh(S.portIPAddress, ","); Strings.IntToStr(S.dataPort MOD 256, str); Strings.Append(S.portIPAddress, str); line := "PORT "; Strings.Append(line, S.portIPAddress); SendCmd(S, line) ELSE Disconnect(S.dataC); S.dataC := NIL; S.reply := "Interrupted"; S.res := Interrupted END END END SetDataPort; PROCEDURE WaitDataCon(S: Session): NetSystem.Connection; VAR C1: NetSystem.Connection; time: LONGINT; BEGIN IF S.dataIP = NetSystem.anyIP THEN time := Input.Time; REPEAT UNTIL NetSystem.Requested(S.dataC) OR ((Input.Time-time) > timeOut) OR UserBreak; IF NetSystem.Requested(S.dataC) THEN NetSystem.Accept(S.dataC, C1, S.res); Disconnect(S.dataC); IF S.res = NetSystem.done THEN S.res := Done; RETURN C1 				ELSE S.res := Failed END ELSIF (Input.Time-time) > timeOut THEN S.res := TimedOut ELSE S.res := Interrupted END; Disconnect(S.dataC) ELSE NetSystem.OpenConnection(C1, NetSystem.anyport, S.dataIP, S.dataPort, S.res); IF S.res = Done THEN RETURN C1 END END; RETURN NIL END WaitDataCon; PROCEDURE EnumDir(S: Session; enum: EnumProc); VAR C: NetSystem.Connection; len: LONGINT; BEGIN S.reply := ""; SetDataPort(S); C := NIL; IF S.res = Interrupted THEN RETURN END; IF S.dataIP = NetSystem.anyIP THEN ReadResponse(S, line) ELSE C := WaitDataCon(S); IF S.res = Done THEN S.status := 200 END END; IF S.status = 200 THEN IF S.system = VMS THEN SendCmd(S, "NLST") ELSE SendCmd(S, "LIST") END; ReadResponse(S, S.reply); IF (S.status = 150) OR (S.status = 250) THEN IF S.dataIP = NetSystem.anyIP THEN C := WaitDataCon(S) END; IF S.res = Done THEN S.res := Done; len := NetSystem.Available(C); WHILE ((len > 0) OR Connected(C, NetSystem.in)) & ~UserBreak DO 						IF len > 0 THEN NetSystem.ReadString(C, line); enum(line) END; len := NetSystem.Available(C) END END; Disconnect(C);	(* before ReadResponse *) ReadResponse(S, S.reply) ELSE S.res := Failed END END; IF C # NIL THEN Disconnect(C) END; IF S.dataC # NIL THEN Disconnect(S.dataC) END END EnumDir; PROCEDURE GetCurDir(S: Session; VAR curdir: ARRAY OF CHAR); VAR i, j: INTEGER; BEGIN SendCmd(S, "PWD"); ReadResponse(S, S.reply); IF S.status = 257 THEN IF S.system = VMS THEN COPY(S.reply, curdir); i := 0; WHILE curdir[i] > " " DO 					INC(i) END; curdir[i] := 0X ELSE i := 0; WHILE (S.reply[i] # 0X) & (S.reply[i] # 22X) DO 					INC(i) END; j := 0; IF S.reply[i] = 22X THEN INC(i); WHILE (S.reply[i] # 0X) & (S.reply[i] # 22X) DO 						curdir[j] := S.reply[i]; INC(j); INC(i) END END; curdir[j] := 0X END; S.res := Done ELSE COPY("", curdir); S.res := Failed END END GetCurDir; PROCEDURE MakeDirS(S: Session; newDir: ARRAY OF CHAR); BEGIN S.reply := "MKD "; Strings.Append(S.reply, newDir); SendCmd(S, S.reply); ReadResponse(S, S.reply); IF S.status = 257 THEN S.res := Done ELSE S.res := Failed END END MakeDirS; PROCEDURE RmDirS(S: Session; dir: ARRAY OF CHAR); BEGIN S.reply := "RMD "; Strings.Append(S.reply, dir); SendCmd(S, S.reply); ReadResponse(S, S.reply); IF S.status = 250 THEN S.res := Done ELSE S.res := Failed END END RmDirS; PROCEDURE DeleteFile(S: Session; remName: ARRAY OF CHAR); BEGIN S.reply := "DELE "; Strings.Append(S.reply, remName); SendCmd(S, S.reply); ReadResponse(S, S.reply); IF S.status = 250 THEN S.res := Done ELSE S.res := Failed END END DeleteFile; PROCEDURE ReadData(S: Session; C: NetSystem.Connection; VAR R: Files.Rider); VAR len, rlen: LONGINT; BEGIN len := NetSystem.Available(C); WHILE (len > 0) OR Connected(C, NetSystem.in) DO 			IF len > BufLen THEN rlen := BufLen ELSE rlen := len END; NetSystem.ReadBytes(C, 0, rlen, buffer); Files.WriteBytes(R, buffer, rlen); DEC(len, rlen); IF len <= 0 THEN IF UserBreak THEN RETURN END; len := NetSystem.Available(C) END END END ReadData; PROCEDURE GetF(S: Session; remName: ARRAY OF CHAR; VAR R: Files.Rider); VAR C: NetSystem.Connection; BEGIN S.reply := ""; SetDataPort(S); C := NIL; IF S.res = Interrupted THEN RETURN END; IF S.dataIP = NetSystem.anyIP THEN ReadResponse(S, line) ELSE C := WaitDataCon(S); IF S.res = Done THEN S.status := 200 END END; IF S.status = 200 THEN line := "RETR "; Strings.Append(line, remName); SendCmd(S, line); ReadResponse(S, line); COPY(line, S.reply); IF (S.status = 150) OR (S.status = 250) THEN IF S.dataIP = NetSystem.anyIP THEN C := WaitDataCon(S) END; IF S.res = Done THEN ReadData(S, C, R) 				END; Disconnect(C);	(* before ReadResponse *) ReadResponse(S, S.reply); IF S.res = Interrupted THEN ReadResponse(S, line) END; ELSE S.res := Failed END END; IF C # NIL THEN Disconnect(C) END; IF S.dataC # NIL THEN Disconnect(S.dataC) END END GetF; PROCEDURE GetFile(S: Session; remName, locName: ARRAY OF CHAR); VAR F: Files.File; R: Files.Rider; BEGIN F := Files.New(locName); IF F # NIL THEN Files.Set(R, F, 0); GetF(S, remName, R); IF (S.status >= 200) & (S.status < 300) THEN Files.Register(F); IF log # NIL THEN Texts.WriteString(W, "Received: "); Texts.WriteString(W, locName); Texts.WriteString(W, " "); Texts.WriteInt(W, Files.Length(F), 1); Texts.WriteString(W, " bytes"); Texts.WriteLn(W); Texts.Append(log, W.buf) END ELSE Texts.WriteLn(W)	(* error message on new line *) END ELSE S.reply := "Bad file name" END END GetFile; PROCEDURE WriteData(C: NetSystem.Connection; VAR R: Files.Rider); BEGIN Files.ReadBytes(R, buffer, BufLen); WHILE ~R.eof DO 			NetSystem.WriteBytes(C, 0, BufLen, buffer); Files.ReadBytes(R, buffer, BufLen) END; IF R.res > 0 THEN NetSystem.WriteBytes(C, 0, BufLen-R.res, buffer) END END WriteData; PROCEDURE PutFile(S: Session; remName, locName: ARRAY OF CHAR); VAR C: NetSystem.Connection; F: Files.File; R: Files.Rider; BEGIN S.reply := ""; C := NIL; F := Files.Old(locName); IF F # NIL THEN SetDataPort(S); IF S.res = Interrupted THEN RETURN END; IF S.dataIP = NetSystem.anyIP THEN ReadResponse(S, line) ELSE C := WaitDataCon(S); IF S.res = Done THEN S.status := 200 END END; IF S.status = 200 THEN line := "STOR "; Strings.Append(line, remName); SendCmd(S, line); ReadResponse(S, S.reply); IF (S.status = 150) OR (S.status = 250) THEN IF S.dataIP = NetSystem.anyIP THEN C := WaitDataCon(S) END; IF S.res = Done THEN Files.Set(R, F, 0); WriteData(C, R) 					END; Disconnect(C);	(* before ReadResponse *) ReadResponse(S, S.reply) ELSE S.res := Failed END END ELSE COPY(locName, S.reply); Strings.Append(S.reply, " not found"); S.res := LocFileNotFound END; IF C # NIL THEN Disconnect(C) END; IF S.dataC # NIL THEN Disconnect(S.dataC) END END PutFile; PROCEDURE ReadText(C: NetSystem.Connection; VAR W: Texts.Writer); VAR len, rlen, i: LONGINT; ch: CHAR; exit: BOOLEAN; BEGIN len := NetSystem.Available(C); exit := FALSE; WHILE (len > 0) OR Connected(C, NetSystem.in) DO 			IF len > (BufLen-2) THEN rlen := BufLen-2 ELSE rlen := len END; NetSystem.ReadBytes(C, 0, rlen, buffer); i := 0; WHILE i < rlen DO 				ch := buffer[i]; IF ch = Strings.CR THEN (* ignore CR *) ELSIF ch = Strings.LF THEN Texts.WriteLn(W) ELSE ch := Strings.ISOToOberon[ORD(ch)]; Texts.Write(W, ch) END; INC(i) END; DEC(len, rlen); IF len <= 0 THEN len := NetSystem.Available(C) END END END ReadText; PROCEDURE GetText(S: Session; remName: ARRAY OF CHAR; VAR W: Texts.Writer); VAR C: NetSystem.Connection; BEGIN S.reply := ""; C := NIL; SendCmd(S, "TYPE A"); ReadResponse(S, line); SetDataPort(S); IF S.res = Interrupted THEN SendCmd(S, "TYPE I"); ReadResponse(S, line); RETURN END; IF S.dataIP = NetSystem.anyIP THEN ReadResponse(S, line) ELSE C := WaitDataCon(S); IF S.res = Done THEN S.status := 200 END END; IF S.status = 200 THEN line := "RETR "; Strings.Append(line, remName); SendCmd(S, line); ReadResponse(S, line); COPY(line, S.reply); IF (S.status = 150) OR (S.status = 250) THEN IF S.dataIP = NetSystem.anyIP THEN C := WaitDataCon(S) END; IF S.res = Done THEN ReadText(C, W) 				END; Disconnect(C);	(* before ReadResponse *) ReadResponse(S, S.reply); IF S.res = Interrupted THEN ReadResponse(S, line) END ELSE S.res := Failed END END; IF C # NIL THEN Disconnect(C) END; IF S.dataC # NIL THEN Disconnect(S.dataC) END; SendCmd(S, "TYPE I"); ReadResponse(S, line) END GetText; PROCEDURE WriteText(C: NetSystem.Connection; T: Texts.Text); VAR R: Texts.Reader; ch: CHAR; BEGIN Texts.OpenReader(R, T, 0); Texts.Read(R, ch); WHILE ~R.eot DO 			IF R.lib IS Fonts.Font THEN IF ch = Strings.CR THEN NetSystem.WriteBytes(C, 0, 2, Strings.CRLF) ELSIF ch # Strings.LF THEN ch := Strings.OberonToISO[ORD(ch)]; NetSystem.Write(C, ch) END END; Texts.Read(R, ch) END END WriteText; PROCEDURE PutText(S: Session; remName: ARRAY OF CHAR; text: Texts.Text); VAR C: NetSystem.Connection; BEGIN S.reply := ""; C := NIL; SendCmd(S, "TYPE A"); ReadResponse(S, line); IF (S.status < 200) OR (S.status >= 300) THEN RETURN END; SetDataPort(S); IF S.res = Interrupted THEN SendCmd(S, "TYPE I"); ReadResponse(S, line); RETURN END; IF S.dataIP = NetSystem.anyIP THEN ReadResponse(S, line) ELSE C := WaitDataCon(S); IF S.res = Done THEN S.status := 200 END END; IF S.status = 200 THEN line := "STOR "; Strings.Append(line, remName); SendCmd(S, line); ReadResponse(S, S.reply); IF (S.status = 150) OR (S.status = 250) THEN IF S.dataIP = NetSystem.anyIP THEN C := WaitDataCon(S) END; IF S.res = Done THEN WriteText(C, text) END; Disconnect(C);	(* before ReadResponse *) ReadResponse(S, S.reply) ELSE S.res := Failed END END; IF C # NIL THEN Disconnect(C) END; IF S.dataC # NIL THEN Disconnect(S.dataC) END; SendCmd(S, "TYPE I"); ReadResponse(S, line) END PutText; PROCEDURE ShowRes; BEGIN Texts.WriteString(W, S.reply); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) END ShowRes; PROCEDURE OpenScanner(VAR S: Texts.Scanner); VAR beg, end, time: LONGINT; text: Texts.Text; BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S); IF (S.class = Texts.Char) & (S.c = "^") THEN time := -1; text := NIL; Oberon.GetSelection(text, beg, end, time); IF (text # NIL) & (time >= 0) THEN Texts.OpenScanner(S, text, beg); Texts.Scan(S) END END END OpenScanner; PROCEDURE SplitFTPAdr(VAR url, host, path, user, passwd: ARRAY OF CHAR; VAR type: CHAR; VAR port: INTEGER): BOOLEAN; VAR i, j, l: LONGINT; service: ARRAY 8 OF CHAR; PROCEDURE Blanks; BEGIN WHILE (url[i] # 0X) & (url[i] <= " ") DO 				INC(i) END END Blanks; BEGIN type := 0X; port := DefConPort; COPY("", user); COPY("", passwd); i := 0; Blanks; FOR j := 0 TO 5 DO service[j] := url[i+j] END; service[6] := 0X; IF Strings.CAPPrefix("ftp:&#47;/", service) THEN INC(i, 6) END; (* look ahead for @ *) j := i; 		WHILE (url[j] # 0X) & (url[j] # "@") & (url[j] # "/") DO 			INC(j) END; IF url[j] = "@" THEN (* get user *) l := LEN(user)-1; j := 0; WHILE (url[i] # 0X) & (url[i] # ":") & (url[i] # "@") DO 				IF (j < l) THEN user[j] := url[i]; INC(j) END; INC(i) END; user[j] := 0X; DEC(j); WHILE (j >= 0) & (user[j] <= " ") DO 				user[j] := 0X; DEC(j) END; IF url[i] = ":" THEN (* get password *) l := LEN(passwd); INC(i); Blanks; j := 0; WHILE (url[i] # 0X) & (url[i] # "@") DO 					IF j < l THEN passwd[j] := url[i]; INC(j) END; INC(i) END; passwd[j] := 0X; DEC(j); WHILE (j >= 0) & (passwd[j] <= " ") DO 					passwd[j] := 0X; DEC(j) END END; INC(i); Blanks END; (* get host *) l := LEN(host); j := 0; WHILE (url[i] # 0X) & (url[i] # ":") & (url[i] # "/") DO 			IF j < l THEN host[j] := url[i]; INC(j) END; INC(i) END; host[j] := 0X; DEC(j); WHILE (j >= 0) & (host[j] <= " ") DO 			host[j] := 0X; DEC(j) END; IF url[i] = ":" THEN port := 0; INC(i); WHILE (url[i] # "/") & (url[i] # 0X) DO 				IF Strings.IsDigit(url[i]) THEN port := port*10+ORD(url[i])-ORD("0") END; INC(i) END; IF port <= 0 THEN port := DefConPort END END; (* get path *) l := LEN(path); j := 0; IF url[i] # 0X THEN path[j] := url[i]; INC(j); INC(i); IF url[i] = "~" THEN j := 0 END END; WHILE (url[i] # 0X) & (url[i] # ";") DO 			IF j < l THEN path[j] := url[i]; INC(j) END; INC(i) END; path[j] := 0X; DEC(j); WHILE (j >= 0) & (path[j] <= " ") DO 			path[j] := 0X; DEC(j) END; IF url[i] = ";" THEN INC(i); Blanks; IF CAP(url[i]) # "T" THEN type := CAP(url[i]) ELSE WHILE (url[i] # 0X) & (url[i] # "=") DO 					INC(i) END; IF url[i] = "=" THEN INC(i); Blanks; type := CAP(url[i]) ELSE type := "T" END END END; RETURN (host # "") & (port > 0) END SplitFTPAdr; (** FTP.Open (server | "^") 		Open an ftp connection to server using username and password set with FTP.SetUser. *) PROCEDURE Open*; VAR Sc: Texts.Scanner; host, path, user, passwd: ARRAY 64 OF CHAR; port: INTEGER; type: CHAR; BEGIN IF S = NIL THEN OpenScanner(Sc); IF Sc.class IN {Texts.Name, Texts.String} THEN IF SplitFTPAdr(Sc.s, host, path, user, passwd, type, port) THEN OpenS(host, user, passwd, port, S); ShowRes; IF S.res # Done THEN S := NIL END END END ELSE Texts.WriteString(W, "already connected"); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) END END Open; PROCEDURE Con: BOOLEAN; BEGIN IF S = NIL THEN Texts.WriteString(W, "not connected"); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); RETURN FALSE ELSE RETURN TRUE END END Con; (** FTP.Close 		Close an previously opened FTP connection. *) PROCEDURE Close*; BEGIN IF Con THEN CloseS(S); ShowRes; IF S.res = Done THEN S := NIL END END END Close; (** FTP.ChangeDir (newdir | "^") 		Change the current directory on the FTP server to newdir. *) PROCEDURE ChangeDir*; VAR Sc: Texts.Scanner; BEGIN IF Con THEN OpenScanner(Sc); IF Sc.class IN {Texts.Name, Texts.String} THEN ChangeDirS(S, Sc.s); ShowRes END END END ChangeDir; PROCEDURE *ShowEntry(entry: ARRAY OF CHAR); BEGIN Texts.WriteString(W, entry); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) END ShowEntry; (** FTP.Dir 		List the contents of the current directory on the FTP server. *) PROCEDURE Dir*; BEGIN IF Con THEN EnumDir(S, ShowEntry); ShowRes END END Dir; PROCEDURE *ShowCompactEntry(entry: ARRAY OF CHAR); VAR i: INTEGER; BEGIN i := 0; WHILE entry[i] # 0X DO 			INC(i) END; IF i > 0 THEN DEC(i) ELSE RETURN END; WHILE (i > 0) & (entry[i] > " ") DO 			DEC(i) END; IF entry[i] <= " " THEN INC(i) END; WHILE entry[i] # 0X DO 			INC(col); Texts.Write(W, entry[i]); INC(i) END; INC(col); IF col >= 50 THEN Texts.WriteLn(W); col := 0 ELSE INC(col); Texts.Write(W, Tab) END; Texts.Append(Oberon.Log, W.buf) END ShowCompactEntry; (** FTP.CompactDir 		List the contents of the current directory on the FTP server in a more 		compact form. *) PROCEDURE CompactDir*; BEGIN IF Con THEN col := 0; EnumDir(S, ShowCompactEntry); IF col > 0 THEN Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) END; ShowRes END END CompactDir; (** FTP.CurDir 		Display the current path on the FTP server *) PROCEDURE CurDir*; VAR curdir: ARRAY 256 OF CHAR; BEGIN IF Con THEN GetCurDir(S, curdir); ShowRes END END CurDir; (** FTP.MakeDir (server | "^") 		Create a new directory. *) PROCEDURE MakeDir*; VAR Sc: Texts.Scanner; BEGIN IF Con THEN OpenScanner(Sc); IF Sc.class IN {Texts.Name, Texts.String} THEN MakeDirS(S, Sc.s); ShowRes END END END MakeDir; (** FTP.RmDir (server | "^") 		Remove an existing directory. *) PROCEDURE RmDir*; VAR Sc: Texts.Scanner; BEGIN IF Con THEN OpenScanner(Sc); IF Sc.class IN {Texts.Name, Texts.String} THEN RmDirS(S, Sc.s); ShowRes END END END RmDir; (** FTP.DeleteFiles ({remname} | "^") 		Delete the files remname on the FTP server. *) PROCEDURE DeleteFiles*; VAR Sc: Texts.Scanner; beg, end, time, pos: LONGINT; text: Texts.Text; BEGIN IF Con THEN end := Oberon.Par.text.len; Texts.OpenScanner(Sc, Oberon.Par.text, Oberon.Par.pos); pos := Texts.Pos(Sc); Texts.Scan(Sc); IF (Sc.class = Texts.Char) & (Sc.c = "^") THEN time := -1; text := NIL; Oberon.GetSelection(text, beg, end, time); IF (text # NIL) & (time >= 0) THEN Texts.OpenScanner(Sc, text, beg); pos := Texts.Pos(Sc); Texts.Scan(Sc) ELSE end := Oberon.Par.text.len END END; Texts.WriteString(W, "FTP.DeleteFile"); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); WHILE (Sc.class IN {Texts.Name, Texts.String}) & (pos < end) & (S.res = Done) DO 				Texts.Write(W, Tab); Texts.WriteString(W, Sc.s); Texts.Write(W, Tab); Texts.Append(Oberon.Log, W.buf); DeleteFile(S, Sc.s); ShowRes; pos := Texts.Pos(Sc); Texts.Scan(Sc); Oberon.Collect END END END DeleteFiles; PROCEDURE ScanPair(VAR S: Texts.Scanner; VAR name1, name2: ARRAY OF CHAR): BOOLEAN; BEGIN (* while loop from pieter *) Oberon.Collect; WHILE ~(S.class IN {Texts.Name, Texts.String}) & ((S.class # Texts.Char) OR (S.c # "~")) & ~S.eot DO 			Texts.Scan(S) END; IF S.class IN {Texts.Name, Texts.String} THEN COPY(S.s, name1); Texts.Scan(S); IF (S.class = Texts.Char) & (S.c = "=") THEN Texts.Scan(S); IF (S.class = Texts.Char) & (S.c = ">") THEN Texts.Scan(S); IF S.class IN {Texts.Name, Texts.String} THEN COPY(S.s, name2); Texts.Scan(S); RETURN TRUE END END ELSE COPY(name1, name2); RETURN TRUE END END; RETURN FALSE END ScanPair; (** FTP.GetFiles ({remname "=>" locname} | "^") 		Get files remname from the FTP server and store them as locname. *) PROCEDURE GetFiles*; VAR Sc: Texts.Scanner; loc, rem: ARRAY LEN(Sc.s) OF CHAR; BEGIN IF Con THEN OpenScanner(Sc); Texts.WriteString(W, "FTP.GetFiles"); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); WHILE ScanPair(Sc, rem, loc) & (S.res = Done) DO 				Texts.Write(W, Tab); Texts.WriteString(W, rem); Texts.WriteLn(W); (* ple, 2004-03-10 *) Texts.WriteString(W, " => "); Texts.WriteString(W, loc); (* Texts.Write(W, Tab); *) Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); GetFile(S, rem, loc); ShowRes END END END GetFiles; (** FTP.GetTexts ({remname "=>" locname} | "^") 		Get text-files remname from the FTP server and store them as locname. *) PROCEDURE GetTexts*; VAR Sc: Texts.Scanner; loc, rem: ARRAY LEN(Sc.s) OF CHAR; T: Texts.Text; F: Files.File; len: LONGINT; Wr: Texts.Writer; BEGIN IF Con THEN OpenScanner(Sc); Texts.WriteString(W, "FTP.GetTexts"); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); WHILE ScanPair(Sc, rem, loc) & (S.res = Done) DO 				Texts.Write(W, Tab); Texts.WriteString(W, rem); Texts.WriteLn(W); Texts.WriteString(W, " => "); Texts.WriteString(W, loc); (* Texts.Write(W, Tab); *) Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); Texts.OpenWriter(Wr); GetText(S, rem, Wr); NEW(T); Texts.Open(T, ""); Texts.Append(T, Wr.buf); IF (S.status >= 200) & (S.status < 300) THEN F := Files.New(loc); IF F # NIL THEN Texts.Store(T, F, 0, len); Files.Register(F); IF log # NIL THEN Texts.WriteString(W, "Received: "); Texts.WriteString(W, loc); Texts.WriteString(W, " "); Texts.WriteInt(W, Files.Length(F), 1); Texts.WriteString(W, " bytes"); Texts.WriteLn(W); Texts.Append(log, W.buf) END ELSE S.reply := "Bad file name" END ELSE Texts.WriteLn(W)	(* error message on new line *) END; ShowRes END END END GetTexts; (** FTP.PutFiles ({locname "=>" remname} | "^") 		Put files locname as remname on the FTP server. *) PROCEDURE PutFiles*; VAR Sc: Texts.Scanner; loc, rem: ARRAY LEN(Sc.s) OF CHAR; BEGIN IF Con THEN OpenScanner(Sc); Texts.WriteString(W, "FTP.PutFiles"); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); WHILE ScanPair(Sc, loc, rem) & (S.res = Done) DO 				Texts.Write(W, Tab); Texts.WriteString(W, loc); Texts.WriteLn(W); Texts.WriteString(W, " => "); Texts.WriteString(W, rem); (* Texts.Write(W, Tab); *) Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); PutFile(S, rem, loc); ShowRes END END END PutFiles; (** FTP.PutTexts ({locname "=>" remname} | "^") 		Put text-files locname as remname on the FTP server. *) PROCEDURE PutTexts*; VAR Sc: Texts.Scanner; loc, rem: ARRAY LEN(Sc.s) OF CHAR; text: Texts.Text; BEGIN IF Con THEN OpenScanner(Sc); Texts.WriteString(W, "FTP.PutTexts"); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); WHILE ScanPair(Sc, loc, rem) & (S.res = Done) DO 				Texts.Write(W, Tab); Texts.WriteString(W, loc); Texts.WriteLn(W); Texts.WriteString(W, " => "); Texts.WriteString(W, rem); (* Texts.Write(W, Tab); *) Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); NEW(text); Texts.Open(text, loc); PutText(S, rem, text); ShowRes END END END PutTexts; (** Open a separate log text for FTP. *) PROCEDURE OpenLog*; BEGIN IF (log = Oberon.Log) OR (log = NIL) THEN NEW(log); Texts.Open(log, "") END; Oberon.OpenText("FTP.Log", log, Display.Width DIV 8 * 3, Display.Height DIV 3) END OpenLog; BEGIN S := NIL; log := NIL; Texts.OpenWriter(W); timeOut := 5*60*Input.TimeUnit; dataPort := MinDataPort END FTP. System.Free FTP ~ Configuration.DoCommands FTP.Open muller@ice ~ FTP.ChangeDir "~muller/ftp.inf/pub/ETHOberon/Native/Update/Alpha/" FTP.PutFiles Oberon0.Dsk=>Temp.Dsk ~ FTP.PutFiles Temp.Dsk ~ FTP.Close ~ System.Directory *.Dsk\d System.CopyFiles Oberon0.Dsk => Rfs:Temp.Dsk ~