Глава 7. FTP-сервер 

Как известно, в FTP участвуют две стороны. Создание нестандартного компонента, выполняющего функции FTP-сервера, позволит вам полностью контролировать операции пересылки файлов между Internet-приложениями.

В главе 6 я описал компонент CsShopper, в котором инкапсулируются функции клиентской стороны при пересылке файлов с использованием протокола FTP. Более того, компонент, выполняющий функции FTP-клиента, даже входит в число примеров Delphi 3. И все же для осуществления полноценного обмена файлами недостаточно иметь только клиентское приложение. Сейчас в Сети появляется все больше пользователей с круглосуточным доступом (за которым закрепился термин 24?7), и все больше людей желает создавать на Delphi свои собственные программы-серверы. Итак, знакомьтесь — CsKeeper! 

CsKeeper — потомок компонента CsSocket из главы 5. В этом VCL-компоненте инкапсулируется серверная сторона FTP-протокола. CsKeeper чем-то похож на продавца маленького магазинчика — он «берет с полки» те файлы, которые затребованы, и передает их клиенту «через прилавок». Впрочем, в отличие от продавца сервер является конечным автоматом, строго соблюдающим правила протокола FTP (и к тому же не пытается болтать на посторонние темы). 

Большая часть того, что было сказано о компоненте CsShopper в главе 6, относится и к CsKeeper. Если вы еще не читали главу 6, я настоятельно вам рекомендую начать именно с нее. В сложном танце под аккомпанемент FTP-протокола участвуют две стороны, и понимание одной из них невозможно без определенного понимания другой. 

Если вы считаете, что достаточно хорошо разобрались с клиентской стороной, мы можем продолжать. Сервер FTP обычно ожидает установки клиентского соединения на TCP-порте с номером 21. При соединении сервер инициирует процесс регистрации, посылая клиенту команду USER. Поскольку процесс регистрации был достаточно подробно рассмотрен в главе 6 при описании CsShopper, я не стану задерживаться на его подробностях. После успешной регистрации сервер готов к выполнению любого FTP-запроса, поступившего от клиента. Магазин открылся! К тому что происходит дальше, стоит присмотреться повнимательнее. 

В компоненте CsKeeper воплощен простой и полезный FTP-сервер, который соответствует минимальным требованиям, формально изложенным в документе RFC959. Следовательно, некоторые команды FTP (такие как ACCT, NLIST и PASV) в настоящее время отсутствуют в словаре CsKeeper. В таблице 7.1 приведен список всех FTP-команд. Команды, не реализованные в текущей версии CsKeeper, помечены звездочкой. При получении неподдерживаемой команды CsKeeper возвращает клиенту код ошибки с содержательным сообщением. 

Обратите внимание: CsKeeper не является FTP-сервером с параллельной обработкой. Это означает, что в каждый момент времени он может обслужи вать лишь одного пользователя. 

CsKeeper за работой 

Рис. 7.1. KEEPER32 в режиме конструирования (отображается вкладка tsKeeper) 

Но перед тем, как запускать приложение KEEPER32, необходимо выполнить некоторые подготовительные действия. Конечно, можно определить поведение компонента CsKeeper1, изменяя значения его свойств в инспекторе объектов в режиме конструирования (см. рис. 7.2). 

Однако работа со свойствами в режиме конструирования удобна для разработчика приложения, но никак не для пользователя — например FTP-администратора, который может вообще не быть программистом и не иметь доступа к исходным текстам программы и к среде Delphi. Администратор наверняка предпочтет работать с информацией о конфигурации FTP-сервера на вкладке tsOptions (обратите внимание: любые изменения в конфигурации учитываются только при загрузке и запуске приложения, поэтому, чтобы они подействовали, придется перезапустить FTP-сервер). Эта вкладка показана на рис. 7.3. 

Рис. 7.2. Свойства CsKeeper1 в инспекторе объектов 

Рис. 7.3. Вкладка Options в режиме конструирования

Конфигурирование KEEPER32 на вкладке Options 

Чтобы задать диск и основной каталог, выберите диск из списка dcbRootDisk (элемент типа TDriveComboBox). Основной каталог выбирается из списка dlbRootDir (элемент типа TDirectoryListBox). Оба элемента находятся в групповом поле gbServerProperties. Двойной щелчок на dcbRootDisk и dlbRootDir автоматически задает значения свойств RootDisk и RootDir. Например, значение свойства RootDisk задается в обработчике OnDblClick элемента dcbRootDisk следующим образом:

procedure TfrmMain.dcbRootDiskDblClick(Sender: 
TObject); 
begin
 CsKeeper1.RootDisk := dcbRootDisk.Drive;
end;

Кроме того, новый каталог можно создать, не отходя от вкладки Options, — нажмите кнопку Make Dir, и на экране появится форма frmMkDir для ввода имени создаваемого каталога. Затем двойной щелчок на новом каталоге в списке dlbRootDir задает новое значение свойства RootDir. 

Группа переключателей rgTransfer используется для выбора стандартного режима пересылки файлов. По умолчанию выбирается режим Stream, то есть файл передается в виде однородного потока байтов. 

