include "socket.s7i";
include "listener.s7i";
include "unicode.s7i";
include "bigint.s7i";
include "time.s7i";
include "osfiles.s7i";
const integer: defaultFtpControlPort is 21;
const type: ftpFileSys is sub fileSys interface;
const func array string: listDir (inout ftpFileSys: fileSystem, in string: dirPath) is DYNAMIC;
const func boolean: getActiveMode (in ftpFileSys: fileSystem) is DYNAMIC;
const proc: setActiveMode (inout ftpFileSys: fileSystem, in boolean: active) is DYNAMIC;
const func boolean: getAsciiTransfer (in ftpFileSys: fileSystem) is DYNAMIC;
const proc: setAsciiTransfer (inout ftpFileSys: fileSystem, in boolean: asciiTransfer) is DYNAMIC;
const proc: closeFtpData (inout ftpFileSys: fileSystem) is DYNAMIC;
const proc: ftpResponse (inout ftpFileSys: fileSystem) is DYNAMIC;
const type: ftpConnection is sub emptyFileSys struct
var file: control is STD_NULL;
var file: data is STD_NULL;
var string: response is "";
var string: responseContent is "";
var boolean: mlstCommandAvailable is TRUE;
var string: ownIpAddress is "";
var boolean: activeMode is FALSE;
var boolean: asciiTransfer is FALSE;
var boolean: openDataSucceeded is FALSE;
var listener: dataPortListener is listener.value;
end struct;
type_implements_interface(ftpConnection, ftpFileSys);
const proc: ftpCommand (inout ftpConnection: ftp, in string: command) is func
begin
write(ftp.control, command <& "\r\n");
end func;
const proc: ftpResponse (inout ftpConnection: ftp) is func
local
var string: responseCode is "";
begin
ftp.response := getln(ftp.control);
if ftp.response[4 len 1] = "-" then
responseCode := ftp.response[.. 3] & " ";
ftp.responseContent := "";
ftp.response := getln(ftp.control);
while not startsWith(ftp.response, responseCode) do
ftp.responseContent &:= ftp.response;
ftp.responseContent &:= '\n';
ftp.response := getln(ftp.control);
end while;
end if;
end func;
const func string: allowUtf8 (in string: inStri) is func
result
var string: outStri is "";
begin
outStri := inStri;
block
outStri := fromUtf8(outStri);
exception
catch RANGE_ERROR:
noop;
end block;
end func;
const func ftpFileSys: openFtp (in string: hostName, in string: user,
in string: password, in integer: ftpControlPort) is func
result
var ftpFileSys: newFileSys is fileSys.value;
local
var ftpConnection: ftp is ftpConnection.value;
begin
if ftpControlPort >= 0 and ftpControlPort <= 65535 then
ftp.control := openInetSocket(hostName, ftpControlPort);
if ftp.control <> STD_NULL then
ftp.ownIpAddress := numericAddress(inetSocketAddress(getHostname, 1024));
ftpResponse(ftp);
if startsWith(ftp.response, "220") then
ftpCommand(ftp, "USER " <& user);
ftpResponse(ftp);
if startsWith(ftp.response, "331") then
ftpCommand(ftp, "PASS " <& password);
ftpResponse(ftp);
end if;
if startsWith(ftp.response, "230") then
ftpCommand(ftp, "TYPE I");
ftpResponse(ftp);
if startsWith(ftp.response, "200") then
newFileSys := toInterface(ftp);
end if;
end if;
end if;
if newFileSys = fileSys.value then
close(ftp.control);
end if;
end if;
end if;
end func;
const func ftpFileSys: openFtp (in string: hostName,
in string: user, in string: password) is
return openFtp(hostName, user, password, defaultFtpControlPort);
const func ftpFileSys: openFtp (in string: connectStri, in integer: ftpControlPort) is func
result
var ftpFileSys: ftp is fileSys.value;
local
var string: hostName is "";
var string: user is "anonymous";
var string: password is "anonymous";
var integer: atPos is 0;
var integer: colonPos is 0;
begin
atPos := pos(connectStri, '@');
if atPos <> 0 then
user := connectStri[.. pred(atPos)];
colonPos := pos(user, ':');
if colonPos <> 0 then
password := user[succ(colonPos) ..];
user := user[.. pred(colonPos)];
end if;
hostName := connectStri[succ(atPos) ..];
else
hostName := connectStri;
end if;
ftp := openFtp(hostName, user, password, ftpControlPort);
end func;
const func ftpFileSys: openFtp (in string: connectStri) is
return openFtp(connectStri, defaultFtpControlPort);
const proc: close (inout ftpConnection: ftp) is func
begin
ftpCommand(ftp, "QUIT");
ftpResponse(ftp);
close(ftp.control);
end func;
const proc: openActiveFtpData (inout ftpConnection: ftp) is func
local
var integer: dataPort is 0;
begin
dataPort := rand(1024, 65535);
ftp.dataPortListener := openInetListener(dataPort);
listen(ftp.dataPortListener, 1);
ftpCommand(ftp, "PORT " <& replace(ftp.ownIpAddress, ".", ",") <& "," <&
dataPort mdiv 256 <& "," <& dataPort mod 256);
ftpResponse(ftp);
ftp.openDataSucceeded := startsWith(ftp.response, "200");
end func;
const proc: openPassiveFtpData (inout ftpConnection: ftp) is func
local
var integer: leftParenPos is 0;
var integer: rightParenPos is 0;
var array string: addrAndPort is 0 times "";
var integer: dataPort is 0;
begin
ftpCommand(ftp, "PASV");
ftpResponse(ftp);
if startsWith(ftp.response, "227") then
leftParenPos := pos(ftp.response, "(");
rightParenPos := pos(ftp.response, ")");
if leftParenPos <> 0 and rightParenPos <> 0 then
addrAndPort := split(ftp.response[succ(leftParenPos) .. pred(rightParenPos)], ",");
if length(addrAndPort) = 6 then
dataPort := integer(addrAndPort[5]) * 256 + integer(addrAndPort[6]);
ftp.data := openInetSocket(join(addrAndPort[ .. 4], "."), dataPort);
ftp.openDataSucceeded := ftp.data <> STD_NULL;
end if;
end if;
end if;
end func;
const proc: openFtpData (inout ftpConnection: ftp) is func
begin
if ftp.activeMode then
openActiveFtpData(ftp);
else
openPassiveFtpData(ftp);
end if;
end func;
const proc: prepareFtpDataCommunication (inout ftpConnection: ftp) is func
begin
if ftp.activeMode then
ftp.data := accept(ftp.dataPortListener);
end if;
end func;
const proc: closeFtpData (inout ftpConnection: ftp) is func
begin
if ftp.activeMode then
close(ftp.dataPortListener);
end if;
close(ftp.data);
ftp.data := STD_NULL;
end func;
const func array string: readDir (inout ftpConnection: ftp, in string: dirPath) is func
result
var array string: fileNames is 0 times "";
local
var string: line is "";
begin
openFtpData(ftp);
if ftp.openDataSucceeded then
if dirPath = "." then
ftpCommand(ftp, "NLST");
else
ftpCommand(ftp, "NLST " <& toUtf8(dirPath));
end if;
ftpResponse(ftp);
if startsWith(ftp.response, "125") or
startsWith(ftp.response, "150") then
prepareFtpDataCommunication(ftp);
line := allowUtf8(getln(ftp.data));
while line <> "" do
fileNames &:= line;
line := allowUtf8(getln(ftp.data));
end while;
closeFtpData(ftp);
ftpResponse(ftp);
if not startsWith(ftp.response, "226") then
raise FILE_ERROR;
end if;
elsif startsWith(ftp.response, "500") then
ftpCommand(ftp, "LIST");
ftpResponse(ftp);
if startsWith(ftp.response, "125") or
startsWith(ftp.response, "150") then
prepareFtpDataCommunication(ftp);
line := allowUtf8(getln(ftp.data));
while line <> "" do
fileNames &:= line;
line := allowUtf8(getln(ftp.data));
end while;
closeFtpData(ftp);
ftpResponse(ftp);
if not startsWith(ftp.response, "226") then
raise FILE_ERROR;
end if;
else
closeFtpData(ftp);
raise FILE_ERROR;
end if;
else
closeFtpData(ftp);
raise FILE_ERROR;
end if;
end if;
end func;
const func array string: listDir (inout ftpConnection: ftp, in string: dirPath) is func
result
var array string: directoryListing is 0 times "";
local
var string: line is "";
begin
openFtpData(ftp);
if ftp.openDataSucceeded then
if dirPath = "." then
ftpCommand(ftp, "LIST");
else
ftpCommand(ftp, "LIST " <& toUtf8(dirPath));
end if;
ftpResponse(ftp);
if startsWith(ftp.response, "125") or
startsWith(ftp.response, "150") then
prepareFtpDataCommunication(ftp);
line := allowUtf8(getln(ftp.data));
while line <> "" do
directoryListing &:= line;
line := allowUtf8(getln(ftp.data));
end while;
closeFtpData(ftp);
ftpResponse(ftp);
if not startsWith(ftp.response, "226") then
raise FILE_ERROR;
end if;
else
closeFtpData(ftp);
raise FILE_ERROR;
end if;
end if;
end func;
const proc: chdir (inout ftpConnection: ftp, in string: dirName) is func
begin
if dirName = ".." then
ftpCommand(ftp, "CDUP");
else
ftpCommand(ftp, "CWD " <& toUtf8(dirName));
end if;
ftpResponse(ftp);
if not startsWith(ftp.response, "250") then
raise FILE_ERROR;
end if;
end func;
const func string: getcwd (inout ftpConnection: ftp) is func
result
var string: currentWorkingDir is "";
local
var integer: firstQuotePos is 0;
var integer: lastQuotePos is 0;
begin
ftpCommand(ftp, "PWD");
ftpResponse(ftp);
if startsWith(ftp.response, "257") then
firstQuotePos := pos(ftp.response, '"');
lastQuotePos := rpos(ftp.response, '"');
if firstQuotePos <> 0 and lastQuotePos <> 0 then
currentWorkingDir := ftp.response[succ(firstQuotePos) .. pred(lastQuotePos)];
currentWorkingDir := replace(allowUtf8(currentWorkingDir), "\"\"", "\"");
end if;
else
raise FILE_ERROR;
end if;
end func;
const func fileType: fileType (inout ftpConnection: ftp, in string: fileName) is func
result
var fileType: aFileType is FILE_ABSENT;
local
var string: lowerCaseReponseContent is "";
var string: workingDir is "";
var integer: pos is 0;
begin
if ftp.mlstCommandAvailable then
ftpCommand(ftp, "MLST " <& toUtf8(fileName));
ftpResponse(ftp);
if startsWith(ftp.response, "250") then
lowerCaseReponseContent := lower(ftp.responseContent);
if pos(lowerCaseReponseContent, "type=dir") <> 0 then
aFileType := FILE_DIR;
elsif pos(lowerCaseReponseContent, "type=file") <> 0 then
aFileType := FILE_REGULAR;
else
aFileType := FILE_UNKNOWN;
end if;
elsif startsWith(ftp.response, "500") then
ftp.mlstCommandAvailable := FALSE;
end if;
end if;
if not ftp.mlstCommandAvailable then
ftpCommand(ftp, "SIZE " <& toUtf8(fileName));
ftpResponse(ftp);
if startsWith(ftp.response, "213") then
aFileType := FILE_REGULAR;
else
workingDir := getcwd(ftp);
ftpCommand(ftp, "CWD " <& toUtf8(fileName));
ftpResponse(ftp);
if startsWith(ftp.response, "250") then
aFileType := FILE_DIR;
ftpCommand(ftp, "CWD " <& toUtf8(workingDir));
ftpResponse(ftp);
end if;
end if;
end if;
end func;
const func fileType: fileTypeSL (inout ftpConnection: ftp, in string: fileName) is
return fileType(ftp, fileName);
const func integer: fileSize (inout ftpConnection: ftp, in string: fileName) is func
result
var integer: size is 0;
begin
ftpCommand(ftp, "SIZE " <& toUtf8(fileName));
ftpResponse(ftp);
if startsWith(ftp.response, "213") then
size := integer(trim(ftp.response[4 ..]));
end if;
end func;
const func bigInteger: bigFileSize (inout ftpConnection: ftp, in string: fileName) is func
result
var bigInteger: size is 0_;
begin
ftpCommand(ftp, "SIZE " <& toUtf8(fileName));
ftpResponse(ftp);
if startsWith(ftp.response, "213") then
size := bigInteger(trim(ftp.response[4 ..]));
end if;
end func;
const func time: getMTime (inout ftpConnection: ftp, in string: fileName) is func
result
var time: modificationTime is time.value;
begin
ftpCommand(ftp, "MDTM " <& toUtf8(fileName));
ftpResponse(ftp);
if startsWith(ftp.response, "213") and isDigitString(ftp.response[5 fixLen 14]) then
modificationTime.year := integer(trim(ftp.response[ 5 fixLen 4]));
modificationTime.month := integer(trim(ftp.response[ 9 fixLen 2]));
modificationTime.day := integer(trim(ftp.response[11 fixLen 2]));
modificationTime.hour := integer(trim(ftp.response[13 fixLen 2]));
modificationTime.minute := integer(trim(ftp.response[15 fixLen 2]));
modificationTime.second := integer(trim(ftp.response[17 fixLen 2]));
modificationTime.micro_second := 0;
if modificationTime.month < 1 or modificationTime.month > 12 or
modificationTime.day < 1 or modificationTime.day >
daysInMonth(modificationTime.year, modificationTime.month) or
modificationTime.hour < 0 or modificationTime.hour > 23 or
modificationTime.minute < 0 or modificationTime.minute > 59 or
modificationTime.second < 0 or modificationTime.second > 59 then
raise RANGE_ERROR;
else
modificationTime := setLocalTZ(modificationTime);
end if;
end if;
end func;
const func boolean: getActiveMode (in ftpConnection: ftp) is
return ftp.activeMode;
const proc: setActiveMode (inout ftpConnection: ftp, in boolean: activeMode) is func
begin
ftp.activeMode := activeMode;
end func;
const func boolean: getAsciiTransfer (in ftpConnection: ftp) is
return ftp.asciiTransfer;
const proc: setAsciiTransfer (inout ftpConnection: ftp, in boolean: asciiTransfer) is func
begin
if asciiTransfer then
if not ftp.asciiTransfer then
ftpCommand(ftp, "TYPE A");
ftpResponse(ftp);
if startsWith(ftp.response, "200") then
ftp.asciiTransfer := TRUE;
end if;
end if;
else
if ftp.asciiTransfer then
ftpCommand(ftp, "TYPE I");
ftpResponse(ftp);
if startsWith(ftp.response, "200") then
ftp.asciiTransfer := FALSE;
end if;
end if;
end if;
end func;
const type: ftpDataFile is sub socket struct
var ftpFileSys: ftp is ftpFileSys.value;
end struct;
const func ftpDataFile: ftpDataFile (in socket: aSocket) is func
result
var ftpDataFile: dataFile is ftpDataFile.value;
begin
dataFile.sock := aSocket.sock;
dataFile.addr := aSocket.addr;
dataFile.service := aSocket.service;
dataFile.acceptedFrom := aSocket.acceptedFrom;
end func;
const proc: close (inout ftpDataFile: dataFile) is func
begin
closeFtpData(dataFile.ftp);
ftpResponse(dataFile.ftp);
if not startsWith(ftpConnection conv (dataFile.ftp).response, "226") then
raise FILE_ERROR;
end if;
end func;
const func file: open (inout ftpConnection: ftp, in string: filePath,
in string: mode) is func
result
var file: dataFile is STD_NULL;
local
var boolean: textMode is FALSE;
var boolean: openForReading is TRUE;
var ftpDataFile: new_file is ftpDataFile.value;
begin
if filePath <> "/" and endsWith(filePath, "/") then
raise RANGE_ERROR;
else
if mode = "r" then
noop;
elsif mode = "w" then
openForReading := FALSE;
elsif mode = "rt" then
textMode := TRUE;
elsif mode = "wt" then
textMode := TRUE;
openForReading := FALSE;
else
raise RANGE_ERROR;
end if;
setAsciiTransfer(ftp, textMode);
openFtpData(ftp);
if ftp.openDataSucceeded then
if openForReading then
ftpCommand(ftp, "RETR " <& toUtf8(filePath));
else
ftpCommand(ftp, "STOR " <& toUtf8(filePath));
end if;
ftpResponse(ftp);
if startsWith(ftp.response, "125") or
startsWith(ftp.response, "150") then
prepareFtpDataCommunication(ftp);
new_file := ftpDataFile(socket conv (ftp.data));
new_file.ftp := ftp;
dataFile := toInterface(new_file);
else
closeFtpData(ftp);
end if;
end if;
end if;
end func;
const func string: getFile (inout ftpConnection: ftp, in string: filePath) is func
result
var string: fileContent is "";
local
var string: buffer is "";
begin
setAsciiTransfer(ftp, FALSE);
openFtpData(ftp);
if ftp.openDataSucceeded then
ftpCommand(ftp, "RETR " <& toUtf8(filePath));
ftpResponse(ftp);
if startsWith(ftp.response, "125") or
startsWith(ftp.response, "150") then
prepareFtpDataCommunication(ftp);
buffer := gets(ftp.data, 1000000);
while buffer <> "" do
fileContent &:= buffer;
buffer := gets(ftp.data, 1000000);
end while;
closeFtpData(ftp);
ftpResponse(ftp);
if not startsWith(ftp.response, "226") then
raise FILE_ERROR;
end if;
else
closeFtpData(ftp);
raise FILE_ERROR;
end if;
end if;
end func;
const proc: putFile (inout ftpConnection: ftp, in string: filePath,
in string: stri) is func
begin
setAsciiTransfer(ftp, FALSE);
openFtpData(ftp);
if ftp.openDataSucceeded then
ftpCommand(ftp, "STOR " <& toUtf8(filePath));
ftpResponse(ftp);
if startsWith(ftp.response, "125") or
startsWith(ftp.response, "150") then
prepareFtpDataCommunication(ftp);
write(ftp.data, stri);
closeFtpData(ftp);
ftpResponse(ftp);
if not startsWith(ftp.response, "226") then
raise FILE_ERROR;
end if;
else
closeFtpData(ftp);
raise FILE_ERROR;
end if;
end if;
end func;
const proc: removeFile (inout ftpConnection: ftp, in string: fileName) is func
begin
ftpCommand(ftp, "DELE " <& toUtf8(fileName));
ftpResponse(ftp);
if not startsWith(ftp.response, "257") then
raise FILE_ERROR;
end if;
end func;
const proc: moveFile (inout ftpConnection: ftp, in string: sourcePath, in string: destPath) is func
begin
ftpCommand(ftp, "RNFR " <& toUtf8(sourcePath));
ftpResponse(ftp);
if not startsWith(ftp.response, "350") then
raise FILE_ERROR;
else
ftpCommand(ftp, "RNTO " <& toUtf8(destPath));
ftpResponse(ftp);
if not startsWith(ftp.response, "250") then
raise FILE_ERROR;
end if;
end if;
end func;
const proc: makeDir (inout ftpConnection: ftp, in string: dirName) is func
begin
ftpCommand(ftp, "MKD " <& toUtf8(dirName));
ftpResponse(ftp);
if not startsWith(ftp.response, "257") then
raise FILE_ERROR;
end if;
end func;
const proc: rmdir (inout ftpConnection: ftp, in string: dirName) is func
begin
ftpCommand(ftp, "RMD " <& toUtf8(dirName));
ftpResponse(ftp);
if not startsWith(ftp.response, "257") then
raise FILE_ERROR;
end if;
end func;
const proc: splitFtpLocation (in string: location, inout string: connectStri,
inout integer: portNumber, inout string: path) is func
local
var integer: slashPos is 0;
var integer: colonPos is 0;
begin
slashPos := pos(location, "/");
if slashPos = 0 then
connectStri := location;
path := "";
else
connectStri := location[.. pred(slashPos)];
path := location[succ(slashPos) ..];
end if;
colonPos := pos(connectStri, ":");
if colonPos <> 0 and isDigitString(connectStri[succ(colonPos) ..]) then
portNumber := integer(connectStri[succ(colonPos) ..]);
connectStri := connectStri[.. pred(colonPos)];
else
portNumber := defaultFtpControlPort;
end if;
end func;
const func string: getFtp (in string: connectStri, in integer: portNumber, in string: path) is func
result
var string: fileContent is "";
local
var ftpFileSys: ftp is fileSys.value;
begin
ftp := openFtp(connectStri, portNumber);
if ftp <> fileSys.value then
fileContent := getFile(ftp, path);
close(ftp);
end if;
end func;
const func string: getFtp (in string: location) is func
result
var string: fileContent is "";
local
var string: connectStri is "";
var integer: portNumber is 0;
var string: path is "";
begin
splitFtpLocation(location, connectStri, portNumber, path);
fileContent := getFtp(connectStri, portNumber, path);
end func;