Ȍ Syntax10.Scn.Fnt Syntax10b.Scn.Fnt Syntax10i.Scn.Fnt n vp _ VersionElems AllocBeg # Syntax10.Scn.Fnt PowerMac
WindowsPowerMac PowerMac Windows $ Syntax14b.Scn.Fnt Windows 3.1/95/NT Syntax14b.Scn.Fnt p _ VersionElems AllocEnd 8 FoldElems New < Syntax10.Scn.Fnt Syntax10i.Scn.Fnt
(********************************************************************
This module implements FTP (the FIle Transfer Protocol) for Web.
To install it, add WebFTP to the "modules" line in the [Web] section of
your Web.Profile.
WebFTP requires the module FTPB.Mod from the FTP client package.
WebFTP is based upon the simple Oberon FTP client (SFTP.Mod) and thus needs
the following settings from the configuration file FTP.Profile:
[FTP]
Type = Automatic | ASCII | Binary
[User]
DownloadsFolder = "your.downloads.folder"
Mail = "your.email.address"
[Type]
ASCII = ...
See the FTP client's documentation for a description of these entries.
Bugs, etc:
Proxies are not supported. Since I currently have no idea how
proxies work for FTP (and how to implement this in the FTPB module),
it'll probable never be implemented.
The cache is not yet supported.
********************************************************************)
8 -8 < Syntax10.Scn.Fnt Syntax10i.Scn.Fnt
(****************************************************
Revision History:
961217: GO first release
****************************************************)
8 8 # Syntax10.Scn.Fnt \ \
TCP, T := Texts, FTPB,
Input, Files, Directories, O := Oberon, Strings, Web, TextFrames;
8 O8 1 Syntax10.Scn.Fnt ; Syntax10b.Scn.Fnt ^ Syntax10i.Scn.Fnt n $
% + ) , !
ftpScheme = "ftp";
protocol = "FTP";
defaultPort = 21;
profile = "FTP.Profile";
asciiType = "type=a";
binaryType = "type=i";
typeUNIX = "UNIX"; (* remote system types *)
typeVMS = "VMS";
typeWinNT = "Windows_NT";
typeMacOS = "MACOS";
typeOther = "";
LF = 0AX;
CR = 0DX;
noErr* = 0; (* error codes *)
cntlOpenErr* = 1; (* can't open control connection *)
dataOpenErr* = 2; (* can't open data connection *)
dataListenErr* = 3; (* can't listen on data connection *)
replyTimeOutErr* = 4; (* request timed out *)
notAvailErr* = 5; (* ftp service not available *)
tempNotAvailErr* = 6; (* ftp service temporarily not available *)
loginErr* = 7; (* login failed *)
resolveAddrErr* = 9; (* can't resolve host address *)
dataConnLostErr* = 10; (* data connection unexpectedly closed *)
cntlConnLostErr* = 11; (* control connection unexpectedly closed *)
fileNotFoundErr* = 40; (* file not found on server *)
fileCreationErr* = 41; (* can't create local file *)
fileOpenErr* = 42; (* can't open local file *)
storeErr* = 43; (* can't store file on server *)
pwdErr* = 50; (* PWD command didn't work *)
unexpectedErr* = 99;
8 8 Syntax10.Scn.Fnt Syntax10b.Scn.Fnt % G
f ! "
Syntax10i.Scn.Fnt q
FTPTransmission* = POINTER TO FTPTransmissionDesc;
FTPTransmissionDesc* = RECORD(FTPB.FTPTransmissionDesc)
itsCntlConn: FTPB.FTPCntlConn
END;
Task = POINTER TO TaskDesc;
TaskDesc = RECORD(Web.TaskDesc)
done: BOOLEAN;
displayerOpened: BOOLEAN;
act: Web.UrlStack;
elem: T.Elem;
trans: FTPTransmission
END;
Loader = POINTER TO LoaderDesc;
LoaderDesc = RECORD(Web.LoaderDesc)
END;
Writer* = POINTER TO WriterDesc;
WriterDesc* = RECORD(FTPB.WriterDesc)
name: ARRAY 256 OF CHAR;
itsFile: Files.File;
webTask: Task
END;
AsciiWriter* = POINTER TO AsciiWriterDesc;
AsciiWriterDesc* = RECORD(WriterDesc) END;
BinaryWriter* = POINTER TO BinaryWriterDesc;
BinaryWriterDesc* = RECORD(WriterDesc) END;
DirWriter* = POINTER TO DirWriterDesc;
DirWriterDesc* = RECORD(WriterDesc)
useNLST: BOOLEAN;
isMacOS: BOOLEAN;
dirEntryLen: INTEGER;
dirEntry: ARRAY 256 OF CHAR
END;
URLData = RECORD
uid, pwd: ARRAY 64 OF CHAR;
noPwd: BOOLEAN; (* no password given *)
host: ARRAY 64 OF CHAR;
port: INTEGER;
path: ARRAY 256 OF CHAR;
name: ARRAY 256 OF CHAR;
type: CHAR
END;
FileType = ARRAY 8 OF CHAR;
8 8 < Syntax10b.Scn.Fnt Syntax10.Scn.Fnt
w: T.Writer;
8 * 8 # Syntax10.Scn.Fnt / /
BEGIN
T.WriteString(w, str)
END WriteString;
8 8 # Syntax10.Scn.Fnt ; ;
BEGIN
T.WriteLn(w); T.Append(O.Log, w.buf);
END WriteLn;
8 & 8 # Syntax10.Scn.Fnt
BEGIN
WriteString("WebFTP Error: ");
CASE errNo OF
cntlOpenErr: WriteString("Can't open FTP control connection.");
| dataOpenErr: WriteString("Can't open FTP data connection.");
| dataListenErr: WriteString("Can't listen on data connection.");
| replyTimeOutErr: WriteString("Time out.");
| notAvailErr: WriteString("FTP service not available at this site.");
| tempNotAvailErr: WriteString("FTP service temporarily not available at this site.");
| loginErr: WriteString("Login failed.");
| resolveAddrErr: WriteString("Can't resolve host address.");
| dataConnLostErr: WriteString("Data connection unexpectedly closed.");
| cntlConnLostErr: WriteString("Control connection unexpectedly closed.");
| fileNotFoundErr: WriteString("File not found on server.");
| fileOpenErr: WriteString("Can't open local file.");
| fileCreationErr: WriteString("Can't create local file.");
| pwdErr: WriteString("PWD command didn't work.");
ELSE
END;
WriteLn();
END WriteError;
8 P 8 m Syntax10.Scn.Fnt Syntax10i.Scn.Fnt J J
(* Copies the last line of a reply into a string. *)
(* In a multi-line reply, the last line usually contains the important information. *)
(* The decimal reply-code (first for chars of every line) is not copied to the string. *)
VAR
b: T.Buffer; t: T.Text; r: T.Reader;
ch: CHAR; i: INTEGER;
BEGIN
(* Copy the buffer, create a new text with it, and copy it to a string. *)
NEW(b); T.OpenBuf(b); T.Copy(replyText.buf, b);
NEW(t); t.notify := TextFrames.NotifyDisplay;
T.Open(t, ""); T.Append(t, b);
T.OpenReader(r, t, 0);
T.Read(r, ch);
WHILE ~r.eot DO
i := 0;
T.Read(r, ch); T.Read(r, ch); T.Read(r, ch); (* skip reply code *)
IF ~r.eot THEN
T.Read(r, ch);
WHILE ~r.eot & (ch # 0DX) DO
IF i < LEN(replyString) - 1 THEN replyString[i] := ch; INC(i) END;
T.Read(r, ch)
END;
replyString[i] := 0X;
END;
IF ~r.eot THEN T.Read(r, ch) END; (* first char of next line *)
END
END ReplyToString;
8 ] 8 Q Syntax10.Scn.Fnt Syntax10i.Scn.Fnt C
5
(* Sends a PWD command to the server and interprets the reply. *)
VAR replyCode: INTEGER; replyText: T.Writer; replyStr: ARRAY 256 OF CHAR; i: INTEGER;
BEGIN
cntlConn.Request("PWD", replyCode, replyText);
ReplyToString(replyText, replyStr);
COPY("/", dir);
success := (replyCode = 257);
IF success THEN
IF replyStr[0] = '"' THEN (* the reply contains a valid path specification *)
i := 1; WHILE (replyStr[i] # 0X) & (replyStr[i] # '"') DO dir[i - 1] := replyStr[i]; INC(i) END;
dir[i - 1] := 0X
END
END
END GetPath;
8 N H8 C Syntax10.Scn.Fnt Syntax10i.Scn.Fnt D 0 v
(* Sends a SYST command to the server and interprets the reply. *)
VAR
replyCode: INTEGER; replyText: T.Writer;
replyStr: ARRAY 256 OF CHAR;
i: INTEGER;
BEGIN
cntlConn.Request("SYST", replyCode, replyText);
ReplyToString(replyText, replyStr);
IF FTPB.GetReplyCategory(replyCode) = FTPB.positiveCompletion THEN
i := 0; WHILE (replyStr[i] # 0X) & (replyStr[i] # ' ') & (i < LEN(type)) DO type[i] := replyStr[i]; INC(i) END;
type[i] := 0X;
IF (type # typeUNIX) & (type # typeVMS) & (type # typeWinNT) & (type # typeMacOS) THEN
COPY(typeOther, type)
END
ELSE
COPY(typeOther, type)
END
END GetSystemType;
8 K 8 C Syntax10.Scn.Fnt Syntax10i.Scn.Fnt
(* Prompts for the user to enter a password. *)
(* Doesn't echo input to screen, but draws an asterisk for each entered char. *)
VAR i: INTEGER; ch: CHAR;
BEGIN
WriteString(prompt); T.Append(O.Log, w.buf);
i := 0; Input.Read(ch);
WHILE (ch # 0DX) & (i < LEN(passwd)) DO
WriteString("*"); T.Append(O.Log, w.buf); passwd[i] := ch; INC(i); Input.Read(ch);
END;
passwd[i] := 0X;
WriteLn();
END ReadPassword;
8 g 8 _ Syntax10.Scn.Fnt Syntax10i.Scn.Fnt #
(* Searches the specified attribute in the profile and returns a scanner for the profile *)
(* text if the search was successfull. The value of the attribute can be obtained by *)
(* calling Texts.Scan(s). *)
VAR profText: T.Text; found: BOOLEAN;
BEGIN
NEW(profText); T.Open(profText, profile);
T.OpenScanner(s, profText, 0);
found := FALSE;
success := FALSE;
REPEAT (* Search section *)
REPEAT T.Scan(s) UNTIL s.eot OR (s.class = T.Char) & (s.c = '[');
IF ~s.eot THEN
T.Scan(s); found := (s.class = T.Name) & (s.s = section);
IF found THEN (* Search attribute *)
REPEAT T.Scan(s) UNTIL s.eot OR (s.class = T.Name) & (s.s = attr);
IF ~s.eot THEN
T.Scan(s);
success := (s.class = T.Char) & (s.c = '=');
END;
END;
END;
UNTIL s.eot OR found
END FindProfile;
8 @ :8 _ Syntax10.Scn.Fnt Syntax10i.Scn.Fnt " h
VAR success: BOOLEAN; s: T.Scanner;
BEGIN
Strings.Cap(name);
FindProfile(profile, "FTP", "Type", success, s); IF success THEN
T.Scan(s); IF s.class = T.Name THEN
IF s.s = "ASCII" THEN type := asciiType
ELSIF s.s = "Binary" THEN type := binaryType
ELSE (* Automatic *)
FindProfile(profile, "Type", "ASCII", success, s); IF success THEN
T.Scan(s); WHILE s.class = T.String DO
Strings.Cap(s.s); (* actually a little bit dirty *)
IF Strings.Match(name, s.s) THEN type := asciiType; RETURN END;
T.Scan(s)
END
END
END
END
END;
type := binaryType
END GetFileType;
8 2 8 C Syntax10.Scn.Fnt Syntax10i.Scn.Fnt ! #
VAR success: BOOLEAN; res: INTEGER; s: T.Scanner;
BEGIN
FindProfile(profile, "User", "Mail", success, s); IF success THEN
T.Scan(s); IF s.class = T.String THEN
COPY(s.s, email)
ELSE
TCP.GetHostName(email, res); Strings.Insert("oberon@", 0, email);
END
END
END GetUserEMail;
8 7 8 C Syntax10.Scn.Fnt Syntax10i.Scn.Fnt
VAR success: BOOLEAN; s: T.Scanner;
BEGIN
FindProfile(profile, "User", "DownloadsFolder", success, s); IF success THEN
T.Scan(s); IF s.class = T.String THEN
COPY(s.s, path)
ELSE
path[0] := 0X;
END
END
END GetDownloadsFolder;
8 K g8 # Syntax10.Scn.Fnt w w
VAR
newCk : Web.ContentKey;
BEGIN
NEW(newCk); newCk.alt := ck; newCk.id := id; ck := newCk
END PrependContentKey; 8
c8 C Syntax10.Scn.Fnt P Syntax10i.Scn.Fnt
[
BEGIN
w.itsFile := Files.New(w.name);
Files.Set(w.webTask.fi.r, w.itsFile, 0)
END Open;
8 8 # Syntax10.Scn.Fnt G G
BEGIN
Files.Register(w.itsFile);
w.webTask.done := TRUE
END Close;
8 . 8 # Syntax10.Scn.Fnt D D
BEGIN
Files.WriteBytes(w.webTask.fi.r, buffer, len)
END PutBytes;
8 . 8 E Syntax10.Scn.Fnt Syntax10i.Scn.Fnt Xp VersionElems AllocBeg # Syntax10.Scn.Fnt PowerMac
WindowsPowerMac PowerMac Windows # Syntax10.Scn.Fnt 0 0
Files.WriteBytes(w.webTask.fi.r, buffer, len)
c p VersionElems AllocEnd
VAR i: INTEGER; (* PowerMac only *)
BEGIN
FOR i := 0 TO len - 1 DO IF buffer[i] # 0AX THEN Files.Write(w.webTask.fi.r, buffer[i]) END END;
END PutBytes;
8 8 # Syntax10.Scn.Fnt
VAR parentDir: ARRAY 256 OF CHAR;
PROCEDURE GetParent(dir: ARRAY OF CHAR; VAR parDir: ARRAY OF CHAR);
VAR i: INTEGER;
BEGIN
i := 0; WHILE dir[i] # 0X DO INC(i) END;
DEC(i);
IF dir[i] = '/' THEN DEC(i) END;
WHILE (i > 0) & (dir[i] # '/') DO DEC(i) END;
parDir[i] := 0X; DEC(i);
WHILE i >= 0 DO parDir[i] := dir[i]; DEC(i) END;
IF parDir = "" THEN COPY("/", parDir) END;
END GetParent;
BEGIN
w.dirEntryLen := 0;
w.itsFile := Files.New("");
Files.Set(w.webTask.fi.r, w.itsFile, 0);
Files.WriteString(w.webTask.fi.r, "");
Files.WriteString(w.webTask.fi.r, "Directory of ");
Files.WriteString(w.webTask.fi.r, w.name);
Files.WriteString(w.webTask.fi.r, "");
Files.WriteString(w.webTask.fi.r, "");
Files.WriteString(w.webTask.fi.r, "Current directory is ");
Files.WriteString(w.webTask.fi.r, w.name);
Files.WriteString(w.webTask.fi.r, "
");
IF w.name # "/" THEN
GetParent(w.name, parentDir);
Files.WriteString(w.webTask.fi.r, 'Up to higher level directory')
END;
Files.WriteString(w.webTask.fi.r, "");
Files.WriteString(w.webTask.fi.r, "
")
END Open;
8 8 # Syntax10.Scn.Fnt
BEGIN
Files.WriteString(w.webTask.fi.r, "
");
Files.WriteString(w.webTask.fi.r, "");
Files.WriteString(w.webTask.fi.r, "");
Files.WriteString(w.webTask.fi.r, "");
w.webTask.done := TRUE
END Close;
8 / 8 Syntax10.Scn.Fnt o 8 FoldElems New # Syntax10.Scn.Fnt
VAR i: INTEGER;
BEGIN
Files.WriteString(r, "");
Files.WriteString(r, '');
i := 0; WHILE (name[i] # 0X) & (i < 32) DO Files.Write(r, name[i]); INC(i) END;
Files.WriteString(r, "");
FOR i := 0 TO 34 - Strings.Length(name) DO Files.Write(r, ' ') END
END WriteName;
8 X :8 # Syntax10.Scn.Fnt
VAR buf: ARRAY 32 OF CHAR; i: INTEGER;
BEGIN
i := 0;
IF int = 0 THEN
buf[0] := '0'; i := 1
ELSE
WHILE int > 0 DO
buf[i] := CHR(int MOD 10 + ORD("0"));
int := int DIV 10;
INC(i)
END
END;
IF leadZero THEN
WHILE i < len DO buf[i] := '0'; INC(i) END
ELSE
WHILE i < len DO buf[i] := ' '; INC(i) END
END;
WHILE i > 0 DO
DEC(i);
Files.Write(r, buf[i])
END
END WriteInt;
8 9 8 # Syntax10.Scn.Fnt J J
BEGIN
WriteInt(d MOD 32, 2, TRUE, r);
Files.Write(r, ".");
WriteInt(ASH(d, -5) MOD 16, 2, TRUE, r);
Files.Write(r, ".");
WriteInt(ASH(d, -9) MOD 128, 2, TRUE, r);
Files.WriteString(r, " ");
WriteInt(ASH(t, -12) MOD 32, 2, TRUE, r);
Files.Write(r, ":");
WriteInt(ASH(t, -6) MOD 64, 2, TRUE, r)
END WriteDate;
8 l 8 # Syntax10.Scn.Fnt
VAR i: INTEGER;
BEGIN
i := 0; WHILE (pos < dirEntLen) & (i < LEN(str) - 1) & (dirEnt[pos] # ' ') DO str[i] := dirEnt[pos]; INC(i); INC(pos) END;
str[i] := 0X;
WHILE (pos < dirEntLen) & (dirEnt[pos] # ' ') DO INC(pos) END
END ScanString; 8 g 18 # Syntax10.Scn.Fnt
BEGIN
num := 0; WHILE (pos < dirEntLen) & (dirEnt[pos] >= '0') & (dirEnt[pos] <= '9') DO
num := num*10 + ORD(dirEnt[pos]) - ORD('0'); INC(pos)
END
END ScanNumber; 8 T 8 # Syntax10.Scn.Fnt X X
BEGIN
WHILE (pos < dirEntLen) & (dirEnt[pos] = ' ') DO INC(pos) END
END SkipBlanks; 8 ^ 8 C Syntax10.Scn.Fnt Syntax10i.Scn.Fnt t 7
(* Generic dir entries are treated as links since *)
(* it can't be determined wheter we have a file or a dir *)
BEGIN
WriteName(dirEnt, r)
END GetGenericDirEntry;
8 [ #8 ( Syntax10.Scn.Fnt Syntax10i.Scn.Fnt R 8 FoldElems New { Syntax10.Scn.Fnt Syntax10i.Scn.Fnt
P
M
VAR
monStr: ARRAY 4 OF CHAR;
year, mon, day, hh, mm: LONGINT;
sysTime, sysDate: LONGINT;
BEGIN
O.GetClock(sysTime, sysDate);
FOR j := 0 TO 2 DO monStr[j] := dirEnt[i]; INC(i) END; monStr[3] := 0X; (* Month *)
mon := Strings.Pos(monStr, "JanFebMarAprMayJunJulAugSepOctNovDec", 0);
IF mon < 0 THEN success := FALSE; RETURN END;
mon := mon DIV 3 + 1;
SkipBlanks(dirEnt, dirEntLen, i);
ScanNumber(dirEnt, dirEntLen, i, day); (* Day *)
SkipBlanks(dirEnt, dirEntLen, i);
ScanNumber(dirEnt, dirEntLen, i, year); (* Year or Hour *)
IF dirEnt[i] = ':' THEN (* Time *)
INC(i); hh := year; mm := 0;
ScanNumber(dirEnt, dirEntLen, i, mm); (* Minutes *)
year := SHORT(ASH(sysDate, -9));
ELSE
year := year - 1900; hh := 0; mm := 0;
END;
d := ASH(year, 9) + ASH(mon, 5) + day;
t := ASH(hh, 12) + ASH(mm, 6);
IF d > sysDate THEN d := ASH(year - 1, 9) + ASH(mon, 5) + day END;
success := TRUE
END ScanDate;
8 8 Syntax10.Scn.Fnt T Syntax10i.Scn.Fnt B O
* = _
y
\ < 4 ! 1 G 0 8
IF (dirEnt[0] # '-') & (dirEnt[0] # 'd') & (dirEnt[0] # 'l') THEN RETURN END;
(* Privs *)
FOR i := 1 TO 9 DO privs[i-1] := dirEnt[i] END; privs[9] := 0X;
(* Skip link count *)
i := 10; SkipBlanks(dirEnt, dirEntLen, i); (*WHILE (i < dirEntLen) & (dirEnt[i] = ' ') DO INC(i) END;*)
IF ~w.isMacOS THEN
WHILE (i < dirEntLen) & (dirEnt[i] >= '0') & (dirEnt[i] <= '9') DO INC(i) END;
SkipBlanks(dirEnt, dirEntLen, i);
END;
(* Owner & Group *)
ScanString(dirEnt, dirEntLen, i, owner);
SkipBlanks(dirEnt, dirEntLen, i);
(* Note: The NetPresenz server on the Macintosh writes the string *)
(* "folder" instead of an owner name and a group name. *)
IF w.isMacOS & (owner = "folder") THEN
COPY("none", group)
ELSE
ScanString(dirEnt, dirEntLen, i, group);
SkipBlanks(dirEnt, dirEntLen, i)
END;
(* Size *)
ScanNumber(dirEnt, dirEntLen, i, size);
(* Just for the case we're wrong, search the next space *)
WHILE (i < dirEntLen) & (dirEnt[i] # ' ') DO INC(i) END;
SkipBlanks(dirEnt, dirEntLen, i);
(* Date *)
ScanDate(date, time, success); IF ~success THEN RETURN END;
WHILE (i < dirEntLen) & (dirEnt[i] = ' ') DO INC(i) END;
(* Name *)
j := 0; WHILE (i < dirEntLen) DO name[j] := dirEnt[i]; INC(i); INC(j) END; name[j] := 0X;
(* The name might contain a link destination (-> dest) *)
k := Strings.Pos(" ->", name, 1);
IF k > 0 THEN (* name contains a link dest. *)
j := k; WHILE (j >= 0) & (name[j] = ' ') DO DEC(j) END;
name[j + 1] := 0X;
i := k + 3; j := 0; WHILE name[i] # 0X DO dest[j] := name[i]; INC(i); INC(j) END; dest[j] := 0X;
ELSE
dest := "n/a"
END;
IF name[0] # '.' THEN
WriteName(name, r);
IF dirEnt[0] = "-" THEN (* file entry *)
IF size >= 1024 THEN
WriteInt(size DIV 1024, 6, FALSE, r); Files.WriteString(r, " Kb ")
ELSE
WriteInt(size, 6, FALSE, r); Files.WriteString(r, " bytes")
END
ELSIF dirEnt[0] = "d" THEN (* directory entry *)
Files.WriteString(r, "directory ")
ELSIF dirEnt[0] = "l" THEN (* symbolic link *)
Files.WriteString(r, " link ")
END; 8 Z
(* This actually works for most server types beside UNIX (MacOS, WinNT, ...) *)
VAR
i, j, k: INTEGER;
size, date, time: LONGINT;
name, path, dest: ARRAY 256 OF CHAR;
privs, owner, group: ARRAY 32 OF CHAR;
success: BOOLEAN;
PROCEDURE ScanDate(VAR d, t: LONGINT; VAR success: BOOLEAN);
BEGIN (* GetUNIXDirEntry *)
Files.WriteString(r, " ");
WriteDate(date, time, r)
END
END GetUNIXDirEntry;
8 X M8 # Syntax10.Scn.Fnt
BEGIN
IF w.useNLST THEN
GetGenericDirEntry(dirEnt, dirEntLen, r)
ELSE
GetUNIXDirEntry(dirEnt, dirEntLen, r)
END
END GetDirEntry;
8 l
VAR
i: INTEGER;
path: ARRAY 256 OF CHAR;
PROCEDURE WriteName(name: ARRAY OF CHAR; VAR r: Files.Rider);
PROCEDURE WriteInt(int: LONGINT; len: INTEGER; leadZero: BOOLEAN; VAR r: Files.Rider);
PROCEDURE WriteDate(d, t: LONGINT; VAR r: Files.Rider);
PROCEDURE ScanString(dirEnt: ARRAY OF CHAR; dirEntLen: INTEGER; VAR pos: INTEGER; VAR str: ARRAY OF CHAR);
PROCEDURE ScanNumber(dirEnt: ARRAY OF CHAR; dirEntLen: INTEGER; VAR pos: INTEGER; VAR num: LONGINT);
PROCEDURE SkipBlanks(dirEnt: ARRAY OF CHAR; dirEntLen: INTEGER; VAR pos: INTEGER);
PROCEDURE GetGenericDirEntry(dirEnt: ARRAY OF CHAR; dirEntLen: INTEGER; VAR r: Files.Rider);
PROCEDURE GetUNIXDirEntry(dirEnt: ARRAY OF CHAR; dirEntLen: INTEGER; VAR r: Files.Rider);
PROCEDURE GetDirEntry(dirEnt: ARRAY OF CHAR; dirEntLen: INTEGER; VAR r: Files.Rider);
BEGIN
FOR i := 0 TO len - 1 DO
IF (buffer[i] = LF) OR (buffer[i] = CR) THEN
w.dirEntry[w.dirEntryLen] := 0X;
IF w.dirEntryLen > 0 THEN GetDirEntry(w.dirEntry, w.dirEntryLen, w.webTask.fi.r) END;
w.dirEntryLen := 0;
ELSIF w.dirEntryLen < LEN(w.dirEntry) THEN
w.dirEntry[w.dirEntryLen] := buffer[i];
INC(w.dirEntryLen)
END
END
END PutBytes;
8 1 n8 # Syntax10.Scn.Fnt p p
VAR w: AsciiWriter;
BEGIN
NEW(w); COPY(fileName, w.name); w.webTask := webTask; RETURN w
END NewAsciiWriter;
8 1 l8 # Syntax10.Scn.Fnt r r
VAR w: BinaryWriter;
BEGIN
NEW(w); COPY(fileName, w.name); w.webTask := webTask; RETURN w
END NewBinaryWriter;
8 1 s8 # Syntax10.Scn.Fnt k k
VAR w: DirWriter;
BEGIN
NEW(w); COPY(dirName, w.name); w.webTask := webTask; RETURN w
END NewDirWriter;
8 , 8 C Syntax10.Scn.Fnt Syntax10i.Scn.Fnt *
(* Sends an ABOR command to the server. *)
VAR replyCode: INTEGER; replyText: T.Writer;
BEGIN
cntlConn.InterruptProcess();
cntlConn.Synch();
cntlConn.Request("ABOR", replyCode, replyText);
IF replyCode = 426 THEN
cntlConn.WaitForReply(replyCode, replyText);
END;
END Abort;
8 : 8 Q Syntax10.Scn.Fnt Syntax10i.Scn.Fnt U 0 & W
(* Sends SITE DIRSTYLE commands to the server until it turns DOS-like output off *)
VAR
replyCode: INTEGER; replyText: T.Writer;
replyStr: ARRAY 256 OF CHAR;
siteCmd: ARRAY 32 OF CHAR;
BEGIN
siteCmd := "SITE DIRSTYLE";
cntlConn.Request(siteCmd, replyCode, replyText);
ReplyToString(replyText, replyStr);
IF replyCode = 200 THEN
IF Strings.Pos(" on", replyStr, 0) > 0 THEN (* oops, we turned on MS-DOS format *)
cntlConn.Request(siteCmd, replyCode, replyText)
END
END
END WinNTSetUNIXFormat;
8 _ w8 Q Syntax10.Scn.Fnt Syntax10i.Scn.Fnt 9 F . 9
(* Converts the host address string to an IP address. *)
VAR res: INTEGER;
BEGIN
IF (host[0] >= '0') & (host[0] <= '9') THEN (* host address in dotted-decimal notation *)
TCP.HostByNumber(host, hostAddr, res)
ELSE
TCP.HostByName(host, hostAddr, res)
END;
success := res = TCP.Done;
END ResolveAddress;
8 P 8 Syntax10.Scn.Fnt Syntax10i.Scn.Fnt 1 d e
C Y
(* Opens the control connection and logs in. *)
VAR
addr: TCP.IpAdr; success: BOOLEAN;
cmd: ARRAY 256 OF CHAR; replyCode: INTEGER; replyText: T.Writer;
user, pass, acct: ARRAY 32 OF CHAR;
port: INTEGER;
BEGIN
(* resolve host address *)
ResolveAddress(url.net.host, addr, success);
IF ~success THEN res := resolveAddrErr; RETURN END;
(* open connection *)
NEW(conn);
IF url.net.port = 0 THEN port := defaultPort ELSE port := url.net.port END;
conn.OpenOnPort(addr, port, success);
IF ~success THEN res := cntlOpenErr; RETURN END;
conn.WaitForReply(replyCode, replyText);
CASE FTPB.GetReplyCategory(replyCode) OF
FTPB.negativeConnection:
res := replyTimeOutErr;
conn.Close(); RETURN;
| FTPB.positivePreliminary:
res := tempNotAvailErr;
conn.Close(); RETURN;
| FTPB.negativeTransient:
res := notAvailErr;
conn.Close(); RETURN;
| FTPB.positiveCompletion:
res := noErr;
ELSE
res := unexpectedErr;
conn.Close(); RETURN
END;
(* login *)
IF url.net.userType # Web.Defined THEN
user := "anonymous";
GetUserEMail(pass)
ELSE
COPY(url.net.userId, user)
END;
cmd := "USER "; Strings.Append(user, cmd);
conn.Request(cmd, replyCode, replyText);
IF replyCode = 331 THEN
(* password required *)
IF (url.net.pwType # Web.Defined) & (url.net.userType = Web.Defined) THEN
ReadPassword("Enter Password: ", pass)
ELSIF url.net.userType = Web.Defined THEN
COPY(url.net.password, pass)
END;
cmd := "PASS "; Strings.Append(pass, cmd);
conn.Request(cmd, replyCode, replyText);
END;
IF replyCode = 332 THEN
(* account required *)
ReadPassword("Enter Account: ", acct);
cmd := "ACCT "; Strings.Append(acct, cmd);
conn.Request(cmd, replyCode, replyText);
END;
CASE FTPB.GetReplyCategory(replyCode) OF
FTPB.negativeConnection:
res := replyTimeOutErr;
conn.Close(); RETURN;
| FTPB.negativeTransient:
res := notAvailErr;
conn.Close(); RETURN;
| FTPB.negativePermanent:
res := loginErr;
conn.Close(); RETURN;
| FTPB.positiveCompletion:
res := noErr;
ELSE
res := unexpectedErr;
conn.Close(); RETURN
END;
END OpenFTP;
8 , 8 C Syntax10.Scn.Fnt Syntax10i.Scn.Fnt C c
(* Sends a QUIT command to the server and closes the connection *)
BEGIN
IF (conn # NIL) & conn.isOpen THEN conn.SendCommand("QUIT"); conn.Close() END
END CloseFTP;
8 W8 C Syntax10.Scn.Fnt z Syntax10i.Scn.Fnt ) g
VAR
conn: FTPB.FTPDataConn; replyCode: INTEGER; replyText: T.Writer;
cmd: ARRAY 256 OF CHAR;
success: BOOLEAN;
BEGIN
(* don't try to retrieve directories *)
IF (Strings.Length(path) = 0) OR (path[Strings.Length(path) - 1] = '/') THEN res := fileNotFoundErr; RETURN END;
NEW(conn); conn.Listen(cntlConn, success);
IF success THEN
conn.GetPortCmd(cmd);
cntlConn.Request(cmd, replyCode, replyText);
IF replyCode # 200 THEN conn.Close(); res := dataOpenErr; RETURN END;
cmd := "RETR "; Strings.Append(path, cmd);
cntlConn.Request(cmd, replyCode, replyText);
IF FTPB.GetReplyCategory(replyCode) # FTPB.positivePreliminary THEN
conn.Close(); res := fileNotFoundErr; RETURN
END;
conn.Accept(success);
IF success THEN
res := noErr;
conn.ReceiveFile(trans, w)
ELSE
res := dataOpenErr
END
ELSE
res := dataListenErr;
END
END GetFile;
8 8 C Syntax10.Scn.Fnt z Syntax10i.Scn.Fnt
VAR
conn: FTPB.FTPDataConn; replyCode: INTEGER; replyText: T.Writer;
cmd: ARRAY 256 OF CHAR;
success: BOOLEAN;
BEGIN
(* change directory *)
IF Strings.Length(path) > 0 THEN
cmd := "CWD "; Strings.Append(path, cmd);
cntlConn.Request(cmd, replyCode, replyText);
IF FTPB.GetReplyCategory(replyCode) # FTPB.positiveCompletion THEN res := fileNotFoundErr; RETURN END;
END;
NEW(conn); conn.Listen(cntlConn, success);
IF success THEN
conn.GetPortCmd(cmd);
cntlConn.Request(cmd, replyCode, replyText);
IF FTPB.GetReplyCategory(replyCode) # FTPB.positiveCompletion THEN conn.Close(); res := dataOpenErr; RETURN END;
IF w(DirWriter).useNLST THEN cmd := "NLST" ELSE cmd := "LIST" END;
cntlConn.Request(cmd, replyCode, replyText);
IF FTPB.GetReplyCategory(replyCode) # FTPB.positivePreliminary THEN
conn.Close(); res := fileNotFoundErr; RETURN
END;
conn.Accept(success);
IF success THEN
res := noErr;
conn.ReceiveFile(trans, w)
ELSE
res := dataOpenErr
END
ELSE
res := dataListenErr;
END
END GetDir;
8 8 C Syntax10.Scn.Fnt Syntax10i.Scn.Fnt
(* Handler for Web.Task *)
VAR
thisTask: Task;
thisFile: Files.File;
len: LONGINT;
act: LONGINT;
BEGIN
thisTask := O.CurTask(Task);
thisFile := Files.Base(thisTask.fi.r);
IF thisTask.cancelled THEN
Abort(thisTask.trans.itsCntlConn);
O.Remove(thisTask.trans);
thisTask.done := TRUE
ELSIF (Files.Length(thisFile) > 0) & ~thisTask.displayerOpened THEN
Web.OpenPresentator(thisTask.fi, thisTask.act, thisTask.txt, thisTask.elem);
thisTask.displayerOpened := TRUE
END;
IF thisTask.done THEN
Files.Close(thisFile);
thisTask.fi.len.act := Files.Length(thisFile);
thisTask.fi.len.def := thisTask.fi.len.act;
Web.RemoveTask(thisTask);
O.Remove(thisTask)
END
END WebTaskHandler; 8 > 8 C Syntax10.Scn.Fnt C Syntax10i.Scn.Fnt 0 g
VAR replyCode: INTEGER; replyText: T.Writer; i, bps: REAL;
BEGIN
(* Wait for "completed" message from server *)
t.itsCntlConn.WaitForReply(replyCode, replyText);
CloseFTP(t.itsCntlConn);
IF success THEN
i := (O.Time() - t.startTime)/Input.TimeUnit; IF i = 0 THEN i := 1 END;
T.WriteString(w, "Transfer completed. ("); T.WriteInt(w, t.bytesTransferred, 0);
T.WriteString(w, " bytes in "); T.WriteRealFix(w, i, 0, 1); T.WriteString(w, " sec. = ");
bps := t.bytesTransferred/i;
IF bps < 1024 THEN
T.WriteRealFix(w, bps, 0, 1)
ELSE
T.WriteRealFix(w, bps/1024, 0, 1); T.WriteString(w, "K")
END;
T.WriteString(w, " bytes/sec.)")
ELSE
WriteString("File transfer failed.")
END;
WriteLn()
END Completed;
8 B8 # Syntax10.Scn.Fnt
VAR ldr: Loader;
BEGIN
NEW(ldr);
ldr.scheme := ftpScheme;
ldr.defPort := defaultPort;
ldr.infoMeth := "";
Web.InstallLoader(ldr)
END InstallProtocol; 8 G 8 Syntax10.Scn.Fnt { 8 FoldElems New # Syntax10.Scn.Fnt > >
VAR ok : BOOLEAN;
BEGIN
ok := TRUE;
IF (url.net.hostType = Web.Empty) OR (url.net.hostType = Web.Omitted) THEN
WriteString("FTP: missing host$"); WriteLn(); ok := FALSE
ELSIF url.net.hostType = Web.Illegal THEN
WriteString("FTP: illegal host"); WriteLn(); ok := FALSE
END;
RETURN ok;
END CheckUrl; 8 )8 # Syntax10.Scn.Fnt
VAR task : Task;
BEGIN
NEW(task);
task.safe := FALSE;
task.time := 0;
task.handle := WebTaskHandler;
task.txt := txt;
task.done := FALSE;
task.displayerOpened := FALSE;
task.act := act;
task.elem := elem;
NEW(task.fi);
NEW(task.fi.len);
task.fi.len.def := Web.undefinedLen;
task.fi.len.act := -1;
task.fi.local := FALSE;
(* AK BEGIN *)
task.fi.coding := "";
(* AK END *)
RETURN task;
END InstallTask; 8 Syntax10i.Scn.Fnt k * c
VAR
task: Task;
conn: FTPB.FTPCntlConn;
res: INTEGER;
remoteType: ARRAY 32 OF CHAR;
fileName: ARRAY 256 OF CHAR;
localPath: ARRAY 256 OF CHAR;
path: ARRAY 256 OF CHAR;
type: FileType;
w: Writer;
trans: FTPTransmission;
cont: Web.ContentKey;
success: BOOLEAN;
replyCode: INTEGER;
replyText: T.Writer;
PROCEDURE CheckUrl(url : Web.Url) : BOOLEAN;
PROCEDURE InstallTask(): Task;
BEGIN
ASSERT(txt # NIL);
IF ~CheckUrl(act.url) THEN RETURN END;
Web.GetFileName(fileName, FALSE, act.url);
GetDownloadsFolder(localPath);
IF (localPath # "") & (Directories.This(localPath) = NIL) THEN
(* create downloads folder *)
Directories.Create(localPath);
WriteString("The downloads folder has been created."); WriteLn()
END;
Strings.Append(Directories.delimiter, localPath);
Strings.Append(fileName, localPath);
OpenFTP(act.url, conn, res);
IF res # noErr THEN WriteError(res); WriteLn(); CloseFTP(conn); RETURN END;
GetSystemType(conn, remoteType);
IF remoteType = typeWinNT THEN WinNTSetUNIXFormat(conn) END;
(* determine file type *)
IF act.url.params = asciiType THEN
type := asciiType
ELSIF act.url.params = binaryType THEN
type := binaryType
ELSE
GetFileType(fileName, type)
END;
task := InstallTask();
(* Send TYPE command *)
IF type = asciiType THEN
conn.Request("TYPE A", replyCode, replyText)
ELSE
conn.Request("TYPE I", replyCode, replyText)
END;
IF FTPB.GetReplyCategory(replyCode) # FTPB.positiveCompletion THEN WriteError(loginErr); CloseFTP(conn); RETURN END;
(* Open Writer *)
IF type = asciiType THEN
w := NewAsciiWriter(localPath, task)
ELSE
w := NewBinaryWriter(localPath, task)
END;
IF w = NIL THEN WriteError(fileCreationErr); CloseFTP(conn); RETURN END;
(* Get file or directory *)
NEW(trans);
trans.itsCntlConn := conn;
GetFile(act.url.path, conn, w, trans, res);
IF res # noErr THEN
(* not a file, probably a directory? *)
IF Strings.Length(act.url.path) > 0 THEN
COPY(act.url.path, path)
ELSE
GetPath(conn, path, success);
IF ~success THEN CloseFTP(conn); WriteError(pwdErr); RETURN END;
END;
w := NewDirWriter(path, task);
w(DirWriter).isMacOS := (remoteType = typeMacOS);
w(DirWriter).useNLST := (remoteType = typeVMS);
GetDir(act.url.path, conn, w, trans, res);
IF res # noErr THEN
CloseFTP(conn)
ELSE
PrependContentKey("text/html", cont);
task.fi.cKey := cont;
Web.AddTask(task);
O.Install(task);
WriteString('Retrieving directory listing of "'); WriteString(act.url.path); WriteString('"'); WriteLn()
END
ELSE
(*
IF type = asciiType THEN PrependContentKey(Web.wildCard, cont) END;
*)
(* AK BEGIN *)
IF (type = asciiType) & (elem = NIL) THEN PrependContentKey(Web.wildCard, cont) END;
(* AK END *)
PrependContentKey("", cont);
Web.GetFileExtension(cont.id, act.url);
(* AK BEGIN *)
IF cont.id = "" THEN cont := cont.alt END;
(* AK END *)
task.fi.cKey := cont;
Web.AddTask(task);
O.Install(task);
WriteString('Retrieving "'); WriteString(fileName); WriteString('" ');
IF type = asciiType THEN WriteString("(ASCII).") ELSE WriteString("(Binary).") END;
WriteLn()
END
END Open;
8 8 C Syntax10.Scn.Fnt Syntax10i.Scn.Fnt , ?
BEGIN
(* only used to force loading of module *)
END Install; 8
MODULE WebFTP;
(** FTP Support for Web. **)
(** By Gnter Obiltschnig (g.obiltschnig@jk.uni-linz.ac.at) **)
(* Compile for PowerMac *)
Description
Revision History
IMPORT
CONST
TYPE
VAR
(* Utility Procs *)
PROCEDURE WriteString(str: ARRAY OF CHAR);
PROCEDURE WriteLn;
PROCEDURE WriteError(errNo: INTEGER);
PROCEDURE ReplyToString(replyText: T.Writer; VAR replyString: ARRAY OF CHAR);
PROCEDURE GetPath(cntlConn: FTPB.FTPCntlConn; VAR dir: ARRAY OF CHAR; VAR success: BOOLEAN);
PROCEDURE GetSystemType(cntlConn: FTPB.FTPCntlConn; VAR type: ARRAY OF CHAR);
PROCEDURE ReadPassword(prompt: ARRAY OF CHAR; VAR passwd: ARRAY OF CHAR);
PROCEDURE FindProfile(profile, section, attr: ARRAY OF CHAR; VAR success: BOOLEAN; VAR s: T.Scanner);
PROCEDURE GetFileType(name: ARRAY OF CHAR; VAR type: FileType);
PROCEDURE GetUserEMail(VAR email: ARRAY OF CHAR);
PROCEDURE GetDownloadsFolder(VAR path: ARRAY OF CHAR);
PROCEDURE PrependContentKey(id : Web.ContentId; VAR ck : Web.ContentKey);
(* Writer *)
PROCEDURE (w: Writer) Open*();
PROCEDURE (w: Writer) Close*();
PROCEDURE (w: BinaryWriter) PutBytes*(VAR buffer: ARRAY OF CHAR; VAR len: INTEGER);
PROCEDURE (w: AsciiWriter) PutBytes*(VAR buffer: ARRAY OF CHAR; VAR len: INTEGER);
PROCEDURE (w: DirWriter) Open*();
PROCEDURE (w: DirWriter) Close*();
PROCEDURE (w: DirWriter) PutBytes*(VAR buffer: ARRAY OF CHAR; VAR len: INTEGER);
PROCEDURE NewAsciiWriter*(fileName: ARRAY OF CHAR; webTask: Task): Writer;
PROCEDURE NewBinaryWriter*(fileName: ARRAY OF CHAR; webTask: Task): Writer;
PROCEDURE NewDirWriter*(dirName: ARRAY OF CHAR; webTask: Task): Writer;
(* Connection Handling *)
PROCEDURE Abort(cntlConn: FTPB.FTPCntlConn);
PROCEDURE WinNTSetUNIXFormat(cntlConn: FTPB.FTPCntlConn);
PROCEDURE ResolveAddress(host: ARRAY OF CHAR; VAR hostAddr: TCP.IpAdr; VAR success: BOOLEAN);
PROCEDURE OpenFTP(url: Web.Url; VAR conn: FTPB.FTPCntlConn; VAR res: INTEGER);
PROCEDURE CloseFTP(conn: FTPB.FTPCntlConn);
PROCEDURE GetFile(path: ARRAY OF CHAR; cntlConn: FTPB.FTPCntlConn;
w: Writer; trans: FTPTransmission; VAR res: INTEGER);
PROCEDURE GetDir(path: ARRAY OF CHAR; cntlConn: FTPB.FTPCntlConn;
w: Writer; trans: FTPTransmission; VAR res: INTEGER);
PROCEDURE WebTaskHandler();
(* FTPTransmission *)
PROCEDURE (t: FTPTransmission) Completed*(success: BOOLEAN);
PROCEDURE InstallProtocol();
PROCEDURE (sch: Loader) Open*(act : Web.UrlStack; txt : Web.Text; elem : T.Elem; cached : BOOLEAN);
PROCEDURE Install*;
(* Initialization *)
BEGIN
T.OpenWriter(w);
InstallProtocol();
T.WriteString(w, "WebFTP (GO, 19.12.96)"); T.WriteLn(w); T.Append(O.Log, w.buf)
END WebFTP.