Режимы Block и Compressed необходимы для реализации команды REST, которая позволяет возобновить пересылку файла с того места, где она была прервана. Переключатели Block и Compressed, а следовательно, и команда REST недоступны в текущей версии CsKeeper. Во время выполнения программы переключатели Block и Compressed блокируются. Поэтому KEEPER32 не сможет выполнить команду MODE с параметром BLOCK или COMPRESSED. Вероятно, в будущем я добавлю поддержку этих двух режимов — конечно, при желании вы тоже можете этим заняться. Впрочем, эти режимы используются довольно редко. 

Протокол FTP позволяет выбрать тип файловой структуры (хотя все значения, кроме File, считаются пережитками прошлого и почти не используются). Тип файловой структуры может принимать три значения — File (то есть однородный файл), Record и Page. По умолчанию CsKeeper устанавливает в группе rgFileStructure переключатель File. Текущая версия CsKeeper не поддерживает работу с файловыми структурами Record и Page и отказывается выполнять полученную от FTP-клиента команду STRU для этих режимов. 

Чтобы сохранить параметры, введенные на вкладке Options, нажмите кнопку Save в групповом поле gbServerProperties. При этом вызывается процедура SavePropSettings (см. листинг 7.1). Кнопка Cancel отменяет изменения конфигурации (но лишь в том случае, если они еще не были сохранены в реестре). 

var
 Reg : TRegistry;
begin
 Reg := TRegistry.Create;
 try
  Reg.OpenKey(FtpServerKey,TRUE);
  Reg.WriteString('DRootDisk',dcbRootDisk.Drive);
 finally
  Reg.CloseKey;
 end;
 try
  Reg.OpenKey(FtpServerKey,TRUE);
  Reg.WriteString('DRootDir',
  dlbRootDir.Directory);
 finally
  Reg.CloseKey;
 end;
 try
  Reg.OpenKey(FtpServerKey,TRUE);
  case rgTransfer.ItemIndex of
   0 :Reg.WriteString('DTransferMode',
   FtpTransferStr[STREAM]);
   1 :Reg.WriteString('DTransferMode',
   FtpTransferStr[BLOCK]);
   2 :Reg.WriteString('DTransferMode',
   FtpTransferStr[COMPRESSED]);
  end;
 finally
  Reg.CloseKey;
 end;
 try
  Reg.OpenKey(FtpServerKey,TRUE);
  case rgFileStructure.ItemIndex of
   0 :Reg.WriteString('DFileStructure',
   FtpFileStructStr[NOREC]);
   1 :Reg.WriteString('DFileStructure',
   FtpFileStructStr[REC]);
   2 :Reg.WriteString('DFileStructure',
   FtpFileStructStr[PAGE]);
  end;
 finally
  Reg.CloseKey;
 end;
 Reg.Free;
end;

Вопросы безопасности 

В групповом поле gbSecurity можно указать, какие действия разрешаются FTP-клиентам, а какие нет. Например, вы можете запретить клиентам удалять каталоги на сервере, для этого следует лишь снять флажок cbDeleteDir. Если вы не хотите, чтобы программа KEEPER32 разрешала клиентам передаватьFRcvBuffer свои файлы на сервер, снимите флажок cbUpload. Внесенные изменения сохраняются кнопкой Save, при нажатии которой вызывается процедура SaveSecure Settings. 

KEEPER32 можно слегка защитить от злонамеренных хакеров посредством ведения списка IP-адресов тех клиентов, которые уже пытались вызвать хаос в вашей системе. Если IP-адрес подключающегося FTP-клиента присутствует в «черном» списке lbBadIPAddrs, CsKeeper1 разрывает соединение. Для добавления, удаления и сохранения «плохих» IP-адресов используются кнопки Add, Remove и Save соответственно. На рис. 7.4 показана вкладка tsOptions после ввода списка нежелательных IP-адресов. 

Рис. 7.4. Список нежелательных IP-адресов, которым KEEPER32 отказывает в установлении соединения 

Информационные сообщения для клиентов 

Иногда бывает нужно сообщить подключающимся FTP-клиентам об изменениях в FTP-услугах, предоставляемых KEEPER32, вывести другие информационные сообщения или инструкции («каталог pub/incoming ликвидирован…»). Такие сообщения обычно передаются пользователям при установлении или разрыве соединения. Они называются «приветственными» (welcome) и «прощальными» (farewell) сообщениями соответственно.

Вы можете ввести такие сообщения, нажимая кнопку Edit в групповом поле gbMessages. При этом на экране появляется форма frmMessages. На ней содержится элемент pcMessages типа TPageControl, имеющий две вкладки, tsWelcome и tsFarewell. На обеих вкладках присутствуют элементы Memo, в которых редактируется текст сообщений. Кнопка Save сохраняет текущее сообщение в текстовом файле. Внешний вид формы frmMessages показан на рис. 7.5. Указывая имена файлов в свойствах Welcome и Farewell компонента CsKeeper1, вы определяете местонахождение хранящихся сообщений. Когда KEEPER32 принимает подключающегося клиента, компонент CsKeeper1 использует свойство Welcome для поиска и открытия файла с текстом сообщения, отображаемого во время регистра ции. 

Рис. 7.5. Форма для ввода приветственных и прощальных сообщений 

Где и как хранится конфигурация 

procedure TfrmMain.LoadSettings;
var
 Reg : TRegistry;
 Count : Integer;
 IPName : String;
