Delphi 3. Библиотека программиста

       

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


Чтобы предотвратить попытки соединения со стороны новых FTP-клиентов, LoginUser вызывает функцию WSAAsyncSelect с последним параметром, равным 0 — при этом Winsock DLL перестает оповещать прослушивающий сокет FSocket. Это происходит в следующей строке:

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.

Листинг 7.5. Метод DecodeFTPCmd

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 закрывает соединение данных. Соединение данных всегда является временным, в отличие от постоянного управляющего соединения.



Содержание раздела