begin
 Reg := TRegistry.Create;
// Чтение параметров
 try
  Reg.OpenKey(FtpServerKey, TRUE);
  if Reg.ValueExists('DRootDisk') then
   CsKeeper1.RootDisk 
   := Reg.ReadString('DRootDisk')
  else
   CsKeeper1.RootDisk := '';
  if Reg.ValueExists('DRootDir') then
   CsKeeper1.RootDir := Reg.ReadString('DRootDir')
  else
   CsKeeper1.RootDir := '';
 finally
  Reg.CloseKey;
 end;
 try
  Reg.OpenKey(FtpServerKey, TRUE);
  if Reg.ValueExists('DTransferMode') then
  begin
   OldTransferMode 
   := Reg.ReadString('DTransferMode');
   if UpperCase(OldTransferMode) = 
       UpperCase(FtpTransferStr[STREAM]) then
   begin
    CsKeeper1.Transfer := STREAM;
    rgTransfer.ItemIndex := 0;
   end;
   if UpperCase(OldTransferMode) = 
       UpperCase(FtpTransferStr[BLOCK]) then
   begin
    CsKeeper1.Transfer := BLOCK;
    rgTransfer.ItemIndex := 1;
   end;
   if UpperCase(OldTransferMode) =
       UpperCase(FtpTransferStr[COMPRESSED]) 
       then
   begin
    CsKeeper1.Transfer := COMPRESSED;
    rgTransfer.ItemIndex := 2;
   end;
  end else
  begin
   OldTransferMode 
   := UpperCase(FtpTransferStr[STREAM]);
   CsKeeper1.Transfer := STREAM;
  end;
 finally
  Reg.CloseKey;
 end;
// Свойство файловой структуры
 try
  Reg.OpenKey(FtpServerKey, TRUE);
  if Reg.ValueExists('DFileStructure') then
  begin
   OldFileStruct 
   := Reg.ReadString('DFileStructure');
   if UpperCase(OldFileStruct) = 
       UpperCase(FtpFileStructStr[NOREC]) then
   begin
    CsKeeper1.FileStruct := NOREC;
    rgFileStructure.ItemIndex := 0;
   end;
   if UpperCase(OldFileStruct) = 
       UpperCase(FtpFileStructStr[REC]) then
   begin
    CsKeeper1.FileStruct := REC;
    rgFileStructure.ItemIndex := 1;
   end;
   if UpperCase(OldFileStruct) = 
       UpperCase(FtpFileStructStr[PAGE]) then
   begin
    CsKeeper1.FileStruct := PAGE;
    rgFileStructure.ItemIndex := 2;
   end;
  end else
  begin
   OldFileStruct 
   := UpperCase(FtpFileStructStr[NOREC]);
   CsKeeper1.FileStruct := NOREC;
   rgFileStructure.ItemIndex := 0;
  end;
 finally
  Reg.CloseKey;
 end;
// Разрешение на создание новых каталогов
 try
  Reg.OpenKey(FtpServerKey, TRUE);
  if Reg.ValueExists('DCreateNewDir') then
  begin
   OldMkDir := Reg.ReadBool('DCreateNewDir');
   CsKeeper1.CreateDir := OldMkDir;
   if OldMkDir then
    cbAllowMkDir.State := cbChecked
   else
    cbAllowMkDir.State := cbUnChecked;
  end else
  begin
   OldMkDir := FALSE;
   CsKeeper1.CreateDir := OldMkDir;
  end;
 finally
  Reg.CloseKey;
 end;
// Разрешение на удаление каталогов
 try
  Reg.OpenKey(FtpServerKey, TRUE);
  if Reg.ValueExists('DDeleteDir') then
  begin
   OldDeleteDir := Reg.ReadBool('DDeleteDir');
   CsKeeper1.DeleteDir := OldDeleteDir;
   if OldDeleteDir then
    cbDeleteDir.State := cbChecked
   else
    cbDeleteDir.State := cbUnChecked;
  end else
  begin
   OldDeleteDir := FALSE;
   CsKeeper1.DeleteDir := OldDeleteDir;
   cbDeleteDir.State := cbUnChecked;
  end;
 finally
  Reg.CloseKey;
 end;
// Разрешение на передачу файлов
 try
  Reg.OpenKey(FtpServerKey, TRUE);
  if Reg.ValueExists('DUpLoads') then
  begin
   OldUpLoads := Reg.ReadBool('DUpLoads');
   CsKeeper1.UpLoads := OldUpLoads;
   if OldUpLoads then
    cbUpLoad.State := cbChecked
   else
    cbUpLoad.State := cbUnChecked;
  end else
  begin
   OldUpLoads := FALSE;
   CsKeeper1.UpLoads := OldUpLoads;
   cbUpLoad.State := cbUnChecked;
  end;
 finally
  Reg.CloseKey;
 end;
 try
  Reg.OpenKey(FtpServerKey, TRUE);
  if Reg.ValueExists('DNoBannedIPs') then
   NoOfBannedIPs := Reg.ReadInteger
   ('DNoBannedIPs')
  else
   NoOfBannedIPs := 1;
 finally
  Reg.CloseKey;
 end;
// Список запрещенных IP-адресов
 for Count := 0 to NoOfBannedIPs - 1 do
 begin
  IPName := Concat('IPName', IntToStr(Count));
  try
   Reg.OpenKey(FtpServerKey + '\IPs' + '\
   ' + IPName, TRUE);
   if Reg.ValueExists('IPName') then
    lbBadIPAddrs.Items.Add(Reg.ReadString
    ('IPName'))
   else
    lbBadIPAddrs.Items.Add('');
OldBannedIPsList.Add(lbBadIPAddrs.Items.Strings
   [Count]);
  finally
   Reg.CloseKey;
  end;
 end; // цикл for
 with CsKeeper1 do
 begin
  if Length(RootDisk) > 0 then
   dcbRootDisk.Drive := Char(RootDisk[1])
  else
   dcbRootDisk.Drive := 'C';
  if Length(RootDir) > 0 then
   dlbRootDir.Directory := RootDir;
  for Count := 0 to NoOfBannedIPs - 1 do
   BadIPs.Add(lbBadIPAddrs.Items.Strings[Count]);
 end;
 Reg.Free;
end;

Открываемся! 

Метод CsKeeper1.StartServer вызывает процедуру GetHome, чтобы изменить текущий диск и основной каталог в соответствии со значениями FRootDisk и FRootDir, загружаемыми процедурой LoadSettings. 

Вывод списка каталогов и файлов 

К сожалению, для представления списка каталогов и файлов не существует стандартного формата. Формат изменяется в зависимости от операционной системы; это одна из проблем, с которыми приходится иметь дело FTP-клиентам. Наш сервер CsKeeper при создании файла INDEX.TXT использует «стандартный» (более или менее) формат Unix. Этот файл пересылается FTP- 

клиенту после успешной регистрации, а также при каждом удалении, создании или смене каталога. 

Рис. 7.6. Программа KEEPER32 готова к обслуживанию клиентов 

procedure TCsKeeper.GetDirList;
var
 F : TextFile;
 SearchRec : TSearchRec;
 SizeStr, FileName, S : String;
 TDate : TDateTime;
 Result, K, L : Integer;
begin
 AssignFile(F, DirListFile);
 Rewrite(F);
 if Pos('\',FDirPath) = length(FDirPath) then
  FileName := Concat(FDirPath,'*.*')
 else
 if Pos('\',FDirPath) < length(FDirPath) then
  FileName := Concat(FDirPath,'\*.*');
 Result := FindFirst(FileName, 
 faAnyFile, SearchRec);
 if Result <> 0 then
 begin
  Status := Failure;
  Exit;
 end;
 try
  TDate := FileDateToDateTime(SearchRec.Time);
  except
   on EConvertError do
   begin
    Status := Failure;
    Data := '500 Internal error';
    closesocket(FSocket);
    Exit;
   end;
 end;
 S := FormatDateTime('mmm dd hh'':''mm',TDate);
 if DirectoryExists(SearchRec.Name) then
  writeln(F,
  'drwxrwxrwx   1 noone    nogroup        ','0',' 
',S,' ',SearchRec.Name)
 else
 begin
  { вычисляем длину строки для размера файла }
  SizeStr := IntToStr(SearchRec.Size);
  L := Length(SizeStr);
  for K := 9 - L downto 1 do
   SizeStr := ConCat(' ',SizeStr);
  write(F,'-rwxrwxrwx   1 noone    nogroup');
  writeln(F, SizeStr,' ',S,' ',SearchRec.Name);
 end;
 while Result = 0 do
 begin
  TDate := FileDateToDateTime(SearchRec.Time);
  S := FormatDateTime('mmm dd hh'':''mm',TDate);
  if DirectoryExists(SearchRec.Name) then
   writeln(F,
   'drwxrwxrwx   1 noone    nogroup        
   ','0',' ',S,' ',SearchRec.Name)
  else
  begin
   SizeStr := IntToStr(SearchRec.Size);
   L := Length(SizeStr);
   for K := 9 - L downto 1 do
    SizeStr := ConCat(' ',SizeStr);
   write(F,'-rwxrwxrwx   1 noone    nogroup');
   writeln(F, SizeStr,' ',S,' ',SearchRec.Name);
  end;
  Result := FindNext(SearchRec);
 end;
 SysUtils.FindClose(SearchRec);
 CloseFile(F);
end;

Как и в случае с CsShopper, процедура CsKeeper1.OnInfo передает KEEPER32 сообщения, отображаемые затем в Memo-элементе memStatus (см. рис. 7.7). Любые ошибки FTP передаются обработчиком CsKeeper1.OnError на панель pnErrorMsg. 

Рис. 7.7. KEEPER32 с сообщениями о FTP-транзакциях после 
выполнения команды LIST 

Создание прослушивающего сокета 

procedure TCsSocket.GetServer;
begin
 GetServ;
 if Status = Failure then Exit;
 FSockAddress.sin_family          
 := PF_INET;
 FSockAddress.sin_port               
 := FServ^.s_port;
 FSockAddress.sin_addr.s_addr          
 := htonl(INADDR_ANY);
 FRemoteName                     := LocalName;
 FSocket                         := CreateSocket;
end;

После того как все необходимые структуры данных инициализированы, GetServer вызывает CreateSocket, чтобы создать прослушивающий сокет FSocket. Далее мы вызываем функцию Winsock API с именем WSAAsyncSelect, чтобы приказать Winsock DLL извещать CsKeeper о событиях сокета посредством отправки сообщений в адрес Wnd (это логический номер окна типа HWND). Для этого используется следующая строка:

if WSAAsyncSelect(FSocket, Wnd, FTP_EVENT, 
FD_ACCEPT)
                    = SOCKET_ERROR then

Затем мы вызываем bind, еще одну функцию Winsock API, чтобы связать локальное имя с безымянным сокетом FSocket, а также с адресом хоста и номером порта. Это необходимо для прослушивания порта на предмет устанав ливаемых соединений. Функция listen сообщает CsKeeper о необходимости прослушивания порта 21. После вызова этой функции программа KEEPER32 готова к установке соединения через этот порт. 

Как вас обслуживают? 

FClientSocket := accept (FSocketNo, @ClientSockAddr), @FAddrSize); 

Затем мы вызываем функцию Winsock API с именем getpeername, чтобы узнать IP-адрес клиента. Получив IP-адрес, CsKeeper поочередно сравнивает его со всеми строками адресов «плохих» клиентов, хранящимися в списке CsKeeper.FBadIPs. Если будет найдено совпадение, CsKeeper посылает предупреждающее сообщение, отсоединяет нежелательного FTP-клиента и возвращается в состояние прослушивания. Если же клиент признан добропорядоч ным, CsKeeper вызывает LoginUser для выполнения оставшейся части регистрации. 

Вход строго по одному 

if WSAAsyncSelect(FSocket, Wnd, FTP_EVENT, 0) = SOCKET_ERROR then
{ продолжение... } 

В результате все остальные FTP-клиенты будут получать отказ в обслуживании до тех пор, пока CsKeeper не закончит работу с текущим клиентом. 

Затем следует очередной вызов WSAAsyncSelect:

if WSAAsyncSelect(FClientSocket, Wnd, FTP_EVENT,
                  FD_READ OR FD_CLOSE 
                  OR FD_OOB OR FD_WRITE) =      
                  SOCKET_ERROR then
begin

{ продолжение... } 

Этот вызов обеспечивает уведомление со стороны Winsock о любых событиях сокета FClientSocket. После завершения регистрации CsKeeper1 ожидает поступления по управляющему соединению других FTP-команд. 

Когда FTP-клиент выдает команду (например, RETR), FtpEvent получает ее, перехватывая событие FD_READ, сгенерированное Winsock DLL. В ветви FD_READ оператора case вызывается процедура DecodeFTPCmd, которая обрабатывает команды, посылаемые FTP-клиентом. DecodeFTPCmd декодирует команду и вызывает соответствующую процедуру. Если команда не опознана, CsKeeper1 посылает FTP-клиенту код ошибки. Процесс обработки FTP-команд в процедуре DecodeFTPCmd показан в листинге 7.5. Именно здесь находится «сердце» компонента CsKeeper.

procedure TCsKeeper.DecodeFTPCmd
(SockNo : TSocket; 
CmdStr : CharArray; S : String);
var
 FtpCmd, Selector : TFtpCmds;
 DirStr, FileName,
 Line, Port1Str, Port2Str, S1, TempStr : String;
 Finished : Boolean;
 Count : Byte;

begin
 FtpCmd := UNK;
 Finished := FALSE;
 Count := 1;
 S1 := '';
 TempStr := StrPas(CmdStr);
 while not Finished do
 begin
  if (TempStr[Count] = ' ') or ((TempStr[Count] 
  = #13) and
     (TempStr[Count + 1] = #10)) then
  begin
   Finished := TRUE;
  end else
  begin
   S1 := ConCat(S1,TempStr[Count]);
   Inc(Count);
  end;
 end;
 Selector := PWD;
 Status := Failure; { На всякий случай 
 предположим, что произошла неудача }
 Finished := FALSE;
 if S1 = '' then Exit; { Пустые строки не 
 обрабатываются }
 while not Finished do
 begin
  if CompareText(S1, FtpCmdStr[Selector]) 
  = 0 then
  begin
   FtpCmd := Selector;
   Status := Success;
   break;
  end else
  begin
   if Selector = UNK then
   begin
    Status := Failure;
    Finished := TRUE;
   end;
   if not Finished then Inc(Selector);
  end;
 end;

 if Status = Failure then
 begin
  Info := Concat('Unrecognised command received 
  from ', FClientAddrStr);
  InfoEvent(Info);
  SendFtpCode(FClientSocket,'500 Unrecognised 
  command');
  Status := Failure;
  Exit;
 end;
 case FtpCmd of
  PWD  : begin
 Info := Concat('PWD command received from ', 
 FClientAddrStr);
 InfoEvent(Info);
 GetDir(0, DirStr);
 SendFtpCode(FClientSocket,'257 Working 
 directory is '+ DirStr);
end;
  RETR : begin
          Info := Concat('RETR command 
received from ',
                         FClientAddrStr);
          InfoEvent(Info);
          FileName := Copy(TempStr, 
          Pos(' ', TempStr)+1,
           Length(TempStr));
          if Pos(#13, FileName) > 0 then
           FileName := Copy(FileName, 1, Pos(#13, 
           FileName)-1);
          Info := Concat('Sending file ',FileName, 
          ' to ', FClientAddrStr);
          InfoEvent(Info);
          if FFileType = IMAGE then
          begin
           Info := Concat('Using IMAGE type');
           InfoEvent(Info);
           SendFtpCode(FClientSocket,
             '150  Opening BINARY data connection 
             for ' + FileName)
          end
          else
          begin
           Info := Concat('Using ASCII type');
           InfoEvent(Info);
           SendFtpCode(FClientSocket,
             '150  Opening ASCII data 
             connection for ' + FileName);
          end;
          SendFile(FileName);
         end;
  STOR : begin
          Info := Concat('STOR command 
received from ', FClientAddrStr);
          InfoEvent(Info);
          if FUpLoads then
          begin
           FileName := Copy(TempStr, 
           Pos(' ', TempStr)+1,
             Length(TempStr));
           if Pos(#13, FileName) > 0 
           then
            FileName := Copy(FileName, 1, 
            Pos(#13, FileName)-1);
           Info := Concat('Sending file ',
           FileName, ' to ',
                          FClientAddrStr);
           InfoEvent(Info);
           if FFileType = IMAGE then
           begin
            Info := Concat('Using IMAGE type');
            InfoEvent(Info);
            SendFtpCode(FClientSocket,
              '150  Opening BINARY data 
              connection for ' + FileName)
           end
           else
           begin
            Info := Concat('Using ASCII type');
            InfoEvent(Info);
            SendFtpCode(FClientSocket,
              '150  Opening ASCII data 
              connection for ' + FileName);
           end;
           GetFile(FileName);
          end else
          SendFtpCode(FClientSocket,
            '500 STOR command not executed 
            (not allowed)');
         end;
  USER : begin
         { Декодируем строку }
          if Pos('ANONYMOUS',UpperCase(TempStr)) 
          > 0 then
          begin
           Info := Concat('USER command received 
           from ',
                          FClientAddrStr);
           InfoEvent(Info);
           Info := Concat('Anonymous login 
           received from ', FClientAddrStr);
           InfoEvent(Info);
           FUserType := ANONYMOUS;
           SendFtpCode(FClientSocket,
             '331- Anonymous user accepted.');
           SendFtpCode(FClientSocket,
             '331  Send in your password, 
             please');
           Info := Concat(FClientAddrStr,' 
           logged in as anonymous');
           InfoEvent(Info);
          end else
          begin
           FUserType := ACCOUNT;
           SendFtpCode(FClientSocket,'500 ' 
           + FtpCmdStr[ACCT] + 
             ' command not implemented');
          end;
         end;
  QUIT : begin
          Info := Concat('QUIT command received 
          from ',
                         FClientAddrStr);
          InfoEvent(Info);
          SendFtpCode(FClientSocket,'221  
          Goodbye from Keeper!');
          Info := FClientAddrStr;
          Info := ConCat(Info, ' logged out');
          InfoEvent(Info);
          closesocket(FClientSocket);
          FClientSocket := INVALID_SOCKET;
          if FNoOfUsers >= 1 then
           Dec(FNoOfUsers);
          { Переходим к основному устройству 
          и каталогу }
          GetHome;
          GetDirList;
          { Возвращаемся в состояние 
          прослушивания }
          if WSAAsyncSelect(FSocket, Wnd, 
          FTP_EVENT, FD_ACCEPT)
                            = SOCKET_ERROR then
          begin
           Info := Concat('ERROR : 11 
           [',FClientAddrStr,'] ',
                          WSAErrorMsg);
           InfoEvent(Info);
           Status := Failure;
           Exit;
          end;
         end;
  PASS : begin
          { Тип пользователя - ? }
          if FUserType = ANONYMOUS then
          begin
           Info := Concat('PASS command received 
           from ',
                          FClientAddrStr);
           InfoEvent(Info);
           { Получаем адрес электронной почты 
           пользователя }
           SendFtpCode(FClientSocket,
                       '230  User logged in. 
                       Go ahead!');
          end;
         end;
  CDUP : begin
          Info := Concat('CDUP command 
          received from ', 
                         FClientAddrStr);
          InfoEvent(Info);
          SendFtpCode(FClientSocket,'500 ' + 
          FtpCmdStr[CDUP] + 
                      ' command not implemented');
         end;
  CWD  : begin
          Info := Concat('CWD command received 
          from ',
                         FClientAddrStr);
          InfoEvent(Info);
           {$I-}
         { Переходим в каталог, указанный в 
         Edit1 }
          FileName := Copy(TempStr, Pos(' ', 
          TempStr)+1,
                           Length(TempStr));
          if Pos(#13, FileName) > 0 then
           FileName := Copy(FileName, 1, Pos(#13, 
           FileName)-1);
          If DirectoryExists(FileName) then
           ChDir(FileName)
          else
          begin
           Status := Failure;
           SendFtpCode(FClientSocket,'500 Not 
           a directory');
           Exit;
          end;
          if IOResult <> 0 then
           SendFtpCode(FClientSocket,'500 Cannot 
           find directory')
          else
          begin
           SendFtpCode(FClientSocket,'200 Changed 
           directory');
           GetDir(0,FDirPath);
           GetDirList;
          end;
         end;
  LIST : begin
          Info := Concat('LIST command received 
          from ', 
                         FClientAddrStr);
          InfoEvent(Info);
          GetDirList;
          Info := Concat('Sending LIST to ',
          FClientAddrStr);
          InfoEvent(Info);
          SendFtpCode(FClientSocket,'150  
          Opening Ascii connection');
          SendFile(DirListFile);
         end;
  PORT : begin
          Info := Concat('PORT command received 
          from ',
                         FClientAddrStr);
          InfoEvent(Info);
          Count := Length(TempStr);
          Port1Str := '';
          Port2Str := '';
          if (TempStr[Count] = #10) and 
          (TempStr[Count-1] = #13) then
           Dec(Count,2); { не включать CR/LF!}
          while TempStr[Count] <> ',' do
          begin
           Port2Str := Concat(TempStr[Count], 
           Port2Str);
           Dec(Count);
          end;
          Dec(Count);
          while TempStr[Count] <> ',' do
          begin
           Port1Str := Concat(TempStr[Count], 
           Port1Str);
           Dec(Count);
          end;
          FPort2 := StrToInt(Port2Str);
          FPort1 := StrToInt(Port1Str);
          FPortNo := FPort2 + 1024;
          Info := Concat('Port No received ',
          IntToStr(FPortNo),
                         ' from ', 
                         FClientAddrStr);
          InfoEvent(Info);
          SendFtpCode(FClientSocket,'200 PORT 
          command okay');
          FClientSockAddr.sin_port := FPortNo;
          { Открываем соединение данных }
         end;
  SYST : begin
          Info := Concat('SYST command received 
          from ',
                         FClientAddrStr);
          InfoEvent(Info);
          SendFtpCode(FClientSocket,'215  
          Unix Keeper 1.0');
         end;
  HELP : begin
          Info := Concat('HELP command received 
          from ',
                         FClientAddrStr);
          InfoEvent(Info);
          SendFtpCode(FClientSocket,
            '211- HELP Commands implemented 
            at this site:');
          SendFtpCode(FClientSocket,
            '211- QUIT RETR USER PASS LIST PORT 
            CWD TYPE PWD');
          SendFtpCode(FClientSocket,'211  ');
         end;
  FTYPE: begin
          if Pos('A', UpperCase(TempStr)) > 0 
          then
          begin
           FFileType := ASCII;
           SendFtpCode(FClientSocket,'200  
           TYPE ASCII');
          end
          else
          if Pos('I', UpperCase(TempStr)) 
          > 0 then
          begin
           FFileType := IMAGE;
           SendFtpCode(FClientSocket,'200 
           TYPE BINARY');
          end;
         end;
  MODE : begin
          Info := Concat('MODE command received 
          from ', 
                         FClientAddrStr);
          InfoEvent(Info);
          if Pos(' S', Uppercase(TempStr)) > 
          0 then
           FTransfer := STREAM
          else
          if Pos(' B', Uppercase(TempStr)) > 
          0 then
           FTransfer := BLOCK
          else
           FTransfer := COMPRESSED;
         end;
  NLST : begin
          Info := Concat('NLST command received 
          from ', 
                         FClientAddrStr);
          InfoEvent(Info);
          SendFtpCode(FClientSocket,'500 ' 
          + FtpCmdStr[NLST] + 
                      ' command not 
                      implemented');
         end;
 QUOTE : begin
          Info := Concat('QUOTE command 
          received from ',
                         FClientAddrStr);
          InfoEvent(Info);
          SendFtpCode(FClientSocket,'500 ' + 
          FtpCmdStr[QUOTE] + 
                      ' command not implemented');
         end;
 PASV  : begin
          Info := Concat('PASV command received 
          from ',
                         FClientAddrStr);
          InfoEvent(Info);
          SendFtpCode(FClientSocket,'500 ' + 
          FtpCmdStr[PASV] +  
                      ' command not implemented');
         end;
 SITE  : begin

          Info := Concat('SITE command received 
          from ',
                         FClientAddrStr);
          InfoEvent(Info);
          SendFtpCode(FClientSocket,'500 ' + 
          FtpCmdStr[SITE] + 
                      ' command not 
                      implemented');
         end;
  MKD  : begin
          if FCreateDir then
          begin
           Info := Concat('MKDIR command 
           received from ',
                          FClientAddrStr);
           InfoEvent(Info);
           Delete(TempStr,1,Pos(' ',TempStr));
           Delete(TempStr,Pos(#13,TempStr),
           Length(TempStr));
          {$I-}
           MkDir(TempStr);
           if IOResult <> 0 then
           begin
            Info := Concat('MKDIR command 
            failed to create ', 
                           TempStr);
            InfoEvent(Info);
            SendFtpCode(FClientSocket,'500 ' 
            + FtpCmdStr[MKD] + 
                        ' command not 
                        implemented');
           end
           else
           begin
            Info := Concat('MKDIR command to 
            create ',TempStr,
                           ' executed 
                           successfully');
            InfoEvent(Info);
            SendFtpCode(FClientSocket,'200 ' + 
            FtpCmdStr[MKD] + 
                        ' command received OK');
           end;
          end else
          SendFtpCode(FClientSocket,'500 ' + 
          FtpCmdStr[MKD] + 
                      ' command not implemented');
         end;
  RMD  : begin
          Info := Concat('RMD command received 
          from ',
                         FClientAddrStr);
          InfoEvent(Info);
          if FDeleteDir then
          begin
           delete(TempStr,1, Pos(' ',TempStr));
           delete(TempStr, Pos(#13,TempStr),
           Length(TempStr));
          {$I-}
           RmDir(TempStr);
           if IOResult <> 0 then
           begin
            Info := Concat('RMD command failed to 
            delete ',TempStr);
            InfoEvent(Info);
            SendFtpCode(FClientSocket,'500 ' + 
            FtpCmdStr[RMD] + 
                        ' command failed');
           end
           else
           begin
            Info := Concat('RMD command to 
            delete ',TempStr,
                           ' executed 
                           successfully');
            InfoEvent(Info);
            SendFtpCode(FClientSocket,'200 ' + 
            FtpCmdStr[RMD] + 
                        ' command received OK');
           end;
          end else
          SendFtpCode(FClientSocket,'500 ' + 
          FtpCmdStr[RMD] + 
                      ' command not executed');
         end;
  STRU : begin
          Info := Concat('STRU command 
          received from ',
                         FClientAddrStr);
          InfoEvent(Info);
          if Pos(' F', Uppercase(TempStr)) > 
          0 then
           FFileStruct := NOREC
          else
          if Pos(' R', Uppercase(TempStr)) > 
          0 then
           FFileStruct := REC
          else
           FFileStruct := PAGE;
         end;
  STAT : begin
          Info := Concat('STAT command received 
          from ',
                         FClientAddrStr);
          InfoEvent(Info);
          SendFtpCode(FClientSocket,'500 ' + 
          FtpCmdStr[STAT] + 
                      ' command not 
                      implemented');
         end;
  ACCT : begin
          Info := Concat('ACCT command 
          received from ',
                         FClientAddrStr);
          InfoEvent(Info);
          SendFtpCode(FClientSocket,'500 ' + 
          FtpCmdStr[ACCT] + 
                      ' command not implemented');
         end;
  NOOP : begin
          Info := Concat('NOOP command received 
          from ',
                         FClientAddrStr);
          InfoEvent(Info);
          SendFtpCode(FClientSocket,'200 ' + 
          FtpCmdStr[NOOP] + 
                      ' command received OK');
         end;
 end;
end;

При получении от FTP-клиента команды LIST CsKeeper вызывает SendFile, чтобы передать файл INDEX.TXT через соединение данных. После того как пересылка будет завершена, CsKeeper закрывает соединение данных. Соединение данных всегда является временным, в отличие от постоянного управляющего соединения. 

Мне, пожалуйста, вот это… 

При получении команды RETR процедура DecodeFTPCmd анализирует переданную командную строку, и с помощью кода, расположенного в ветви RETR большого оператора case, извлекает из нее имя передаваемого файла. Полученное имя передается процедуре SendFile, которая и выполняет пересылку. Чтобы обеспечить прием файла FTP-клиентом, CsKeeper вызывает SendFTPCode с кодом 150, сообщая тем самым клиенту о необходимости прослушивания данных на ранее заданном порте. 

В самой пересылке файла нет ничего сверхъестественного. SendFile создает локальный сокет с именем LocalSocket и затем вызывает функцию connect, чтобы открыть соединение данных. После установки соединения CsKeeper открывает файл, из которого должны читаться передаваемые данные. Процедура BlockRead в цикле repeat…until читает данные блок за блоком, а функция send передает их. Когда данных для пересылки не остается, CsKeeper закрывает файл и уничтожает соединение данных, вызывая closesocket для закрытия сокета LocalSocket. Затем CsKeeper вызывает SendFTPCode, чтобы передать FTP-клиенту код ответа 226, сообщающий о том, что передача файла завершена. 

Сохраните, пожалуйста… 

TCsKeeper.GetFile создает для соединения данных локальный сокет с именем LocalSocket; для этого используется вызов функции connect, входящей в Winsock API:

if connect (LocalSocket, DataS, SizeOf(TSockAddrIn))= SOCKET_ERROR then
{ продолжение... } 

После открытия файла мы сохраняем поступающие данные в цикле while…do с помощью функций recv (Winsock API) и BlockWrite:

while not Finished do
begin
Response := recv(LocalSocket, Buffer, SizeOf(Buffer), 0);
{ пропуск... }
if Response > 0 then
BlockWrite(F, Buffer, Response);
end; 

После того как все данные от клиента будут приняты, TCsKeeper.GetFile закрывает установленное через LocalSocket соединение данных и передает клиенту положительный код ответа 226 с помощью процедуры SendFtpCode. 

Закрыто на переучет 

Тем не менее существует одно усовершенствование, которое сделает CsKeeper намного более полезным — речь идет о параллельной обработке. Она позволяет одновременно подключать к серверу и обслуживать сразу несколько FTP-клиентов. Практически все современные серверы поддерживают параллельную обработку, особенно если учесть, что на рынке серверов сейчас господствуют операционные системы Windows NT и Unix. Чтобы реализовать параллельную обработку в FTP-сервере, нам пришлось бы изучать реализацию многопоточности (multithreading) в Delphi. Это весьма достойная тема, но она, к сожалению, выходит за рамки этой главы.