7266 lines
264 KiB
Plaintext
7266 lines
264 KiB
Plaintext
|
{
|
|||
|
|
$Project$
|
|||
|
|
$Workfile$
|
|||
|
|
$Revision$
|
|||
|
|
$DateUTC$
|
|||
|
|
$Id$
|
|||
|
|
|
|||
|
|
This file is part of the Indy (Internet Direct) project, and is offered
|
|||
|
|
under the dual-licensing agreement described on the Indy website.
|
|||
|
|
(http://www.indyproject.org/)
|
|||
|
|
|
|||
|
|
Copyright:
|
|||
|
|
(c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
|
|||
|
|
}
|
|||
|
|
{
|
|||
|
|
$Log$
|
|||
|
|
}
|
|||
|
|
{
|
|||
|
|
Rev 1.146 3/23/2005 5:16:56 AM JPMugaas
|
|||
|
|
Should compile.
|
|||
|
|
|
|||
|
|
Rev 1.145 3/14/05 11:28:50 AM RLebeau
|
|||
|
|
Bug fix for CommandSIZE() not checking the FTPFileSystem property.
|
|||
|
|
|
|||
|
|
Updated to reflect changes in TIdReply.NumericCode handling.
|
|||
|
|
|
|||
|
|
Rev 1.144 3/5/2005 3:33:58 PM JPMugaas
|
|||
|
|
Fix for some compiler warnings having to do with TStream.Read being platform
|
|||
|
|
specific. This was fixed by changing the Compressor API to use TIdStreamVCL
|
|||
|
|
instead of TStream. I also made appropriate adjustments to other units for
|
|||
|
|
this.
|
|||
|
|
|
|||
|
|
Rev 1.143 11/22/2004 8:29:20 PM JPMugaas
|
|||
|
|
Fix for a compiler warning.
|
|||
|
|
|
|||
|
|
Rev 1.142 11/22/2004 7:49:36 PM JPMugaas
|
|||
|
|
You now can access help before you are logged in. This is done to conform
|
|||
|
|
to RFC 959.
|
|||
|
|
|
|||
|
|
Rev 1.141 2004.10.27 9:17:48 AM czhower
|
|||
|
|
For TIdStrings
|
|||
|
|
|
|||
|
|
Rev 1.140 10/26/2004 9:40:42 PM JPMugaas
|
|||
|
|
Updated ref.
|
|||
|
|
|
|||
|
|
Rev 1.139 9/15/2004 5:01:00 PM DSiders
|
|||
|
|
Added localization comments.
|
|||
|
|
|
|||
|
|
Rev 1.138 2004.08.13 11:03:22 czhower
|
|||
|
|
Removed unused var.
|
|||
|
|
|
|||
|
|
Rev 1.137 7/29/2004 1:33:10 AM JPMugaas
|
|||
|
|
Reordered AUTH command values for a new property under development. This
|
|||
|
|
should make things more logical.
|
|||
|
|
|
|||
|
|
Rev 1.136 7/18/2004 3:00:42 PM DSiders
|
|||
|
|
Added localization comments.
|
|||
|
|
|
|||
|
|
Rev 1.135 7/15/2004 1:33:00 AM JPMugaas
|
|||
|
|
Bug fix for error 105. I fixed this by changing data channel command
|
|||
|
|
processing. If the command is not ABOR or STAT, the command is put into a
|
|||
|
|
FIFO queue. After the data channel operation is completed, the commands from
|
|||
|
|
the FIFO queue are processed. I have tested FlashFXP 3.0 RC4 and it does
|
|||
|
|
worki as expected. The behavior is also the same as what NcFTPD does with a
|
|||
|
|
NOOP being sent during a data transfer.
|
|||
|
|
|
|||
|
|
This may also help with FTP command pipelining as proposed by:
|
|||
|
|
http://cr.yp.to/ftp/pipelining.html
|
|||
|
|
|
|||
|
|
Note that we can not use the regular command handler framework for data
|
|||
|
|
channel commands because STAT and ABOR need to be handled IMMEDIATELY.
|
|||
|
|
|
|||
|
|
Rev 1.134 7/13/04 9:08:10 PM RLebeau
|
|||
|
|
Renamed OnPASV event to OnPASVBeforeBind and added new OnPASVReply event
|
|||
|
|
|
|||
|
|
Rev 1.133 7/13/04 8:13:56 PM RLebeau
|
|||
|
|
Various changed for DefaultDataPort handling
|
|||
|
|
|
|||
|
|
Rev 1.132 7/13/2004 3:34:12 AM JPMugaas
|
|||
|
|
CCC command and a few other minor modifications to comply with
|
|||
|
|
http://www.ietf.org/internet-drafts/draft-murray-auth-ftp-ssl-14.txt .
|
|||
|
|
|
|||
|
|
I also fixed a few minor bugs in the help and a problem with some error
|
|||
|
|
replies sending an extra 200 after a 5xxx code messing up some clients.
|
|||
|
|
|
|||
|
|
I also expanded the Security options to selectively disable CCC per user.
|
|||
|
|
Some administrators may want to do this for security reasons.
|
|||
|
|
|
|||
|
|
Rev 1.131 7/12/2004 11:46:44 PM JPMugaas
|
|||
|
|
Improvement in OPTS MODE Z handling. It will give an error if there's only
|
|||
|
|
one param. Params must be in pairs. If no valid parameters are present, we
|
|||
|
|
give an error.
|
|||
|
|
|
|||
|
|
Rev 1.130 07/07/2004 17:34:38 ANeillans
|
|||
|
|
Corrected compile bug.
|
|||
|
|
Line 6026,
|
|||
|
|
if PosInStrArray(IntToStr(LNoVal),STATES,False)>-1 then
|
|||
|
|
Function expected a string, not an integer.
|
|||
|
|
|
|||
|
|
Rev 1.129 7/6/2004 4:52:16 PM DSiders
|
|||
|
|
Corrected spelling of Challenge in properties, methods, types.
|
|||
|
|
|
|||
|
|
Rev 1.128 6/29/2004 4:09:04 PM JPMugaas
|
|||
|
|
OPTS MODE Z now supported as per draft-preston-ftpext-deflate-02.txt. This
|
|||
|
|
should keep FTP Voyager 11 happy.
|
|||
|
|
|
|||
|
|
Rev 1.127 6/28/2004 7:23:20 PM JPMugaas
|
|||
|
|
Bugfix. An invalid site command would cause no reply to be given. Now a
|
|||
|
|
syntax is given in such cases.
|
|||
|
|
|
|||
|
|
Rev 1.126 6/27/2004 1:45:30 AM JPMugaas
|
|||
|
|
Can now optionally support LastAccessTime like Smartftp's FTP Server could.
|
|||
|
|
I also made the MLST listing object and parser support this as well.
|
|||
|
|
|
|||
|
|
Rev 1.125 6/17/2004 3:56:28 PM JPMugaas
|
|||
|
|
Fix for AV that happens after data channel operation.
|
|||
|
|
|
|||
|
|
Rev 1.124 6/16/2004 2:29:32 PM JPMugaas
|
|||
|
|
Removed direct access to a FConnection. We now use the Connection property
|
|||
|
|
in the TIdContext.
|
|||
|
|
|
|||
|
|
Rev 1.123 6/12/2004 9:05:52 AM JPMugaas
|
|||
|
|
Telnet control sequences should now work during a data transfer.
|
|||
|
|
Removed HandleTelnetSequences. It was part of a crude workaround which had
|
|||
|
|
never works and the matter was fixed in another way.
|
|||
|
|
OnCustomDir should now work if the DirStyle is custom.
|
|||
|
|
|
|||
|
|
Rev 1.122 6/11/2004 9:35:12 AM DSiders
|
|||
|
|
Added "Do not Localize" comments.
|
|||
|
|
|
|||
|
|
Rev 1.121 2004.05.20 11:37:26 AM czhower
|
|||
|
|
IdStreamVCL
|
|||
|
|
|
|||
|
|
Rev 1.120 5/16/04 5:30:26 PM RLebeau
|
|||
|
|
Added setter methods to the ReplyUnknownSITECommand and SITECommands
|
|||
|
|
properties
|
|||
|
|
|
|||
|
|
Added GetRepliesClass() overrides
|
|||
|
|
|
|||
|
|
Rev 1.119 5/1/2004 1:52:20 PM JPMugaas
|
|||
|
|
Updated for PeekBytes API change.
|
|||
|
|
|
|||
|
|
Rev 1.118 4/8/2004 12:19:08 PM JPMugaas
|
|||
|
|
Should work with new code.
|
|||
|
|
|
|||
|
|
Rev 1.117 3/3/2004 6:34:46 PM JPMugaas
|
|||
|
|
Improved help system.
|
|||
|
|
Some manditory (RFC 1123 were rutning syntax errors instead of not
|
|||
|
|
implemented.
|
|||
|
|
Add some mention of some other RFC 2228 commands for completness. Not that
|
|||
|
|
there are not supported or implemented.
|
|||
|
|
|
|||
|
|
Rev 1.116 3/3/2004 6:02:14 AM JPMugaas
|
|||
|
|
Command descriptions.
|
|||
|
|
|
|||
|
|
Rev 1.115 3/2/2004 8:13:28 AM JPMugaas
|
|||
|
|
Fixup for minor API change.
|
|||
|
|
|
|||
|
|
Rev 1.113 3/1/2004 12:41:40 PM JPMugaas
|
|||
|
|
Should compile with new code.
|
|||
|
|
|
|||
|
|
Rev 1.112 2/29/2004 6:02:38 PM JPMugaas
|
|||
|
|
Improved bug fix for problem with Telnet sequences not being handled properly
|
|||
|
|
in the FTP server. Litteral CR and LF are now handled properly (according to
|
|||
|
|
the Telnet Specification).
|
|||
|
|
|
|||
|
|
Rev 1.111 2/25/2004 3:27:04 PM JPMugaas
|
|||
|
|
STAT -l now works like a LIST command except that it returns output on the
|
|||
|
|
control channel. This is for consistancy with microsoft FTP Service,
|
|||
|
|
RaidenFTPD, and a few other servers. FlashFXP can take advantage of this
|
|||
|
|
feature as well to gain some efficiency. Note that I do not do not advocate
|
|||
|
|
doing this on the FTP client because some servers will act differently than
|
|||
|
|
you would assume. I may see about possible options for using STAT -l but I
|
|||
|
|
can NOT promise anything.
|
|||
|
|
|
|||
|
|
Rev 1.110 2/17/2004 6:37:28 PM JPMugaas
|
|||
|
|
OnPASV event added for people needing to change the IP address or port value
|
|||
|
|
in commands such as PASV. This should only be done if you have a compelling
|
|||
|
|
reason to do it.
|
|||
|
|
|
|||
|
|
Note that the IP address parameter can NOT work with EPSV and SPSV because
|
|||
|
|
only the port number is returned. The IP address is presumed to be the same
|
|||
|
|
one that the host is connecting to.
|
|||
|
|
|
|||
|
|
Rev 1.109 2/17/2004 12:26:06 PM JPMugaas
|
|||
|
|
The client now supports MODE Z (deflate) uploads and downloads as specified
|
|||
|
|
by http://www.ietf.org/internet-drafts/draft-preston-ftpext-deflate-00.txt
|
|||
|
|
|
|||
|
|
Rev 1.108 2/15/2004 12:11:04 AM JPMugaas
|
|||
|
|
SPSV support. SPSV is an old propoal to help FTP support IPv6. This was
|
|||
|
|
mentioned at: http://cr.yp.to/ftp/retr.html and is supported by PureFTPD.
|
|||
|
|
|
|||
|
|
Rev 1.107 2/14/2004 10:00:40 PM JPMugaas
|
|||
|
|
Both upload and download should now work in MODE Z. Dir already worked
|
|||
|
|
properly.
|
|||
|
|
|
|||
|
|
Rev 1.106 2/12/2004 11:34:38 PM JPMugaas
|
|||
|
|
FTP Deflate preliminary support. Work still needs to be done for upload and
|
|||
|
|
downloading.
|
|||
|
|
|
|||
|
|
Rev 1.105 2004.02.08 3:08:10 PM czhower
|
|||
|
|
.Net fix.
|
|||
|
|
|
|||
|
|
Rev 1.104 2004.02.07 5:03:10 PM czhower
|
|||
|
|
.net fixes.
|
|||
|
|
|
|||
|
|
Rev 1.103 2004.02.03 5:45:54 PM czhower
|
|||
|
|
Name changes
|
|||
|
|
|
|||
|
|
Rev 1.102 1/29/2004 3:15:52 PM JPMugaas
|
|||
|
|
Fix for P@SW in InitCommandHandlers used "PASV" isntead of "P@SW". Fixed.
|
|||
|
|
|
|||
|
|
Rev 1.101 1/22/2004 8:29:06 AM JPMugaas
|
|||
|
|
Removed Ansi*.
|
|||
|
|
|
|||
|
|
Rev 1.100 1/21/2004 2:34:38 PM JPMugaas
|
|||
|
|
Fixed SITE ZONE reply.
|
|||
|
|
InitComponent
|
|||
|
|
|
|||
|
|
Rev 1.99 1/19/2004 4:37:02 AM JPMugaas
|
|||
|
|
MinutesFromGMT was moved to IdFTPCommon because the client now uses it.
|
|||
|
|
|
|||
|
|
Rev 1.98 1/18/2004 9:19:08 AM JPMugaas
|
|||
|
|
P@SW now supported.
|
|||
|
|
|
|||
|
|
This is necessary as some routers that replace a PASV with a P@SW
|
|||
|
|
as part of a misguided attempt to add a feature.
|
|||
|
|
A router would do a replacement so a client would think that
|
|||
|
|
PASV wasn't supported and then the client would do a PORT command
|
|||
|
|
instead. That doesn't happen so this just caused the client not to work.
|
|||
|
|
|
|||
|
|
See: http://www.gbnetwork.co.uk/smcftpd/
|
|||
|
|
|
|||
|
|
Rev 1.97 1/17/2004 7:40:08 PM JPMugaas
|
|||
|
|
MLSD added to FEAT list for consistancy with other FTP servers.
|
|||
|
|
Fixed bug that would cause FXP transfers to fail when receiving a PASV.
|
|||
|
|
|
|||
|
|
Rev 1.96 1/16/2004 12:25:06 AM JPMugaas
|
|||
|
|
Fixes for MTDM set modified time.
|
|||
|
|
|
|||
|
|
Rev 1.94 1/15/2004 2:36:50 AM JPMugaas
|
|||
|
|
XMD5 command support.
|
|||
|
|
SITE ZONE command added for FTP Voyager.
|
|||
|
|
Minor adjustment in AUTH line in the FEAT response to indicate that we
|
|||
|
|
support the AUTH TLS, AUTH TLS-C, AUTH SSL, and AUTH TLS-P explicit TLS
|
|||
|
|
commands.
|
|||
|
|
|
|||
|
|
Rev 1.93 1/14/2004 4:11:30 PM JPMugaas
|
|||
|
|
CPSV support added. This is like PASV but indicates that we use ssl_connect
|
|||
|
|
instead of ssl_accept. CPSV is used in FlashFXP for secure site-to-site file
|
|||
|
|
transfers.
|
|||
|
|
|
|||
|
|
Rev 1.92 1/14/2004 12:24:06 PM JPMugaas
|
|||
|
|
SSCN Support for secure Site to Site Transfers using SSL.
|
|||
|
|
|
|||
|
|
SSCN is defined at:
|
|||
|
|
|
|||
|
|
http://www.raidenftpd.com/kb/kb000000037.htm
|
|||
|
|
|
|||
|
|
Rev 1.91 1/13/2004 6:30:38 AM JPMugaas
|
|||
|
|
Numerous bug fixes.
|
|||
|
|
Now supports XCWD (a predicessor to CWD).
|
|||
|
|
Command Reply for unknown command works again.
|
|||
|
|
Started putting some formatting into common routines.
|
|||
|
|
CuteFTP goes bonkers with a "215 " reply to SYST command. Now indicate that
|
|||
|
|
SYST isn't implemented instead of giving that "215 ". Note that a
|
|||
|
|
"CustomSystID" should be provided when DirFormat is ftpdfCustom.
|
|||
|
|
If DirFormat is ftpdfCustom and OnListDirectory is provided; MLST, MLSD, and
|
|||
|
|
OPTS MLSD will be DISABLED. OnListDirectory is used in the custom format for
|
|||
|
|
structed standardized output with the MLSD and MLST commands.
|
|||
|
|
A not implemented is now given for some commands.
|
|||
|
|
|
|||
|
|
Rev 1.90 1/5/2004 11:53:00 PM JPMugaas
|
|||
|
|
Some messages moved to resource strings. Minor tweeks. EIdException no
|
|||
|
|
longer raised.
|
|||
|
|
|
|||
|
|
Rev 1.88 1/4/2004 3:51:32 PM JPMugaas
|
|||
|
|
Fixed a CWD bug. The parameter was being ignored.
|
|||
|
|
|
|||
|
|
Rev 1.87 1/3/2004 8:05:18 PM JPMugaas
|
|||
|
|
Bug fix: Sometimes, replies will appear twice due to the way functionality
|
|||
|
|
was enherited.
|
|||
|
|
|
|||
|
|
Rev 1.86 1/3/2004 5:37:56 PM JPMugaas
|
|||
|
|
Changes from Bas:
|
|||
|
|
|
|||
|
|
added function GetReplyClass, this function returns the class of reply this
|
|||
|
|
server class uses, this is because in dotnet there can be no code before the
|
|||
|
|
inherited in the constructor ( that is used mow to determine the<68>reply class )
|
|||
|
|
<20>
|
|||
|
|
changed System.Delete to IdDelete (in coreglobal) because System.Delete is
|
|||
|
|
not in dotnet
|
|||
|
|
<20>
|
|||
|
|
SplitLines is not enabled in dotnet yet, so i made it a todo, make sure to
|
|||
|
|
enable it and remove the todo if you check it in<69>
|
|||
|
|
<20>
|
|||
|
|
|
|||
|
|
Rev 1.85 1/2/2004 1:02:08 AM JPMugaas
|
|||
|
|
Made comment about why the SYST descriptor is determined the way it is.
|
|||
|
|
|
|||
|
|
Rev 1.84 1/2/2004 12:55:32 AM JPMugaas
|
|||
|
|
Now compiles. Removed the EmulateSystem property. Replaced one part with
|
|||
|
|
the DirFormat property.
|
|||
|
|
|
|||
|
|
Rev 1.83 1/1/2004 10:55:10 PM JPMugaas
|
|||
|
|
Remy Lebeau found a bug with path processing in the FTP server. I was
|
|||
|
|
passing an emptry Result string instead of APath in FTPNormalize.
|
|||
|
|
|
|||
|
|
Rev 1.77 10/11/2003 10:17:28 AM JPMugaas
|
|||
|
|
Checked in a more recent version which should be worked on instead.
|
|||
|
|
|
|||
|
|
Rev 1.75 9/19/2003 12:50:18 PM JPMugaas
|
|||
|
|
Started attempt to get the server to compile.
|
|||
|
|
|
|||
|
|
Rev 1.74 9/18/2003 10:20:06 AM JPMugaas
|
|||
|
|
Updated for new API.
|
|||
|
|
|
|||
|
|
Rev 1.73 8/24/2003 06:50:02 PM JPMugaas
|
|||
|
|
API Change in the FileSystem component so that a thread is passed instead of
|
|||
|
|
some data from the thread. This should also make the API's easier to manage
|
|||
|
|
than before and provide more flexibility for developers writing their own
|
|||
|
|
file system components.
|
|||
|
|
|
|||
|
|
Rev 1.72 7/13/2003 7:56:00 PM SPerry
|
|||
|
|
fixed problem with commandhandlers
|
|||
|
|
|
|||
|
|
Rev 1.69 6/17/2003 09:30:20 PM JPMugaas
|
|||
|
|
Fixed an AV with the ALLO command if no parameters were passed. Stated in
|
|||
|
|
HELP command that we don't support some old FTP E-Mail commands from RFC 765
|
|||
|
|
which have not been in use for many years. We now give a reply saying those
|
|||
|
|
aren't implemented to be consistant with some Unix FTP deamons.
|
|||
|
|
|
|||
|
|
Rev 1.68 6/17/2003 03:16:36 PM JPMugaas
|
|||
|
|
I redid the help and site help implementations so that they list commands.
|
|||
|
|
It did mean loosing the FHelpText TIdStrings property but this should be more
|
|||
|
|
consistant with common practices.
|
|||
|
|
|
|||
|
|
Rev 1.67 6/17/2003 09:07:40 AM JPMugaas
|
|||
|
|
Improved SITE HELP handling.
|
|||
|
|
|
|||
|
|
Rev 1.65 5/26/2003 12:22:50 PM JPMugaas
|
|||
|
|
|
|||
|
|
Rev 1.64 5/25/2003 03:54:28 AM JPMugaas
|
|||
|
|
|
|||
|
|
Rev 1.63 5/21/2003 3:59:32 PM BGooijen
|
|||
|
|
removed with in InitializeCommandHandlers, and changed exception replies
|
|||
|
|
|
|||
|
|
Rev 1.62 5/21/2003 09:29:40 AM JPMugaas
|
|||
|
|
|
|||
|
|
Rev 1.61 5/19/2003 08:11:44 PM JPMugaas
|
|||
|
|
Now should compile properly with new code in Core.
|
|||
|
|
|
|||
|
|
Rev 1.60 4/10/2003 02:54:14 PM JPMugaas
|
|||
|
|
Improvement for FTP STOU command. Unique filename now uses
|
|||
|
|
IdGlobal.GetUniqueFileName instead of Rand. I also fixed GetUniqueFileName
|
|||
|
|
so that it can accept an empty path specification.
|
|||
|
|
|
|||
|
|
Rev 1.59 3/30/2003 12:18:38 AM BGooijen
|
|||
|
|
bug fix + ssl one data channel fixed
|
|||
|
|
|
|||
|
|
Rev 1.58 3/24/2003 11:08:42 PM BGooijen
|
|||
|
|
'transfer'-commands now block, until the transfer is done/aborted.
|
|||
|
|
this made it possible to send the reply after the transfer in the
|
|||
|
|
control-thread
|
|||
|
|
|
|||
|
|
Rev 1.57 3/16/2003 06:11:18 PM JPMugaas
|
|||
|
|
Server now derrives from a TLS framework.
|
|||
|
|
|
|||
|
|
Rev 1.56 3/14/2003 11:33:46 PM JPMugaas
|
|||
|
|
|
|||
|
|
Rev 1.55 3/14/2003 10:44:38 PM BGooijen
|
|||
|
|
Removed warnings, changed StartSSL to PassThrough:=false;
|
|||
|
|
|
|||
|
|
Rev 1.54 3/14/2003 10:00:24 PM BGooijen
|
|||
|
|
Removed TIdServerIOHandlerSSLBase.PeerPassthrough, the ssl is now enabled in
|
|||
|
|
the server-protocol-files
|
|||
|
|
|
|||
|
|
Rev 1.53 3/13/2003 05:21:18 PM JPMugaas
|
|||
|
|
Bas's bug fix. There was a wrong typecast.
|
|||
|
|
|
|||
|
|
Rev 1.52 3/13/2003 8:57:30 PM BGooijen
|
|||
|
|
changed TIdSSLIOHandlerSocketBase to TIdIOHandlerSocket in
|
|||
|
|
TIdDataChannelContext.SetupDataChannel
|
|||
|
|
|
|||
|
|
Rev 1.51 3/13/2003 09:49:06 AM JPMugaas
|
|||
|
|
Now uses an abstract SSL base class instead of OpenSSL so 3rd-party vendors
|
|||
|
|
can plug-in their products.
|
|||
|
|
|
|||
|
|
Rev 1.50 3/13/2003 06:11:54 AM JPMugaas
|
|||
|
|
Updated with Bas's change.
|
|||
|
|
|
|||
|
|
Rev 1.49 3/10/2003 09:12:46 PM JPMugaas
|
|||
|
|
Most command handlers now use Do methods for consistancy with other Indy code.
|
|||
|
|
|
|||
|
|
Rev 1.48 3/10/2003 05:09:22 PM JPMugaas
|
|||
|
|
MLST now works as expected with the file system. Note that the MLST means
|
|||
|
|
simply to give information about an item instead of its contents.
|
|||
|
|
GetRealFileName in IdFTPFileSystem now can accept the wildcard *.
|
|||
|
|
When doing dirs in EPLF, only information about a directory is retruned if it
|
|||
|
|
is specified.
|
|||
|
|
|
|||
|
|
Rev 1.47 3/9/2003 02:11:34 PM JPMugaas
|
|||
|
|
Removed server support for MODE B and MODE C. It turns out that we do not
|
|||
|
|
support those modes properly. We only implemented Stream mode. We now
|
|||
|
|
simply return a 504 for modes we don't support instead of a 200 okay. This
|
|||
|
|
was throwing off Opera 7.02.
|
|||
|
|
|
|||
|
|
Rev 1.46 3/6/2003 11:00:12 AM JPMugaas
|
|||
|
|
Now handles the MFMT command and the MFCT (Modified Date fact) command.
|
|||
|
|
|
|||
|
|
Rev 1.45 3/6/2003 08:26:28 AM JPMugaas
|
|||
|
|
Bug fixes.
|
|||
|
|
|
|||
|
|
FTP COMB command can now work in the FTPFileSystem component.
|
|||
|
|
|
|||
|
|
Rev 1.44 3/5/2003 03:28:16 PM JPMugaas
|
|||
|
|
MD5, MMD5, and XCRC are now supported in the Virtual File System.
|
|||
|
|
|
|||
|
|
Rev 1.43 3/5/2003 11:46:38 AM JPMugaas
|
|||
|
|
Rename now works in Virtual FileSystem.
|
|||
|
|
|
|||
|
|
Rev 1.42 3/2/2003 04:54:34 PM JPMugaas
|
|||
|
|
Now does recursive dir lists with the Virtual File System layer as well as
|
|||
|
|
honors other switches.
|
|||
|
|
|
|||
|
|
Rev 1.41 3/2/2003 02:18:32 PM JPMugaas
|
|||
|
|
Bug fix for where a reply was not returned when using a file system component.
|
|||
|
|
|
|||
|
|
Rev 1.40 3/2/2003 02:23:38 AM JPMugaas
|
|||
|
|
fix for problem with pathes in the virtual file system.
|
|||
|
|
|
|||
|
|
Rev 1.39 2/24/2003 08:50:44 PM JPMugaas
|
|||
|
|
|
|||
|
|
Rev 1.38 2/24/2003 07:56:22 PM JPMugaas
|
|||
|
|
Now uses /bin/ls strings.
|
|||
|
|
|
|||
|
|
Rev 1.37 2/24/2003 07:21:10 AM JPMugaas
|
|||
|
|
FTP Server now strips out any -R switches when emulating EPLF servers.
|
|||
|
|
Recursive lists aren't supported with EPLF.
|
|||
|
|
|
|||
|
|
Rev 1.36 2/21/2003 06:54:10 PM JPMugaas
|
|||
|
|
The FTP list processing has been restructured so that Directory output is not
|
|||
|
|
done by IdFTPList. This now also uses the IdFTPListParserBase for parsing so
|
|||
|
|
that the code is more scalable.
|
|||
|
|
|
|||
|
|
Rev 1.35 2/15/2003 10:29:42 AM JPMugaas
|
|||
|
|
Added support for some Unix specific facts with MLSD and MLST.
|
|||
|
|
|
|||
|
|
Rev 1.34 2/14/2003 05:42:08 PM JPMugaas
|
|||
|
|
Moved everything from IdFTPUtils to IdFTPCommon at Kudzu's suggestion.
|
|||
|
|
|
|||
|
|
Rev 1.33 2/14/2003 11:57:48 AM JPMugaas
|
|||
|
|
Updated for new API. Made sure that there were no calls to a function we
|
|||
|
|
removed.
|
|||
|
|
|
|||
|
|
Rev 1.32 2/14/2003 10:45:18 AM JPMugaas
|
|||
|
|
Updated for minor API change.
|
|||
|
|
|
|||
|
|
Rev 1.30 2/13/2003 01:28:08 AM JPMugaas
|
|||
|
|
MLSD and MLST should now work better.
|
|||
|
|
|
|||
|
|
Rev 1.29 2/12/2003 12:30:56 PM JPMugaas
|
|||
|
|
Now honors parameters with the NLIST command.
|
|||
|
|
|
|||
|
|
Rev 1.28 2/5/2003 10:30:04 PM BGooijen
|
|||
|
|
Re-enabled ssl-support
|
|||
|
|
|
|||
|
|
Rev 1.27 2/4/2003 05:31:40 PM JPMugaas
|
|||
|
|
Added ASwitches parameter to the ListEvent so we can pass parameters such as
|
|||
|
|
"-R" in addition to the standard path.
|
|||
|
|
|
|||
|
|
Rev 1.26 2/3/2003 11:01:50 AM JPMugaas
|
|||
|
|
Moved list export to IdFTPList.
|
|||
|
|
|
|||
|
|
Rev 1.25 1/31/2003 01:59:18 PM JPMugaas
|
|||
|
|
Security options are now reenabled.
|
|||
|
|
|
|||
|
|
Rev 1.24 1/31/2003 01:19:00 PM JPMugaas
|
|||
|
|
Now passes the ControlConnection context instead of the ControlConnection
|
|||
|
|
object itself.
|
|||
|
|
|
|||
|
|
Rev 1.23 1/31/2003 06:34:52 AM JPMugaas
|
|||
|
|
Now SYST command works as expected.
|
|||
|
|
|
|||
|
|
Rev 1.22 1/31/2003 04:23:24 AM JPMugaas
|
|||
|
|
FTP Server security options can be set for individual users and the server
|
|||
|
|
will now use the Context's security options. THis should permit more
|
|||
|
|
flexibility in security.
|
|||
|
|
|
|||
|
|
Rev 1.21 1/30/2003 03:31:06 AM JPMugaas
|
|||
|
|
Now should also properly handle exceptions in the MLSx commands.
|
|||
|
|
|
|||
|
|
Rev 1.20 1/30/2003 02:55:26 AM JPMugaas
|
|||
|
|
Now properly handles exceptions in the ListEvent for the STAT and LIST
|
|||
|
|
commands.
|
|||
|
|
|
|||
|
|
Rev 1.19 1/29/2003 01:17:18 AM JPMugaas
|
|||
|
|
Exception handling should mostly work as it should. There's still a problem
|
|||
|
|
with the list.
|
|||
|
|
|
|||
|
|
Rev 1.18 1/28/2003 02:27:26 AM JPMugaas
|
|||
|
|
Improved exception handling in several events to try to be more consistant.
|
|||
|
|
Now can optionally hide the exception message when giving an error reply to
|
|||
|
|
the user. This should prevent some inadvertant information about a computer
|
|||
|
|
going to a troublemaker.
|
|||
|
|
|
|||
|
|
Rev 1.17 1/27/2003 05:03:16 AM JPMugaas
|
|||
|
|
Now a developer can provide status information to a user with the STAT
|
|||
|
|
command if they want. We format the reply in a standard manner for them.
|
|||
|
|
They just provide the information.
|
|||
|
|
|
|||
|
|
Rev 1.16 1/27/2003 02:13:30 AM JPMugaas
|
|||
|
|
Added more security options as suggested by:
|
|||
|
|
http://www.sans.org/rr/infowar/fingerprint.php to help slow down an attack.
|
|||
|
|
You can optionally disable both SYST and the STAT commands. Trouble makers
|
|||
|
|
can use those to help determine server type and then use known flaws to
|
|||
|
|
compromise it. Note that these do not completely prevent attacks and should
|
|||
|
|
not lull administrators into a false sense of security.
|
|||
|
|
|
|||
|
|
Rev 1.15 1/27/2003 12:32:08 AM JPMugaas
|
|||
|
|
Now can optionally return the identifier for the real operating system. By
|
|||
|
|
default, this property is false for security reasons.
|
|||
|
|
|
|||
|
|
Rev 1.14 1/26/2003 11:59:16 PM JPMugaas
|
|||
|
|
SystemDescriptor behavior change as well as SYST command change.
|
|||
|
|
SystemDescriptor no longer needs an OS type as the first word. That is now
|
|||
|
|
handled by the SYST commandhandler to better comply with RFC 959.
|
|||
|
|
|
|||
|
|
Rev 1.13 1/25/2003 02:00:58 AM JPMugaas
|
|||
|
|
MMD5 (for multiple MD5 checksums) is now supported.
|
|||
|
|
Refined MD5 command support slgihtly.
|
|||
|
|
|
|||
|
|
This is based on:
|
|||
|
|
http://www.ietf.org/internet-drafts/draft-twine-ftpmd5-00.txt
|
|||
|
|
|
|||
|
|
Rev 1.12 1/24/2003 6:07:24 PM BGooijen
|
|||
|
|
Changed TIdDataChannelThread to TIdDataChannelContext
|
|||
|
|
|
|||
|
|
Rev 1.11 1/23/2003 9:06:26 PM BGooijen
|
|||
|
|
changed the CommandAbor
|
|||
|
|
|
|||
|
|
Rev 1.10 1/23/2003 10:39:38 AM BGooijen
|
|||
|
|
TIdDataChannelContext.FServer was never assigned
|
|||
|
|
|
|||
|
|
Rev 1.9 1/20/2003 1:15:40 PM BGooijen
|
|||
|
|
Changed to TIdTCPServer / TIdCmdTCPServer classes
|
|||
|
|
|
|||
|
|
Rev 1.8 1/17/2003 06:21:02 PM JPMugaas
|
|||
|
|
Now works with new design.
|
|||
|
|
|
|||
|
|
Rev 1.7 1/17/2003 05:28:42 PM JPMugaas
|
|||
|
|
|
|||
|
|
Rev 1.6 1-9-2003 14:45:30 BGooijen
|
|||
|
|
Added ABOR command with telnet escape characters
|
|||
|
|
Fixed hanging of ABOR command
|
|||
|
|
STOR and STOU now use REST-position
|
|||
|
|
ABOR now returns 226 instead of 200
|
|||
|
|
|
|||
|
|
Rev 1.5 1-9-2003 14:35:52 BGooijen
|
|||
|
|
changed TIdFTPServerContext(ASender.Context.Thread) to
|
|||
|
|
TIdFTPServerContext(ASender.Context) on some places
|
|||
|
|
|
|||
|
|
Rev 1.4 1/9/2003 06:08:10 AM JPMugaas
|
|||
|
|
Updated to be based on IdContext.
|
|||
|
|
|
|||
|
|
Rev 1.3 1-1-2003 20:13:06 BGooijen
|
|||
|
|
Changed to support the new TIdContext class
|
|||
|
|
|
|||
|
|
Rev 1.2 12-15-2002 21:15:46 BGooijen
|
|||
|
|
IFDEF-ed all SSL code, the IFDEF-s are removed as soon as the SSL works again.
|
|||
|
|
|
|||
|
|
Rev 1.1 11/14/2002 02:55:58 PM JPMugaas
|
|||
|
|
FEAT and MLST now completely use the RFC Reply objects instead of
|
|||
|
|
Connection.WriteLn. The Connection.WriteLn was a workaround for a deficit in
|
|||
|
|
the original RFC Reply object. The workaround is no longer needed.
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
unit IdFTPServer;
|
|||
|
|
|
|||
|
|
{
|
|||
|
|
Original Author: Sergio Perry
|
|||
|
|
Date: 04/21/2001
|
|||
|
|
Fixes and modifications: Doychin Bondzhev
|
|||
|
|
Date: 08/10/2001
|
|||
|
|
Further Extensive changes by Chad Z. Hower (Kudzu)
|
|||
|
|
EPSV/EPRT support for IPv6 by Johannes Berg
|
|||
|
|
|
|||
|
|
TODO:
|
|||
|
|
both EPSV and EPRT only allow data connections that have the same
|
|||
|
|
protocol as the control connection, because the ftp server could be
|
|||
|
|
used in a network only supporting one of them
|
|||
|
|
|
|||
|
|
TODO:
|
|||
|
|
Change events to use DoXXXX
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
interface
|
|||
|
|
|
|||
|
|
{$i IdCompilerDefines.inc}
|
|||
|
|
|
|||
|
|
uses
|
|||
|
|
Classes,
|
|||
|
|
IdAssignedNumbers, IdCommandHandlers, IdGlobal, IdContext, IdException,
|
|||
|
|
IdExplicitTLSClientServerBase, IdFTPBaseFileSystem, IdFTPCommon,
|
|||
|
|
IdBaseComponent, IdFTPList, IdFTPListOutput, IdFTPServerContextBase,
|
|||
|
|
IdReply, IdReplyFTP, IdReplyRFC, IdScheduler, IdServerIOHandler,
|
|||
|
|
IdTCPConnection, IdCmdTCPServer, IdTCPServer, IdThread, IdUserAccounts,
|
|||
|
|
IdYarn, IdZLibCompressorBase, SysUtils;
|
|||
|
|
|
|||
|
|
type
|
|||
|
|
TIdFTPDirFormat = (ftpdfDOS, ftpdfUnix, ftpdfEPLF, ftpdfCustom, ftpdfOSDependent);
|
|||
|
|
TIdFTPPathProcessing = (ftppDOS, ftppUnix, ftpOSDependent, ftppCustom);
|
|||
|
|
TIdFTPOperation = (ftpRetr, ftpStor);
|
|||
|
|
|
|||
|
|
TIdMLSDAttr = (mlsdUniqueID,
|
|||
|
|
mlsdPerms,
|
|||
|
|
mlsdUnixModes,
|
|||
|
|
mlsdUnixOwner,
|
|||
|
|
mlsdUnixGroup,
|
|||
|
|
mlsdFileCreationTime,
|
|||
|
|
mlsdFileLastAccessTime,
|
|||
|
|
mlsdWin32Attributes,
|
|||
|
|
mlsdWin32DriveType,
|
|||
|
|
mlstWin32DriveLabel);
|
|||
|
|
|
|||
|
|
TIdMLSDAttrs = set of TIdMLSDAttr;
|
|||
|
|
|
|||
|
|
const
|
|||
|
|
DEF_DIRFORMAT = ftpdfUnix; //ftpdfOSDependent;
|
|||
|
|
Id_DEF_AllowAnon = False;
|
|||
|
|
Id_DEF_PassStrictCheck = True;
|
|||
|
|
DEF_FTP_IMPLICIT_FTP = False;
|
|||
|
|
|
|||
|
|
DEF_FTP_HIDE_INVALID_USER = True;
|
|||
|
|
DEF_FTP_PASSWORDATTEMPTS = 3;
|
|||
|
|
DEF_FTP_INVALIDPASS_DELAY = 3000; //3 seconds
|
|||
|
|
DEF_FTP_PASV_SAME_IP = True;
|
|||
|
|
DEF_FTP_PORT_SAME_IP = True;
|
|||
|
|
DEF_FTP_NO_RESERVED_PORTS = True;
|
|||
|
|
DEF_FTP_BLOCK_ALL_PORTS = False;
|
|||
|
|
DEF_FTP_DISABLE_SYST = False;
|
|||
|
|
DEF_FTP_DISABLE_STAT = False;
|
|||
|
|
DEF_FTP_PERMIT_CCC = False;
|
|||
|
|
DEF_FTP_REPORT_EX_MSG = False;
|
|||
|
|
DEF_PASV_BOUND_MIN = 0;
|
|||
|
|
DEF_PASV_BOUND_MAX = 0;
|
|||
|
|
DEF_PATHPROCESSING = ftpOSDependent;
|
|||
|
|
|
|||
|
|
{Do not change these as it could break some clients}
|
|||
|
|
SYST_ID_UNIX = 'UNIX Type: L8'; {Do not translate}
|
|||
|
|
SYST_ID_NT = 'Windows_NT'; {Do not translate}
|
|||
|
|
|
|||
|
|
const AAlwaysValidOpts : array [0..2] of string =
|
|||
|
|
('SIZE', 'TYPE', 'MODIFY'); {Do not translate}
|
|||
|
|
|
|||
|
|
type
|
|||
|
|
TIdFTPServerContext = class;
|
|||
|
|
//The final parameter could've been one item but I decided against that
|
|||
|
|
//because occaisionally, you might have a situation where you need to specify
|
|||
|
|
//the "type" fact to be several different things.
|
|||
|
|
//
|
|||
|
|
//http://www.ietf.org/internet-drafts/draft-ietf-ftpext-mlst-16.txt
|
|||
|
|
TIdOnMLST = procedure(ASender : TIdFTPServerContext; const APath: TIdFTPFileName;
|
|||
|
|
ADirectoryListing: TIdFTPListOutput) of object;
|
|||
|
|
//data port binding events
|
|||
|
|
TOnDataPortBind = procedure(ASender : TIdFTPServerContext) of object;
|
|||
|
|
//note that the CHMOD value is now a VAR because we also want to support a "MFF UNIX.mode="
|
|||
|
|
//to do the same thing as a chmod. MFF is to "Modify a file fact".
|
|||
|
|
TOnSetATTRIB = procedure(ASender: TIdFTPServerContext; var VAttr : UInt32; const AFileName : TIdFTPFileName; var VAUth : Boolean) of object;
|
|||
|
|
//Note that VAuth : Boolean is used because you may want to deny permission for
|
|||
|
|
//users to change their Unix permissions or UMASK - which is done in anonymous FTP
|
|||
|
|
TOnSiteUMASK = procedure(ASender: TIdFTPServerContext; var VUMASK : Integer; var VAUth : Boolean) of object;
|
|||
|
|
//note that the CHMOD value is now a VAR because we also want to support a "MFF UNIX.mode="
|
|||
|
|
//to do the same thing as a chmod. MFF is to "Modify a file fact".
|
|||
|
|
TOnSiteCHMOD = procedure(ASender: TIdFTPServerContext; var APermissions : Integer; const AFileName : TIdFTPFileName; var VAUth : Boolean) of object;
|
|||
|
|
//chown as an option can specify group
|
|||
|
|
TOnSiteCHOWN = procedure(ASender: TIdFTPServerContext; var AOwner, AGroup : String; const AFileName : TIdFTPFileName; var VAUth : Boolean) of object;
|
|||
|
|
|
|||
|
|
TOnSiteCHGRP = procedure(ASender: TIdFTPServerContext; var AGroup : String; const AFileName : TIdFTPFileName; var VAUth : Boolean) of object;
|
|||
|
|
|
|||
|
|
TOnCustomPathProcess = procedure(ASender: TIdFTPServerContext; var VPath : TIdFTPFileName) of object;
|
|||
|
|
//
|
|||
|
|
TOnFTPUserLoginEvent = procedure(ASender: TIdFTPServerContext; const AUsername, APassword: string;
|
|||
|
|
var AAuthenticated: Boolean) of object;
|
|||
|
|
TOnFTPUserAccountEvent = procedure(ASender : TIdFTPServerContext; const AUsername, APassword,AAcount: string; var AAuthenticated: Boolean) of object;
|
|||
|
|
|
|||
|
|
TOnAfterUserLoginEvent = procedure(ASender: TIdFTPServerContext) of object;
|
|||
|
|
|
|||
|
|
TOnDirectoryEvent = procedure(ASender: TIdFTPServerContext; var VDirectory: TIdFTPFileName) of object;
|
|||
|
|
TOnGetFileSizeEvent = procedure(ASender: TIdFTPServerContext; const AFilename: TIdFTPFileName;
|
|||
|
|
var VFileSize: Int64) of object;
|
|||
|
|
TOnGetFileDateEvent = procedure(ASender: TIdFTPServerContext; const AFilename: TIdFTPFileName;
|
|||
|
|
var VFileDate: TDateTime) of object;
|
|||
|
|
//note we have to use a switches parameter because LIST in practice can have both a path and some
|
|||
|
|
//some switches such as -R for recursive.
|
|||
|
|
TOnListDirectoryEvent = procedure(ASender: TIdFTPServerContext; const APath: TIdFTPFileName;
|
|||
|
|
ADirectoryListing: TIdFTPListOutput; const ACmd : String; const ASwitches : String) of object;
|
|||
|
|
TOnCustomListDirectoryEvent = procedure(ASender: TIdFTPServerContext; const APath: TIdFTPFileName;
|
|||
|
|
ADirectoryListing: TStrings; const ACmd : String; const ASwitches : String) of object;
|
|||
|
|
TOnFileEvent = procedure(ASender: TIdFTPServerContext; const APathName: TIdFTPFileName) of object;
|
|||
|
|
TOnCheckFileEvent = procedure(ASender: TIdFTPServerContext; const APathName: TIdFTPFileName; var VExist : Boolean) of object;
|
|||
|
|
TOnRenameFileEvent = procedure(ASender: TIdFTPServerContext; const ARenameFromFile, ARenameToFile: TIdFTPFileName) of object;
|
|||
|
|
TOnRetrieveFileEvent = procedure(ASender: TIdFTPServerContext; const AFileName: TIdFTPFileName;
|
|||
|
|
var VStream: TStream) of object;
|
|||
|
|
TOnStoreFileEvent = procedure(ASender: TIdFTPServerContext; const AFileName: TIdFTPFileName;
|
|||
|
|
AAppend: Boolean; var VStream: TStream) of object;
|
|||
|
|
TOnCombineFiles = procedure(ASender: TIdFTPServerContext; const ATargetFileName: TIdFTPFileName;
|
|||
|
|
AParts : TStrings) of object;
|
|||
|
|
TOnCheckSumFile = procedure(ASender: TIdFTPServerContext; const AFileName : TIdFTPFileName; var VStream : TStream) of object;
|
|||
|
|
TOnCacheChecksum = procedure(ASender: TIdFTPServerContext; const AFileName : TIdFTPFileName; var VCheckSum : String) of object;
|
|||
|
|
TOnVerifyChecksum = procedure(ASender: TIdFTPServerContext; const AFileName : TIdFTPFileName; const ACheckSum : String) of object;
|
|||
|
|
TOnSetFileDateEvent = procedure(ASender: TIdFTPServerContext; const AFileName : TIdFTPFileName; var AFileTime : TDateTime) of object;
|
|||
|
|
TOnHostCheck = procedure(ASender:TIdFTPServerContext; const AHost : String; var VAccepted : Boolean) of object;
|
|||
|
|
//This is just to be efficient with the SITE UTIME command and for setting the windows.lastaccesstime fact
|
|||
|
|
TOnSiteUTIME = procedure(ASender: TIdFTPServerContext; const AFileName : TIdFTPFileName;
|
|||
|
|
var VLastAccessTime, VLastModTime, VCreateDate : TDateTime;
|
|||
|
|
var VAUth : Boolean) of object;
|
|||
|
|
|
|||
|
|
EIdFTPServerException = class(EIdException);
|
|||
|
|
EIdFTPServerNoOnListDirectory = class(EIdFTPServerException);
|
|||
|
|
EIdFTPImplicitTLSRequiresSSL = class(EIdFTPServerException);
|
|||
|
|
EIdFTPBoundPortMaxGreater = class(EIdFTPServerException);
|
|||
|
|
EIdFTPBoundPortMinLess = class(EIdFTPServerException);
|
|||
|
|
EIdFTPCannotBeNegative = class(EIdFTPServerException);
|
|||
|
|
|
|||
|
|
//we don't parse CLNT parameters as they might be freeform for all we know
|
|||
|
|
TIdOnClientID = procedure(ASender: TIdFTPServerContext; const AID : String) of object;
|
|||
|
|
TIdOnFTPStatEvent = procedure(ASender: TIdFTPServerContext; AStatusInfo : TStrings) of object;
|
|||
|
|
TIdOnBanner = procedure(ASender: TIdFTPServerContext; AGreeting : TIdReply) of object;
|
|||
|
|
//This is for EPSV and PASV support - do not change the values unless you
|
|||
|
|
//have an extremely compelling reason to do so. This even is ONLY for those compelling case.
|
|||
|
|
TIdOnPASV = procedure(ASender: TIdFTPServerContext; var VIP : String;
|
|||
|
|
var VPort : TIdPort; const AIPVer : TIdIPVersion) of object;
|
|||
|
|
TIdOnPASVRange = procedure(ASender: TIdFTPServerContext; var VIP : String;
|
|||
|
|
var VPortMin, VPortMax : TIdPort; const AIPVer : TIdIPVersion) of object;
|
|||
|
|
TIdOnDirSizeInfo = procedure(ASender : TIdFTPServerContext;
|
|||
|
|
const APathName : TIdFTPFileName;
|
|||
|
|
var VIsAFile : Boolean; var VSpace : Int64) of object;
|
|||
|
|
TIdFTPServer = class;
|
|||
|
|
TIdFTPSecurityOptions = class(TPersistent)
|
|||
|
|
protected
|
|||
|
|
// RFC 2577 Recommends these
|
|||
|
|
// Note that the current code already hides user ID's by
|
|||
|
|
// only authenticating after the password
|
|||
|
|
FPasswordAttempts : UInt32;
|
|||
|
|
FInvalidPassDelay : UInt32;
|
|||
|
|
// http://cr.yp.to/ftp/security.html Recommends these
|
|||
|
|
FRequirePASVFromSameIP : Boolean;
|
|||
|
|
FRequirePORTFromSameIP : Boolean;
|
|||
|
|
FNoReservedRangePORT : Boolean;
|
|||
|
|
FBlockAllPORTTransfers : Boolean;
|
|||
|
|
FDisableSYSTCommand : Boolean;
|
|||
|
|
FDisableSTATCommand : Boolean;
|
|||
|
|
FPermitCCC : Boolean;
|
|||
|
|
public
|
|||
|
|
constructor Create; virtual;
|
|||
|
|
procedure Assign(Source: TPersistent); override;
|
|||
|
|
published
|
|||
|
|
//limit login attempts - some hackers will try guessing passwords from a dictionary
|
|||
|
|
property PasswordAttempts : UInt32 read FPasswordAttempts write FPasswordAttempts
|
|||
|
|
default DEF_FTP_PASSWORDATTEMPTS;
|
|||
|
|
//should slow-down a password guessing attack - note those dictionaries
|
|||
|
|
property InvalidPassDelay : UInt32 read FInvalidPassDelay write FInvalidPassDelay
|
|||
|
|
default DEF_FTP_INVALIDPASS_DELAY;
|
|||
|
|
//client IP Address is the only one that we will accept a PASV
|
|||
|
|
//transfer from
|
|||
|
|
//http://cr.yp.to/ftp/security.html
|
|||
|
|
property RequirePASVFromSameIP : Boolean read FRequirePASVFromSameIP write FRequirePASVFromSameIP
|
|||
|
|
default DEF_FTP_PASV_SAME_IP;
|
|||
|
|
//Accept port transfers from the same IP address as the client -
|
|||
|
|
//should prevent bounce attacks
|
|||
|
|
property RequirePORTFromSameIP : Boolean read FRequirePORTFromSameIP write FRequirePORTFromSameIP
|
|||
|
|
default DEF_FTP_PORT_SAME_IP;
|
|||
|
|
//Do not accept port requests to ports in the reserved range. That is dangerous on some systems
|
|||
|
|
property NoReservedRangePORT : Boolean read FNoReservedRangePORT write FNoReservedRangePORT
|
|||
|
|
default DEF_FTP_NO_RESERVED_PORTS;
|
|||
|
|
//Do not accept any PORT transfers at all. This is a little extreme but reduces troubles further.
|
|||
|
|
//This will break the the Win32 console clients and a number of other programs.
|
|||
|
|
property BlockAllPORTTransfers : Boolean read FBlockAllPORTTransfers write FBlockAllPORTTransfers
|
|||
|
|
default DEF_FTP_BLOCK_ALL_PORTS;
|
|||
|
|
//Disable SYST command. SYST usually gives the system description.
|
|||
|
|
//Disabling it may make it harder for a trouble maker to know about your computer
|
|||
|
|
//but will not be a complete security solution. See http://www.sans.org/rr/infowar/fingerprint.php for details
|
|||
|
|
//On the other hand, disabling it will break RFC 959 complience and may break some FTP programs.
|
|||
|
|
property DisableSYSTCommand : Boolean read FDisableSYSTCommand write FDisableSYSTCommand
|
|||
|
|
default DEF_FTP_DISABLE_SYST;
|
|||
|
|
//Disable STAT command. STAT gives freeform information about the connection status.
|
|||
|
|
// http://www.sans.org/rr/infowar/fingerprint.php advises administrators to disable this
|
|||
|
|
//because servers tend to give distinct patterns of information and some trouble makers
|
|||
|
|
//can figure out what type of server you are running simply with this.
|
|||
|
|
property DisableSTATCommand : Boolean read FDisableSTATCommand write FDisableSTATCommand
|
|||
|
|
default DEF_FTP_DISABLE_STAT;
|
|||
|
|
//Permit CCC (Clear Command Connection) in TLS FTP
|
|||
|
|
property PermitCCC : Boolean read FPermitCCC write FPermitCCC default DEF_FTP_PERMIT_CCC;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
TIdDataChannel = class(TObject)
|
|||
|
|
protected
|
|||
|
|
FNegotiateTLS : Boolean;
|
|||
|
|
FControlContext: TIdFTPServerContext;
|
|||
|
|
FDataChannel: TIdTCPConnection;
|
|||
|
|
FErrorReply: TIdReplyRFC;
|
|||
|
|
FFtpOperation: TIdFTPOperation;
|
|||
|
|
FOKReply: TIdReplyRFC;
|
|||
|
|
FReply: TIdReplyRFC;
|
|||
|
|
|
|||
|
|
FServer : TIdFTPServer;
|
|||
|
|
FRequirePASVFromSameIP : Boolean;
|
|||
|
|
FStopped : Boolean;
|
|||
|
|
FData : TObject;
|
|||
|
|
procedure SetErrorReply(const AValue: TIdReplyRFC);
|
|||
|
|
procedure SetOKReply(const AValue: TIdReplyRFC);
|
|||
|
|
function GetPeerIP: String;
|
|||
|
|
function GetPeerPort: TIdPort;
|
|||
|
|
function GetLocalIP: String;
|
|||
|
|
function GetLocalPort: TIdPort;
|
|||
|
|
public
|
|||
|
|
constructor Create(APASV: Boolean; AControlContext: TIdFTPServerContext; const ARequirePASVFromSameIP : Boolean; AServer : TIdFTPServer); reintroduce;
|
|||
|
|
destructor Destroy; override;
|
|||
|
|
procedure InitOperation(const AConnectMode : Boolean = False);
|
|||
|
|
property PeerIP : String read GetPeerIP;
|
|||
|
|
property PeerPort : TIdPort read GetPeerPort;
|
|||
|
|
property LocalIP : String read GetLocalIP;
|
|||
|
|
property LocalPort : TIdPort read GetLocalPort;
|
|||
|
|
property Stopped : Boolean read FStopped write FStopped;
|
|||
|
|
property Data : TObject read FData write FData;
|
|||
|
|
property Server : TIdFTPServer read FServer;
|
|||
|
|
property OKReply: TIdReplyRFC read FOKReply write SetOKReply;
|
|||
|
|
property ErrorReply: TIdReplyRFC read FErrorReply write SetErrorReply;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
TIdFTPServerContext = class(TIdFTPServerContextBase)
|
|||
|
|
protected
|
|||
|
|
FXAUTKey : UInt32;
|
|||
|
|
FRESTPos: Integer;
|
|||
|
|
FDataChannel : TIdDataChannel;
|
|||
|
|
FAuthMechanism : String;
|
|||
|
|
FCCC : Boolean; //flag for CCC issuance
|
|||
|
|
FDataType: TIdFTPTransferType;
|
|||
|
|
FDataMode : TIdFTPTransferMode;
|
|||
|
|
FDataPort: TIdPort;
|
|||
|
|
FDataProtBufSize : UInt32;
|
|||
|
|
FDataStruct: TIdFTPDataStructure;
|
|||
|
|
|
|||
|
|
FPasswordAttempts : UInt32;
|
|||
|
|
FPASV: Boolean;
|
|||
|
|
|
|||
|
|
FEPSVAll: Boolean;
|
|||
|
|
FDataPortDenied : Boolean;
|
|||
|
|
FDataProtection : TIdFTPDataPortSecurity;
|
|||
|
|
FDataPBSZCalled : Boolean;
|
|||
|
|
FMLSOpts : TIdFTPFactOutputs;
|
|||
|
|
|
|||
|
|
FSSCNOn : Boolean;
|
|||
|
|
FServer : TIdFTPServer;
|
|||
|
|
FUserSecurity : TIdFTPSecurityOptions;
|
|||
|
|
FUMask : Integer; //for SITE UMASK command
|
|||
|
|
//only used for Windows NT imitation
|
|||
|
|
FMSDOSMode : Boolean; //False - off imitate Unix, //True - On imitate DOS
|
|||
|
|
//This is a queued request to quite.
|
|||
|
|
//if it's issued during a data transfer, we treat it as quit
|
|||
|
|
//only after the request is completed.
|
|||
|
|
FQuitReply : String;
|
|||
|
|
//ZLib settings
|
|||
|
|
FZLibCompressionLevel : Integer; //7
|
|||
|
|
FZLibWindowBits : Integer; //-15
|
|||
|
|
FZLibMemLevel : Integer; //8
|
|||
|
|
FZLibStratagy : Integer; //0 - default
|
|||
|
|
//
|
|||
|
|
procedure ResetZLibSettings;
|
|||
|
|
procedure PortOnAfterBind(ASender : TObject);
|
|||
|
|
procedure PortOnBeforeBind(ASender : TObject);
|
|||
|
|
procedure SetUserSecurity(const Value: TIdFTPSecurityOptions);
|
|||
|
|
procedure CreateDataChannel(APASV: Boolean = False);
|
|||
|
|
function IsAuthenticated(ASender: TIdCommand): Boolean;
|
|||
|
|
procedure ReInitialize; override;
|
|||
|
|
|
|||
|
|
public
|
|||
|
|
constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil); override;
|
|||
|
|
destructor Destroy; override;
|
|||
|
|
procedure KillDataChannel;
|
|||
|
|
|
|||
|
|
property DataChannel : TIdDataChannel read FDataChannel;
|
|||
|
|
property Server : TIdFTPServer read FServer write FServer;
|
|||
|
|
|
|||
|
|
property UserSecurity : TIdFTPSecurityOptions read FUserSecurity write SetUserSecurity;
|
|||
|
|
//
|
|||
|
|
//This is for tracking what AUTH mechanism was specified and that
|
|||
|
|
//we support. This may not matter as much now, but it could later on
|
|||
|
|
//RFC 2228
|
|||
|
|
property AuthMechanism : String read FAuthMechanism write FAuthMechanism;
|
|||
|
|
property DataType: TIdFTPTransferType read FDataType write FDataType;
|
|||
|
|
property DataMode : TIdFTPTransferMode read FDataMode write FDataMode;
|
|||
|
|
property DataPort: TIdPort read FDataPort;
|
|||
|
|
//We do not use this much for now but if more AUTH mechanisms are added,
|
|||
|
|
//we may need this property
|
|||
|
|
property DataProtBufSize : UInt32 read FDataProtBufSize write FDataProtBufSize;
|
|||
|
|
property DataPBSZCalled : Boolean read FDataPBSZCalled write FDataPBSZCalled;
|
|||
|
|
property DataStruct: TIdFTPDataStructure read FDataStruct write FDataStruct;
|
|||
|
|
//currently, only <C>lear and <P>rivate are used. This could change
|
|||
|
|
//later on
|
|||
|
|
property DataProtection : TIdFTPDataPortSecurity read FDataProtection write FDataProtection;
|
|||
|
|
property PasswordAttempts : UInt32 read FPasswordAttempts write FPasswordAttempts;
|
|||
|
|
property PASV: Boolean read FPASV write FPASV;
|
|||
|
|
property RESTPos: Integer read FRESTPos write FRESTPos;
|
|||
|
|
property MLSOpts : TIdFTPFactOutputs read FMLSOpts write FMLSOpts;
|
|||
|
|
//SSCN secure FTPX - http://www.raidenftpd.com/kb/kb000000037.htm
|
|||
|
|
property SSCNOn : Boolean read FSSCNOn write FSSCNOn;
|
|||
|
|
//SITE DIRSTYLE flag - true for MSDOS, false for Unix
|
|||
|
|
property MSDOSMode : Boolean read FMSDOSMode write FMSDOSMode;
|
|||
|
|
//SITE UMASK settings
|
|||
|
|
property UMask : Integer read FUMask write FUMask;
|
|||
|
|
//ZLib settings
|
|||
|
|
property ZLibCompressionLevel : Integer read FZLibCompressionLevel write FZLibCompressionLevel; //7
|
|||
|
|
property ZLibWindowBits : Integer read FZLibWindowBits write FZLibWindowBits; //-15
|
|||
|
|
property ZLibMemLevel : Integer read FZLibMemLevel write FZLibMemLevel; //8
|
|||
|
|
property ZLibStratagy : Integer read FZLibStratagy write FZLibStratagy; //0 - default
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
TIdOnGetCustomListFormat = procedure(ASender: TIdFTPServer; AItem: TIdFTPListItem;
|
|||
|
|
var VText: string) of object;
|
|||
|
|
|
|||
|
|
{ FTP Server }
|
|||
|
|
TIdFTPServer = class(TIdExplicitTLSServer)
|
|||
|
|
protected
|
|||
|
|
FSupportXAUTH: Boolean;
|
|||
|
|
FDirFormat : TIdFTPDirFormat;
|
|||
|
|
FPathProcessing : TIdFTPPathProcessing;
|
|||
|
|
FOnClientID : TIdOnClientID;
|
|||
|
|
FDataChannelCommands: TIdCommandHandlers;
|
|||
|
|
FSITECommands: TIdCommandHandlers;
|
|||
|
|
FOPTSCommands: TIdCommandHandlers;
|
|||
|
|
FMLSDFacts : TIdMLSDAttrs;
|
|||
|
|
FAnonymousAccounts: TStrings;
|
|||
|
|
FAllowAnonymousLogin: Boolean;
|
|||
|
|
FAnonymousPassStrictCheck: Boolean;
|
|||
|
|
// FEmulateSystem: TIdFTPSystems;
|
|||
|
|
FPASVBoundPortMin : TIdPort;
|
|||
|
|
FPASVBoundPortMax : TIdPort;
|
|||
|
|
FSystemType: string;
|
|||
|
|
FDefaultDataPort : TIdPort;
|
|||
|
|
{$IFDEF USE_OBJECT_ARC}[Weak]{$ENDIF} FUserAccounts: TIdCustomUserManager;
|
|||
|
|
FOnUserAccount : TOnFTPUserAccountEvent;
|
|||
|
|
FOnAfterUserLogin: TOnAfterUserLoginEvent;
|
|||
|
|
FOnUserLogin: TOnFTPUserLoginEvent;
|
|||
|
|
FOnChangeDirectory: TOnDirectoryEvent;
|
|||
|
|
FOnGetFileSize: TOnGetFileSizeEvent;
|
|||
|
|
FOnGetFileDate:TOnGetFileDateEvent;
|
|||
|
|
FOnListDirectory: TOnListDirectoryEvent;
|
|||
|
|
FOnCustomListDirectory : TOnCustomListDirectoryEvent;
|
|||
|
|
FOnRenameFile: TOnRenameFileEvent;
|
|||
|
|
FOnDeleteFile: TOnFileEvent;
|
|||
|
|
FOnRetrieveFile: TOnRetrieveFileEvent;
|
|||
|
|
FOnStoreFile: TOnStoreFileEvent;
|
|||
|
|
FOnMakeDirectory: TOnDirectoryEvent;
|
|||
|
|
FOnRemoveDirectory: TOnDirectoryEvent;
|
|||
|
|
FOnStat : TIdOnFTPStatEvent;
|
|||
|
|
FFTPSecurityOptions : TIdFTPSecurityOptions;
|
|||
|
|
FOnCRCFile : TOnCheckSumFile;
|
|||
|
|
FOnCombineFiles : TOnCombineFiles;
|
|||
|
|
FOnSetModifiedTime : TOnSetFileDateEvent;
|
|||
|
|
FOnFileExistCheck : TOnCheckFileEvent; //for MDTM variation to set the file time
|
|||
|
|
FOnSetCreationTime : TOnSetFileDateEvent;
|
|||
|
|
FOnMD5Cache : TOnCacheChecksum;
|
|||
|
|
FOnMD5Verify : TOnVerifyChecksum;
|
|||
|
|
FOnGreeting : TIdOnBanner;
|
|||
|
|
FOnLoginSuccessBanner : TIdOnBanner;
|
|||
|
|
FOnLoginFailureBanner : TIdOnBanner;
|
|||
|
|
FOnQuitBanner : TIdOnBanner;
|
|||
|
|
FOnSetATTRIB : TOnSetATTRIB;
|
|||
|
|
FOnSiteUMASK : TOnSiteUMASK;
|
|||
|
|
FOnSiteCHMOD : TOnSiteCHMOD;
|
|||
|
|
FOnSiteCHOWN : TOnSiteCHOWN;
|
|||
|
|
FOnSiteCHGRP : TOnSiteCHGRP;
|
|||
|
|
FOnAvailDiskSpace : TIdOnDirSizeInfo;
|
|||
|
|
FOnCompleteDirSize : TIdOnDirSizeInfo;
|
|||
|
|
FOnRemoveDirectoryAll: TOnDirectoryEvent;
|
|||
|
|
FOnCustomPathProcess : TOnCustomPathProcess;
|
|||
|
|
|
|||
|
|
FOnDataPortBeforeBind : TOnDataPortBind;
|
|||
|
|
FOnDataPortAfterBind : TOnDataPortBind;
|
|||
|
|
FOnPASVBeforeBind : TIdOnPASVRange;
|
|||
|
|
FOnPASVReply : TIdOnPASV;
|
|||
|
|
{$IFDEF USE_OBJECT_ARC}[Weak]{$ENDIF} FFTPFileSystem: TIdFTPBaseFileSystem;
|
|||
|
|
FEndOfHelpLine : String;
|
|||
|
|
FCustomSystID : String;
|
|||
|
|
FReplyUnknownSITECommand : TIdReply;
|
|||
|
|
FCompressor : TIdZLibCompressorBase;
|
|||
|
|
FOnMLST : TIdOnMLST;
|
|||
|
|
FOnSiteUTIME : TOnSiteUTIME;
|
|||
|
|
FOnHostCheck : TOnHostCheck;
|
|||
|
|
procedure SetOnUserAccount(AValue : TOnFTPUserAccountEvent);
|
|||
|
|
procedure AuthenticateUser(ASender: TIdCommand);
|
|||
|
|
function SupportTaDirSwitches(AContext : TIdFTPServerContext) : Boolean;
|
|||
|
|
function IgnoreLastPathDelim(const APath : String) : String;
|
|||
|
|
procedure DoOnPASVBeforeBind(ASender : TIdFTPServerContext; var VIP : String;
|
|||
|
|
var VPortMin, VPortMax : TIdPort; const AIPVersion : TIdIPVersion);
|
|||
|
|
procedure DoOnPASVReply(ASender : TIdFTPServerContext; var VIP : String;
|
|||
|
|
var VPort : TIdPort; const AIPVersion : TIdIPVersion);
|
|||
|
|
function InternalPASV(ASender: TIdCommand; var VIP : String;
|
|||
|
|
var VPort: TIdPort; var VIPVersion : TIdIPVersion): Boolean;
|
|||
|
|
function DoSysType(ASender : TIdFTPServerContext) : String;
|
|||
|
|
function DoProcessPath(ASender : TIdFTPServerContext; const APath: TIdFTPFileName): TIdFTPFileName;
|
|||
|
|
|
|||
|
|
function FTPNormalizePath(const APath: String) : String;
|
|||
|
|
function MLSFEATLine(const AFactMask : TIdMLSDAttrs; const AFacts : TIdFTPFactOutputs) : String;
|
|||
|
|
|
|||
|
|
function HelpText(Cmds : TStrings) : String;
|
|||
|
|
function IsValidPermNumbers(const APermNos : String) : Boolean;
|
|||
|
|
procedure SetRFCReplyFormat(AReply : TIdReply);
|
|||
|
|
function CDUPDir(AContext : TIdFTPServerContext) : String;
|
|||
|
|
procedure DisconUser(ASender: TIdCommand);
|
|||
|
|
//command reply common code
|
|||
|
|
procedure CmdNotImplemented(ASender : TIdCommand);
|
|||
|
|
procedure CmdFileActionAborted(ASender : TIdCommand);
|
|||
|
|
procedure CmdSyntaxError(AContext: TIdContext; ALine: string; const AReply : TIdReply = nil); overload;
|
|||
|
|
procedure CmdSyntaxError(ASender : TIdCommand); overload;
|
|||
|
|
procedure CmdInvalidParams(ASender: TIdCommand);
|
|||
|
|
procedure CmdInvalidParamNum(ASender:TIdCommand);
|
|||
|
|
//The http://www.potaroo.net/ietf/idref/draft-twine-ftpmd5/
|
|||
|
|
//draft didn't specify 550 as an error. It said use 504.
|
|||
|
|
procedure CmdTwineFileActionAborted(ASender : TIdCommand);
|
|||
|
|
//success reply codes can vary amoung commands
|
|||
|
|
procedure CmdCommandSuccessful(ASender: TIdCommand; const AReplyCode : Integer = 250);
|
|||
|
|
//Command replies
|
|||
|
|
procedure CommandQUIT(ASender:TIdCommand);
|
|||
|
|
procedure CommandUSER(ASender: TIdCommand);
|
|||
|
|
procedure CommandPASS(ASender: TIdCommand);
|
|||
|
|
procedure CommandACCT(ASender: TIdCommand);
|
|||
|
|
procedure CommandXAUT(ASender : TIdCommand);
|
|||
|
|
procedure CommandCWD(ASender: TIdCommand);
|
|||
|
|
procedure CommandCDUP(ASender: TIdCommand);
|
|||
|
|
procedure CommandREIN(ASender: TIdCommand);
|
|||
|
|
procedure CommandPORT(ASender: TIdCommand);
|
|||
|
|
procedure CommandPASV(ASender: TIdCommand);
|
|||
|
|
procedure CommandTYPE(ASender: TIdCommand);
|
|||
|
|
procedure CommandSTRU(ASender: TIdCommand);
|
|||
|
|
procedure CommandMODE(ASender: TIdCommand);
|
|||
|
|
procedure CommandRETR(ASender: TIdCommand);
|
|||
|
|
procedure CommandSSAP(ASender: TIdCommand);
|
|||
|
|
procedure CommandALLO(ASender: TIdCommand);
|
|||
|
|
procedure CommandREST(ASender: TIdCommand);
|
|||
|
|
procedure CommandRNFR(ASender: TIdCommand);
|
|||
|
|
procedure CommandRNTO(ASender: TIdCommand);
|
|||
|
|
procedure CommandABOR(ASender: TIdCommand);
|
|||
|
|
//AVBL from Streamlined FTP Command Extensions
|
|||
|
|
// draft-peterson-streamlined-ftp-command-extensions-01.txt
|
|||
|
|
procedure CommandAVBL(ASender: TIdCommand);
|
|||
|
|
procedure CommandDELE(ASender: TIdCommand);
|
|||
|
|
|
|||
|
|
//DSIZ from Streamlined FTP Command Extensions
|
|||
|
|
// draft-peterson-streamlined-ftp-command-extensions-01.txt
|
|||
|
|
procedure CommandDSIZ(ASender : TIdCommand);
|
|||
|
|
procedure CommandRMDA(ASender : TIdCommand);
|
|||
|
|
|
|||
|
|
procedure CommandRMD(ASender: TIdCommand);
|
|||
|
|
procedure CommandMKD(ASender: TIdCommand);
|
|||
|
|
procedure CommandPWD(ASender: TIdCommand);
|
|||
|
|
procedure CommandLIST(ASender: TIdCommand);
|
|||
|
|
procedure CommandSYST(ASender: TIdCommand);
|
|||
|
|
procedure CommandSTAT(ASender: TIdCommand);
|
|||
|
|
procedure CommandSIZE(ASender: TIdCommand);
|
|||
|
|
procedure CommandFEAT(ASender: TIdCommand);
|
|||
|
|
procedure CommandOPTS(ASender: TIdCommand);
|
|||
|
|
procedure CommandAUTH(ASender: TIdCommand);
|
|||
|
|
procedure CommandCCC(ASender: TIdCommand);
|
|||
|
|
// rfc 2428:
|
|||
|
|
procedure CommandEPSV(ASender: TIdCommand);
|
|||
|
|
procedure CommandEPRT(ASender: TIdCommand);
|
|||
|
|
//
|
|||
|
|
procedure CommandMDTM(ASender: TIdCommand);
|
|||
|
|
procedure CommandMFF(ASender: TIdCommand);
|
|||
|
|
//
|
|||
|
|
procedure CommandMD5(ASender: TIdCommand);
|
|||
|
|
procedure CommandMMD5(ASender: TIdCommand);
|
|||
|
|
//
|
|||
|
|
procedure CommandPROT(ASender: TIdCommand);
|
|||
|
|
procedure CommandPBSZ(ASender: TIdCommand);
|
|||
|
|
|
|||
|
|
procedure CommandMFMT(ASender: TIdCommand);
|
|||
|
|
procedure CommandMFCT(ASender: TIdCommand);
|
|||
|
|
|
|||
|
|
procedure CommandMLSD(ASender: TIdCommand);
|
|||
|
|
procedure CommandMLST(ASender: TIdCommand);
|
|||
|
|
|
|||
|
|
procedure CommandCheckSum(ASender: TIdCommand);
|
|||
|
|
procedure CommandCOMB(ASender: TIdCommand);
|
|||
|
|
|
|||
|
|
procedure CommandCLNT(ASender: TIdCommand);
|
|||
|
|
//SSCN Secure FTPX - http://www.raidenftpd.com/kb/kb000000037.htm
|
|||
|
|
procedure CommandSSCN(ASender: TIdCommand);
|
|||
|
|
//Informal - like PASV accept SSL is in client mode - used by FlashXP
|
|||
|
|
procedure CommandCPSV(ASender: TIdCommand);
|
|||
|
|
//Informal - like PASV except that only the port is communicated.
|
|||
|
|
//
|
|||
|
|
procedure CommandSPSV(ASender: TIdCommand);
|
|||
|
|
|
|||
|
|
procedure CommandHOST(ASender : TIdCommand);
|
|||
|
|
procedure CommandSecRFC(ASender : TIdCommand); //stub for some commands in 2228
|
|||
|
|
procedure CommandSITE(ASender: TIdCommand);
|
|||
|
|
procedure CommandSiteHELP(ASender : TIdCommand);
|
|||
|
|
//site commands - Unix
|
|||
|
|
procedure CommandSiteUMASK(ASender : TIdCommand);
|
|||
|
|
procedure CommandSiteCHMOD(ASender : TIdCommand);
|
|||
|
|
//SITE CHOWN - supported by some Unix servers
|
|||
|
|
procedure CommandSiteCHOWN(ASender : TIdCommand);
|
|||
|
|
//SITE CHGRP - supported by some Unix servers
|
|||
|
|
procedure CommandSiteCHGRP(ASender : TIdCommand);
|
|||
|
|
//site commans - MS IIS
|
|||
|
|
procedure CommandSiteDIRSTYLE(ASender : TIdCommand);
|
|||
|
|
//used by FTP Voyager
|
|||
|
|
procedure CommandSiteZONE(ASender : TIdCommand);
|
|||
|
|
//supported by RaidenFTP - http://www.raidenftpd.com/kb/kb000000049.htm
|
|||
|
|
procedure CommandSiteATTRIB(ASender : TIdCommand);
|
|||
|
|
//McFTP client uses this to set the time stamps for a file.
|
|||
|
|
procedure CommandSiteUTIME(ASender : TIdCommand);
|
|||
|
|
// end site commands
|
|||
|
|
|
|||
|
|
procedure CommandOptsMLST(ASender : TIdCommand);
|
|||
|
|
procedure CommandOptsMODEZ(ASender : TIdCommand);
|
|||
|
|
procedure CommandOptsUTF8(ASender: TIdCommand);
|
|||
|
|
procedure CommandHELP(ASender: TIdCommand);
|
|||
|
|
//
|
|||
|
|
procedure DoOnRenameFile(ASender: TIdFTPServerContext; const ARenameFromFile, ARenameToFile: string);
|
|||
|
|
procedure DoOnDeleteFile(ASender: TIdFTPServerContext; const APathName: string);
|
|||
|
|
procedure DoOnChangeDirectory(AContext: TIdFTPServerContext; var VDirectory: TIdFTPFileName);
|
|||
|
|
procedure DoOnMakeDirectory(AContext: TIdFTPServerContext; var VDirectory: TIdFTPFileName);
|
|||
|
|
procedure DoOnRemoveDirectory(AContext: TIdFTPServerContext; var VDirectory: TIdFTPFileName);
|
|||
|
|
procedure DoOnGetFileSize(ASender: TIdFTPServerContext; const AFilename: string; var VFileSize: Int64);
|
|||
|
|
procedure DoOnGetFileDate(ASender: TIdFTPServerContext; const AFilename: string; var VFileDate: TDateTime);
|
|||
|
|
procedure DoOnSetModifiedTime(AContext: TIdFTPServerContext; const AFileName : String; var VDateTime: TDateTime); overload;
|
|||
|
|
procedure DoOnSetModifiedTime(AContext: TIdFTPServerContext; const AFileName : String; var VDateTimeStr : String); overload;
|
|||
|
|
procedure DoOnFileExistCheck(AContext: TIdFTPServerContext; const AFileName : String; var VExist : Boolean);
|
|||
|
|
procedure DoOnSetModifiedTimeGMT(AContext: TIdFTPServerContext; const AFileName : String; var VDateTime: TDateTime);
|
|||
|
|
procedure DoOnSetCreationTime(AContext: TIdFTPServerContext; const AFileName : String; var VDateTime: TDateTime); overload;
|
|||
|
|
procedure DoOnSetCreationTime(AContext: TIdFTPServerContext; const AFileName : String; var VDateTimeStr : String); overload;
|
|||
|
|
procedure DoOnSetCreationTimeGMT(AContext: TIdFTPServerContext; const AFileName : String; var VDateTime: TDateTime);
|
|||
|
|
procedure DoOnCRCFile(ASender: TIdFTPServerContext; const AFileName : String; var VStream : TStream);
|
|||
|
|
procedure DoOnMD5Verify(ASender: TIdFTPServerContext; const AFileName : String; const ACheckSum : String);
|
|||
|
|
procedure DoOnMD5Cache(ASender: TIdFTPServerContext; const AFileName : String; var VCheckSum : String);
|
|||
|
|
procedure DoOnCombineFiles(ASender: TIdFTPServerContext; const ATargetFileName: string; AParts : TStrings);
|
|||
|
|
procedure DoOnSetATTRIB(ASender: TIdFTPServerContext; var VAttr : UInt32; const AFileName : String; var VAUth : Boolean);
|
|||
|
|
procedure DoOnSiteUMASK(ASender: TIdFTPServerContext; var VUMASK : Integer; var VAUth : Boolean);
|
|||
|
|
procedure DoOnSiteCHMOD(ASender: TIdFTPServerContext; var APermissions : Integer; const AFileName : String; var VAUth : Boolean);
|
|||
|
|
procedure DoOnSiteCHOWN(ASender: TIdFTPServerContext; var AOwner, AGroup : String; const AFileName : String; var VAUth : Boolean);
|
|||
|
|
procedure DoOnSiteCHGRP(ASender: TIdFTPServerContext; var AGroup : String; const AFileName : String; var VAUth : Boolean);
|
|||
|
|
procedure SetUseTLS(AValue: TIdUseTLS); override;
|
|||
|
|
procedure SetSupportXAUTH(AValue : Boolean);
|
|||
|
|
procedure InitializeCommandHandlers; override;
|
|||
|
|
procedure ListDirectory(ASender: TIdFTPServerContext; ADirectory: string;
|
|||
|
|
ADirContents: TStrings; ADetails: Boolean; const ACmd : String = 'LIST';
|
|||
|
|
const ASwitches : String = ''); {do not localize}
|
|||
|
|
{$IFNDEF USE_OBJECT_ARC}
|
|||
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|||
|
|
{$ENDIF}
|
|||
|
|
procedure SetAnonymousAccounts(const AValue: TStrings);
|
|||
|
|
procedure SetUserAccounts(const AValue: TIdCustomUserManager);
|
|||
|
|
procedure SetFTPSecurityOptions(const AValue: TIdFTPSecurityOptions);
|
|||
|
|
procedure SetPASVBoundPortMax(const AValue: TIdPort);
|
|||
|
|
procedure SetPASVBoundPortMin(const AValue: TIdPort);
|
|||
|
|
procedure SetReplyUnknownSITECommand(AValue: TIdReply);
|
|||
|
|
procedure SetSITECommands(AValue: TIdCommandHandlers);
|
|||
|
|
procedure ThreadException(AThread: TIdThread; AException: Exception);
|
|||
|
|
procedure SetFTPFileSystem(const AValue: TIdFTPBaseFileSystem);
|
|||
|
|
function GetMD5Checksum(ASender : TIdFTPServerContext; const AFileName : String) : String;
|
|||
|
|
//overrides from TIdTCPServer
|
|||
|
|
procedure DoConnect(AContext:TIdContext); override;
|
|||
|
|
procedure DoDisconnect(AContext:TIdContext); override;
|
|||
|
|
procedure ContextCreated(AContext:TIdContext); override;
|
|||
|
|
|
|||
|
|
procedure DoOnDataPortBeforeBind(ASender : TIdFTPServerContext); virtual;
|
|||
|
|
procedure DoDataChannelOperation(ASender: TIdCommand; const AConnectMode : Boolean = False);virtual;
|
|||
|
|
procedure DoOnDataPortAfterBind(ASender : TIdFTPServerContext); virtual;
|
|||
|
|
procedure DoOnCustomListDirectory(ASender: TIdFTPServerContext; const APath: string;
|
|||
|
|
ADirectoryListing: TStrings; const ACmd : String; const ASwitches : String);
|
|||
|
|
function GetReplyClass: TIdReplyClass; override;
|
|||
|
|
function GetRepliesClass: TIdRepliesClass; override;
|
|||
|
|
procedure InitComponent; override;
|
|||
|
|
procedure DoReplyUnknownCommand(AContext: TIdContext; ALine: string); override;
|
|||
|
|
// overriden so we can close active transfers during a shutdown
|
|||
|
|
procedure DoTerminateContext(AContext: TIdContext); override;
|
|||
|
|
//overriden so we can handle telnet sequences
|
|||
|
|
function ReadCommandLine(AContext: TIdContext): string; override;
|
|||
|
|
public
|
|||
|
|
destructor Destroy; override;
|
|||
|
|
property SupportXAUTH : Boolean read FSupportXAUTH write SetSupportXAUTH;
|
|||
|
|
published
|
|||
|
|
{This is an object that can compress and decompress HTTP Deflate encoding}
|
|||
|
|
property Compressor : TIdZLibCompressorBase read FCompressor write FCompressor;
|
|||
|
|
property CustomSystID : String read FCustomSystID write FCustomSystID;
|
|||
|
|
property DirFormat : TIdFTPDirFormat read FDirFormat write FDirFormat default DEF_DIRFORMAT;
|
|||
|
|
property PathProcessing : TIdFTPPathProcessing read FPathProcessing write FPathProcessing default DEF_PATHPROCESSING;
|
|||
|
|
property UseTLS;
|
|||
|
|
property DefaultPort default IDPORT_FTP;
|
|||
|
|
property AllowAnonymousLogin: Boolean read FAllowAnonymousLogin write FAllowAnonymousLogin default Id_DEF_AllowAnon;
|
|||
|
|
property AnonymousAccounts: TStrings read FAnonymousAccounts write SetAnonymousAccounts;
|
|||
|
|
property AnonymousPassStrictCheck: Boolean read FAnonymousPassStrictCheck
|
|||
|
|
write FAnonymousPassStrictCheck default Id_DEF_PassStrictCheck;
|
|||
|
|
property DefaultDataPort : TIdPort read FDefaultDataPort write FDefaultDataPort default IdPORT_FTP_DATA;
|
|||
|
|
property FTPFileSystem:TIdFTPBaseFileSystem read FFTPFileSystem write SetFTPFileSystem;
|
|||
|
|
property FTPSecurityOptions : TIdFTPSecurityOptions read FFTPSecurityOptions write SetFTPSecurityOptions;
|
|||
|
|
property EndOfHelpLine : String read FEndOfHelpLine write FEndOfHelpLine;
|
|||
|
|
property PASVBoundPortMin : TIdPort read FPASVBoundPortMin write SetPASVBoundPortMin default DEF_PASV_BOUND_MIN;
|
|||
|
|
property PASVBoundPortMax : TIdPort read FPASVBoundPortMax write SetPASVBoundPortMax default DEF_PASV_BOUND_MAX;
|
|||
|
|
property UserAccounts: TIdCustomUserManager read FUserAccounts write SetUserAccounts;
|
|||
|
|
property SystemType: string read FSystemType write FSystemType;
|
|||
|
|
property OnGreeting : TIdOnBanner read FOnGreeting write FOnGreeting;
|
|||
|
|
property OnLoginSuccessBanner : TIdOnBanner read FOnLoginSuccessBanner write FOnLoginSuccessBanner;
|
|||
|
|
property OnLoginFailureBanner : TIdOnBanner read FOnLoginFailureBanner write FOnLoginFailureBanner;
|
|||
|
|
//for retreiving MD5 Checksums from a cache
|
|||
|
|
property OnMD5Cache : TOnCacheChecksum read FOnMD5Cache write FOnMD5Cache;
|
|||
|
|
property OnMD5Verify : TOnVerifyChecksum read FOnMD5Verify write FOnMD5Verify;
|
|||
|
|
property OnQuitBanner : TIdOnBanner read FOnQuitBanner write FOnQuitBanner;
|
|||
|
|
property OnCustomListDirectory : TOnCustomListDirectoryEvent read FOnCustomListDirectory write FOnCustomListDirectory;
|
|||
|
|
property OnCustomPathProcess : TOnCustomPathProcess read FOnCustomPathProcess write FOnCustomPathProcess;
|
|||
|
|
property OnAfterUserLogin: TOnAfterUserLoginEvent read FOnAfterUserLogin write FOnAfterUserLogin;
|
|||
|
|
property OnChangeDirectory: TOnDirectoryEvent read FOnChangeDirectory write FOnChangeDirectory;
|
|||
|
|
property OnGetFileSize: TOnGetFileSizeEvent read FOnGetFileSize write FOnGetFileSize;
|
|||
|
|
property OnGetFileDate: TOnGetFileDateEvent read FOnGetFileDate write FOnGetFileDate;
|
|||
|
|
property OnUserLogin: TOnFTPUserLoginEvent read FOnUserLogin write FOnUserLogin;
|
|||
|
|
property OnUserAccount : TOnFTPUserAccountEvent read FOnUserAccount write SetOnUserAccount;
|
|||
|
|
property OnListDirectory: TOnListDirectoryEvent read FOnListDirectory write FOnListDirectory;
|
|||
|
|
property OnDataPortBeforeBind : TOnDataPortBind read FOnDataPortBeforeBind write FOnDataPortBeforeBind;
|
|||
|
|
property OnDataPortAfterBind : TOnDataPortBind read FOnDataPortAfterBind write FOnDataPortAfterBind;
|
|||
|
|
property OnRenameFile: TOnRenameFileEvent read FOnRenameFile write FOnRenameFile;
|
|||
|
|
property OnDeleteFile: TOnFileEvent read FOnDeleteFile write FOnDeleteFile;
|
|||
|
|
property OnRetrieveFile: TOnRetrieveFileEvent read FOnRetrieveFile write FOnRetrieveFile;
|
|||
|
|
property OnStoreFile: TOnStoreFileEvent read FOnStoreFile write FOnStoreFile;
|
|||
|
|
property OnMakeDirectory: TOnDirectoryEvent read FOnMakeDirectory write FOnMakeDirectory;
|
|||
|
|
property OnRemoveDirectory: TOnDirectoryEvent read FOnRemoveDirectory write FOnRemoveDirectory;
|
|||
|
|
property OnStat : TIdOnFTPStatEvent read FOnStat write FOnStat;
|
|||
|
|
property OnCombineFiles : TOnCombineFiles read FOnCombineFiles write FOnCombineFiles;
|
|||
|
|
property OnCRCFile : TOnCheckSumFile read FOnCRCFile write FOnCRCFile;
|
|||
|
|
property OnSetCreationTime : TOnSetFileDateEvent read FOnSetCreationTime write FOnSetCreationTime;
|
|||
|
|
property OnSetModifiedTime : TOnSetFileDateEvent read FOnSetModifiedTime write FOnSetModifiedTime;
|
|||
|
|
property OnFileExistCheck : TOnCheckFileEvent read FOnFileExistCheck write FOnFileExistCheck;
|
|||
|
|
property OnHostCheck : TOnHostCheck read FOnHostCheck write FOnHostCheck;
|
|||
|
|
property OnSetATTRIB : TOnSetATTRIB read FOnSetATTRIB write FOnSetATTRIB;
|
|||
|
|
property OnSiteUMASK : TOnSiteUMASK read FOnSiteUMASK write FOnSiteUMASK;
|
|||
|
|
property OnSiteCHMOD : TOnSiteCHMOD read FOnSiteCHMOD write FOnSiteCHMOD;
|
|||
|
|
property OnSiteCHOWN : TOnSiteCHOWN read FOnSiteCHOWN write FOnSiteCHOWN;
|
|||
|
|
property OnSiteCHGRP : TOnSiteCHGRP read FOnSiteCHGRP write FOnSiteCHGRP;
|
|||
|
|
{
|
|||
|
|
READ THIS!!!
|
|||
|
|
|
|||
|
|
Do not change values in the OnPASV event unless you have a compelling reason to do so.
|
|||
|
|
|
|||
|
|
In SPSV, the PORT is the only thing that can work because that's all which is
|
|||
|
|
given as a reply. The server IP is the same one that the client connects to.
|
|||
|
|
|
|||
|
|
In EPSV, the PORT is the only thing that can work because that's all which is
|
|||
|
|
given as a reply. The server IP is the same one that the client connects to.
|
|||
|
|
|
|||
|
|
}
|
|||
|
|
property OnPASVBeforeBind : TIdOnPASVRange read FOnPASVBeforeBind write FOnPASVBeforeBind;
|
|||
|
|
property OnPASVReply : TIdOnPASV read FOnPASVReply write FOnPASVReply;
|
|||
|
|
property OnMLST : TIdOnMLST read FOnMLST write FOnMLST;
|
|||
|
|
property OnSiteUTIME : TOnSiteUTIME read FOnSiteUTIME write FOnSiteUTIME;
|
|||
|
|
property OnAvailDiskSpace : TIdOnDirSizeInfo read FOnAvailDiskSpace write FOnAvailDiskSpace;
|
|||
|
|
property OnCompleteDirSize : TIdOnDirSizeInfo read FOnCompleteDirSize write FOnCompleteDirSize;
|
|||
|
|
|
|||
|
|
property SITECommands: TIdCommandHandlers read FSITECommands write SetSITECommands;
|
|||
|
|
property MLSDFacts : TIdMLSDAttrs read FMLSDFacts write FMLSDFacts;
|
|||
|
|
property OnClientID : TIdOnClientID read FOnClientID write FOnClientID;
|
|||
|
|
property ReplyUnknownSITCommand: TIdReply read FReplyUnknownSITECommand write SetReplyUnknownSITECommand;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
{This is used internally for some Telnet sequence parsing}
|
|||
|
|
type
|
|||
|
|
TIdFTPTelnetState = (tsData, tsCheckCR, tsIAC, tsWill, tsDo, tsWont, tsDont,
|
|||
|
|
tsNegotiate, tsNegotiateData, tsNegotiateIAC, tsInterrupt, tsInterruptIAC);
|
|||
|
|
|
|||
|
|
implementation
|
|||
|
|
|
|||
|
|
uses
|
|||
|
|
{$IFDEF DOTNET}
|
|||
|
|
{$IFDEF USE_INLINE}
|
|||
|
|
System.Threading,
|
|||
|
|
{$ENDIF}
|
|||
|
|
{$ENDIF}
|
|||
|
|
{$IFDEF USE_VCL_POSIX}
|
|||
|
|
Posix.SysSelect,
|
|||
|
|
Posix.SysTime,
|
|||
|
|
{$ENDIF}
|
|||
|
|
IdFIPS,
|
|||
|
|
IdHash, IdHashCRC, IdHashMessageDigest, IdHashSHA, IdIOHandlerSocket,
|
|||
|
|
IdResourceStringsProtocols, IdGlobalProtocols, IdSimpleServer, IdSSL,
|
|||
|
|
IdIOHandlerStack, IdSocketHandle, IdStrings, IdTCPClient, IdEMailAddress,
|
|||
|
|
IdStack, IdFTPListTypes;
|
|||
|
|
|
|||
|
|
const
|
|||
|
|
//THese commands need some special treatment in the Indy 10 FTP Server help system
|
|||
|
|
//as they will not always work
|
|||
|
|
HELP_SPEC_CMDS : array [0..25] of string =
|
|||
|
|
('SIZE','MDTM', {do not localize}
|
|||
|
|
'AUTH','PBSZ','PROT','CCC','MIC','CONF','ENC', 'SSCN','CPSV', {do not localize}
|
|||
|
|
'MFMT','MFF',
|
|||
|
|
'MD5','MMD5','XCRC','XMD5','XSHA1','XSHA256','XSHA512', {do not localize}
|
|||
|
|
'COMB','AVBL','DSIZ','RMDA','HOST','XAUT'); {do not localize}
|
|||
|
|
|
|||
|
|
//These commands must always be present even if not implemented
|
|||
|
|
//alt help topics and superscripts should be used sometimes.
|
|||
|
|
//These are mandated by RFC 1123
|
|||
|
|
HELP_ALT_MD_CMD : array [0..17] of string =
|
|||
|
|
('RETR', {do not localize}
|
|||
|
|
'STOR','STOU', {do not localize}
|
|||
|
|
'APPE', {do not localize}
|
|||
|
|
'RNFR', 'RNTO', {do not localize}
|
|||
|
|
'DELE', {do not localize}
|
|||
|
|
'LIST','NLST', {do not localize}
|
|||
|
|
'CWD','XCWD', {do not localize}
|
|||
|
|
'CDUP','XCUP', {do not localize}
|
|||
|
|
'RMD','XRMD', {do not localize}
|
|||
|
|
'MKD', 'XMKD', {do not localize}
|
|||
|
|
'SYST'); {do not localize}
|
|||
|
|
|
|||
|
|
HELP_ALT_MD_TP : array [0..17] of string =
|
|||
|
|
('RETR (retrieve); unimplemented.', {do not localize}
|
|||
|
|
'STOR (store); unimplemented.', {do not localize}
|
|||
|
|
'STOU (store unique); unimplemented.', {do not localize}
|
|||
|
|
'APPE (append); unimplemented.', {do not localize}
|
|||
|
|
'RNFR (rename from); unimplemented.', {do not localize}
|
|||
|
|
'RNTO (rename to); unimplemented.', {do not localize}
|
|||
|
|
'DELE (delete); unimplemented.', {do not localize}
|
|||
|
|
'LIST (list); unimplemented.', {do not localize}
|
|||
|
|
'NLIST (name-list); unimplemented.', {do not localize}
|
|||
|
|
'CWD (change working directory); unimplemented.', {do not localize}
|
|||
|
|
'XCWD (change working directory); unimplemented.', {do not localize}
|
|||
|
|
'CDUP (change to parent directory); unimplemented.', {do not localize}
|
|||
|
|
'XCDUP (change to parent directory); unimplemented.', {do not localize}
|
|||
|
|
'RMD (remove Directory); unimplemented.', {do not localize}
|
|||
|
|
'XRMD (remove Directory); unimplemented.', {do not localize}
|
|||
|
|
'MKD (make Directory); unimplemented.', {do not localize}
|
|||
|
|
'XMKD (make Directory); unimplemented.', {do not localize}
|
|||
|
|
'SYST (system); unimplemented.' {do not localize}
|
|||
|
|
);
|
|||
|
|
|
|||
|
|
//SSCN, OPTS MODE Z EXTRA, and OPTS UTF8 states
|
|||
|
|
OnOffStates : array [0..1] of string =
|
|||
|
|
('ON', {do not localize}
|
|||
|
|
'OFF' {do not localize}
|
|||
|
|
);
|
|||
|
|
|
|||
|
|
const
|
|||
|
|
//%s = host
|
|||
|
|
//%n = xauth key
|
|||
|
|
XAUTHBANNER = '%s X2 WS_FTP Server Compatible(%d)';
|
|||
|
|
ACCT_HELP_DISABLED = 'ACCT (specify account); unimplemented.'; {do not localize}
|
|||
|
|
ACCT_HELP_ENABLED = 'Syntax: ACCT <SP> <account-information> <CRLF>';
|
|||
|
|
|
|||
|
|
const
|
|||
|
|
NLSTEncType: array[Boolean] of IdTextEncodingType = (encASCII, encUTF8);
|
|||
|
|
|
|||
|
|
function CalculateCheckSum(AHashClass: TIdHashClass; AStrm: TStream; ABeginPos, AEndPos: TIdStreamSize): String;
|
|||
|
|
{$IFDEF USE_INLINE} inline; {$ENDIF}
|
|||
|
|
var
|
|||
|
|
LHash: TIdHash;
|
|||
|
|
begin
|
|||
|
|
LHash := AHashClass.Create;
|
|||
|
|
try
|
|||
|
|
Result := LHash.HashStreamAsHex(AStrm, ABeginPos, AEndPos-ABeginPos);
|
|||
|
|
finally
|
|||
|
|
LHash.Free;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure XAutGreeting(AContext: TIdContext; AGreeting : TIdReply; const AHostName : String);
|
|||
|
|
{$IFDEF USE_INLINE} inline; {$ENDIF}
|
|||
|
|
var
|
|||
|
|
s : String;
|
|||
|
|
begin
|
|||
|
|
//for XAUT to work with WS-FTP Pro, you need a banner mentioning "WS_FTP Server"
|
|||
|
|
//and that banner can only be one line in length.
|
|||
|
|
s := IndyFormat(XAUTHBANNER,
|
|||
|
|
[ GStack.HostName, (AContext as TIdFTPServerContext).FXAUTKey]) + ' '+AGreeting.Text.Text;
|
|||
|
|
s := Fetch(s,CR);
|
|||
|
|
s := Fetch(s,LF);
|
|||
|
|
AGreeting.Text.Text := s;
|
|||
|
|
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
{ TIdFTPServer }
|
|||
|
|
|
|||
|
|
constructor TIdFTPServerContext.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn;
|
|||
|
|
AList: TIdContextThreadList = nil);
|
|||
|
|
begin
|
|||
|
|
inherited Create(AConnection, AYarn, AList);
|
|||
|
|
FUserSecurity := TIdFTPSecurityOptions.Create;
|
|||
|
|
//we don't initialize FCCC flag here because that shouldn't be cleared with implicit SSL
|
|||
|
|
FCCC := False;
|
|||
|
|
FDataMode := dmStream;
|
|||
|
|
FMLSOpts := [ItemType, Modify, Size];
|
|||
|
|
//no write permissions for group and others
|
|||
|
|
FUMask := 22;
|
|||
|
|
ResetZLibSettings;
|
|||
|
|
ReInitialize;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServerContext.SetUserSecurity(const Value: TIdFTPSecurityOptions);
|
|||
|
|
begin
|
|||
|
|
FUserSecurity.Assign( Value);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
destructor TIdFTPServerContext.Destroy;
|
|||
|
|
begin
|
|||
|
|
KillDataChannel;
|
|||
|
|
FreeAndNil(FUserSecurity);
|
|||
|
|
inherited Destroy;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServerContext.CreateDataChannel(APASV: Boolean = False);
|
|||
|
|
begin
|
|||
|
|
KillDataChannel; //let the old one terminate
|
|||
|
|
FDataChannel := TIdDataChannel.Create(APASV, Self, UserSecurity.RequirePASVFromSameIP, Server);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServerContext.KillDataChannel;
|
|||
|
|
begin
|
|||
|
|
if Assigned(FDataChannel) then begin
|
|||
|
|
if not FDataChannel.Stopped then begin
|
|||
|
|
FDataChannel.Stopped := True;
|
|||
|
|
FDataChannel.FDataChannel.Disconnect(False);
|
|||
|
|
end;
|
|||
|
|
FreeAndNil(FDataChannel);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServerContext.ReInitialize;
|
|||
|
|
begin
|
|||
|
|
inherited;
|
|||
|
|
FDataType := ftASCII;
|
|||
|
|
// FDataMode := dmStream;
|
|||
|
|
FDataPort := 0;
|
|||
|
|
FDataStruct := dsFile;
|
|||
|
|
FPASV := False;
|
|||
|
|
FEPSVAll := False;
|
|||
|
|
FDataProtection := ftpdpsClear;
|
|||
|
|
DataPBSZCalled := False;
|
|||
|
|
FDataProtBufSize := 0;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdFTPServerContext.IsAuthenticated(ASender: TIdCommand): Boolean;
|
|||
|
|
begin
|
|||
|
|
Result := FAuthenticated;
|
|||
|
|
if not Result then begin
|
|||
|
|
ASender.Reply.SetReply(530, RSFTPUserNotLoggedIn);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
{ TIdFTPServer }
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.InitComponent;
|
|||
|
|
begin
|
|||
|
|
inherited InitComponent;
|
|||
|
|
HelpReply.Code := ''; //we will handle the help ourselves
|
|||
|
|
FDataChannelCommands := TIdCommandHandlers.Create(Self, FReplyClass, ReplyTexts, ExceptionReply);
|
|||
|
|
FSITECommands := TIdCommandHandlers.Create(Self, FReplyClass, ReplyTexts, ExceptionReply);
|
|||
|
|
FOPTSCommands := TIdCommandHandlers.Create(Self, FReplyClass, ReplyTexts, ExceptionReply);
|
|||
|
|
//inherited from TLS classes
|
|||
|
|
FRegularProtPort := IdPORT_FTP;
|
|||
|
|
FImplicitTLSProtPort := IdPORT_ftps;
|
|||
|
|
//
|
|||
|
|
FAnonymousAccounts := TStringList.Create;
|
|||
|
|
// By default these user names will be treated as anonymous.
|
|||
|
|
FAnonymousAccounts.Add('anonymous'); { do not localize }
|
|||
|
|
FAnonymousAccounts.Add('ftp'); { do not localize }
|
|||
|
|
FAnonymousAccounts.Add('guest'); { do not localize }
|
|||
|
|
FAllowAnonymousLogin := Id_DEF_AllowAnon;
|
|||
|
|
FAnonymousPassStrictCheck := Id_DEF_PassStrictCheck;
|
|||
|
|
DefaultPort := IDPORT_FTP;
|
|||
|
|
DefaultDataPort := IdPORT_FTP_DATA;
|
|||
|
|
// FEmulateSystem := Id_DEF_SystemType;
|
|||
|
|
Greeting.SetReply(220, RSFTPDefaultGreeting);
|
|||
|
|
|
|||
|
|
FContextClass := TIdFTPServerContext;
|
|||
|
|
ReplyUnknownCommand.SetReply(500, 'Unknown Command'); {do not localize}
|
|||
|
|
|
|||
|
|
FReplyUnknownSITECommand := FReplyClass.Create(nil);
|
|||
|
|
FReplyUnknownSITECommand.SetReply(500, 'Invalid SITE command.'); {do not localize}
|
|||
|
|
|
|||
|
|
FFTPSecurityOptions := TIdFTPSecurityOptions.Create;
|
|||
|
|
FPASVBoundPortMin := DEF_PASV_BOUND_MIN;
|
|||
|
|
FPASVBoundPortMax := DEF_PASV_BOUND_MAX;
|
|||
|
|
FPathProcessing := DEF_PATHPROCESSING;
|
|||
|
|
FDirFormat := DEF_DIRFORMAT;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdFTPServer.GetReplyClass: TIdReplyClass;
|
|||
|
|
begin
|
|||
|
|
Result := TIdReplyFTP;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdFTPServer.GetRepliesClass: TIdRepliesClass;
|
|||
|
|
begin
|
|||
|
|
Result := TIdRepliesFTP;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandHELP(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
s : String;
|
|||
|
|
LCmds : TStringList;
|
|||
|
|
i : Integer;
|
|||
|
|
LExp : String;
|
|||
|
|
|
|||
|
|
function ShouldShowCommand(const ACommand : String) : Boolean;
|
|||
|
|
begin
|
|||
|
|
Result := False;
|
|||
|
|
case PosInStrArray(ACommand, HELP_SPEC_CMDS, False) of
|
|||
|
|
-1 :
|
|||
|
|
Result := True;
|
|||
|
|
0 : //'SIZE'
|
|||
|
|
if Assigned(FOnGetFileSize) then begin
|
|||
|
|
Result := True;
|
|||
|
|
end;
|
|||
|
|
1 :// 'MDTM',
|
|||
|
|
if Assigned(FOnGetFileDate) or Assigned(FTPFileSystem) then begin
|
|||
|
|
Result := True;
|
|||
|
|
end;
|
|||
|
|
2 : // 'AUTH'
|
|||
|
|
if (FUseTLS in ExplicitTLSVals) then begin
|
|||
|
|
Result := True;
|
|||
|
|
end;
|
|||
|
|
3,4,5,6,7,8,9,10 : //'PBSZ','PROT', 'CCC','MIC','CONF','ENC','SSCN','CPSV',
|
|||
|
|
if (FUseTLS <> utNoTLSSupport) then begin
|
|||
|
|
Result := True;
|
|||
|
|
end;
|
|||
|
|
11,12 : // 'MFMT','MFF',
|
|||
|
|
if Assigned(FOnSetModifiedTime) or Assigned(FTPFileSystem) then begin
|
|||
|
|
Result := True;
|
|||
|
|
end;
|
|||
|
|
13,14, 15,16 : //'MD5','MMD5','XCRC','XMD5',
|
|||
|
|
begin
|
|||
|
|
Result := False;
|
|||
|
|
if not GetFIPSMode then begin
|
|||
|
|
if Assigned(FOnCRCFile) or Assigned(FTPFileSystem) then begin
|
|||
|
|
Result := True;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
17 : // 'XSHA1',
|
|||
|
|
if Assigned(FOnCRCFile) or Assigned(FTPFileSystem) then begin
|
|||
|
|
Result := True;
|
|||
|
|
end;
|
|||
|
|
18 : //'XSHA256'
|
|||
|
|
if (Assigned(FOnCRCFile) or Assigned(FTPFileSystem))
|
|||
|
|
and TIdHashSHA256.IsAvailable then begin
|
|||
|
|
Result := True;
|
|||
|
|
end;
|
|||
|
|
19 : //'XSHA512'
|
|||
|
|
if (Assigned(FOnCRCFile) or Assigned(FTPFileSystem)) and
|
|||
|
|
TIdHashSHA512.IsAvailable then begin
|
|||
|
|
Result := True;
|
|||
|
|
end;
|
|||
|
|
20 : // 'COMB');
|
|||
|
|
if Assigned(OnCombineFiles) or Assigned(FTPFileSystem) then begin
|
|||
|
|
Result := True;
|
|||
|
|
end;
|
|||
|
|
21 : // AVBL
|
|||
|
|
if Assigned(FOnAvailDiskSpace) then begin
|
|||
|
|
Result := True;
|
|||
|
|
end;
|
|||
|
|
22 : // DSIZ
|
|||
|
|
if Assigned(FOnCompleteDirSize) then begin
|
|||
|
|
Result := True;
|
|||
|
|
end;
|
|||
|
|
23 : // RMDA
|
|||
|
|
if Assigned(FOnRemoveDirectoryAll) then begin
|
|||
|
|
Result := True;
|
|||
|
|
end;
|
|||
|
|
24 : // HOST
|
|||
|
|
if Assigned( FOnHostCheck ) then begin
|
|||
|
|
Result := True;
|
|||
|
|
end;
|
|||
|
|
25 : // XAUT
|
|||
|
|
if (not GetFIPSMode) and Self.FSupportXAUTH then begin
|
|||
|
|
Result := True;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function IsNotImplemented(const ACommand : String; var VHelp : String) : Boolean;
|
|||
|
|
var
|
|||
|
|
idx : Integer;
|
|||
|
|
begin
|
|||
|
|
Result := False; //presume that the command is implemented
|
|||
|
|
idx := PosInStrArray(ACommand, HELP_ALT_MD_CMD, False);
|
|||
|
|
if idx = -1 then begin
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
case idx of
|
|||
|
|
0 : // 'RETR'
|
|||
|
|
begin
|
|||
|
|
if (not Assigned(FOnRetrieveFile)) and (not Assigned(FFTPFileSystem)) then begin
|
|||
|
|
Result := True;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
1,2,3 : //'STOR','STOU', 'APPE',
|
|||
|
|
begin
|
|||
|
|
if (not Assigned(FOnStoreFile)) and (not Assigned(FFTPFileSystem)) then begin
|
|||
|
|
Result := True;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
4,5 : // 'RNFR', 'RNTO',
|
|||
|
|
begin
|
|||
|
|
if (not Assigned(FOnRenameFile)) and (not Assigned(FFTPFileSystem)) then begin
|
|||
|
|
Result := True;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
6 : // 'DELE',
|
|||
|
|
begin
|
|||
|
|
if (not Assigned(FOnDeleteFile)) and (not Assigned(FFTPFileSystem)) then begin
|
|||
|
|
Result := True;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
7,8 :// 'LIST','NLST',
|
|||
|
|
begin
|
|||
|
|
if (not Assigned(FOnListDirectory)) or
|
|||
|
|
((FDirFormat = ftpdfCustom) and (not Assigned(OnCustomListDirectory))) then begin
|
|||
|
|
Result := True;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
9, 10, //'CWD','XCWD',
|
|||
|
|
11, 12 : // 'CDUP','XCUP',
|
|||
|
|
begin
|
|||
|
|
if (not Assigned(FOnChangeDirectory)) and (not Assigned(FFTPFileSystem)) then begin
|
|||
|
|
Result := True;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
13, 14 : //'RMD','XRMD',
|
|||
|
|
begin
|
|||
|
|
if (not Assigned(FOnRemoveDirectory)) and (not Assigned(FFTPFileSystem)) then begin
|
|||
|
|
Result := True;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
15,16 : //'MKD', 'XMKD',
|
|||
|
|
begin
|
|||
|
|
if (not Assigned(FOnMakeDirectory)) and (not Assigned(FFTPFileSystem)) then begin
|
|||
|
|
Result := True;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
17 :// 'SYST',
|
|||
|
|
begin
|
|||
|
|
if (not Assigned(FOnMakeDirectory)) and (not Assigned(FFTPFileSystem)) then begin
|
|||
|
|
Result := True;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
if Result then begin
|
|||
|
|
LExp := HELP_ALT_MD_TP[idx];
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
begin
|
|||
|
|
if ASender.Params.Count > 0 then begin
|
|||
|
|
for i := 0 to CommandHandlers.Count-1 do begin
|
|||
|
|
if TextIsSame(ASender.Params[0], CommandHandlers.Items[i].Command) then begin
|
|||
|
|
if CommandHandlers.Items[i].HelpVisible and ShouldShowCommand(ASender.Params[0]) then begin
|
|||
|
|
if IsNotImplemented(CommandHandlers.Items[i].Command, LExp) then begin
|
|||
|
|
ASender.Reply.SetReply(214, LExp);
|
|||
|
|
end else begin
|
|||
|
|
ASender.Reply.SetReply(214, CommandHandlers.Items[i].Description.Text);
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
ASender.Reply.SetReply(502, IndyFormat(RSFTPCmdHelpNotKnown, [UpperCase(ASender.Params[0])]));
|
|||
|
|
end;
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
ASender.Reply.SetReply(502, IndyFormat(RSFTPCmdHelpNotKnown, [UpperCase(ASender.Params[0])]));
|
|||
|
|
end else begin
|
|||
|
|
s := RSFTPHelpBegining + EOL;
|
|||
|
|
LCmds := TStringList.Create;
|
|||
|
|
try
|
|||
|
|
//
|
|||
|
|
for i := 0 to CommandHandlers.Count -1 do begin
|
|||
|
|
if CommandHandlers.Items[i].HelpVisible and ShouldShowCommand(CommandHandlers.Items[i].Command) then begin
|
|||
|
|
if IsNotImplemented(CommandHandlers.Items[i].Command, LExp) then begin
|
|||
|
|
LCmds.Add(CommandHandlers.Items[i].Command + '*'); {do not localize}
|
|||
|
|
end else begin
|
|||
|
|
LCmds.Add(CommandHandlers.Items[i].Command + CommandHandlers.Items[i].HelpSuperScript);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
LCmds.Sort;
|
|||
|
|
s := s + HelpText(LCmds) + FEndOfHelpLine;
|
|||
|
|
if FEndOfHelpLine = '' then begin
|
|||
|
|
s := s + EOL; //prevent ugliness if last row out of alignment with the rest
|
|||
|
|
end;
|
|||
|
|
ASender.Reply.SetReply(214, s);
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(LCmds);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandHOST(ASender: TIdCommand);
|
|||
|
|
var LTmp : String;
|
|||
|
|
LValid : Boolean;
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
begin
|
|||
|
|
LContext := TIdFTPServerContext(ASender.Context);
|
|||
|
|
if Assigned(OnHostCheck) then begin
|
|||
|
|
if LContext.Username <> '' then begin
|
|||
|
|
ASender.Reply.SetReply(530, RSFTPNotAfterAuthentication );
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
if (ASender.Params.Count > 0) then begin
|
|||
|
|
LTmp := ASender.Params[0];
|
|||
|
|
if Copy(LTmp,1,1)='[' then begin
|
|||
|
|
Delete(LTmp,1,1);
|
|||
|
|
end;
|
|||
|
|
LTmp := Fetch(LTmp,']');
|
|||
|
|
LValid := False;
|
|||
|
|
FOnHostCheck(LContext,LTmp,LValid);
|
|||
|
|
if LValid then begin
|
|||
|
|
LContext.Host := LTmp;
|
|||
|
|
if Assigned(OnGreeting) then begin
|
|||
|
|
OnGreeting(LContext,ASender.Reply);
|
|||
|
|
end;
|
|||
|
|
if ASender.Reply.NumericCode = 421 then begin
|
|||
|
|
ASender.Disconnect := True;
|
|||
|
|
end else begin
|
|||
|
|
if not GetFIPSMode then begin
|
|||
|
|
//setting the reply code number directly causes the text to be cleared
|
|||
|
|
if FSupportXAUTH and (ASender.Reply.NumericCode = 220) then begin
|
|||
|
|
XAutGreeting(LContext,ASender.Reply, LTmp);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
ASender.Reply.SetReply(220,ASender.Reply.Text.Text);
|
|||
|
|
end;
|
|||
|
|
ASender.SendReply;
|
|||
|
|
end else begin
|
|||
|
|
ASender.Reply.SetReply(530,RSFTPHostNotFound);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
CmdSyntaxError(ASender);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.InitializeCommandHandlers;
|
|||
|
|
var
|
|||
|
|
LCmd : TIdCommandHandler;
|
|||
|
|
begin
|
|||
|
|
inherited InitializeCommandHandlers;
|
|||
|
|
|
|||
|
|
//ACCESS CONTROL COMMANDS
|
|||
|
|
//USER <SP> <username> <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'USER'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandUSER;
|
|||
|
|
LCmd.Description.Text := 'Syntax: USER <sp> username'; {do not localize}
|
|||
|
|
|
|||
|
|
//PASS <SP> <password> <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'PASS'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandPASS;
|
|||
|
|
LCmd.Description.Text := 'Syntax: PASS <sp> password'; {do not localize}
|
|||
|
|
|
|||
|
|
//ACCT <SP> <account-information> <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'ACCT'; {Do not Localize}
|
|||
|
|
// LCMd.NormalReply.SetReply(502, IndyFormat(RSFTPCmdNotImplemented, ['ACCT'])); {do not localize}
|
|||
|
|
LCmd.OnCommand := CommandACCT;
|
|||
|
|
if Assigned(Self.FOnUserAccount) then begin
|
|||
|
|
LCmd.HelpSuperScript := ''; //not supported
|
|||
|
|
LCmd.Description.Text := ACCT_HELP_ENABLED;
|
|||
|
|
end else begin
|
|||
|
|
LCmd.HelpSuperScript := '*'; //not supported
|
|||
|
|
LCmd.Description.Text := ACCT_HELP_DISABLED;
|
|||
|
|
end;
|
|||
|
|
// 'ACCT (specify account); unimplemented.'; {do not localize}
|
|||
|
|
|
|||
|
|
{
|
|||
|
|
LCmd.NormalReply.SetReply(502, Format(RSFTPCmdNotImplemented, ['ACCT'])); {Do not Localize}
|
|||
|
|
|
|||
|
|
//CWD <SP> <pathname> <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'CWD'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandCWD;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 550;
|
|||
|
|
LCmd.Description.Text := 'Syntax: CWD [ <sp> directory-name ]'; {do not localize}
|
|||
|
|
|
|||
|
|
//CDUP <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'CDUP'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandCDUP;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 550;
|
|||
|
|
LCmd.Description.Text := 'Syntax: CDUP (change to parent directory)'; {do not localize}
|
|||
|
|
|
|||
|
|
//SMNT <SP> <pathname> <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'SMNT'; {Do not Localize}
|
|||
|
|
LCmd.NormalReply.SetReply(502, RSFTPFileActionCompleted);//250 for success
|
|||
|
|
LCmd.HelpSuperScript := '*';
|
|||
|
|
LCmd.Description.Text := 'SMNT (structure mount); unimplemented.'; {do not localize}
|
|||
|
|
|
|||
|
|
//QUIT <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'QUIT'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandQUIT;
|
|||
|
|
LCmd.Disconnect := True;
|
|||
|
|
LCmd.NormalReply.SetReply(221, RSFTPQuitGoodby); {Do not Localize}
|
|||
|
|
LCmd.Description.Text := 'Syntax: QUIT (terminate service)'; {do not localize}
|
|||
|
|
|
|||
|
|
//REIN <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'REIN'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandREIN;
|
|||
|
|
LCmd.Description.Text := 'Syntax: REIN (reinitialize server state)'; {do not localize}
|
|||
|
|
|
|||
|
|
//PORT <SP> <host-port> <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'PORT'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandPORT;
|
|||
|
|
LCmd.Description.Text := 'Syntax: PORT <sp> b0, b1, b2, b3, b4'; {do not localize}
|
|||
|
|
|
|||
|
|
//PASV <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'PASV'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandPASV;
|
|||
|
|
LCmd.Description.Text := 'Syntax: PASV (set server in passive mode)'; {do not localize}
|
|||
|
|
|
|||
|
|
//P@SW <CRLF>
|
|||
|
|
//This is for some routers that replace a PASV with a P@SW
|
|||
|
|
//as part of a misguided attempt to add a feature.
|
|||
|
|
//A router would do a replacement so a client would think that
|
|||
|
|
//PASV wasn't supported and then the client would do a PORT command
|
|||
|
|
//instead. That doesn't happen so this just caused the client not to work.
|
|||
|
|
//See: http://www.gbnetwork.co.uk/smcftpd/
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'P@SW'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandPASV;
|
|||
|
|
LCmd.HelpVisible := False; //this is just a workaround
|
|||
|
|
|
|||
|
|
//TYPE <SP> <type-code> <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'TYPE'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandTYPE;
|
|||
|
|
LCmd.Description.Text := 'Syntax: TYPE <sp> [ A | E | I | L ]'; {do not localize}
|
|||
|
|
|
|||
|
|
//STRU <SP> <structure-code> <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'STRU'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandSTRU;
|
|||
|
|
LCmd.Description.Text := 'Syntax: STRU (specify file structure)'; {do not localize}
|
|||
|
|
|
|||
|
|
//MODE <SP> <mode-code> <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'MODE'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandMODE;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 501;
|
|||
|
|
LCmd.Description.Text := 'Syntax: MODE (specify transfer mode)'; {do not localize}
|
|||
|
|
|
|||
|
|
//FTP SERVICE COMMANDS
|
|||
|
|
//RETR <SP> <pathname> <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'RETR'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandRETR;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 550;
|
|||
|
|
LCmd.Description.Text := 'Syntax: RETR <sp> file-name'; {do not localize}
|
|||
|
|
|
|||
|
|
//STOR <SP> <pathname> <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'STOR'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandSSAP;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 551;
|
|||
|
|
LCmd.Description.Text := 'Syntax: STOR <sp> file-name'; {do not localize}
|
|||
|
|
|
|||
|
|
//STOU <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'STOU'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandSSAP;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 551;
|
|||
|
|
LCmd.Description.Text := 'Syntax: STOU <sp> file-name'; {do not localize}
|
|||
|
|
|
|||
|
|
//APPE <SP> <pathname> <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'APPE'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandSSAP;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 550;
|
|||
|
|
LCmd.Description.Text := 'Syntax: APPE <sp> file-name'; {do not localize}
|
|||
|
|
|
|||
|
|
//ALLO <SP> <decimal-integer>
|
|||
|
|
// [<SP> R <SP> <decimal-integer>] <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'ALLO'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandALLO;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 550;
|
|||
|
|
LCmd.Description.Text := 'Syntax: ALLO allocate storage (vacuously)'; {do not localize}
|
|||
|
|
|
|||
|
|
//REST <SP> <marker> <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'REST'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandREST;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 550;
|
|||
|
|
LCmd.Description.Text := 'Syntax: REST (restart command)'; {do not localize}
|
|||
|
|
|
|||
|
|
//RNFR <SP> <pathname> <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'RNFR'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandRNFR;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 550;
|
|||
|
|
LCmd.Description.Text := 'Syntax: RNFR <sp> file-name'; {do not localize}
|
|||
|
|
|
|||
|
|
//RNTO <SP> <pathname> <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'RNTO'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandRNTO;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 550;
|
|||
|
|
LCmd.Description.Text := 'Syntax: RNTO <sp> file-name'; {do not localize}
|
|||
|
|
|
|||
|
|
//ABOR <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'ABOR'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandABOR;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 550;
|
|||
|
|
LCmd.Description.Text := 'Syntax: ABOR (abort operation)'; {do not localize}
|
|||
|
|
|
|||
|
|
//DELE <SP> <pathname> <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'DELE'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandDELE;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 550;
|
|||
|
|
LCmd.Description.Text := 'Syntax: DELE <sp> file-name'; {do not localize}
|
|||
|
|
|
|||
|
|
// 'SMNT (structure mount); unimplemented.';
|
|||
|
|
|
|||
|
|
//RMD <SP> <pathname> <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'RMD'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandRMD;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 550;
|
|||
|
|
LCmd.Description.Text := 'Syntax: RMD <sp> path-name'; {do not localize}
|
|||
|
|
|
|||
|
|
//MKD <SP> <pathname> <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'MKD'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandMKD;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 550;
|
|||
|
|
LCmd.Description.Text := 'Syntax: MKD <sp> path-name'; {do not localize}
|
|||
|
|
|
|||
|
|
//PWD <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'PWD'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandPWD;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 550;
|
|||
|
|
LCmd.Description.Text := 'Syntax: PWD (return current directory)'; {do not localize}
|
|||
|
|
|
|||
|
|
//LIST [<SP> <pathname>] <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'LIST'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandLIST;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 450;
|
|||
|
|
LCmd.Description.Text := 'Syntax: LIST [ <sp> path-name ]'; {do not localize}
|
|||
|
|
|
|||
|
|
//NLST [<SP> <pathname>] <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'NLST'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandLIST;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 450;
|
|||
|
|
LCmd.Description.Text := 'Syntax: NLST [ <sp> path-name ]'; {do not localize}
|
|||
|
|
|
|||
|
|
//SITE <SP> <string> <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'SITE'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandSITE;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 501;
|
|||
|
|
LCmd.Description.Text := 'Syntax: SITE (site-specific commands)';
|
|||
|
|
|
|||
|
|
//SYST <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'SYST'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandSYST;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 501;
|
|||
|
|
LCmd.Description.Text := 'Syntax: SYST (get type of operating system)'; {do not localize}
|
|||
|
|
|
|||
|
|
//STAT [<SP> <pathname>] <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'STAT'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandSTAT;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 450;
|
|||
|
|
LCmd.Description.Text := 'Syntax: CWD [ <sp> directory-name ]'; {do not localize}
|
|||
|
|
|
|||
|
|
//NOOP <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'NOOP'; {Do not Localize}
|
|||
|
|
LCmd.NormalReply.SetReply(200, IndyFormat(RSFTPCmdSuccessful, ['NOOP'])); {Do not Localize}
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 550;
|
|||
|
|
LCmd.Description.Text := 'Syntax: NOOP'; {do not localize}
|
|||
|
|
|
|||
|
|
//RFC 775
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'XMKD'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandMKD;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 551; //use the ones in parathensies
|
|||
|
|
LCmd.Description.Text := 'Syntax: XMKD <sp> path-name'; {do not localize}
|
|||
|
|
|
|||
|
|
//XCWD <SP> <pathname> <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'XCWD'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandCWD;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 550;
|
|||
|
|
LCmd.Description.Text := 'Syntax: XCWD [ <sp> directory-name ]'; {do not localize}
|
|||
|
|
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'XRMD'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandRMD;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 551; //use the ones in parathensies
|
|||
|
|
LCmd.Description.Text := 'Syntax: XRMD <sp> path-name'; {do not localize}
|
|||
|
|
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'XPWD'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandPWD;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 502;
|
|||
|
|
LCmd.Description.Text := 'Syntax: PWD (return current directory)'; {do not localize}
|
|||
|
|
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'XCUP'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandCDUP;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 551; //use the ones in parathensies
|
|||
|
|
LCmd.Description.Text := 'Syntax: XCUP (change to parent directory)'; {do not localize}
|
|||
|
|
|
|||
|
|
//RFC 2389
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'FEAT'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandFEAT;
|
|||
|
|
SetRFCReplyFormat(LCmd.NormalReply);
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 501;
|
|||
|
|
LCmd.Description.Text := 'Syntax: FEAT (returns feature list)'; {do not localize}
|
|||
|
|
|
|||
|
|
//RFC 2389
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'OPTS'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandOPTS;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 501;
|
|||
|
|
LCmd.Description.Text := 'Syntax: OPTS <sp> command [<sp> options]'; {do not localize}
|
|||
|
|
|
|||
|
|
//SIZE [<FILE>] CRLF
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'SIZE'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandSIZE;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 550;
|
|||
|
|
LCmd.Description.Text := 'Syntax: SIZE <sp> path-name'; {do not localize}
|
|||
|
|
|
|||
|
|
//EPSV [protocol] <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'EPSV'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandEPSV;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 501;
|
|||
|
|
LCmd.Description.Text := 'Syntax: EPSV (returns port |||port|)'; {do not localize}
|
|||
|
|
|
|||
|
|
//EPRT [address/port string] <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'EPRT'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandEPRT;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 501;
|
|||
|
|
LCmd.Description.Text := 'Syntax: EPRT <sp> |proto|addr|port|'; {do not localize}
|
|||
|
|
|
|||
|
|
//MDTM [<FILE>] <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'MDTM'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandMDTM;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 550;
|
|||
|
|
LCmd.Description.Text := 'Syntax: MDTM <sp> path-name'; {do not localize}
|
|||
|
|
|
|||
|
|
//RFC 2228
|
|||
|
|
//AUTH [Mechanism] <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'AUTH'; {Do not translate}
|
|||
|
|
LCmd.OnCommand := CommandAUTH;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 501;
|
|||
|
|
LCmd.Description.Text := 'Syntax: AUTH <sp> mechanism-name'; {do not localize}
|
|||
|
|
|
|||
|
|
//PBSZ [Protection Buffer Size] <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'PBSZ'; {Do not translate}
|
|||
|
|
LCmd.OnCommand := CommandPBSZ;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 501;
|
|||
|
|
LCmd.Description.Text := 'Syntax: PBSZ <sp> protection buffer size'; {do not localize}
|
|||
|
|
|
|||
|
|
//PROT Protection Type <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'PROT'; {Do not translate}
|
|||
|
|
LCmd.OnCommand := CommandPROT;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 501;
|
|||
|
|
LCmd.Description.Text := 'Syntax: PROT <sp> protection code'; {do not localize}
|
|||
|
|
|
|||
|
|
//CCC Clear Command Channel
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'CCC'; {Do not translate}
|
|||
|
|
LCmd.OnCommand := CommandCCC;
|
|||
|
|
LCmd.Description.Text := 'Syntax: CCC (clear command channel)'; {do not localize}
|
|||
|
|
|
|||
|
|
//MIC Integrity Protected Command
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'MIC'; {Do not translate}
|
|||
|
|
LCmd.OnCommand := CommandSecRFC;
|
|||
|
|
LCmd.HelpSuperScript := '*';
|
|||
|
|
LCmd.Description.Text := 'MIC (integrity protected command); unimplemented.'; {do not localize}
|
|||
|
|
|
|||
|
|
//CONF Confidentiality protected command
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'CONF'; {Do not translate}
|
|||
|
|
LCmd.OnCommand := CommandSecRFC;
|
|||
|
|
LCmd.HelpSuperScript := '*';
|
|||
|
|
LCmd.Description.Text := 'CONF (confidentiality protected command); unimplemented.'; {do not localize}
|
|||
|
|
|
|||
|
|
//ENC Privacy Protected command
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'ENC'; {Do not translate}
|
|||
|
|
LCmd.OnCommand := CommandSecRFC;
|
|||
|
|
LCmd.HelpSuperScript := '*';
|
|||
|
|
LCmd.Description.Text := 'ENC (privacy protected command); unimplemented.'; {do not localize}
|
|||
|
|
|
|||
|
|
//These are from IETF Draft "Extensions to FTP"
|
|||
|
|
//MLSD [Pathname] <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'MLSD'; {Do not translate}
|
|||
|
|
LCmd.OnCommand := CommandMLSD;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 550;
|
|||
|
|
LCmd.Description.Text := 'Syntax: MLSD [ <sp> path-name ]'; {do not localize}
|
|||
|
|
|
|||
|
|
//MLST [Pathname] <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'MLST'; {Do not translate}
|
|||
|
|
LCmd.OnCommand := CommandMLST;
|
|||
|
|
SetRFCReplyFormat(LCmd.NormalReply);
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 550;
|
|||
|
|
LCmd.Description.Text := 'Syntax: MLST [ <sp> path-name ]'; {do not localize}
|
|||
|
|
|
|||
|
|
//Defined in http://www.trevezel.com/downloads/draft-somers-ftp-mfxx-00.html
|
|||
|
|
//Modify File Modification Time
|
|||
|
|
//MFMT [ATime] [Path-name]<CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'MFMT'; {Do not translate}
|
|||
|
|
LCmd.OnCommand := CommandMFMT;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 550;
|
|||
|
|
LCmd.Description.Text := 'Syntax: MFMT [ATime] [Path-name]<CRLF>'; {do not localize}
|
|||
|
|
|
|||
|
|
//Defined in http://www.trevezel.com/downloads/draft-somers-ftp-mfxx-00.html
|
|||
|
|
//Modify File Creation Time
|
|||
|
|
//MFMT [ATime] [Pathname]<CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'MFCT'; {Do not translate}
|
|||
|
|
LCmd.OnCommand := CommandMFCT;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 550;
|
|||
|
|
LCmd.Description.Text := 'Syntax: MFCT [ATime] [Path-name]'; {do not localize}
|
|||
|
|
|
|||
|
|
//params are the same format as the MLS output
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'MFF'; {Do not translate}
|
|||
|
|
LCmd.OnCommand := CommandMFF;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 550;
|
|||
|
|
LCmd.Description.Text := 'Syntax: MFF [ mff-facts ] SP path-name'; {do not localize}
|
|||
|
|
|
|||
|
|
//From http://www.ietf.org/internet-drafts/draft-twine-ftpmd5-00.txt
|
|||
|
|
//MD5 [Pathname]
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'MD5'; {Do not translate}
|
|||
|
|
LCmd.OnCommand := CommandMD5;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 504;
|
|||
|
|
LCmd.Description.Text := 'Syntax: MD5 [Pathname]'; {do not localize}
|
|||
|
|
|
|||
|
|
//MMD5 [Filepath1], [Filepath2] [...]
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'MMD5'; {Do not translate}
|
|||
|
|
LCmd.OnCommand := CommandMMD5;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 504;
|
|||
|
|
LCmd.Description.Text := 'Syntax: MMD5 [Filepath1], [Filepath2] [...]'; {do not localize}
|
|||
|
|
|
|||
|
|
//These two commands are not in RFC's or drafts
|
|||
|
|
// but are documented in:
|
|||
|
|
// GlobalSCAPE Secure FTP Server User<65>s Guide
|
|||
|
|
//XCRC "[filename]" [start] [finish]
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'XCRC'; {Do not translate}
|
|||
|
|
LCmd.OnCommand := CommandCheckSum;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 550;
|
|||
|
|
LCmd.Description.Text := 'Syntax: XCRC "[file-name]" [start] [finish]'; {do not localize}
|
|||
|
|
|
|||
|
|
//COMB "[filename]" [start] [finish]
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'COMB'; {Do not translate}
|
|||
|
|
LCmd.OnCommand := CommandCOMB;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 550;
|
|||
|
|
LCmd.Description.Text := 'Syntax: COMB "[file-name]" [start] [finish]'; {do not localize}
|
|||
|
|
|
|||
|
|
//informal but we might want to support this anyway
|
|||
|
|
//SSCN - specified by:
|
|||
|
|
//http://www.raidenftpd.com/kb/kb000000037.htm
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'SSCN'; {Do not translate}
|
|||
|
|
LCmd.OnCommand := CommandSSCN;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 550;
|
|||
|
|
LCmd.NormalReply.NumericCode := 200;
|
|||
|
|
LCmd.Description.Text := 'Syntax: SSCN [ON|OFF]'; {do not localize}
|
|||
|
|
|
|||
|
|
//CPSV <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'CPSV'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandCPSV;
|
|||
|
|
LCmd.Description.Text := 'Syntax: CPSV (set server in passive mode with SSL Connect)'; {do not localize}
|
|||
|
|
|
|||
|
|
//Seen in RaidenFTPD documentation
|
|||
|
|
//XCRC "[filename]" [start] [finish]
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'XMD5'; {Do not translate}
|
|||
|
|
LCmd.OnCommand := CommandCheckSum;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 550;
|
|||
|
|
LCmd.Description.Text := 'Syntax: XMD5 "[filename]" [start] [finish]'; {do not localize}
|
|||
|
|
|
|||
|
|
//Seen in RaidenFTPD documentation
|
|||
|
|
//XCRC "[filename]" [start] [finish]
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'XSHA1'; {Do not translate}
|
|||
|
|
LCmd.OnCommand := CommandCheckSum;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 550;
|
|||
|
|
LCmd.Description.Text := 'Syntax: XSHA1 "[filename]" [start] [finish]'; {do not localize}
|
|||
|
|
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'XSHA256'; {Do not translate}
|
|||
|
|
LCmd.OnCommand := CommandCheckSum;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 550;
|
|||
|
|
LCmd.Description.Text := 'Syntax: XSHA256 "[filename]" [start] [finish]'; {do not localize}
|
|||
|
|
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'XSHA512'; {Do not translate}
|
|||
|
|
LCmd.OnCommand := CommandCheckSum;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 550;
|
|||
|
|
LCmd.HelpVisible := True;
|
|||
|
|
LCmd.Description.Text := 'Syntax: XSHA512 "[filename]" [start] [finish]'; {do not localize}
|
|||
|
|
|
|||
|
|
//commands from
|
|||
|
|
// draft-peterson-streamlined-ftp-command-extensions-01.txt
|
|||
|
|
//http://tools.ietf.org/html/draft-peterson-streamlined-ftp-command-extensions-01#section-2.4
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'AVBL'; {Do not localize}
|
|||
|
|
LCmd.OnCommand := CommandAVBL;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 500;
|
|||
|
|
LCmd.Description.Text := 'Syntax: AVBL [<sp> dirpath] (returns the number of '+
|
|||
|
|
'bytes available for uploading in the directory or current working directory)';
|
|||
|
|
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'DSIZ'; {Do not localize}
|
|||
|
|
LCmd.OnCommand := CommandDSIZ;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 500;
|
|||
|
|
LCmd.Description.Text := 'DSIZ [<sp> dirpath] (returns the number of bytes '+
|
|||
|
|
'in the directory or current working directory, including sub directories)';
|
|||
|
|
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'RMDA';
|
|||
|
|
LCmd.OnCommand := CommandRMDA;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 550;
|
|||
|
|
LCmd.Description.Text := 'RMDA <sp> pathname (deletes (removes) the '+
|
|||
|
|
'specified directory and it s contents)';
|
|||
|
|
|
|||
|
|
//informal but we might want to support this anyway
|
|||
|
|
//CLNT
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'CLNT'; {do not localize}
|
|||
|
|
LCmd.OnCommand := CommandCLNT;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 550;
|
|||
|
|
LCmd.NormalReply.SetReply(200, RSFTPClntNoted); {Do not Localize}
|
|||
|
|
LCmd.Description.Text := 'Syntax: CLNT<space><clientname>'; {do not localize}
|
|||
|
|
|
|||
|
|
//Informal - an old proposed solution to IPv6 support in FTP.
|
|||
|
|
//Mentioned at: http://cr.yp.to/ftp/retr.html
|
|||
|
|
//and supported by PureFTPD.
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'SPSV'; {do not localize}
|
|||
|
|
LCmd.OnCommand := CommandSPSV;
|
|||
|
|
LCmd.Description.Text := 'Syntax: SPSV (set server in passive mode)'; {do not localize}
|
|||
|
|
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'HOST'; {Do not localize}
|
|||
|
|
LCmd.OnCommand := CommandHOST;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 504;
|
|||
|
|
LCmd.Description.Text := 'Syntax: HOST <sp> domain (select a domain prior to logging in)'; {Do not localize}
|
|||
|
|
|
|||
|
|
//Note that these commands are mentioned in old RFC's
|
|||
|
|
//and we will not support them at all. The commands
|
|||
|
|
//were there because FTP was a predisessor of SMTP
|
|||
|
|
//These are from RFC 765
|
|||
|
|
//MLFL [<SP> <ident>] <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'MLFL'; {Do not Localize}
|
|||
|
|
LCmd.NormalReply.SetReply(502, IndyFormat(RSFTPCmdNotImplemented, ['MLFL'])); {Do not Localize}
|
|||
|
|
LCmd.HelpSuperScript := '*';
|
|||
|
|
LCmd.Description.Text := 'MLFL (mail file); unimplemented.'; {do not localize}
|
|||
|
|
|
|||
|
|
//MAIL [<SP> <ident>] <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'MAIL'; {Do not Localize}
|
|||
|
|
LCmd.NormalReply.SetReply(502, IndyFormat(RSFTPCmdNotImplemented, ['MAIL'])); {Do not Localize}
|
|||
|
|
LCmd.HelpSuperScript := '*';
|
|||
|
|
LCmd.Description.Text := 'MAIL (mail to user); unimplemented.'; {do not localize}
|
|||
|
|
|
|||
|
|
// MSND [<SP> <ident>] <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'MSND'; {Do not Localize}
|
|||
|
|
LCmd.NormalReply.SetReply(502, IndyFormat(RSFTPCmdNotImplemented, ['MSND'])); {Do not Localize}
|
|||
|
|
LCmd.HelpSuperScript := '*';
|
|||
|
|
LCmd.Description.Text := 'MSND (mail send to terminal); unimplemented.'; {do not localize}
|
|||
|
|
|
|||
|
|
// MSOM [<SP> <ident>] <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'MSOM'; {Do not Localize}
|
|||
|
|
LCmd.NormalReply.SetReply(502, IndyFormat(RSFTPCmdNotImplemented, ['MSOM'])); {Do not Localize}
|
|||
|
|
LCmd.HelpSuperScript := '*';
|
|||
|
|
LCmd.Description.Text := 'MSOM (mail send to terminal or mailbox); unimplemented.'; {do not localize}
|
|||
|
|
|
|||
|
|
// MSAM [<SP> <ident>] <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'MSAM'; {Do not Localize}
|
|||
|
|
LCmd.NormalReply.SetReply(502, IndyFormat(RSFTPCmdNotImplemented, ['MSAM'])); {Do not Localize}
|
|||
|
|
LCmd.HelpSuperScript := '*';
|
|||
|
|
LCmd.Description.Text := 'MSAM (mail send to terminal and mailbox); unimplemented.'; {do not localize}
|
|||
|
|
|
|||
|
|
// MRSQ [<SP> <scheme>] <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'MRSQ'; {Do not Localize}
|
|||
|
|
LCmd.NormalReply.SetReply(502, IndyFormat(RSFTPCmdNotImplemented, ['MRSQ'])); {Do not Localize}
|
|||
|
|
LCmd.HelpSuperScript := '*';
|
|||
|
|
LCmd.Description.Text := 'MRSQ (mail recipient scheme question); unimplemented.'; {do not localize}
|
|||
|
|
|
|||
|
|
// MRCP <SP> <ident> <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'MRCP'; {Do not Localize}
|
|||
|
|
LCmd.NormalReply.SetReply(502, IndyFormat(RSFTPCmdNotImplemented, ['MRCP'])); {Do not Localize}
|
|||
|
|
LCmd.HelpSuperScript := '*';
|
|||
|
|
LCmd.Description.Text := 'MRCP (mail recipient); unimplemented.'; {do not localize}
|
|||
|
|
//
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'HELP'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := COmmandHELP;
|
|||
|
|
LCmd.NormalReply.NumericCode := 214;
|
|||
|
|
LCmd.Description.Text := 'Syntax: HELP [ <sp> <string> ]'; {do not localize}
|
|||
|
|
|
|||
|
|
//We use a separate command handler collection for some things which are
|
|||
|
|
//valid durring the data connection.
|
|||
|
|
//ABOR <CRLF>
|
|||
|
|
LCmd := FDataChannelCommands.Add;
|
|||
|
|
LCmd.Command := 'ABOR'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandABOR;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 550;
|
|||
|
|
|
|||
|
|
//STAT [<SP> <pathname>] <CRLF>
|
|||
|
|
LCmd := FDataChannelCommands.Add;
|
|||
|
|
LCmd.Command := 'STAT'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandSTAT;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 450;
|
|||
|
|
|
|||
|
|
//This is for SITE commands to make it easy for the user to add their own site commands
|
|||
|
|
//as they wish
|
|||
|
|
//These are Unix site commands
|
|||
|
|
LCmd := FSITECommands.Add;
|
|||
|
|
LCmd.Command := 'HELP'; {Do not localize}
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 501;
|
|||
|
|
LCmd.OnCommand := CommandSiteHELP;
|
|||
|
|
LCmd.Description.Text := 'Syntax: SITE HELP [ <sp> <string> ]'; {do not localize}
|
|||
|
|
|
|||
|
|
//SITE ATTRIB<SP>Attribs<SP>FileName<CRLF>
|
|||
|
|
LCmd := FSITECommands.Add;
|
|||
|
|
LCmd.Command := 'ATTRIB'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandSiteATTRIB;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 501;
|
|||
|
|
LCmd.Description.Text := 'Syntax: SITE ATTRIB<SP>Attribs<SP>Filename'; {do not localize}
|
|||
|
|
|
|||
|
|
//SITE UMASK<SP>[mask]
|
|||
|
|
LCmd := FSITECommands.Add;
|
|||
|
|
LCmd.Command := 'UMASK'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandSiteUMASK;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 501;
|
|||
|
|
LCmd.Description.Text := 'Syntax: SITE UMASK'; {do not localize}
|
|||
|
|
//SITE CHMOD<SP>Permission numbers<SP>Filename<CRLF>
|
|||
|
|
LCmd := FSITECommands.Add;
|
|||
|
|
LCmd.Command := 'CHMOD'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandSiteCHMOD;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 501;
|
|||
|
|
LCmd.Description.Text := 'Syntax: SITE CHMOD<SP>Permission numbers<SP>Filename'; {do not localize}
|
|||
|
|
|
|||
|
|
//additional Unix server commands that aren't supported but should be supported, IMAO
|
|||
|
|
//SITE CHOWN<SP>Owner[:Group]<SP>Filename<CRLF>
|
|||
|
|
LCmd := FSITECommands.Add;
|
|||
|
|
LCmd.Command := 'CHOWN'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandSiteCHOWN;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 501;
|
|||
|
|
LCmd.Description.Text := 'Syntax: SITE CHOWN<SP>Owner[:Group]<SP>Filename<CRLF>'; {do not localize}
|
|||
|
|
|
|||
|
|
//SITE CHGRP<SP>Group<SP>Filename<CRLF>
|
|||
|
|
LCmd := FSITECommands.Add;
|
|||
|
|
LCmd.Command := 'CHGRP'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandSiteCHGRP;
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 501;
|
|||
|
|
LCmd.Description.Text := 'Syntax: SITE CHGRP<SP>Group<SP>Filename<CRLF>'; {do not localize}
|
|||
|
|
|
|||
|
|
//Microsoft IIS SITE commands
|
|||
|
|
//SITE DIRSTYLE
|
|||
|
|
LCmd := FSITECommands.Add;
|
|||
|
|
LCmd.Command := 'DIRSTYLE'; {Do not Localize}
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 501;
|
|||
|
|
LCmd.OnCommand := CommandSiteDIRSTYLE;
|
|||
|
|
LCmd.Description.Text := 'Syntax: SITE DIRSTYLE (toggle directory format)'; {do not localize}
|
|||
|
|
|
|||
|
|
//SITE ZONE
|
|||
|
|
LCmd := FSITECommands.Add;
|
|||
|
|
LCmd.Command := 'ZONE'; {Do not localize}
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 530;
|
|||
|
|
LCmd.OnCommand := CommandSiteZONE;
|
|||
|
|
LCmd.Description.Text := 'Syntax: SITE ZONE (returns the server offset from GMT)'; {do not localize}
|
|||
|
|
|
|||
|
|
//SITE UTIME
|
|||
|
|
LCmd := FSITECommands.Add;
|
|||
|
|
LCmd.Command := 'UTIME'; {Do not localize}
|
|||
|
|
LCmd.NormalReply.NumericCode := 200;
|
|||
|
|
LCmd.NormalReply.Text.Text := 'Date/time changed okay.';
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 530;
|
|||
|
|
LCmd.OnCommand := CommandSiteUTIME;
|
|||
|
|
LCmd.Description.Text :=
|
|||
|
|
'Syntax: SITE UTIME <file> <access-time> <modification-time> <creation time>'+CR+LF+ {do not localize}
|
|||
|
|
' Each timestamp must be in the format YYYYMMDDhhmmss'; {do not localize}
|
|||
|
|
|
|||
|
|
//OPTS MLST
|
|||
|
|
LCmd := FOPTSCommands.Add;
|
|||
|
|
LCmd.Command := 'MLST'; {Do not localize}
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 501;
|
|||
|
|
LCmd.OnCommand := CommandOptsMLST;
|
|||
|
|
|
|||
|
|
//OPTS MODE Z
|
|||
|
|
LCmd := FOPTSCommands.Add;
|
|||
|
|
LCmd.Command := 'MODE Z'; {Do not localize}
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 501;
|
|||
|
|
LCmd.OnCommand := CommandOptsMODEZ;
|
|||
|
|
|
|||
|
|
// OPTS UTF-8 <NLST>
|
|||
|
|
LCmd := FOPTSCommands.Add;
|
|||
|
|
LCmd.Command := 'UTF-8'; {Do not localize}
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 501;
|
|||
|
|
LCmd.NormalReply.NumericCode := 200;
|
|||
|
|
LCmd.OnCommand := CommandOptsUTF8;
|
|||
|
|
|
|||
|
|
// OPTS UTF8 <ON|OFF>
|
|||
|
|
LCmd := FOPTSCommands.Add;
|
|||
|
|
LCmd.Command := 'UTF8'; {Do not localize}
|
|||
|
|
LCmd.ExceptionReply.NumericCode := 501;
|
|||
|
|
LCmd.NormalReply.NumericCode := 200;
|
|||
|
|
LCmd.OnCommand := CommandOptsUTF8;
|
|||
|
|
|
|||
|
|
//XAUT <SP> <xor encrypted data> <CRLF>
|
|||
|
|
LCmd := CommandHandlers.Add;
|
|||
|
|
LCmd.Command := 'XAUT'; {Do not Localize}
|
|||
|
|
LCmd.OnCommand := CommandXAUT;
|
|||
|
|
LCmd.Description.Text := 'Syntax: XAUT <sp> 2 <sp> <encrypted username and password>'; {do not localize}
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.ContextCreated(AContext: TIdContext);
|
|||
|
|
var
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
begin
|
|||
|
|
LContext := (AContext as TIdFTPServerContext);
|
|||
|
|
LContext.Server := Self;
|
|||
|
|
//from Before run method
|
|||
|
|
LContext.FDataPort := 0;
|
|||
|
|
LContext.FPasswordAttempts := 0;
|
|||
|
|
LContext.FDataPortDenied := False;
|
|||
|
|
LContext.FUserSecurity.Assign(FTPSecurityOptions);
|
|||
|
|
if (DirFormat = ftpdfOSDependent) and (GOSType = otWindows) then begin
|
|||
|
|
LContext.MSDOSMode := True;
|
|||
|
|
end;
|
|||
|
|
//
|
|||
|
|
if mlsdUnixModes in FMLSDFacts then begin
|
|||
|
|
LContext.MLSOpts := LContext.MLSOpts + [UnixMODE];
|
|||
|
|
end;
|
|||
|
|
if mlsdUnixOwner in FMLSDFacts then begin
|
|||
|
|
LContext.MLSOpts := LContext.MLSOpts + [UnixOwner];
|
|||
|
|
end;
|
|||
|
|
if mlsdUnixGroup in FMLSDFacts then begin
|
|||
|
|
LContext.MLSOpts := LContext.MLSOpts + [UnixGroup];
|
|||
|
|
end;
|
|||
|
|
if mlsdFileCreationTime in FMLSDFacts then begin
|
|||
|
|
LContext.MLSOpts := LContext.MLSOpts + [CreateTime];
|
|||
|
|
end;
|
|||
|
|
if mlsdPerms in FMLSDFacts then begin
|
|||
|
|
LContext.MLSOpts := LContext.MLSOpts + [Perm];
|
|||
|
|
end;
|
|||
|
|
if mlsdUniqueID in FMLSDFacts then begin
|
|||
|
|
LContext.MLSOpts := LContext.MLSOpts + [Unique];
|
|||
|
|
end;
|
|||
|
|
if mlsdFileLastAccessTime in FMLSDFacts then begin
|
|||
|
|
LContext.MLSOpts := LContext.MLSOpts + [LastAccessTime];
|
|||
|
|
end;
|
|||
|
|
if mlsdWin32Attributes in FMLSDFacts then begin
|
|||
|
|
LContext.MLSOpts := LContext.MLSOpts + [WinAttribs];
|
|||
|
|
end;
|
|||
|
|
if mlsdWin32DriveType in FMLSDFacts then begin
|
|||
|
|
LContext.MLSOpts := LContext.MLSOpts + [WinDriveType];
|
|||
|
|
end;
|
|||
|
|
if mlstWin32DriveLabel in FMLSDFacts then begin
|
|||
|
|
LContext.MLSOpts := LContext.MLSOpts + [WinDriveLabel];
|
|||
|
|
end;
|
|||
|
|
//MS-DOS mode on for MS-DOS
|
|||
|
|
if FDirFormat = ftpdfDOS then begin
|
|||
|
|
LContext.FMSDOSMode := True;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
destructor TIdFTPServer.Destroy;
|
|||
|
|
begin
|
|||
|
|
FreeAndNil(FAnonymousAccounts);
|
|||
|
|
FreeAndNil(FFTPSecurityOptions);
|
|||
|
|
FreeAndNil(FOPTSCommands);
|
|||
|
|
FreeAndNil(FDataChannelCommands);
|
|||
|
|
FreeAndNil(FSITECommands);
|
|||
|
|
FreeAndNil(FReplyUnknownSITECommand);
|
|||
|
|
inherited Destroy;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.ListDirectory(ASender: TIdFTPServerContext; ADirectory: string;
|
|||
|
|
ADirContents: TStrings; ADetails: Boolean; const ACmd : String = 'LIST';
|
|||
|
|
const ASwitches : String = ''); {do not localize}
|
|||
|
|
var
|
|||
|
|
LDirectoryList: TIdFTPListOutput;
|
|||
|
|
LPathSep: string;
|
|||
|
|
LIsMLST: Boolean;
|
|||
|
|
// under ARC, convert a weak reference to a strong reference before working with it
|
|||
|
|
LFileSystem: TIdFTPBaseFilesystem;
|
|||
|
|
begin
|
|||
|
|
LIsMLST := PosInStrArray(ACmd, ['MLSD', 'MLST']) <> -1; {do not localize}
|
|||
|
|
if (FDirFormat = ftpdfCustom) and (not LIsMLST) then begin
|
|||
|
|
DoOnCustomListDirectory(ASender, ADirectory, ADirContents, ACmd, ASwitches);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
LFileSystem := FFTPFileSystem;
|
|||
|
|
if Assigned(FOnListDirectory) or Assigned(LFileSystem) then begin
|
|||
|
|
LDirectoryList := TIdFTPListOutput.Create;
|
|||
|
|
try
|
|||
|
|
case FDirFormat of
|
|||
|
|
ftpdfEPLF :
|
|||
|
|
LDirectoryList.DirFormat := doEPLF;
|
|||
|
|
ftpdfDOS :
|
|||
|
|
if ASender.FMSDOSMode then begin
|
|||
|
|
LDirectoryList.DirFormat := DoWin32;
|
|||
|
|
end else begin
|
|||
|
|
LDirectoryList.DirFormat := DoUnix;
|
|||
|
|
end;
|
|||
|
|
ftpdfOSDependent :
|
|||
|
|
if (GOSType = otWindows) and (ASender.FMSDOSMode) then begin
|
|||
|
|
LDirectoryList.DirFormat := DoWin32;
|
|||
|
|
end else begin
|
|||
|
|
LDirectoryList.DirFormat := DoUnix;
|
|||
|
|
end;
|
|||
|
|
else
|
|||
|
|
LDirectoryList.DirFormat := DoUnix;
|
|||
|
|
end;
|
|||
|
|
//someone might be using the STAT -l to get a dir without a data channel
|
|||
|
|
if IndyPos('l', ASwitches) > 0 then begin
|
|||
|
|
LDirectoryList.Switches := LDirectoryList.Switches + 'l';
|
|||
|
|
end;
|
|||
|
|
//we do things this way because the 'a' and 'T' swithces only make sense
|
|||
|
|
//when listing Unix dirs.
|
|||
|
|
if SupportTaDirSwitches(ASender) then begin
|
|||
|
|
if IndyPos('a', ASwitches) > 0 then begin
|
|||
|
|
LDirectoryList.Switches := LDirectoryList.Switches + 'a';
|
|||
|
|
end;
|
|||
|
|
if IndyPos('T', ASwitches) > 0 then begin
|
|||
|
|
LDirectoryList.Switches := LDirectoryList.Switches + 'T';
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
LDirectoryList.ExportTotalLine := True;
|
|||
|
|
LPathSep := '/'; {Do not Localize}
|
|||
|
|
if not TextEndsWith(ADirectory, LPathSep) then begin
|
|||
|
|
ADirectory := ADirectory + LPathSep;
|
|||
|
|
end;
|
|||
|
|
if Assigned(LFileSystem) then begin
|
|||
|
|
LFileSystem.ListDirectory(ASender, ADirectory, LDirectoryList, ACmd, ASwitches);
|
|||
|
|
end else begin
|
|||
|
|
FOnListDirectory(ASender, ADirectory, LDirectoryList, ACmd, ASwitches); // Event
|
|||
|
|
end;
|
|||
|
|
if LIsMLST then begin {Do not translate}
|
|||
|
|
LDirectoryList.MLISTOutputDir(ADirContents, ASender.MLSOpts);
|
|||
|
|
end
|
|||
|
|
else if ADetails then begin
|
|||
|
|
LDirectoryList.LISTOutputDir(ADirContents);
|
|||
|
|
end else begin
|
|||
|
|
LDirectoryList.NLISTOutputDir(ADirContents);
|
|||
|
|
end;
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(LDirectoryList);
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
raise EIdFTPServerNoOnListDirectory.Create(RSFTPNoOnDirEvent); {Do not Localize}
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.SetUserAccounts(const AValue: TIdCustomUserManager);
|
|||
|
|
var
|
|||
|
|
// under ARC, convert a weak reference to a strong reference before working with it
|
|||
|
|
LUserAccounts: TIdCustomUserManager;
|
|||
|
|
begin
|
|||
|
|
LUserAccounts := FUserAccounts;
|
|||
|
|
|
|||
|
|
if LUserAccounts <> AValue then begin
|
|||
|
|
// under ARC, all weak references to a freed object get nil'ed automatically
|
|||
|
|
|
|||
|
|
{$IFNDEF USE_OBJECT_ARC}
|
|||
|
|
if Assigned(LUserAccounts) then begin
|
|||
|
|
LUserAccounts.RemoveFreeNotification(Self);
|
|||
|
|
end;
|
|||
|
|
{$ENDIF}
|
|||
|
|
|
|||
|
|
FUserAccounts := AValue;
|
|||
|
|
|
|||
|
|
if Assigned(AValue) then begin
|
|||
|
|
{$IFNDEF USE_OBJECT_ARC}
|
|||
|
|
AValue.FreeNotification(Self);
|
|||
|
|
{$ENDIF}
|
|||
|
|
FOnUserAccount := nil;
|
|||
|
|
//XAUT can not work with an account manager that sends
|
|||
|
|
//a challange because that command is a USER/PASS rolled into
|
|||
|
|
//one command.
|
|||
|
|
if AValue.SendsChallange then begin
|
|||
|
|
FSupportXAUTH := False;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.SetFTPFileSystem(const AValue: TIdFTPBaseFileSystem);
|
|||
|
|
begin
|
|||
|
|
{$IFDEF USE_OBJECT_ARC}
|
|||
|
|
// under ARC, all weak references to a freed object get nil'ed automatically
|
|||
|
|
FFTPFileSystem := AValue;
|
|||
|
|
{$ELSE}
|
|||
|
|
if FFTPFileSystem <> AValue then begin
|
|||
|
|
if Assigned(FFTPFileSystem) then begin
|
|||
|
|
FFTPFileSystem.RemoveFreeNotification(Self);
|
|||
|
|
end;
|
|||
|
|
FFTPFileSystem := AValue;
|
|||
|
|
if Assigned(AValue) then begin
|
|||
|
|
AValue.FreeNotification(Self);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
{$ENDIF}
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.SetReplyUnknownSITECommand(AValue: TIdReply);
|
|||
|
|
begin
|
|||
|
|
FReplyUnknownSITECommand.Assign(AValue);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.SetSITECommands(AValue: TIdCommandHandlers);
|
|||
|
|
begin
|
|||
|
|
FSITECommands.Assign(AValue);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
// under ARC, all weak references to a freed object get nil'ed automatically
|
|||
|
|
{$IFNDEF USE_OBJECT_ARC}
|
|||
|
|
procedure TIdFTPServer.Notification(AComponent: TComponent; Operation: TOperation);
|
|||
|
|
begin
|
|||
|
|
if Operation = opRemove then begin
|
|||
|
|
if AComponent = FUserAccounts then begin
|
|||
|
|
FUserAccounts := nil;
|
|||
|
|
end
|
|||
|
|
else if AComponent = FFTPFileSystem then begin
|
|||
|
|
FFTPFileSystem := nil;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
inherited Notification(AComponent, Operation);
|
|||
|
|
end;
|
|||
|
|
{$ENDIF}
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.SetAnonymousAccounts(const AValue: TStrings);
|
|||
|
|
begin
|
|||
|
|
if Assigned(AValue) then begin
|
|||
|
|
FAnonymousAccounts.Assign(AValue);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.SetSupportXAUTH(AValue : Boolean);
|
|||
|
|
var
|
|||
|
|
// under ARC, convert a weak reference to a strong reference before working with it
|
|||
|
|
LUserAccounts: TIdCustomUserManager;
|
|||
|
|
begin
|
|||
|
|
if FSupportXAUTH <> AValue then begin
|
|||
|
|
LUserAccounts := FUserAccounts;
|
|||
|
|
if Assigned(LUserAccounts) then begin
|
|||
|
|
if LUserAccounts.SendsChallange then begin
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
FSupportXAUTH := AValue;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.ThreadException(AThread: TIdThread; AException: Exception);
|
|||
|
|
begin
|
|||
|
|
//we do not want to show an exception in a dialog-box
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
//Command Replies/Handling
|
|||
|
|
procedure TIdFTPServer.CommandUSER(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
LSafe: Boolean;
|
|||
|
|
LChallenge: String;
|
|||
|
|
LContext: TIdFTPServerContext;
|
|||
|
|
// under ARC, convert a weak reference to a strong reference before working with it
|
|||
|
|
LUserAccounts: TIdCustomUserManager;
|
|||
|
|
begin
|
|||
|
|
LChallenge := '';
|
|||
|
|
LContext := ASender.Context as TIdFTPServerContext;
|
|||
|
|
if (FUseTLS = utUseRequireTLS) and (LContext.AuthMechanism <> 'TLS') then begin {do not localize}
|
|||
|
|
DisconUser(ASender);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
LContext.Authenticated := False;
|
|||
|
|
if (FAnonymousAccounts.IndexOf(LowerCase(ASender.UnparsedParams)) >= 0) and AllowAnonymousLogin then begin
|
|||
|
|
LContext.UserType := utAnonymousUser;
|
|||
|
|
LContext.Username := ASender.UnparsedParams;
|
|||
|
|
ASender.Reply.SetReply(331, RSFTPAnonymousUserOkay);
|
|||
|
|
end else begin
|
|||
|
|
LContext.UserType := utNormalUser;
|
|||
|
|
if Length(ASender.UnparsedParams) > 0 then begin
|
|||
|
|
LContext.Username := ASender.UnparsedParams;
|
|||
|
|
LUserAccounts := FUserAccounts;
|
|||
|
|
if Assigned(LUserAccounts) then begin
|
|||
|
|
LChallenge := LUserAccounts.ChallengeUser(LSafe, LContext.Username);
|
|||
|
|
{$IFDEF USE_OBJECT_ARC}LUserAccounts := nil;{$ENDIF}
|
|||
|
|
if not LSafe then begin
|
|||
|
|
//we do this to prevent a potential race attack
|
|||
|
|
DisconUser(ASender);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
if LChallenge = '' then begin
|
|||
|
|
ASender.Reply.SetReply(331, RSFTPUserOkay);
|
|||
|
|
end else begin
|
|||
|
|
ASender.Reply.SetReply(331, LChallenge);
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
ASender.Reply.SetReply(332, RSFTPNeedAccountForLogin);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.AuthenticateUser(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
LValidated: Boolean;
|
|||
|
|
LContext: TIdFTPServerContext;
|
|||
|
|
// under ARC, convert a weak reference to a strong reference before working with it
|
|||
|
|
LUserAccounts: TIdCustomUserManager;
|
|||
|
|
begin
|
|||
|
|
LContext:= ASender.Context as TIdFTPServerContext;
|
|||
|
|
try
|
|||
|
|
LContext.FAuthenticated := False;
|
|||
|
|
case LContext.FUserType of
|
|||
|
|
utAnonymousUser:
|
|||
|
|
begin
|
|||
|
|
LValidated := Length(LContext.Password ) > 0;
|
|||
|
|
if FAnonymousPassStrictCheck and LValidated then begin
|
|||
|
|
LValidated := False;
|
|||
|
|
if FindFirstOf('@.', LContext.Password) > 0 then begin {Do not Localize}
|
|||
|
|
LValidated := True;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
if LValidated then begin
|
|||
|
|
LContext.FAuthenticated := True;
|
|||
|
|
ASender.Reply.SetReply(230, RSFTPAnonymousUserLogged);
|
|||
|
|
if Assigned(OnLoginSuccessBanner) then begin
|
|||
|
|
OnLoginSuccessBanner(LContext, ASender.Reply);
|
|||
|
|
ASender.Reply.SetReply(230, ASender.Reply.Text.Text);
|
|||
|
|
end;
|
|||
|
|
LContext.FPasswordAttempts := 0;
|
|||
|
|
end else begin
|
|||
|
|
LContext.FUserType := utNone;
|
|||
|
|
LContext.FAuthenticated := False;
|
|||
|
|
LContext.FPassword := ''; {Do not Localize}
|
|||
|
|
Inc(LContext.FPasswordAttempts);
|
|||
|
|
if LContext.UserSecurity.InvalidPassDelay > 0 then begin
|
|||
|
|
//Delay our error response to slow down a dictionary attack
|
|||
|
|
IndySleep(FFTPSecurityOptions.InvalidPassDelay);
|
|||
|
|
end;
|
|||
|
|
if (LContext.UserSecurity.PasswordAttempts > 0) and
|
|||
|
|
(LContext.FPasswordAttempts >= LContext.UserSecurity.PasswordAttempts) then begin
|
|||
|
|
DisconUser(ASender);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
ASender.Reply.SetReply(530, RSFTPUserNotLoggedIn);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
utNormalUser:
|
|||
|
|
begin
|
|||
|
|
LUserAccounts := FUserAccounts;
|
|||
|
|
if Assigned(LUserAccounts) then begin
|
|||
|
|
LContext.FAuthenticated := LUserAccounts.AuthenticateUser(LContext.FUsername, ASender.UnparsedParams);
|
|||
|
|
{$IFDEF USE_OBJECT_ARC}LUserAccounts := nil;{$ENDIF}
|
|||
|
|
if LContext.FAuthenticated then begin
|
|||
|
|
LContext.FPasswordAttempts := 0;
|
|||
|
|
ASender.Reply.SetReply(230, RSFTPUserLogged);
|
|||
|
|
end else begin
|
|||
|
|
LContext.FPassword := ''; {Do not Localize}
|
|||
|
|
Inc(LContext.FPasswordAttempts);
|
|||
|
|
if LContext.UserSecurity.InvalidPassDelay > 0 then begin
|
|||
|
|
//Delay our error response to slow down a dictionary attack
|
|||
|
|
IndySleep(LContext.UserSecurity.InvalidPassDelay);
|
|||
|
|
end;
|
|||
|
|
if (LContext.UserSecurity.PasswordAttempts > 0) and
|
|||
|
|
(LContext.FPasswordAttempts >= LContext.UserSecurity.PasswordAttempts) then
|
|||
|
|
begin
|
|||
|
|
//Max login attempts exceeded, close the connection
|
|||
|
|
DisconUser(ASender);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
ASender.Reply.SetReply(530, RSFTPUserNotLoggedIn);
|
|||
|
|
end;
|
|||
|
|
end
|
|||
|
|
else if Assigned(FOnUserLogin) then begin
|
|||
|
|
LValidated := False;
|
|||
|
|
FOnUserLogin(LContext, LContext.FUsername, LContext.Password, LValidated);
|
|||
|
|
LContext.FAuthenticated := LValidated;
|
|||
|
|
if LValidated then begin
|
|||
|
|
if (LContext.AccountNeeded = True) and Assigned(FOnUserAccount) then begin
|
|||
|
|
LContext.FAuthenticated := False;
|
|||
|
|
ASender.Reply.SetReply(332,'Need account for login.');
|
|||
|
|
Exit;
|
|||
|
|
end else begin
|
|||
|
|
LContext.FAuthenticated := LValidated;
|
|||
|
|
ASender.Reply.SetReply(230, RSFTPUserLogged);
|
|||
|
|
if Assigned(OnLoginSuccessBanner) then begin
|
|||
|
|
OnLoginSuccessBanner(LContext, ASender.Reply);
|
|||
|
|
ASender.Reply.SetReply(230, ASender.Reply.Text.Text);
|
|||
|
|
end;
|
|||
|
|
LContext.FPasswordAttempts := 0;
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
LContext.FPassword := ''; {Do not Localize}
|
|||
|
|
Inc(LContext.FPasswordAttempts);
|
|||
|
|
if (LContext.UserSecurity.PasswordAttempts > 0) and
|
|||
|
|
(LContext.FPasswordAttempts >= LContext.UserSecurity.PasswordAttempts) then begin
|
|||
|
|
//Max login attempts exceeded, close the connection
|
|||
|
|
DisconUser(ASender);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
ASender.Reply.SetReply(530, RSFTPUserNotLoggedIn);
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
//APR 020423
|
|||
|
|
ASender.Reply.SetReply(530, RSFTPUserNotLoggedIn); // user manager not found
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
else
|
|||
|
|
ASender.Reply.SetReply(503, RSFTPNeedLoginWithUser);
|
|||
|
|
end;//case
|
|||
|
|
except
|
|||
|
|
on E : Exception do begin
|
|||
|
|
ASender.Reply.SetReply(503, E.Message);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
//After login
|
|||
|
|
if LContext.FAuthenticated and Assigned(FOnAfterUserLogin) then begin
|
|||
|
|
FOnAfterUserLogin(LContext);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandPASS(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
LContext: TIdFTPServerContext;
|
|||
|
|
begin
|
|||
|
|
LContext:= ASender.Context as TIdFTPServerContext;
|
|||
|
|
if (FUseTLS = utUseRequireTLS) and (LContext.AuthMechanism <> 'TLS') then begin {do not localize}
|
|||
|
|
DisconUser(ASender);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
LContext.FAuthenticated := False;
|
|||
|
|
LContext.FPassword := ASender.UnparsedParams;
|
|||
|
|
AuthenticateUser(ASender);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandXAUT(ASender : TIdCommand);
|
|||
|
|
var
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
s : String;
|
|||
|
|
LPos : Integer;
|
|||
|
|
begin
|
|||
|
|
LContext := ASender.Context as TIdFTPServerContext;
|
|||
|
|
if (FUseTLS = utUseRequireTLS) and (LContext.AuthMechanism <> 'TLS') then begin {do not localize}
|
|||
|
|
DisconUser(ASender);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
LContext := ASender.Context as TIdFTPServerContext;
|
|||
|
|
s := ASender.UnparsedParams;
|
|||
|
|
s := IdFTPCommon.ExtractAutInfoFromXAUT(s, LContext.FXAUTKey );
|
|||
|
|
LPos := RPos(':',s);
|
|||
|
|
if LPos > 1 then begin
|
|||
|
|
LContext.Username := Copy(s,1,LPos - 1);
|
|||
|
|
s := Copy(s,LPos + 1,$FF);
|
|||
|
|
//for some reason, WS-FTP Pro likes to add the string "^vta4r2" to
|
|||
|
|
//the authentication information if you aren't using anonymous login.
|
|||
|
|
//I'm not sure what the significance of "^vta4r2" really is.
|
|||
|
|
// 1234567
|
|||
|
|
if TextEndsWith(s,'^vta4r2') then begin
|
|||
|
|
LContext.Password := Copy(s,1,Length(s)-7);
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
LContext.Username := s;
|
|||
|
|
LContext.Password := '';
|
|||
|
|
end;
|
|||
|
|
LContext.Authenticated := False;
|
|||
|
|
if (FAnonymousAccounts.IndexOf(LowerCase(ASender.UnparsedParams)) >= 0) and AllowAnonymousLogin then begin
|
|||
|
|
LContext.UserType := utAnonymousUser;
|
|||
|
|
end else begin
|
|||
|
|
LContext.UserType := utNormalUser;
|
|||
|
|
end;
|
|||
|
|
AuthenticateUser(ASender);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandACCT(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
LValidated : Boolean;
|
|||
|
|
begin
|
|||
|
|
LValidated := False;
|
|||
|
|
if Assigned(FOnUserAccount) then begin
|
|||
|
|
LContext := ASender.Context as TIdFTPServerContext;
|
|||
|
|
LContext.Account := ASender.UnparsedParams;
|
|||
|
|
FOnUserAccount(LContext,LContext.Username, LContext.Password, LContext.Account, LValidated);
|
|||
|
|
LContext.Authenticated := LValidated;
|
|||
|
|
if LValidated then begin
|
|||
|
|
LContext.AccountNeeded := False;
|
|||
|
|
ASender.Reply.SetReply(230, RSFTPUserLogged);
|
|||
|
|
if Assigned(OnLoginSuccessBanner) then begin
|
|||
|
|
OnLoginSuccessBanner(LContext, ASender.Reply);
|
|||
|
|
ASender.Reply.SetReply(230, ASender.Reply.Text.Text);
|
|||
|
|
LContext.PasswordAttempts := 0;
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
LContext.FPassword := ''; {Do not Localize}
|
|||
|
|
Inc(LContext.FPasswordAttempts);
|
|||
|
|
if (LContext.UserSecurity.PasswordAttempts > 0) and
|
|||
|
|
(LContext.FPasswordAttempts >= LContext.UserSecurity.PasswordAttempts) then begin
|
|||
|
|
//Max login attempts exceeded, close the connection
|
|||
|
|
DisconUser(ASender);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
ASender.Reply.SetReply(530, RSFTPUserNotLoggedIn);
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
ASender.Reply.SetReply(502, IndyFormat(RSFTPCmdNotImplemented, ['ACCT'])); {do not localize}
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandCWD(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
s: TIdFTPFileName;
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
// under ARC, convert a weak reference to a strong reference before working with it
|
|||
|
|
LFileSystem: TIdFTPBaseFilesystem;
|
|||
|
|
begin
|
|||
|
|
LContext := ASender.Context as TIdFTPServerContext;
|
|||
|
|
s := ASender.UnparsedParams;
|
|||
|
|
if LContext.IsAuthenticated(ASender) then begin
|
|||
|
|
s := IgnoreLastPathDelim(s);
|
|||
|
|
LFileSystem := FFTPFileSystem;
|
|||
|
|
if Assigned(OnChangeDirectory) or Assigned(LFileSystem) then begin
|
|||
|
|
if s = '..' then begin {do not localize}
|
|||
|
|
s := CDUPDir(LContext);
|
|||
|
|
end
|
|||
|
|
else if s = '.' then begin {do not localize}
|
|||
|
|
s := LContext.CurrentDir;
|
|||
|
|
end else begin
|
|||
|
|
s := DoProcessPath(LContext, s);
|
|||
|
|
end;
|
|||
|
|
s := RemoveDuplicatePathSyms(s);
|
|||
|
|
DoOnChangeDirectory(LContext, s);
|
|||
|
|
LContext.CurrentDir := s;
|
|||
|
|
CmdCommandSuccessful(ASender);
|
|||
|
|
end else begin
|
|||
|
|
CmdNotImplemented(ASender);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandCDUP(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
s: TIdFTPFileName;
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
// under ARC, convert a weak reference to a strong reference before working with it
|
|||
|
|
LFileSystem: TIdFTPBaseFileSystem;
|
|||
|
|
begin
|
|||
|
|
LContext := ASender.Context as TIdFTPServerContext;
|
|||
|
|
if LContext.IsAuthenticated(ASender) then begin
|
|||
|
|
s := CDUPDir(LContext);
|
|||
|
|
s := DoProcessPath(LContext, s);
|
|||
|
|
LFileSystem := FFTPFileSystem;
|
|||
|
|
if Assigned(FOnChangeDirectory) or Assigned(LFileSystem) then begin
|
|||
|
|
DoOnChangeDirectory(LContext, s);
|
|||
|
|
LContext.FCurrentDir := s;
|
|||
|
|
ASender.Reply.SetReply(250, IndyFormat(RSFTPCurrentDirectoryIs, [LContext.FCurrentDir]));
|
|||
|
|
end else begin
|
|||
|
|
CmdNotImplemented(ASender);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandREIN(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
LIO : TIdSSLIOHandlerSocketBase;
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
begin
|
|||
|
|
LContext := ASender.Context as TIdFTPServerContext;
|
|||
|
|
if LContext.IsAuthenticated(ASender) then begin
|
|||
|
|
LContext.ReInitialize;
|
|||
|
|
LContext.Connection.IOHandler.DefStringEncoding := IndyTextEncoding_8Bit;
|
|||
|
|
ASender.Reply.SetReply(220, RSFTPServiceOpen);
|
|||
|
|
if (FUseTLS in ExplicitTLSVals) then begin
|
|||
|
|
LIO := ASender.Context.Connection.IOHandler as TIdSSLIOHandlerSocketBase;
|
|||
|
|
if not LIO.PassThrough then begin
|
|||
|
|
LIO.Passthrough := True;
|
|||
|
|
end;
|
|||
|
|
LContext.FCCC := False;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandPORT(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
LLo, LHi : Integer;
|
|||
|
|
LPort: TIdPort;
|
|||
|
|
LParm, LIP : string;
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
LDataChannel: TIdTCPClient;
|
|||
|
|
begin
|
|||
|
|
LContext := ASender.Context as TIdFTPServerContext;
|
|||
|
|
if LContext.IsAuthenticated(ASender) then begin
|
|||
|
|
if LContext.FEPSVAll then begin
|
|||
|
|
ASender.Reply.SetReply(501, IndyFormat(RSFTPNotAllowedAfterEPSVAll, [ASender.CommandHandler.Command]));
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
if LContext.UserSecurity.BlockAllPORTTransfers then
|
|||
|
|
begin
|
|||
|
|
LContext.FDataPort := 0;
|
|||
|
|
LContext.FDataPortDenied := True;
|
|||
|
|
ASender.Reply.SetReply(502, RSFTPPORTDisabled);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
LContext.FPASV := False;
|
|||
|
|
LParm := ASender.UnparsedParams;
|
|||
|
|
LIP := ''; {Do not Localize}
|
|||
|
|
{ h1 }
|
|||
|
|
LIP := LIP + Fetch(LParm, ',') + '.'; {Do not Localize}
|
|||
|
|
{ h2 }
|
|||
|
|
LIP := LIP + Fetch(LParm, ',') + '.'; {Do not Localize}
|
|||
|
|
{ h3 }
|
|||
|
|
LIP := LIP + Fetch(LParm, ',') + '.'; {Do not Localize}
|
|||
|
|
{ h4 }
|
|||
|
|
LIP := LIP + Fetch(LParm, ','); {Do not Localize}
|
|||
|
|
{ p1 }
|
|||
|
|
LLo := IndyStrToInt(Fetch(LParm, ',')); {Do not Localize}
|
|||
|
|
{ p2 }
|
|||
|
|
LHi := IndyStrToInt(LParm);
|
|||
|
|
LPort := TIdPort((LLo * 256) + LHi);
|
|||
|
|
if LContext.UserSecurity.NoReservedRangePORT and
|
|||
|
|
((LPort > 0) and (LPort <= 1024)) then begin
|
|||
|
|
LContext.FDataPort := 0;
|
|||
|
|
LContext.FDataPortDenied := True;
|
|||
|
|
ASender.Reply.SetReply(504, RSFTPPORTRange);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
{//BGO}
|
|||
|
|
if LContext.UserSecurity.FRequirePORTFromSameIP and
|
|||
|
|
(LIP <> LContext.Binding.PeerIP) then begin
|
|||
|
|
LContext.FDataPort := 0;
|
|||
|
|
LContext.FDataPortDenied := True;
|
|||
|
|
ASender.Reply.SetReply(504, RSFTPSameIPAddress);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
{//BGO}
|
|||
|
|
LContext.CreateDataChannel(False);
|
|||
|
|
LDataChannel := TIdTCPClient(LContext.FDataChannel.FDataChannel);
|
|||
|
|
LDataChannel.Host := LIP;
|
|||
|
|
LDataChannel.Port := LPort;
|
|||
|
|
LDataChannel.IPVersion := Id_IPv4;
|
|||
|
|
LContext.FDataPort := LPort;
|
|||
|
|
LContext.FDataPortDenied := False;
|
|||
|
|
CmdCommandSuccessful(ASender, 200);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandPASV(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
LParam: string;
|
|||
|
|
LBPort: Word;
|
|||
|
|
LIPVersion : TIdIPVersion;
|
|||
|
|
begin
|
|||
|
|
//InternalPASV does all of the checking
|
|||
|
|
if InternalPASV(ASender, LParam, LBPort, LIPVersion) then begin
|
|||
|
|
DoOnPASVReply(TIdFTPServerContext(ASender.Context), LParam, LBPort, LIPVersion);
|
|||
|
|
LParam := ReplaceAll(LParam, '.', ','); {Do not Localize}
|
|||
|
|
LParam := LParam + ',' + IntToStr(LBPort div 256) + ',' + IntToStr(LBPort mod 256); {Do not Localize}
|
|||
|
|
ASender.Reply.SetReply(227, IndyFormat(RSFTPPassiveMode, [LParam]));
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandTYPE(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
s: string;
|
|||
|
|
begin
|
|||
|
|
LContext := ASender.Context as TIdFTPServerContext;
|
|||
|
|
if LContext.IsAuthenticated(ASender) then begin
|
|||
|
|
s := ASender.UnparsedParams;
|
|||
|
|
s := UpperCase(Fetch(s));
|
|||
|
|
if Length(s) = 1 then begin
|
|||
|
|
//Default data type is ASCII
|
|||
|
|
case s[1] of
|
|||
|
|
'A': LContext.FDataType := ftASCII; {Do not Localize}
|
|||
|
|
'I': LContext.FDataType := ftBinary; {Do not Localize}
|
|||
|
|
else Exit;
|
|||
|
|
end;
|
|||
|
|
ASender.Reply.SetReply(200, IndyFormat(RSFTPTYPEChanged, [s]));
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandSTRU(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
s: String;
|
|||
|
|
begin
|
|||
|
|
LContext := ASender.Context as TIdFTPServerContext;
|
|||
|
|
if LContext.IsAuthenticated(ASender) then begin
|
|||
|
|
s := ASender.UnparsedParams;
|
|||
|
|
s := UpperCase(Fetch(s));
|
|||
|
|
if Length(s) = 1 then begin
|
|||
|
|
//Default structure is file
|
|||
|
|
case s[1] of
|
|||
|
|
'F': LContext.FDataStruct := dsFile; {Do not Localize}
|
|||
|
|
'R': LContext.FDataStruct := dsRecord; {Do not Localize}
|
|||
|
|
'P': LContext.FDataStruct := dsPage; {Do not Localize}
|
|||
|
|
else Exit;
|
|||
|
|
end;
|
|||
|
|
ASender.Reply.SetReply(200, IndyFormat(RSFTPSTRUChanged, [s]));
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandMODE(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
s: String;
|
|||
|
|
begin
|
|||
|
|
LContext := TIdFTPServerContext(ASender.Context);
|
|||
|
|
if LContext.IsAuthenticated(ASender) then begin
|
|||
|
|
s := ASender.UnparsedParams;
|
|||
|
|
s := UpperCase(Fetch(s));
|
|||
|
|
if Length(s) = 1 then begin
|
|||
|
|
//Default data mode is stream
|
|||
|
|
case s[1] of
|
|||
|
|
'S' : //stream mode
|
|||
|
|
begin
|
|||
|
|
LContext.DataMode := dmStream;
|
|||
|
|
ASender.Reply.SetReply(200, IndyFormat(RSFTPMODEChanged, [s]));
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
'Z' : //deflate
|
|||
|
|
begin
|
|||
|
|
if Assigned(FCompressor) then begin
|
|||
|
|
LContext.DataMode := dmDeflate;
|
|||
|
|
ASender.Reply.SetReply(200, IndyFormat(RSFTPMODEChanged, [s]));
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
ASender.Reply.SetReply(504, RSFTPMODENotSupported);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandRETR(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
s: string;
|
|||
|
|
LStream: TStream;
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
// under ARC, convert a weak reference to a strong reference before working with it
|
|||
|
|
LFileSystem: TIdFTPBaseFileSystem;
|
|||
|
|
begin
|
|||
|
|
LContext := ASender.Context as TIdFTPServerContext;
|
|||
|
|
if LContext.IsAuthenticated(ASender) then begin
|
|||
|
|
if (not Assigned(LContext.FDataChannel)) or LContext.FDataPortDenied then begin
|
|||
|
|
ASender.Reply.SetReply(425, RSFTPCantOpenData);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
//TODO: Fix reference to /
|
|||
|
|
s := DoProcessPath(LContext, ASender.UnparsedParams);
|
|||
|
|
LFileSystem := FFTPFileSystem;
|
|||
|
|
if Assigned(FOnRetrieveFile) or Assigned(LFileSystem) then begin
|
|||
|
|
LStream := nil;
|
|||
|
|
try
|
|||
|
|
//some file stream creations can fail with an exception so
|
|||
|
|
//we need to handle this gracefully.
|
|||
|
|
if Assigned(LFileSystem) then begin
|
|||
|
|
LFileSystem.RetrieveFile(LContext, s, LStream)
|
|||
|
|
end else begin
|
|||
|
|
FOnRetrieveFile(LContext, s, LStream);
|
|||
|
|
end;
|
|||
|
|
except
|
|||
|
|
on E : Exception do begin
|
|||
|
|
LContext.KillDataChannel;
|
|||
|
|
ASender.Reply.SetReply(550, E.Message);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
if Assigned(LStream) then begin
|
|||
|
|
try
|
|||
|
|
LStream.Position := LContext.FRESTPos;
|
|||
|
|
LContext.FRESTPos := 0;
|
|||
|
|
//it should be safe to assume that the FDataChannel object exists because
|
|||
|
|
//we checked it earlier
|
|||
|
|
LContext.FDataChannel.FFtpOperation := ftpRetr;
|
|||
|
|
LContext.FDataChannel.FData := LStream;
|
|||
|
|
LContext.FDataChannel.OKReply.SetReply(226, RSFTPDataConnClosed);
|
|||
|
|
LContext.FDataChannel.ErrorReply.SetReply(426, RSFTPDataConnClosedAbnormally);
|
|||
|
|
ASender.Reply.SetReply(150, RSFTPDataConnToOpen);
|
|||
|
|
ASender.SendReply;
|
|||
|
|
DoDataChannelOperation(ASender, LContext.SSCNOn);
|
|||
|
|
finally
|
|||
|
|
LStream.Free;
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
//make sure the data connection is closed
|
|||
|
|
LContext.KillDataChannel;
|
|||
|
|
CmdFileActionAborted(ASender);
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
//make sure the data connection is closed
|
|||
|
|
LContext.KillDataChannel;
|
|||
|
|
CmdNotImplemented(ASender);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandSSAP(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
LStream: TStream;
|
|||
|
|
LTmp1: string;
|
|||
|
|
LAppend: Boolean;
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
// under ARC, convert a weak reference to a strong reference before working with it
|
|||
|
|
LFileSystem: TIdFTPBaseFileSystem;
|
|||
|
|
begin
|
|||
|
|
LContext := ASender.Context as TIdFTPServerContext;
|
|||
|
|
if LContext.IsAuthenticated(ASender) then begin
|
|||
|
|
if (not Assigned(LContext.FDataChannel)) or LContext.FDataPortDenied then begin
|
|||
|
|
ASender.Reply.SetReply(425, RSFTPCantOpenData);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
if TextIsSame(ASender.CommandHandler.Command, 'STOU') then begin {Do not Localize}
|
|||
|
|
LTmp1 := GetUniqueFileName('', 'Temp', ''); {Do not localize}
|
|||
|
|
//This is a standardized format
|
|||
|
|
ASender.Reply.SetReply(150, IndyFormat('FILE: %s', [LTmp1])); {Do not translate}
|
|||
|
|
end else begin
|
|||
|
|
LTmp1 := ASender.UnparsedParams;
|
|||
|
|
ASender.Reply.SetReply(150, RSFTPDataConnToOpen);
|
|||
|
|
end;
|
|||
|
|
LTmp1 := DoProcessPath(LContext, LTmp1);
|
|||
|
|
LAppend := TextIsSame(ASender.CommandHandler.Command, 'APPE'); {Do not Localize}
|
|||
|
|
|
|||
|
|
LFileSystem := FFTPFileSystem;
|
|||
|
|
if Assigned(FOnStoreFile) or Assigned(LFileSystem) then begin
|
|||
|
|
LStream := nil;
|
|||
|
|
try
|
|||
|
|
if Assigned(LFileSystem) then begin
|
|||
|
|
LFileSystem.StoreFile(LContext, LTmp1, LAppend, LStream);
|
|||
|
|
{$IFDEF USE_OBJECT_ARC}LFileSystem := nil;{$ENDIF}
|
|||
|
|
end else begin
|
|||
|
|
FOnStoreFile(LContext, LTmp1, LAppend, LStream);
|
|||
|
|
end;
|
|||
|
|
except
|
|||
|
|
on E : Exception do
|
|||
|
|
begin
|
|||
|
|
ASender.Reply.SetReply(550, E.Message);
|
|||
|
|
LContext.KillDataChannel;
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
if Assigned(LStream) then begin
|
|||
|
|
try
|
|||
|
|
//Issued previously by ALLO cmd
|
|||
|
|
if LContext.ALLOSize > 0 then begin
|
|||
|
|
LStream.Size := LContext.FALLOSize;
|
|||
|
|
end;
|
|||
|
|
if LAppend then begin
|
|||
|
|
LStream.Position := LStream.Size;
|
|||
|
|
end else begin
|
|||
|
|
LStream.Position := LContext.FRESTPos;
|
|||
|
|
LContext.FRESTPos := 0;
|
|||
|
|
end;
|
|||
|
|
{ Data transfer }
|
|||
|
|
//it should be safe to assume that the FDataChannel object exists because
|
|||
|
|
//we checked it earlier
|
|||
|
|
LContext.FDataChannel.FFtpOperation := ftpStor;
|
|||
|
|
LContext.FDataChannel.Data := LStream;
|
|||
|
|
LContext.FDataChannel.OKReply.SetReply(226, RSFTPDataConnClosed);
|
|||
|
|
LContext.FDataChannel.ErrorReply.SetReply(426, RSFTPDataConnClosedAbnormally);
|
|||
|
|
ASender.SendReply;
|
|||
|
|
DoDataChannelOperation(ASender, LContext.SSCNOn);
|
|||
|
|
finally
|
|||
|
|
LStream.Free;
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
//make sure the data connection is closed
|
|||
|
|
LContext.KillDataChannel;
|
|||
|
|
CmdFileActionAborted(ASender);
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
//make sure the data connection is closed
|
|||
|
|
LContext.KillDataChannel;
|
|||
|
|
CmdNotImplemented(ASender);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandALLO(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
LContext: TIdFTPServerContext;
|
|||
|
|
LALLOSize, s: string;
|
|||
|
|
begin
|
|||
|
|
LContext := TIdFTPServerContext(ASender.Context);
|
|||
|
|
if LContext.IsAuthenticated(ASender) then begin
|
|||
|
|
LALLOSize := '';
|
|||
|
|
if Length(ASender.UnparsedParams) > 0 then begin
|
|||
|
|
if TextStartsWith(ASender.UnparsedParams, 'R ') then begin {Do not localize}
|
|||
|
|
LALLOSize := TrimLeft(Copy(s, 3, MaxInt));
|
|||
|
|
end else begin
|
|||
|
|
LALLOSize := TrimLeft(ASender.UnparsedParams);
|
|||
|
|
end;
|
|||
|
|
LALLOSize := Fetch(LALLOSize);
|
|||
|
|
end;
|
|||
|
|
if LALLOSize <> '' then begin
|
|||
|
|
LContext.FALLOSize := IndyStrToInt(LALLOSize, 0);
|
|||
|
|
CmdCommandSuccessful(ASender, 200);
|
|||
|
|
end else begin
|
|||
|
|
ASender.Reply.SetReply(504, RSFTPInvalidForParam);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandREST(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
LContext: TIdFTPServerContext;
|
|||
|
|
begin
|
|||
|
|
LContext := TIdFTPServerContext(ASender.Context);
|
|||
|
|
if LContext.IsAuthenticated(ASender) then begin
|
|||
|
|
LContext.FRESTPos := IndyStrToInt(ASender.UnparsedParams, 0);
|
|||
|
|
ASender.Reply.SetReply(350, RSFTPFileActionPending);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandRNFR(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
LContext: TIdFTPServerContext;
|
|||
|
|
s: string;
|
|||
|
|
begin
|
|||
|
|
LContext := TIdFTPServerContext(ASender.Context);
|
|||
|
|
if LContext.IsAuthenticated(ASender) then begin
|
|||
|
|
s := ASender.UnparsedParams;
|
|||
|
|
if Assigned(FOnRenameFile) or Assigned(FTPFileSystem) then begin
|
|||
|
|
ASender.Reply.SetReply(350, RSFTPFileActionPending);
|
|||
|
|
LContext.FRNFR := DoProcessPath(TIdFTPServerContext(LContext), s);
|
|||
|
|
end else begin
|
|||
|
|
CmdNotImplemented(ASender);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandRNTO(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
s: string;
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
// under ARC, convert a weak reference to a strong reference before working with it
|
|||
|
|
LFileSystem: TIdFTPBaseFileSystem;
|
|||
|
|
begin
|
|||
|
|
LContext := ASender.Context as TIdFTPServerContext;
|
|||
|
|
if LContext.IsAuthenticated(ASender) then begin
|
|||
|
|
s := ASender.UnparsedParams;
|
|||
|
|
LFileSystem := FFTPFileSystem;
|
|||
|
|
if Assigned(LFileSystem) or Assigned(FOnRenameFile) then begin
|
|||
|
|
DoOnRenameFile(LContext, LContext.FRNFR, DoProcessPath(LContext, s));
|
|||
|
|
ASender.Reply.NumericCode := 250;
|
|||
|
|
end else begin
|
|||
|
|
CmdNotImplemented(ASender);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandABOR(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
LContext: TIdFTPServerContext;
|
|||
|
|
begin
|
|||
|
|
LContext := TIdFTPServerContext(ASender.Context);
|
|||
|
|
if LContext.IsAuthenticated(ASender) then begin
|
|||
|
|
if Assigned(LContext.FDataChannel) then begin
|
|||
|
|
if not LContext.FDataChannel.Stopped then begin
|
|||
|
|
LContext.FDataChannel.OkReply.SetReply(426, RSFTPDataConnClosedAbnormally);
|
|||
|
|
LContext.FDataChannel.ErrorReply.SetReply(426, RSFTPDataConnClosedAbnormally);
|
|||
|
|
LContext.KillDataChannel;
|
|||
|
|
ASender.Reply.SetReply(226, RSFTPDataConnClosed);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
CmdCommandSuccessful(ASender, 226);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandDELE(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
// under ARC, convert a weak reference to a strong reference before working with it
|
|||
|
|
LFileSystem: TIdFTPBaseFileSystem;
|
|||
|
|
(*
|
|||
|
|
DELE <SP> <pathname> <CRLF>
|
|||
|
|
250 Requested file action okay, completed.
|
|||
|
|
450 Requested file action not taken. - File is busy
|
|||
|
|
550 Requested action not taken. - File unavailable, no access permitted, etc
|
|||
|
|
500 Syntax error, command unrecognized.
|
|||
|
|
501 Syntax error in parameters or arguments.
|
|||
|
|
502 Command not implemented.
|
|||
|
|
421 Service not available, closing control connection. - During server shutdown, etc
|
|||
|
|
530 Not logged in.
|
|||
|
|
*)
|
|||
|
|
//TODO: Need to set replies when not authenticated and set NormalReply to 250
|
|||
|
|
// do for all procs, list valid replies in comments. Or maybe default is 550
|
|||
|
|
begin
|
|||
|
|
LContext := ASender.Context as TIdFTPServerContext;
|
|||
|
|
if LContext.IsAuthenticated(ASender) then begin
|
|||
|
|
LFileSystem := FTPFileSystem;
|
|||
|
|
if Assigned(FOnDeleteFile) or Assigned(LFileSystem) then begin
|
|||
|
|
DoOnDeleteFile(LContext, DoProcessPath(LContext, ASender.UnparsedParams));
|
|||
|
|
ASender.Reply.SetReply(250, RSFTPFileActionCompleted);
|
|||
|
|
end else begin
|
|||
|
|
CmdNotImplemented(ASender);
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
ASender.Reply.SetReply(550, RSFTPFileActionNotTaken);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandRMD(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
s: TIdFTPFileName;
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
// under ARC, convert a weak reference to a strong reference before working with it
|
|||
|
|
LFileSystem: TIdFTPBaseFileSystem;
|
|||
|
|
begin
|
|||
|
|
LContext := ASender.Context as TIdFTPServerContext;
|
|||
|
|
if LContext.IsAuthenticated(ASender) then begin
|
|||
|
|
S := IgnoreLastPathDelim(S);
|
|||
|
|
s := DoProcessPath(LContext, ASender.UnparsedParams);
|
|||
|
|
LFileSystem := FFTPFileSystem;
|
|||
|
|
if Assigned(LFileSystem) or Assigned(FOnRemoveDirectory) then begin
|
|||
|
|
DoOnRemoveDirectory(LContext, s);
|
|||
|
|
ASender.Reply.SetReply(250, RSFTPFileActionCompleted);
|
|||
|
|
end else begin
|
|||
|
|
CmdNotImplemented(ASender);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandMKD(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
S: TIdFTPFileName;
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
begin
|
|||
|
|
LContext := ASender.Context as TIdFTPServerContext;
|
|||
|
|
if LContext.IsAuthenticated(ASender) then begin
|
|||
|
|
S := IgnoreLastPathDelim(S);
|
|||
|
|
S := DoProcessPath(LContext, ASender.UnparsedParams);
|
|||
|
|
DoOnMakeDirectory(LContext, s);
|
|||
|
|
ASender.Reply.SetReply(257, RSFTPFileActionCompleted);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandPWD(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
LContext: TIdFTPServerContext;
|
|||
|
|
begin
|
|||
|
|
LContext := TIdFTPServerContext(ASender.Context);
|
|||
|
|
if LContext.IsAuthenticated(ASender) then begin
|
|||
|
|
ASender.Reply.SetReply(257, IndyFormat(RSFTPCurrentDirectoryIs, [LContext.FCurrentDir]));
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandLIST(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
LStream: TStringList;
|
|||
|
|
LSendData : Boolean;
|
|||
|
|
LPath, LSwitches : String;
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
|
|||
|
|
function DeletRSwitch(const AString : String): String;
|
|||
|
|
var
|
|||
|
|
i : Integer;
|
|||
|
|
begin
|
|||
|
|
Result := '';
|
|||
|
|
for i := 1 to Length(AString) do begin
|
|||
|
|
if AString[i] <> 'R' then begin
|
|||
|
|
Result := Result + AString[i];
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
begin
|
|||
|
|
LSendData := False;
|
|||
|
|
LContext := ASender.Context as TIdFTPServerContext;
|
|||
|
|
if LContext.IsAuthenticated(ASender) then begin
|
|||
|
|
if (not Assigned(LContext.FDataChannel)) or LContext.FDataPortDenied then begin
|
|||
|
|
ASender.Reply.SetReply(425, RSFTPCantOpenData);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
if (not Assigned(FOnListDirectory)) and
|
|||
|
|
((FDirFormat = ftpdfCustom) and (not Assigned(FOnCustomListDirectory))) then begin
|
|||
|
|
LContext.KillDataChannel;
|
|||
|
|
CmdNotImplemented(ASender);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
LStream := TStringList.Create;
|
|||
|
|
try
|
|||
|
|
LSwitches := '';
|
|||
|
|
LPath := ASender.UnparsedParams;
|
|||
|
|
if TextStartsWith(LPath, '-') then begin {Do not Localize}
|
|||
|
|
LSwitches := Fetch(LPath);
|
|||
|
|
end;
|
|||
|
|
//we can't support recursive lists with EPLF
|
|||
|
|
if DirFormat = ftpdfEPLF then begin
|
|||
|
|
LSwitches := DeletRSwitch(LSwitches);
|
|||
|
|
end;
|
|||
|
|
ListDirectory(LContext, DoProcessPath(LContext, LPath), LStream,
|
|||
|
|
TextIsSame(ASender.CommandHandler.Command, 'LIST'), ASender.CommandHandler.Command,
|
|||
|
|
LSwitches);
|
|||
|
|
LSendData := True;
|
|||
|
|
finally
|
|||
|
|
try
|
|||
|
|
if LSendData then begin
|
|||
|
|
//it should be safe to assume that the FDataChannel object exists because
|
|||
|
|
//we checked it earlier
|
|||
|
|
LContext.FDataChannel.Data := LStream;
|
|||
|
|
LContext.FDataChannel.FFtpOperation := ftpRetr;
|
|||
|
|
LContext.FDataChannel.OKReply.SetReply(226, RSFTPDataConnClosed);
|
|||
|
|
LContext.FDataChannel.ErrorReply.SetReply(426, RSFTPDataConnClosedAbnormally);
|
|||
|
|
if FDirFormat = ftpdfEPLF then begin
|
|||
|
|
ASender.Reply.SetReply(125, RSFTPDataConnToOpen);
|
|||
|
|
LContext.FDataChannel.OKReply.SetReply(226, RSFTPDataConnClosed);
|
|||
|
|
end
|
|||
|
|
else if TextIsSame(ASender.CommandHandler.Command, 'LIST') or (LSwitches <> '') then begin {do not localize}
|
|||
|
|
ASender.Reply.SetReply(125, RSFTPDataConnList);
|
|||
|
|
end else begin
|
|||
|
|
ASender.Reply.SetReply(125, RSFTPDataConnNList);
|
|||
|
|
end;
|
|||
|
|
ASender.SendReply;
|
|||
|
|
DoDataChannelOperation(ASender);
|
|||
|
|
end else begin
|
|||
|
|
LContext.KillDataChannel;
|
|||
|
|
ASender.Reply.SetReply(426, RSFTPDataConnClosedAbnormally);
|
|||
|
|
end;
|
|||
|
|
finally
|
|||
|
|
LStream.Free;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.DoDataChannelOperation(ASender: TIdCommand; const AConnectMode : Boolean = False);
|
|||
|
|
const
|
|||
|
|
DEF_BLOCKSIZE = 10*10240;
|
|||
|
|
{CH DEF_CHECKCMD_WAIT = 1; }
|
|||
|
|
var
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
LCmdQueue : TStringList;
|
|||
|
|
LLine : String;
|
|||
|
|
LStrm : TStream;
|
|||
|
|
|
|||
|
|
procedure CheckControlConnection(AContext : TIdFTPServerContext; ACmdQueue : TStrings);
|
|||
|
|
var
|
|||
|
|
LLocalLine : String;
|
|||
|
|
begin
|
|||
|
|
LLocalLine := ReadCommandLine(AContext);
|
|||
|
|
if LLocalLine <> '' then begin
|
|||
|
|
if not FDataChannelCommands.HandleCommand(AContext, LLocalLine) then begin
|
|||
|
|
ACmdQueue.Add(LLocalLine);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure ReadFromStream(AContext : TIdFTPServerContext; ACmdQueue : TStrings; ADestStream : TStream);
|
|||
|
|
var
|
|||
|
|
LM : TStream;
|
|||
|
|
begin
|
|||
|
|
if AContext.DataMode = dmDeflate then begin
|
|||
|
|
LM := TMemoryStream.Create;
|
|||
|
|
end else begin
|
|||
|
|
LM := ADestStream;
|
|||
|
|
end;
|
|||
|
|
try
|
|||
|
|
repeat
|
|||
|
|
AContext.FDataChannel.FDataChannel.IOHandler.CheckForDisconnect(False);
|
|||
|
|
AContext.FDataChannel.FDataChannel.IOHandler.ReadStream(LM, DEF_BLOCKSIZE, True);
|
|||
|
|
CheckControlConnection(AContext, ACmdQueue);
|
|||
|
|
until not AContext.FDataChannel.FDataChannel.IOHandler.Connected;
|
|||
|
|
if AContext.DataMode = dmDeflate then begin
|
|||
|
|
LM.Position := 0;
|
|||
|
|
FCompressor.DecompressFTPDeflate(LM, ADestStream, AContext.ZLibWindowBits);
|
|||
|
|
end;
|
|||
|
|
finally
|
|||
|
|
if AContext.DataMode = dmDeflate then begin
|
|||
|
|
FreeAndNil(LM);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure WriteToStream(AContext : TIdFTPServerContext; ACmdQueue : TStrings;
|
|||
|
|
ASrcStream : TStream; const AIgnoreCompression : Boolean = False);
|
|||
|
|
var
|
|||
|
|
LBufSize : TIdStreamSize;
|
|||
|
|
LOutStream : TStream;
|
|||
|
|
begin
|
|||
|
|
if AContext.DataMode = dmDeflate then begin
|
|||
|
|
LOutStream := TMemoryStream.Create;
|
|||
|
|
end else begin
|
|||
|
|
LOutStream := ASrcStream;
|
|||
|
|
end;
|
|||
|
|
try
|
|||
|
|
if AContext.DataMode = dmDeflate then begin
|
|||
|
|
FCompressor.CompressFTPDeflate(ASrcStream, LOutStream,
|
|||
|
|
AContext.ZLibCompressionLevel, AContext.ZLibWindowBits,
|
|||
|
|
AContext.ZLibMemLevel, AContext.ZLibStratagy);
|
|||
|
|
LOutStream.Position := 0;
|
|||
|
|
end;
|
|||
|
|
repeat
|
|||
|
|
LBufSize := LOutStream.Size - LOutStream.Position;
|
|||
|
|
if LBufSize > DEF_BLOCKSIZE then begin
|
|||
|
|
LBufSize := DEF_BLOCKSIZE;
|
|||
|
|
end;
|
|||
|
|
if LBufSize > 0 then begin
|
|||
|
|
AContext.FDataChannel.FDataChannel.IOHandler.Write(LOutStream, LBufSize, False);
|
|||
|
|
if LOutStream.Position < LOutStream.Size then begin
|
|||
|
|
CheckControlConnection(AContext, ACmdQueue);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
until (LBufSize = 0) or (not AContext.FDataChannel.FDataChannel.IOHandler.Connected);
|
|||
|
|
finally
|
|||
|
|
if AContext.DataMode = dmDeflate then begin
|
|||
|
|
FreeAndNil(LOutStream);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure WriteStrings(AContext : TIdFTPServerContext; ACmdQueue : TStrings; ASrcStrings : TStrings);
|
|||
|
|
var
|
|||
|
|
i : Integer;
|
|||
|
|
LM : TStream;
|
|||
|
|
LEncoding: IIdTextEncoding;
|
|||
|
|
begin
|
|||
|
|
//for loops will execute at least once triggering an out of range error.
|
|||
|
|
//write nothing if AStrings is empty.
|
|||
|
|
if ASrcStrings.Count < 1 then begin
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
{
|
|||
|
|
IMPORTANT!!!
|
|||
|
|
|
|||
|
|
If LIST data is sent as 8bit, you have a FTP list that is unparsable by
|
|||
|
|
some FTP clients. If UTF8 OPTS OFF, you should send the data as 7bit
|
|||
|
|
for the LIST and NLST commands. That way, unprintable charactors are
|
|||
|
|
returned as ?. While the file name is not valid, at least, there some
|
|||
|
|
thing that looks better than binary junk.
|
|||
|
|
}
|
|||
|
|
if PosInStrArray(ASender.CommandHandler.Command, ['LIST', 'NLST', 'MLSD'], False) > -1 then begin
|
|||
|
|
LEncoding := IndyTextEncoding(NLSTEncType[AContext.NLSTUtf8]);
|
|||
|
|
end else begin
|
|||
|
|
LEncoding := IndyTextEncoding_8Bit;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
if AContext.DataMode = dmDeflate then begin
|
|||
|
|
LM := TMemoryStream.Create;
|
|||
|
|
try
|
|||
|
|
for i := 0 to ASrcStrings.Count-1 do begin
|
|||
|
|
WriteStringToStream(LM, ASrcStrings[i] + EOL, LEncoding);
|
|||
|
|
end;
|
|||
|
|
LM.Position := 0;
|
|||
|
|
WriteToStream(AContext, ACmdQueue, LM, True);
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(LM);
|
|||
|
|
end;
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
for i := 0 to ASrcStrings.Count-1 do begin
|
|||
|
|
if AContext.FDataChannel.FDataChannel.IOHandler.Connected then begin
|
|||
|
|
AContext.FDataChannel.FDataChannel.IOHandler.WriteLn(ASrcStrings[i], LEncoding);
|
|||
|
|
if ((i mod 10) = 0) and (i <> (ASrcStrings.Count-1)) then begin
|
|||
|
|
if AContext.FDataChannel.FDataChannel.IOHandler.Connected then begin
|
|||
|
|
CheckControlConnection(AContext, ACmdQueue);
|
|||
|
|
end else begin
|
|||
|
|
Break;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
Break;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
begin
|
|||
|
|
if not Assigned(ASender) then begin
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
if not Assigned(ASender.Context) then begin
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
LContext := ASender.Context as TIdFTPServerContext;
|
|||
|
|
if not Assigned(LContext.FDataChannel) then begin
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
try
|
|||
|
|
LCmdQueue := TStringList.Create;
|
|||
|
|
try
|
|||
|
|
LContext.FDataChannel.InitOperation(AConnectMode);
|
|||
|
|
try
|
|||
|
|
try
|
|||
|
|
try
|
|||
|
|
if LContext.FDataChannel.Data is TStream then begin
|
|||
|
|
LStrm := TStream(LContext.FDataChannel.Data);
|
|||
|
|
case LContext.FDataChannel.FFtpOperation of
|
|||
|
|
ftpRetr:
|
|||
|
|
WriteToStream(LContext, LCmdQueue, LStrm);
|
|||
|
|
ftpStor:
|
|||
|
|
ReadFromStream(LContext, LCmdQueue, LStrm);
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
case LContext.FDataChannel.FFtpOperation of
|
|||
|
|
ftpRetr:
|
|||
|
|
if Assigned(LContext.FDataChannel.Data) then begin
|
|||
|
|
WriteStrings(LContext, LCmdQueue, LContext.FDataChannel.Data as TStrings);
|
|||
|
|
end;
|
|||
|
|
ftpStor:
|
|||
|
|
if Assigned(LContext.FDataChannel.Data) then begin
|
|||
|
|
LStrm := TMemoryStream.Create;
|
|||
|
|
try
|
|||
|
|
ReadFromStream(LContext, LCmdQueue, LStrm);
|
|||
|
|
//TODO;
|
|||
|
|
// SplitLines(TMemoryStream(LStrm).Memory, LMemStream.Size, LContext.FDataChannel.FData as TStrings);
|
|||
|
|
finally
|
|||
|
|
LStrm.Free;
|
|||
|
|
end;
|
|||
|
|
end;//ftpStor
|
|||
|
|
end;//case
|
|||
|
|
end;
|
|||
|
|
finally
|
|||
|
|
if Assigned(LContext.FDataChannel.FDataChannel) then begin
|
|||
|
|
LContext.FDataChannel.FDataChannel.Disconnect(False);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
LContext.FDataChannel.FReply.Assign(LContext.FDataChannel.FOKReply); //226
|
|||
|
|
except
|
|||
|
|
on E: Exception do begin
|
|||
|
|
if not (E is EIdSilentException) then begin
|
|||
|
|
LContext.FDataChannel.FReply.Assign(LContext.FDataChannel.FErrorReply); //426
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
finally
|
|||
|
|
ASender.Reply.Assign(LContext.FDataChannel.FReply);
|
|||
|
|
ASender.SendReply;
|
|||
|
|
//now we have to handle the FIFO queue we had made
|
|||
|
|
while LCmdQueue.Count > 0 do begin
|
|||
|
|
LLine := LCmdQueue[0];
|
|||
|
|
if not FCommandHandlers.HandleCommand(ASender.Context, LLine) then begin
|
|||
|
|
DoReplyUnknownCommand(ASender.Context, LLine);
|
|||
|
|
end;
|
|||
|
|
if Assigned(ASender.Context.Connection) then begin
|
|||
|
|
if not ASender.Context.Connection.Connected then begin
|
|||
|
|
Break;
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
Break;
|
|||
|
|
end;
|
|||
|
|
LCmdQueue.Delete(0);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(LCmdQueue);
|
|||
|
|
end;
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(LContext.FDataChannel);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandSYST(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
begin
|
|||
|
|
LContext := ASender.Context as TIdFTPServerContext;
|
|||
|
|
if LContext.UserSecurity.DisableSYSTCommand then begin
|
|||
|
|
CmdNotImplemented(ASender);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
//this should keep CuteFTP Pro 3.0 from stopping there's no custom ID and
|
|||
|
|
//the Dir format is custonm.
|
|||
|
|
if (FDirFormat = ftpdfCustom) and (Trim(FCustomSystID) = '') then begin
|
|||
|
|
CmdNotImplemented(ASender);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
if LContext.IsAuthenticated(ASender) then begin
|
|||
|
|
ASender.Reply.SetReply(215, DoSysType(LContext));
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandSTAT(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
LStream: TStringList;
|
|||
|
|
LActAsList: boolean;
|
|||
|
|
LSwitches, LPath : String;
|
|||
|
|
i : Integer;
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
begin
|
|||
|
|
LContext := ASender.Context as TIdFTPServerContext;
|
|||
|
|
LActAsList := (ASender.Params.Count > 0);
|
|||
|
|
if not LActAsList then begin
|
|||
|
|
if LContext.UserSecurity.DisableSTATCommand then begin
|
|||
|
|
if ASender.UnparsedParams = '' then begin
|
|||
|
|
CmdNotImplemented(ASender);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
if LContext.IsAuthenticated(ASender) then begin
|
|||
|
|
if Assigned(LContext.DataChannel) then begin
|
|||
|
|
if not LContext.DataChannel.Stopped then begin
|
|||
|
|
LActAsList := False;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
if not LActAsList then begin
|
|||
|
|
ASender.Reply.NumericCode := 211;
|
|||
|
|
ASender.Reply.Text.Clear;
|
|||
|
|
if Assigned(FOnStat) then begin
|
|||
|
|
LStream := TStringList.Create;
|
|||
|
|
try
|
|||
|
|
SetRFCReplyFormat(ASender.Reply);
|
|||
|
|
FOnStat(LContext, LStream);
|
|||
|
|
for i := 0 to LStream.Count - 1 do begin
|
|||
|
|
ASender.Reply.Text.Add(' ' + TrimLeft(LStream[i])); {Do not Localize}
|
|||
|
|
end;
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(LStream);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
ASender.Reply.Text.Insert(0,RSFTPCmdStartOfStat);
|
|||
|
|
ASender.Reply.Text.Add(RSFTPCmdEndOfStat);
|
|||
|
|
end else begin //else act as LIST command without a data channel
|
|||
|
|
LStream := TStringList.Create;
|
|||
|
|
try
|
|||
|
|
LSwitches := '';
|
|||
|
|
LPath := ASender.UnparsedParams;
|
|||
|
|
if TextStartsWith(LPath, '-') then begin
|
|||
|
|
LSwitches := Fetch(LPath);
|
|||
|
|
end;
|
|||
|
|
ListDirectory(LContext, DoProcessPath(LContext, LPath), LStream, True, LSwitches);
|
|||
|
|
//we use IOHandler.WriteLn here because we need better control over what
|
|||
|
|
//we send than what Reply.SendReply offers. This is important as the dir
|
|||
|
|
//is written using WriteStrings and I found that with Reply.SetReply, a stat
|
|||
|
|
//reply could throw off a FTP client.
|
|||
|
|
LContext.Connection.IOHandler.WriteLn(IndyFormat('213-%s', [RSFTPDataConnToOpen])); {Do not Localize}
|
|||
|
|
LContext.Connection.IOHandler.Write(LStream, False, IndyTextEncoding(NLSTEncType[LContext.NLSTUtf8]));
|
|||
|
|
ASender.PerformReply := True;
|
|||
|
|
ASender.Reply.SetReply(213, RSFTPCmdEndOfStat);
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(LStream);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandFEAT(ASender: TIdCommand);
|
|||
|
|
const
|
|||
|
|
MFFPREFIX = 'MFF '; {Do not Localize}
|
|||
|
|
var
|
|||
|
|
LTmp : String;
|
|||
|
|
LContext: TIdFTPServerContext;
|
|||
|
|
// under ARC, convert a weak reference to a strong reference before working with it
|
|||
|
|
LFileSystem: TIdFTPBaseFileSystem;
|
|||
|
|
begin
|
|||
|
|
LContext := TIdFTPServerContext(ASender.Context);
|
|||
|
|
LFileSystem := FTPFileSystem;
|
|||
|
|
ASender.Reply.Clear;
|
|||
|
|
SetRFCReplyFormat(ASender.Reply);
|
|||
|
|
ASender.Reply.NumericCode := 211;
|
|||
|
|
ASender.Reply.Text.Add(RSFTPCmdExtsSupportedStart); {Do not translate}
|
|||
|
|
//AUTH
|
|||
|
|
if IOHandler is TIdServerIOHandlerSSLBase then begin
|
|||
|
|
if (FUseTLS <> utUseImplicitTLS) then begin
|
|||
|
|
ASender.Reply.Text.Add('AUTH TLS;AUTH TLS-C;SSL;TLS-P;'); {Do not translate}
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
//AVBL
|
|||
|
|
if Assigned(FOnAvailDiskSpace) then begin
|
|||
|
|
ASender.Reply.Text.Add('AVBL');
|
|||
|
|
end;
|
|||
|
|
//CCC
|
|||
|
|
if (FUseTLS <> utNoTLSSupport) then begin
|
|||
|
|
ASender.Reply.Text.Add('CCC'); {Do not translate}
|
|||
|
|
end;
|
|||
|
|
//CLNT
|
|||
|
|
if Assigned(FOnClientID) then begin
|
|||
|
|
ASender.Reply.Text.Add('CLNT'); {Do not translate}
|
|||
|
|
end;
|
|||
|
|
//COMB
|
|||
|
|
if Assigned(FOnCombineFiles) or Assigned(LFileSystem) then begin
|
|||
|
|
ASender.Reply.Text.Add('COMB target;source_list'); {Do not translate}
|
|||
|
|
end;
|
|||
|
|
//CPSV
|
|||
|
|
//CPSV is not supported in IPv6 - same problem as PASV
|
|||
|
|
if (UseTLS <> utNoTLSSupport) and (LContext.Binding.IPVersion = Id_IPv4) then begin
|
|||
|
|
ASender.Reply.Text.Add('CPSV'); {Do not translate}
|
|||
|
|
end;
|
|||
|
|
//DSIZ
|
|||
|
|
if Assigned(OnCompleteDirSize) then begin
|
|||
|
|
ASender.Reply.Text.Add('DSIZ'); {Do not localize}
|
|||
|
|
end;
|
|||
|
|
//EPRT
|
|||
|
|
ASender.Reply.Text.Add('EPRT'); {Do not translate}
|
|||
|
|
//EPSV
|
|||
|
|
ASender.Reply.Text.Add('EPSV'); {Do not translate}
|
|||
|
|
//Host
|
|||
|
|
if Assigned(FOnHostCheck) then begin
|
|||
|
|
ASender.Reply.Text.Add('HOST domain'); {Do not localize}
|
|||
|
|
end;
|
|||
|
|
//
|
|||
|
|
//This is not proper but FTP Voyager uses it to determine if the -T parameter
|
|||
|
|
//will work.
|
|||
|
|
if Assigned(FOnListDirectory) then begin
|
|||
|
|
//we do things this way because the 'a' and 'T' swithces only make sense
|
|||
|
|
//when listing Unix dirs.
|
|||
|
|
LTmp := 'LIST -l'; {Do not translate}
|
|||
|
|
if SupportTaDirSwitches(LContext) then begin
|
|||
|
|
LTmp := LTmp + 'aT'; {Do not translate}
|
|||
|
|
end;
|
|||
|
|
ASender.Reply.Text.Add(LTmp); {do not localize}
|
|||
|
|
end;
|
|||
|
|
//MDTM
|
|||
|
|
if Assigned(FOnGetFileDate) or Assigned(LFileSystem) then begin
|
|||
|
|
ASender.Reply.Text.Add('MDTM'); {Do not translate}
|
|||
|
|
//MDTM YYYYMMDDHHMMSS filename
|
|||
|
|
if Assigned(FOnSetModifiedTime) then begin
|
|||
|
|
// ASender.Reply.Text.Add('MDTM YYYYMMDDHHMMSS[+-TZ];filename');
|
|||
|
|
//Indicate that we wish to use FTP Voyager's old MDTM variation for seting time.
|
|||
|
|
//time is returned as local (relative to server's timezone. We do this for compatibility
|
|||
|
|
ASender.Reply.Text.Add('MDTM YYYYMMDDHHMMSS filename'); {Do not translate}
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
//MFCT
|
|||
|
|
if Assigned(FOnSetCreationTime) then begin
|
|||
|
|
ASender.Reply.Text.Add('MFCT'); {Do not Localize}
|
|||
|
|
//TODO: The logic for the MMF entry may need to change if we
|
|||
|
|
//support modifying more facts
|
|||
|
|
end;
|
|||
|
|
//MFF
|
|||
|
|
LTmp := MFFPREFIX; {Do not localize}
|
|||
|
|
if Assigned(FOnSetCreationTime) and (mlsdFileLastAccessTime in FMLSDFacts) then begin
|
|||
|
|
LTmp := LTmp + 'Create;'; {Do not Localize}
|
|||
|
|
end;
|
|||
|
|
if Assigned(FOnSetModifiedTime) or Assigned(LFileSystem) then begin
|
|||
|
|
LTmp := LTmp + 'Modify;'; {Do not Localize}
|
|||
|
|
end;
|
|||
|
|
if Assigned(FOnSiteCHMOD) then begin
|
|||
|
|
LTmp := LTmp + 'Unix.mode;';
|
|||
|
|
end;
|
|||
|
|
if Assigned(FOnSiteCHOWN) then begin
|
|||
|
|
LTmp := LTmp + 'Unix.owner;';
|
|||
|
|
end;
|
|||
|
|
if Assigned(FOnSiteCHGRP) then begin
|
|||
|
|
LTmp := LTmp + 'Unix.group;';
|
|||
|
|
end;
|
|||
|
|
if Assigned(FOnSiteUTIME) and (mlsdFileLastAccessTime in FMLSDFacts) then begin
|
|||
|
|
LTmp := LTmp + 'Windows.lastaccesstime;';
|
|||
|
|
end;
|
|||
|
|
if Assigned(FOnSetATTRIB) then begin
|
|||
|
|
LTmp := LTmp + 'Win32.ea;';
|
|||
|
|
end;
|
|||
|
|
if LTmp <> MFFPREFIX then begin
|
|||
|
|
ASender.Reply.Text.Add(LTmp);
|
|||
|
|
end;
|
|||
|
|
//MFMT
|
|||
|
|
if Assigned(FOnSetModifiedTime) or Assigned(LFileSystem) then begin
|
|||
|
|
ASender.Reply.Text.Add('MFMT'); {Do not Localize}
|
|||
|
|
end;
|
|||
|
|
//MLST
|
|||
|
|
if Assigned(FOnListDirectory) then begin
|
|||
|
|
ASender.Reply.Text.Add('MLSD'); {Do not translate}
|
|||
|
|
ASender.Reply.Text.Add(MLSFEATLine(FMLSDFacts, LContext.MLSOpts)); {Do not translate}
|
|||
|
|
end;
|
|||
|
|
//MODE Z
|
|||
|
|
if Assigned(FCompressor) then begin
|
|||
|
|
ASender.Reply.Text.Add('MODE Z'); {do not localize}
|
|||
|
|
end;
|
|||
|
|
//OPTS
|
|||
|
|
LTmp := 'OPTS ';
|
|||
|
|
if Assigned(FOnListDirectory) then begin
|
|||
|
|
LTmp := LTmp + 'MLST;';
|
|||
|
|
end;
|
|||
|
|
if Assigned(FCompressor) then begin
|
|||
|
|
LTmp := LTmp + 'MODE;';
|
|||
|
|
end;
|
|||
|
|
LTmp := LTmp + 'UTF8';
|
|||
|
|
ASender.Reply.Text.Add(LTmp);
|
|||
|
|
//PBSZ
|
|||
|
|
if (FUseTLS <> utNoTLSSupport) then begin
|
|||
|
|
ASender.Reply.Text.Add('PBSZ'); {Do not translate}
|
|||
|
|
end;
|
|||
|
|
//PROT
|
|||
|
|
if (FUseTLS <> utNoTLSSupport) then begin
|
|||
|
|
ASender.Reply.Text.Add('PROT'); {Do not translate}
|
|||
|
|
end;
|
|||
|
|
//REST STREAM
|
|||
|
|
ASender.Reply.Text.Add('REST STREAM'); {Do not translate}
|
|||
|
|
//RMDA
|
|||
|
|
if Assigned(FOnRemoveDirectoryAll) then begin
|
|||
|
|
ASender.Reply.Text.Add('RMDA directoryname'); {Do not localize}
|
|||
|
|
end;
|
|||
|
|
//SITE ZONE
|
|||
|
|
//Listing a SITE command in feature negotiation is unusual and
|
|||
|
|
//may be a little off-spec. FTP Voyager scans this looking for
|
|||
|
|
//SITE ZONE and if it's present, it will use the SITE ZONE
|
|||
|
|
//to help it convert the time to the user's local time zone.
|
|||
|
|
//The only other way that FTP Voyager would know is if the initial
|
|||
|
|
//FTP greeting banner started with "Serv-U FTP-Server v2.5f" which
|
|||
|
|
//is more problematic because Serve-U is a trademark and we would then
|
|||
|
|
//then be stuck with a situation where everyone has to use it down the road.
|
|||
|
|
//This would amount to the same mess we had with "Mozilla" in the HTTP
|
|||
|
|
//User-Agent header field.
|
|||
|
|
//also list other supported site commands;
|
|||
|
|
LTmp := 'SITE ZONE';
|
|||
|
|
if Assigned(FOnSetATTRIB) then begin
|
|||
|
|
LTmp := LTmp + ';ATTRIB';
|
|||
|
|
end;
|
|||
|
|
if Assigned(FOnSiteUMASK) then begin
|
|||
|
|
LTmp := LTmp + 'UMASK';
|
|||
|
|
end;
|
|||
|
|
if Assigned(FOnSiteCHMOD) then begin
|
|||
|
|
LTmp := LTmp + ';CHMOD';
|
|||
|
|
end;
|
|||
|
|
if (FDirFormat = ftpdfDOS) or
|
|||
|
|
((FDirFormat = ftpdfOSDependent) and (GOSType = otWindows)) then begin
|
|||
|
|
LTmp := LTmp + ';DIRSTYLE';
|
|||
|
|
end;
|
|||
|
|
if Assigned(OnSiteUTIME) or Assigned(OnSetModifiedTime) then begin
|
|||
|
|
LTmp := LTmp + ';UTIME';
|
|||
|
|
end;
|
|||
|
|
if Assigned(OnSiteCHOWN) then begin
|
|||
|
|
LTmp := LTmp + ';CHOWN';
|
|||
|
|
end;
|
|||
|
|
if Assigned(OnSiteCHGRP) then begin
|
|||
|
|
LTmp := LTmp + ';CHGRP';
|
|||
|
|
end;
|
|||
|
|
ASender.Reply.Text.Add(LTmp); {do not localize}
|
|||
|
|
//SIZE
|
|||
|
|
if Assigned(FOnGetFileSize) or Assigned(LFileSystem) then begin
|
|||
|
|
ASender.Reply.Text.Add('SIZE'); {do not localize}
|
|||
|
|
end;
|
|||
|
|
//SPSV
|
|||
|
|
ASender.Reply.Text.Add('SPSV'); {do not localize}
|
|||
|
|
//SSCN
|
|||
|
|
if UseTLS <> utNoTLSSupport then begin
|
|||
|
|
ASender.Reply.Text.Add('SSCN'); {do not localize}
|
|||
|
|
end;
|
|||
|
|
//STAT -l
|
|||
|
|
//Some servers such as Microsoft FTP Service, RaidenFTPD, and a few others,
|
|||
|
|
//treat a STAT -l as a LIST command, only it's sent on the control connection.
|
|||
|
|
//Some versions of Flash FXP can also use this as an option to improve efficiency.
|
|||
|
|
if Assigned(FOnListDirectory) then begin
|
|||
|
|
//we do things this way because the 'a' and 'T' swithces only make sense
|
|||
|
|
//when listing Unix dirs.
|
|||
|
|
LTmp := 'STAT -l'; {Do not translate}
|
|||
|
|
if SupportTaDirSwitches(LContext) then begin
|
|||
|
|
LTmp := LTmp + 'aT'; {Do not translate}
|
|||
|
|
end;
|
|||
|
|
ASender.Reply.Text.Add(LTmp); {do not localize}
|
|||
|
|
end;
|
|||
|
|
//TVFS
|
|||
|
|
if FPathProcessing <> ftppCustom then begin
|
|||
|
|
//TVFS should not be indicated for custom parsing because
|
|||
|
|
//we don't know what a person will do.
|
|||
|
|
ASender.Reply.Text.Add('TVFS'); {Do not localize}
|
|||
|
|
end;
|
|||
|
|
// UTF-8
|
|||
|
|
// RFC 2640 says that "Servers MUST support the UTF-8 feature in response to the FEAT command [RFC2389]."
|
|||
|
|
// TODO: finish actually implementing UTF-8 support
|
|||
|
|
ASender.Reply.Text.Add('UTF8'); {Do not localize}
|
|||
|
|
//XCRC
|
|||
|
|
if Assigned(FOnCRCFile) or Assigned(LFileSystem) then begin
|
|||
|
|
if not GetFIPSMode then begin
|
|||
|
|
ASender.Reply.Text.Add('XCRC "filename" SP EP');//filename;start;end'); {Do not Localize}
|
|||
|
|
ASender.Reply.Text.Add('XMD5 "filename" SP EP');//filename;start;end'); {Do not Localize}
|
|||
|
|
end;
|
|||
|
|
ASender.Reply.Text.Add('XSHA1 "filename" SP EP');//filename;start;end'); {Do not Localize}
|
|||
|
|
|
|||
|
|
if TIdHashSHA256.IsAvailable then begin
|
|||
|
|
ASender.Reply.Text.Add('XSHA256 "filename" SP EP'); //file;start/end
|
|||
|
|
end;
|
|||
|
|
if TIdHashSHA512.IsAvailable then begin
|
|||
|
|
ASender.Reply.Text.Add('XSHA512 "filename" SP EP'); //file;start/end
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
//I'm doing things this way with complience level to match the current
|
|||
|
|
//version of NcFTPD
|
|||
|
|
LTmp := 'RFC 959 2389 ';
|
|||
|
|
if LContext.UserSecurity.FInvalidPassDelay <> 0 then begin
|
|||
|
|
LTmp := LTmp + '2577 ';
|
|||
|
|
end;
|
|||
|
|
LTmp := LTmp + '3659 '; {Do not Localize}
|
|||
|
|
if IOHandler is TIdServerIOHandlerSSLBase then begin
|
|||
|
|
if (FUseTLS <> utUseImplicitTLS) then begin
|
|||
|
|
LTmp := LTmp + '4217 '; {Do not localize}
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
ASender.Reply.Text.Add(Trim(LTmp)); {Do not Localize}
|
|||
|
|
ASender.Reply.Text.Add(RSFTPCmdExtsSupportedEnd);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandOPTS(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
LCmd : String;
|
|||
|
|
begin
|
|||
|
|
LCmd := ASender.UnparsedParams;
|
|||
|
|
ASender.Reply.Clear;
|
|||
|
|
if TextIsSame(Fetch(LCmd, ' ', False), 'MLST') then begin {do not localize}
|
|||
|
|
//just in case the user doesn't create a ListDirectory event.
|
|||
|
|
if not Assigned(FOnListDirectory) then begin
|
|||
|
|
ASender.Reply.SetReply(501, RSFTPOptNotRecog);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
if not FOPTSCommands.HandleCommand(ASender.Context, LCmd) then begin
|
|||
|
|
ASender.Reply.SetReply(501, RSFTPOptNotRecog);
|
|||
|
|
end else begin
|
|||
|
|
//we don't want an extra 200 reply.
|
|||
|
|
ASender.PerformReply := False;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandSIZE(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
s: string;
|
|||
|
|
LSize: Int64;
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
// under ARC, convert a weak reference to a strong reference before working with it
|
|||
|
|
LFileSystem: TIdFTPBaseFileSystem;
|
|||
|
|
begin
|
|||
|
|
LContext := ASender.Context as TIdFTPServerContext;
|
|||
|
|
if LContext.IsAuthenticated(ASender) then begin
|
|||
|
|
LFileSystem := FFTPFileSystem;
|
|||
|
|
if Assigned(FOnGetFileSize) or Assigned(LFileSystem) then begin
|
|||
|
|
LSize := -1;
|
|||
|
|
s := DoProcessPath(LContext, ASender.UnparsedParams);
|
|||
|
|
DoOnGetFileSize(LContext, s, LSize);
|
|||
|
|
if LSize > -1 then begin
|
|||
|
|
ASender.Reply.SetReply(213, IntToStr(LSize));
|
|||
|
|
end else begin
|
|||
|
|
CmdFileActionAborted(ASender);
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
CmdSyntaxError(ASender);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.DoOnChangeDirectory(AContext: TIdFTPServerContext; var VDirectory: TIdFTPFileName);
|
|||
|
|
var
|
|||
|
|
// under ARC, convert a weak reference to a strong reference before working with it
|
|||
|
|
LFileSystem: TIdFTPBaseFileSystem;
|
|||
|
|
begin
|
|||
|
|
LFileSystem := FFTPFileSystem;
|
|||
|
|
if Assigned(LFileSystem) then begin
|
|||
|
|
LFileSystem.ChangeDir(AContext, VDirectory);
|
|||
|
|
end else if Assigned(FOnChangeDirectory) then begin
|
|||
|
|
FOnChangeDirectory(AContext, VDirectory);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.DoOnRemoveDirectory(AContext: TIdFTPServerContext; var VDirectory: TIdFTPFileName);
|
|||
|
|
var
|
|||
|
|
// under ARC, convert a weak reference to a strong reference before working with it
|
|||
|
|
LFileSystem: TIdFTPBaseFileSystem;
|
|||
|
|
begin
|
|||
|
|
LFileSystem := FFTPFileSystem;
|
|||
|
|
if Assigned(LFileSystem) then begin
|
|||
|
|
LFileSystem.RemoveDirectory(AContext, VDirectory);
|
|||
|
|
end else if Assigned(FOnRemoveDirectory) then begin
|
|||
|
|
FOnRemoveDirectory(AContext, VDirectory);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.DoOnMakeDirectory(AContext: TIdFTPServerContext; var VDirectory: TIdFTPFileName);
|
|||
|
|
var
|
|||
|
|
// under ARC, convert a weak reference to a strong reference before working with it
|
|||
|
|
LFileSystem: TIdFTPBaseFileSystem;
|
|||
|
|
begin
|
|||
|
|
LFileSystem := FFTPFileSystem;
|
|||
|
|
if Assigned(LFileSystem) then begin
|
|||
|
|
LFileSystem.MakeDirectory(AContext, VDirectory);
|
|||
|
|
end else if Assigned(FOnMakeDirectory) then begin
|
|||
|
|
FOnMakeDirectory(AContext, VDirectory);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandEPRT(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
LParm, LIP: string;
|
|||
|
|
LDelim: char;
|
|||
|
|
LReqIPVersion: TIdIPVersion;
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
LDataChannel: TIdTCPClient;
|
|||
|
|
begin
|
|||
|
|
LContext := ASender.Context as TIdFTPServerContext;
|
|||
|
|
if LContext.IsAuthenticated(ASender) then begin
|
|||
|
|
LContext.FPASV := False;
|
|||
|
|
LParm := ASender.UnparsedParams;
|
|||
|
|
if Length(LParm) = 0 then begin
|
|||
|
|
LContext.FDataPortDenied := True;
|
|||
|
|
CmdInvalidParamNum(ASender);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
if FFTPSecurityOptions.BlockAllPORTTransfers then begin
|
|||
|
|
LContext.FDataPortDenied := True;
|
|||
|
|
ASender.Reply.SetReply(502, RSFTPPORTDisabled);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
LDelim := LParm[1];
|
|||
|
|
Fetch(LParm, LDelim);
|
|||
|
|
case IndyStrToInt(Fetch(LParm, LDelim), -1) of
|
|||
|
|
1: LReqIPVersion := Id_IPv4;
|
|||
|
|
2: if GStack.SupportsIPv6 then begin
|
|||
|
|
LReqIPVersion := Id_IPv6;
|
|||
|
|
end else begin
|
|||
|
|
LContext.FDataPort := 0;
|
|||
|
|
LContext.FDataPortDenied := True;
|
|||
|
|
ASender.Reply.SetReply(522, IndyFormat(RSFTPNetProtNotSup, ['1'])); {Do not translate}
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
else
|
|||
|
|
begin
|
|||
|
|
LContext.FDataPort := 0;
|
|||
|
|
LContext.FDataPortDenied := True;
|
|||
|
|
ASender.Reply.SetReply(522, IndyFormat(RSFTPNetProtNotSup, [iif(GStack.SupportsIPv6, '1,2', '1')])); {Do not translate}
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
LIP := Fetch(LParm, LDelim);
|
|||
|
|
if Length(LIP) = 0 then begin
|
|||
|
|
LContext.FDataPort := 0;
|
|||
|
|
LContext.FDataPortDenied := True;
|
|||
|
|
ASender.Reply.SetReply(500, RSFTPInvalidIP);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
LContext.FDataPort := TIdPort(IndyStrToInt(Fetch(LParm, LDelim), 0));
|
|||
|
|
if LContext.FDataPort = 0 then begin
|
|||
|
|
LContext.FDataPortDenied := True;
|
|||
|
|
ASender.Reply.SetReply(500, RSFTPInvalidPort);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
if FFTPSecurityOptions.NoReservedRangePORT and
|
|||
|
|
((LContext.FDataPort > 0) and (LContext.FDataPort <= 1024)) then begin
|
|||
|
|
LContext.FDataPort := 0;
|
|||
|
|
LContext.FDataPortDenied := True;
|
|||
|
|
ASender.Reply.SetReply(504, RSFTPPORTRange);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
if FFTPSecurityOptions.FRequirePORTFromSameIP then begin
|
|||
|
|
case LReqIPVersion of
|
|||
|
|
Id_IPv4: LIP := MakeCanonicalIPv4Address(LIP);
|
|||
|
|
Id_IPv6: LIP := MakeCanonicalIPv6Address(LIP);
|
|||
|
|
end;
|
|||
|
|
if LIP <> LContext.Binding.PeerIP then begin
|
|||
|
|
LContext.FDataPort := 0;
|
|||
|
|
LContext.FDataPortDenied := True;
|
|||
|
|
ASender.Reply.SetReply(504, RSFTPSameIPAddress);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
LContext.CreateDataChannel(False);
|
|||
|
|
LDataChannel := TIdTCPClient(LContext.FDataChannel.FDataChannel);
|
|||
|
|
LDataChannel.Host := LIP;
|
|||
|
|
LDataChannel.Port := LContext.FDataPort;
|
|||
|
|
LDataChannel.IPVersion := LReqIPVersion;
|
|||
|
|
LContext.FDataPortDenied := False;
|
|||
|
|
CmdCommandSuccessful(ASender, 200);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandEPSV(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
LParam: string;
|
|||
|
|
LBPortMin, LBPortMax: Word;
|
|||
|
|
LIP : String;
|
|||
|
|
LIPVersion: TIdIPVersion;
|
|||
|
|
LReqIPVersion: TIdIPVersion;
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
LDataChannel: TIdSimpleServer;
|
|||
|
|
begin
|
|||
|
|
LContext := ASender.Context as TIdFTPServerContext;
|
|||
|
|
if LContext.IsAuthenticated(ASender) then begin
|
|||
|
|
LIPVersion := LContext.Binding.IPVersion;
|
|||
|
|
LReqIPVersion := LIPVersion;
|
|||
|
|
LParam := ASender.UnparsedParams;
|
|||
|
|
if Length(LParam) > 0 then begin
|
|||
|
|
case IndyStrToInt(LParam, -1) of
|
|||
|
|
1: LReqIPVersion := Id_IPv4;
|
|||
|
|
2: if GStack.SupportsIPv6 then begin
|
|||
|
|
LReqIPVersion := Id_IPv6;
|
|||
|
|
end else begin
|
|||
|
|
ASender.Reply.SetReply(522, IndyFormat(RSFTPNetProtNotSup, ['1'])); {do not localize}
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
else
|
|||
|
|
begin
|
|||
|
|
if TextIsSame(LParam, 'ALL') then begin { do not localize }
|
|||
|
|
LContext.FEPSVAll := True;
|
|||
|
|
ASender.Reply.SetReply(200, RSFTPEPSVAllEntered);
|
|||
|
|
end else begin
|
|||
|
|
ASender.Reply.SetReply(522, IndyFormat(RSFTPNetProtNotSup, [iif(GStack.SupportsIPv6, '1,2', '1')])); {do not localize}
|
|||
|
|
end;
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
if LReqIPVersion = LIPVersion then begin
|
|||
|
|
LIP := LContext.Binding.IP;
|
|||
|
|
end;
|
|||
|
|
if (FPASVBoundPortMin <> 0) and (FPASVBoundPortMax <> 0) then begin
|
|||
|
|
LBPortMin := FPASVBoundPortMin;
|
|||
|
|
LBPortMax := FPASVBoundPortMax;
|
|||
|
|
end else begin
|
|||
|
|
LBPortMin := FDefaultDataPort;
|
|||
|
|
LBPortMax := LBPortMin;
|
|||
|
|
end;
|
|||
|
|
DoOnPASVBeforeBind(LContext, LIP, LBPortMin, LBPortMax, LReqIPVersion);
|
|||
|
|
|
|||
|
|
LContext.CreateDataChannel(True);
|
|||
|
|
LDataChannel := TIdSimpleServer(LContext.FDataChannel.FDataChannel);
|
|||
|
|
LDataChannel.BoundIP := LIP;
|
|||
|
|
if LBPortMin = LBPortMax then begin
|
|||
|
|
LDataChannel.BoundPort := LBPortMin;
|
|||
|
|
LDataChannel.BoundPortMin := 0;
|
|||
|
|
LDataChannel.BoundPortMax := 0;
|
|||
|
|
end else begin
|
|||
|
|
LDataChannel.BoundPort := 0;
|
|||
|
|
LDataChannel.BoundPortMin := LBPortMin;
|
|||
|
|
LDataChannel.BoundPortMax := LBPortMax;
|
|||
|
|
end;
|
|||
|
|
LDataChannel.IPVersion := LReqIPVersion;
|
|||
|
|
LDataChannel.BeginListen;
|
|||
|
|
LIP := LDataChannel.Binding.IP;
|
|||
|
|
LBPortMin := LDataChannel.Binding.Port;
|
|||
|
|
|
|||
|
|
//Note that only one Port can work with EPSV
|
|||
|
|
DoOnPASVReply(LContext, LIP, LBPortMin, LReqIPVersion);
|
|||
|
|
LParam := '|||' + IntToStr(LBPortMin) + '|'; {Do not localize}
|
|||
|
|
ASender.Reply.SetReply(229, IndyFormat(RSFTPEnteringEPSV, [LParam]));
|
|||
|
|
ASender.SendReply;
|
|||
|
|
LContext.FPASV := True;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandMDTM(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
s: string;
|
|||
|
|
LDate: TDateTime;
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
LSDate : String;
|
|||
|
|
LExists : Boolean;
|
|||
|
|
// under ARC, convert a weak reference to a strong reference before working with it
|
|||
|
|
LFileSystem: TIdFTPBaseFileSystem;
|
|||
|
|
{
|
|||
|
|
I know that this code and design are a mess.
|
|||
|
|
|
|||
|
|
There are actually two forms of MDTM and they mean different things.
|
|||
|
|
|
|||
|
|
The formal spec indicates that anything after the space in MDTM <filename>
|
|||
|
|
is the filename.
|
|||
|
|
|
|||
|
|
FTP Voyager and some other clients abuse the MDTM command by using it to specify
|
|||
|
|
a timestamp for the "Modified Time" on a file. The format is like this:
|
|||
|
|
|
|||
|
|
MDTM YYYYMMDDHHMMSS filename
|
|||
|
|
|
|||
|
|
Thus, there's an ambiguity.
|
|||
|
|
|
|||
|
|
Does MDTM 20031229152022 ESBAdDemo.exe mean
|
|||
|
|
1) Set the date time on ESBAdDemo.exe to 12/29/2003 3:20:22 PM
|
|||
|
|
|
|||
|
|
or
|
|||
|
|
|
|||
|
|
2) Get the time for a file named 20031229152022 ESBAdDemo.exe
|
|||
|
|
|
|||
|
|
To resolve this ambiguity, we check specifically for a valid date, and then see
|
|||
|
|
if a file, 20031229152022 ESBAdDemo.exe really does exist. If not, we interpret
|
|||
|
|
MDTM as a set date command. Otherwise, we will traat it as a request for the timestamp
|
|||
|
|
of a file, 20031229152022 ESBAdDemo.exe.
|
|||
|
|
|
|||
|
|
Note also that the time is sometimes given as either relative to the local server
|
|||
|
|
or an offset is provided.
|
|||
|
|
|
|||
|
|
Note from:
|
|||
|
|
http://www.ftpvoyager.com/releasenotes.asp
|
|||
|
|
====
|
|||
|
|
Added support for RFC change and the MDTM. MDTM requires sending the server
|
|||
|
|
GMT (UTC) instead of a "fixed" date and time. FTP Voyager supports this with
|
|||
|
|
Serv-U automatically by checking the Serv-U version number and by checking the
|
|||
|
|
response to the FEAT command for MDTM. Servers returning "MDTM" or
|
|||
|
|
"MDTM YYYYMMDDHHMMSS[+-TZ] filename" will use the old method. Servers
|
|||
|
|
returning "MDTM YYYYMMDDHHMMSS" only will use the new method where the date a
|
|||
|
|
and time is GMT (UTC).
|
|||
|
|
===
|
|||
|
|
We will use the old form for compatiability with some older FTP Voyager clients
|
|||
|
|
and because a few servers support the old form as well. I do this even though,
|
|||
|
|
this is really inconsistant with what MDTM returns for a query request. I might
|
|||
|
|
consider some type of support for the new form but I do not feel that such
|
|||
|
|
things are just abuse of the MDTM command. That's why I prefer a separate command for
|
|||
|
|
modifying file modification dates (MFMT).
|
|||
|
|
}
|
|||
|
|
begin
|
|||
|
|
LFileSystem := FFTPFileSystem;
|
|||
|
|
if Assigned(FOnGetFileDate) or Assigned(LFileSystem) then
|
|||
|
|
begin
|
|||
|
|
LContext := ASender.Context as TIdFTPServerContext;
|
|||
|
|
if LContext.IsAuthenticated(ASender) then begin
|
|||
|
|
s := ASender.UnparsedParams;
|
|||
|
|
LSDate := Fetch(s);
|
|||
|
|
if IsMDTMDate(LSDate) then begin
|
|||
|
|
s := DoProcessPath(LContext, ASender.UnparsedParams );
|
|||
|
|
DoOnFileExistCheck(LContext, s, LExists);
|
|||
|
|
if not LExists then begin
|
|||
|
|
s := ASender.UnparsedParams;
|
|||
|
|
Fetch(s);
|
|||
|
|
s := DoProcessPath(LContext, s);
|
|||
|
|
LDate := FTPMDTMToGMTDateTime(LSDate);
|
|||
|
|
DoOnSetModifiedTime(LContext, s, LDate);
|
|||
|
|
// Self.DoOnSetModifiedTime(LF,s, LSDate);
|
|||
|
|
ASender.Reply.SetReply(253, 'Date/time changed okay.'); {do not localize}
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
s := DoProcessPath(LContext, ASender.UnparsedParams);
|
|||
|
|
LDate := 0;
|
|||
|
|
DoOnGetFileDate(LContext, s, LDate);
|
|||
|
|
if LDate > 0 then begin
|
|||
|
|
ASender.Reply.SetReply(213, FTPGMTDateTimeToMLS(LDate));
|
|||
|
|
end else begin
|
|||
|
|
CmdFileActionAborted(ASender);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
CmdSyntaxError(ASender);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.SetFTPSecurityOptions(const AValue: TIdFTPSecurityOptions);
|
|||
|
|
begin
|
|||
|
|
FFTPSecurityOptions.Assign(AValue);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.SetOnUserAccount(AValue: TOnFTPUserAccountEvent);
|
|||
|
|
var
|
|||
|
|
LCmd : TIdCommandHandler;
|
|||
|
|
i : Integer;
|
|||
|
|
begin
|
|||
|
|
if FUserAccounts = nil then begin
|
|||
|
|
FOnUserAccount := AValue;
|
|||
|
|
for i := 0 to CommandHandlers.Count - 1 do begin
|
|||
|
|
LCmd := CommandHandlers.Items[i];
|
|||
|
|
if LCmd.Command = 'ACCT' then begin
|
|||
|
|
if Assigned(AValue) then begin
|
|||
|
|
LCmd.HelpSuperScript := '';
|
|||
|
|
LCmd.Description.Text := ACCT_HELP_ENABLED;
|
|||
|
|
end else begin
|
|||
|
|
LCmd.HelpSuperScript := '*';
|
|||
|
|
LCmd.Description.Text := ACCT_HELP_DISABLED;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandAUTH(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
LIO : TIdSSLIOHandlerSocketBase;
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
begin
|
|||
|
|
LContext := ASender.Context as TIdFTPServerContext;
|
|||
|
|
if (PosInStrArray(ASender.UnparsedParams, TLS_AUTH_NAMES) > -1) and (IOHandler is TIdServerIOHandlerSSLBase)
|
|||
|
|
and (FUseTLS in ExplicitTLSVals) then begin
|
|||
|
|
ASender.Reply.SetReply(234,RSFTPAuthSSL);
|
|||
|
|
ASender.SendReply;
|
|||
|
|
LIO := ASender.Context.Connection.IOHandler as TIdSSLIOHandlerSocketBase;
|
|||
|
|
LIO.Passthrough := False;
|
|||
|
|
{
|
|||
|
|
This is from:
|
|||
|
|
|
|||
|
|
http://www.ford-hutchinson.com/~fh-1-pfh/ftps-ext.html#bad
|
|||
|
|
|
|||
|
|
and we implement things this way for historical reasons so
|
|||
|
|
we don't break older and newer clients.
|
|||
|
|
}
|
|||
|
|
case PosInStrArray(ASender.UnparsedParams, TLS_AUTH_NAMES) of
|
|||
|
|
0,2 : LContext.DataProtection := ftpdpsClear; //AUTH TLS, AUTH TLS-C
|
|||
|
|
1,3 : LContext.DataProtection := ftpdpsPrivate; //AUTH SSL, AUTH TLS-P
|
|||
|
|
end;
|
|||
|
|
LContext.AuthMechanism := 'TLS'; {Do not localize}
|
|||
|
|
end else begin
|
|||
|
|
CmdSyntaxError(ASender);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandAVBL(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
LIsFile : Boolean;
|
|||
|
|
LSize : Int64;
|
|||
|
|
LPath : String;
|
|||
|
|
begin
|
|||
|
|
LIsFile := True;
|
|||
|
|
LSize := 0;
|
|||
|
|
LContext := ASender.Context as TIdFTPServerContext;
|
|||
|
|
if LContext.IsAuthenticated(ASender) then begin
|
|||
|
|
if Assigned(FOnAvailDiskSpace) then begin
|
|||
|
|
LPath := DoProcessPath(LContext, ASender.UnparsedParams);
|
|||
|
|
FOnAvailDiskSpace(LContext, LPath, LIsFile, LSize);
|
|||
|
|
if LIsFile then begin
|
|||
|
|
ASender.Reply.SetReply(550, IndyFormat(RSFTPIsAFile,[LPath]));
|
|||
|
|
end else begin
|
|||
|
|
ASender.Reply.SetReply(213, IntToStr(LSize));
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
CmdNotImplemented(ASender);
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
ASender.Reply.SetReply(550, RSFTPFileActionNotTaken);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
//FOnCompleteDirSize
|
|||
|
|
procedure TIdFTPServer.CommandDSIZ(ASender : TIdCommand);
|
|||
|
|
var
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
LIsFile : Boolean;
|
|||
|
|
LSize : Int64;
|
|||
|
|
LPath : String;
|
|||
|
|
begin
|
|||
|
|
LIsFile := True;
|
|||
|
|
LSize := 0;
|
|||
|
|
LContext := ASender.Context as TIdFTPServerContext;
|
|||
|
|
if LContext.IsAuthenticated(ASender) then begin
|
|||
|
|
if Assigned(FOnCompleteDirSize) then begin
|
|||
|
|
LPath := DoProcessPath(LContext, ASender.UnparsedParams);
|
|||
|
|
FOnCompleteDirSize(LContext, LPath, LIsFile, LSize);
|
|||
|
|
if LIsFile then begin
|
|||
|
|
ASender.Reply.SetReply(550, IndyFormat(RSFTPIsAFile,[LPath]));
|
|||
|
|
end else begin
|
|||
|
|
ASender.Reply.SetReply(213, IntToStr(LSize));
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
CmdNotImplemented(ASender);
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
ASender.Reply.SetReply(550, RSFTPFileActionNotTaken);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandRMDA(ASender : TIdCommand);
|
|||
|
|
var
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
LPath : TIdFTPFileName;
|
|||
|
|
begin
|
|||
|
|
//FOnRemoveDirectoryAll: TOnDirectoryEvent;
|
|||
|
|
LContext := ASender.Context as TIdFTPServerContext;
|
|||
|
|
if LContext.IsAuthenticated(ASender) then begin
|
|||
|
|
if Assigned(FOnRemoveDirectoryAll) then begin
|
|||
|
|
LPath := DoProcessPath(LContext, ASender.UnparsedParams);
|
|||
|
|
FOnRemoveDirectoryAll(LContext, LPath);
|
|||
|
|
ASender.Reply.SetReply(250, RSFTPFileActionCompleted);
|
|||
|
|
end else begin
|
|||
|
|
CmdNotImplemented(ASender);
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
ASender.Reply.SetReply(550, RSFTPFileActionNotTaken);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandCCC(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
LIO : TIdSSLIOHandlerSocketBase;
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
begin
|
|||
|
|
LContext := ASender.Context as TIdFTPServerContext;
|
|||
|
|
if FUseTLS <> utNoTLSSupport then begin
|
|||
|
|
//Not sure if it's proper to require authentication before a CCC
|
|||
|
|
//but it is a good idea anyway because you definately want to
|
|||
|
|
//prevent eavesdropping
|
|||
|
|
if LContext.IsAuthenticated(ASender) then begin
|
|||
|
|
if LContext.FUserSecurity.PermitCCC then begin
|
|||
|
|
ASender.Reply.SetReply(200, RSFTPClearCommandConnection);
|
|||
|
|
ASender.SendReply;
|
|||
|
|
LIO := ASender.Context.Connection.IOHandler as TIdSSLIOHandlerSocketBase;
|
|||
|
|
LIO.Passthrough := True;
|
|||
|
|
LContext.FCCC := True;
|
|||
|
|
end else begin
|
|||
|
|
ASender.Reply.SetReply(534, RSFTPClearCommandNotPermitted);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
CmdSyntaxError(ASender);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandPBSZ(ASender: TIdCommand);
|
|||
|
|
{Note that this may have to be expanded and reworked for other AUTH mechanisms}
|
|||
|
|
var
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
begin
|
|||
|
|
LContext := ASender.Context as TIdFTPServerContext;
|
|||
|
|
if IOHandler is TIdServerIOHandlerSSLBase then begin
|
|||
|
|
if ASender.UnparsedParams = '' then begin
|
|||
|
|
CmdInvalidParamNum(ASender);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
if (LContext.AuthMechanism = '') and (FUseTLS <> utUseImplicitTLS) then begin
|
|||
|
|
ASender.Reply.SetReply(503, RSFTPPBSZAuthDataRequired);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
if LContext.FCCC then begin
|
|||
|
|
ASender.Reply.SetReply(503, RSFTPPBSZNotAfterCCC);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
if (LContext.AuthMechanism = 'TLS') or (FUseTLS = utUseImplicitTLS) then begin {Do not localize}
|
|||
|
|
ASender.Reply.SetReply(200,RSFTPDataProtBuffer0);
|
|||
|
|
LContext.DataPBSZCalled := True;
|
|||
|
|
end
|
|||
|
|
else if IsNumeric(ASender.UnparsedParams) then begin
|
|||
|
|
ASender.Reply.SetReply(200,'PBSZ=0'); {Do not translate}
|
|||
|
|
LContext.DataPBSZCalled := True;
|
|||
|
|
end else begin
|
|||
|
|
CmdInvalidParams(ASender);
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
CmdSyntaxError(ASender);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandPROT(ASender: TIdCommand);
|
|||
|
|
const
|
|||
|
|
LValidParams : array [0..3] of string = ('C','S','E','P'); {Do not translate}
|
|||
|
|
{Note that this may have to be expanded and reworked for other AUTH mechanisms}
|
|||
|
|
var
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
begin
|
|||
|
|
LContext := ASender.Context as TIdFTPServerContext;
|
|||
|
|
if IOHandler is TIdServerIOHandlerSSLBase then begin
|
|||
|
|
if LContext.FCCC then begin
|
|||
|
|
ASender.Reply.SetReply(503, RSFTPPBSZNotAfterCCC);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
if not LContext.DataPBSZCalled then begin
|
|||
|
|
ASender.Reply.SetReply(503, RSFTPPROTProtBufRequired);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
case PosInStrArray(ASender.UnparsedParams, LValidParams) of
|
|||
|
|
0 : begin
|
|||
|
|
LContext.FDataProtection := ftpdpsClear;
|
|||
|
|
ASender.Reply.SetReply(200, RSFTPProtTypeClear);
|
|||
|
|
end;
|
|||
|
|
1, 2 : ASender.Reply.SetReply(536, RSFTPInvalidProtTypeForMechanism);
|
|||
|
|
3 : begin
|
|||
|
|
LContext.FDataProtection := ftpdpsPrivate;
|
|||
|
|
ASender.Reply.SetReply(200, RSFTPProtTypePrivate);
|
|||
|
|
end;
|
|||
|
|
else
|
|||
|
|
ASender.Reply.SetReply(504, RSFTPInvalidForParam);
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
CmdNotImplemented(ASender);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandCOMB(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
LFileParts : TStringList;
|
|||
|
|
LBuf : String;
|
|||
|
|
LTargetFileName : String;
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
// under ARC, convert a weak reference to a strong reference before working with it
|
|||
|
|
LFileSystem: TIdFTPBaseFileSystem;
|
|||
|
|
begin
|
|||
|
|
LContext := ASender.Context as TIdFTPServerContext;
|
|||
|
|
LFileSystem := FTPFileSystem;
|
|||
|
|
if Assigned(FOnCombineFiles) or Assigned(LFileSystem) then begin
|
|||
|
|
if LContext.IsAuthenticated(ASender) then begin
|
|||
|
|
if ASender.UnparsedParams = '' then begin
|
|||
|
|
CmdInvalidParamNum(ASender);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
if Pos('"', ASender.UnparsedParams) > 0 then begin
|
|||
|
|
LBuf := ASender.UnparsedParams;
|
|||
|
|
Fetch(LBuf,'"');
|
|||
|
|
LTargetFileName := Fetch(LBuf, '"');
|
|||
|
|
LTargetFileName := DoProcessPath(LContext, LTargetFileName);
|
|||
|
|
LBuf := Trim(LBuf);
|
|||
|
|
LFileParts := TStringList.Create;
|
|||
|
|
try
|
|||
|
|
while LBuf <> '' do begin
|
|||
|
|
Fetch(LBuf,'"');
|
|||
|
|
LFileParts.Add(DoProcessPath(LContext, Fetch(LBuf,'"')));
|
|||
|
|
end;
|
|||
|
|
DoOnCombineFiles(LContext, LTargetFileName, LFileParts);
|
|||
|
|
ASender.Reply.SetReply(250, RSFTPFileOpSuccess);
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(LFileParts);
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
CmdInvalidParams(ASender);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
CmdNotImplemented(ASender);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.DoConnect(AContext: TIdContext);
|
|||
|
|
var
|
|||
|
|
LGreeting : TIdReplyRFC;
|
|||
|
|
begin
|
|||
|
|
AContext.Connection.IOHandler.DefStringEncoding := IndyTextEncoding_8Bit;
|
|||
|
|
if AContext.Connection.IOHandler is TIdSSLIOHandlerSocketBase then begin
|
|||
|
|
if FUseTLS = utUseImplicitTLS then begin
|
|||
|
|
TIdSSLIOHandlerSocketBase(AContext.Connection.IOHandler).PassThrough := False;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
(AContext as TIdFTPServerContext).FXAUTKey := MakeXAUTKey;
|
|||
|
|
if Assigned(OnGreeting) then begin
|
|||
|
|
LGreeting := TIdReplyRFC.Create(nil);
|
|||
|
|
try
|
|||
|
|
LGreeting.Assign(Greeting);
|
|||
|
|
OnGreeting(TIdFTPServerContext(AContext), LGreeting);
|
|||
|
|
ReplyTexts.UpdateText(LGreeting);
|
|||
|
|
if (not GetFIPSMode) and FSupportXAUTH and (LGreeting.NumericCode = 220) then begin
|
|||
|
|
(AContext as TIdFTPServerContext).FXAUTKey := IdFTPCommon.MakeXAUTKey;
|
|||
|
|
XAutGreeting(AContext,LGreeting, GStack.HostName);
|
|||
|
|
end;
|
|||
|
|
AContext.Connection.IOHandler.Write(LGreeting.FormattedReply);
|
|||
|
|
if Assigned(OnConnect) then begin
|
|||
|
|
OnConnect(AContext);
|
|||
|
|
end;
|
|||
|
|
if LGreeting.NumericCode = 421 then begin
|
|||
|
|
AContext.Connection.Disconnect(False);
|
|||
|
|
end;
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(LGreeting);
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
if (not GetFIPSMode) and FSupportXAUTH and (Greeting.NumericCode = 220) then begin
|
|||
|
|
LGreeting := TIdReplyRFC.Create(nil);
|
|||
|
|
try
|
|||
|
|
LGreeting.Assign(Greeting);
|
|||
|
|
XAutGreeting(AContext,LGreeting, GStack.HostName);
|
|||
|
|
AContext.Connection.IOHandler.Write(LGreeting.FormattedReply);
|
|||
|
|
if Assigned(OnConnect) then begin
|
|||
|
|
OnConnect(AContext);
|
|||
|
|
end;
|
|||
|
|
if LGreeting.NumericCode = 421 then begin
|
|||
|
|
AContext.Connection.Disconnect(False);
|
|||
|
|
end;
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(LGreeting);
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
inherited DoConnect(AContext);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandQUIT(ASender: TIdCommand);
|
|||
|
|
begin
|
|||
|
|
if Assigned(FOnQuitBanner) then begin
|
|||
|
|
FOnQuitBanner(TIdFTPServerContext(ASender.Context), ASender.Reply);
|
|||
|
|
ASender.Disconnect := True;
|
|||
|
|
end else begin
|
|||
|
|
ASender.Reply.Assign(ASender.CommandHandler.NormalReply);
|
|||
|
|
end;
|
|||
|
|
ASender.Reply.SetReply(221, ASender.Reply.Text.Text);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandMLSD(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
LStream: TStringList;
|
|||
|
|
LSendData : Boolean;
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
begin
|
|||
|
|
if not Assigned(OnListDirectory) then begin
|
|||
|
|
CmdSyntaxError(ASender);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
LContext := ASender.Context as TIdFTPServerContext;
|
|||
|
|
LSendData := False;
|
|||
|
|
if LContext.IsAuthenticated(ASender) then begin
|
|||
|
|
if (not Assigned(LContext.FDataChannel)) or LContext.FDataPortDenied then begin
|
|||
|
|
ASender.Reply.SetReply(425, RSFTPCantOpenData);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
LStream := TStringList.Create;
|
|||
|
|
try
|
|||
|
|
ListDirectory(LContext, DoProcessPath(LContext, ASender.UnparsedParams),
|
|||
|
|
LStream, TextIsSame(ASender.CommandHandler.Command, 'LIST'), 'MLSD'); {Do not translate}
|
|||
|
|
LSendData := True;
|
|||
|
|
finally
|
|||
|
|
try
|
|||
|
|
if LSendData then begin
|
|||
|
|
//it should be safe to assume that the FDataChannel object exists because
|
|||
|
|
//we checked it earlier
|
|||
|
|
LContext.FDataChannel.Data := LStream;
|
|||
|
|
LContext.FDataChannel.OKReply.SetReply(226, RSFTPDataConnClosed);
|
|||
|
|
LContext.FDataChannel.ErrorReply.SetReply(426, RSFTPDataConnClosedAbnormally);
|
|||
|
|
LContext.FDataChannel.FFtpOperation := ftpRetr;
|
|||
|
|
ASender.Reply.SetReply(125, RSFTPDataConnToOpen);
|
|||
|
|
ASender.SendReply;
|
|||
|
|
DoDataChannelOperation(ASender);
|
|||
|
|
end else begin
|
|||
|
|
LContext.KillDataChannel;
|
|||
|
|
ASender.Reply.SetReply(426, RSFTPDataConnClosedAbnormally);
|
|||
|
|
end;
|
|||
|
|
finally
|
|||
|
|
LStream.Free;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandMLST(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
LStream : TStringList;
|
|||
|
|
i : Integer;
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
LPath : String;
|
|||
|
|
LDir : TIdFTPListOutput;
|
|||
|
|
begin
|
|||
|
|
if Assigned(OnListDirectory) or Assigned(FOnMLST) then begin
|
|||
|
|
LContext := ASender.Context as TIdFTPServerContext;
|
|||
|
|
if LContext.IsAuthenticated(ASender) then begin
|
|||
|
|
LStream := TStringList.Create;
|
|||
|
|
try
|
|||
|
|
LPath := DoProcessPath(LContext, ASender.UnparsedParams);
|
|||
|
|
if Assigned(FOnMLST) then begin
|
|||
|
|
LDir := TIdFTPListOutput.Create;
|
|||
|
|
try
|
|||
|
|
FOnMLST(LContext, LPath, LDir);
|
|||
|
|
LDir.MLISTOutputDir(LStream, LContext.MLSOpts);
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(LDir);
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
//this part is kept just for backwards compatibility
|
|||
|
|
ListDirectory(LContext, LPath, LStream, True, 'MLST'); {Do not translate}
|
|||
|
|
end;
|
|||
|
|
ASender.Reply.Clear;
|
|||
|
|
SetRFCReplyFormat(ASender.Reply);
|
|||
|
|
ASender.Reply.NumericCode := 250;
|
|||
|
|
ASender.Reply.Text.Add('Begin'); {do not localize}
|
|||
|
|
for i := 0 to LStream.Count -1 do begin
|
|||
|
|
ASender.Reply.Text.Add(' ' + LStream[i]);
|
|||
|
|
end;
|
|||
|
|
ASender.Reply.Text.Add('End'); {do not localize}
|
|||
|
|
ASender.SendReply;
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(LStream);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
CmdSyntaxError(ASender);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.DoOnSetModifiedTime(AContext: TIdFTPServerContext; const AFileName : String; var VDateTime: TDateTime);
|
|||
|
|
var
|
|||
|
|
// under ARC, convert a weak reference to a strong reference before working with it
|
|||
|
|
LFileSystem: TIdFTPBaseFileSystem;
|
|||
|
|
begin
|
|||
|
|
LFileSystem := FTPFileSystem;
|
|||
|
|
if Assigned(LFileSystem) then begin
|
|||
|
|
LFileSystem.SetModifiedFileDate(AContext, AFileName, VDateTime);
|
|||
|
|
end else if Assigned(FOnSetModifiedTime) then begin
|
|||
|
|
FOnSetModifiedTime(AContext, AFileName, VDateTime);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.DoOnSetModifiedTime(AContext: TIdFTPServerContext; const AFileName : String; var VDateTimeStr : String);
|
|||
|
|
var
|
|||
|
|
LTime : TDateTime;
|
|||
|
|
begin
|
|||
|
|
LTime := FTPMLSToGMTDateTime(VDateTimeStr);
|
|||
|
|
DoOnSetModifiedTime(AContext, AFileName, LTime);
|
|||
|
|
VDateTimeStr := FTPGMTDateTimeToMLS(LTime);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.DoOnSetCreationTime(AContext: TIdFTPServerContext; const AFileName : String; var VDateTime: TDateTime);
|
|||
|
|
var
|
|||
|
|
// under ARC, convert a weak reference to a strong reference before working with it
|
|||
|
|
LFileSystem: TIdFTPBaseFileSystem;
|
|||
|
|
begin
|
|||
|
|
LFileSystem := FTPFileSystem;
|
|||
|
|
if Assigned(LFileSystem) then begin
|
|||
|
|
//LFileSystem.SetCreationFileDate(AContext,AFileName,VDateTime);
|
|||
|
|
end else if Assigned(FOnSetCreationTime) then begin
|
|||
|
|
FOnSetCreationTime(AContext, AFileName, VDateTime);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.DoOnSetCreationTimeGMT(AContext: TIdFTPServerContext;
|
|||
|
|
const AFileName: String; var VDateTime: TDateTime);
|
|||
|
|
begin
|
|||
|
|
if Assigned(FOnSetCreationTime) then begin
|
|||
|
|
FOnSetCreationTime(AContext, AFileName, VDateTime);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.DoOnSetModifiedTimeGMT(AContext: TIdFTPServerContext;
|
|||
|
|
const AFileName: String; var VDateTime: TDateTime);
|
|||
|
|
begin
|
|||
|
|
if Assigned(FOnSetModifiedTime) then begin
|
|||
|
|
FOnSetModifiedTime(AContext, AFileName, VDateTime);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.DoOnSetCreationTime(AContext: TIdFTPServerContext;
|
|||
|
|
const AFileName : String; var VDateTimeStr : String);
|
|||
|
|
var
|
|||
|
|
LTime : TDateTime;
|
|||
|
|
begin
|
|||
|
|
LTime := FTPMLSToLocalDateTime(VDateTimeStr);
|
|||
|
|
DoOnSetCreationTime(AContext, AFileName, LTime);
|
|||
|
|
VDateTimeStr := FTPLocalDateTimeToMLS(LTime);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandMFMT(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
LTimeStr, LFileName : String;
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
// under ARC, convert a weak reference to a strong reference before working with it
|
|||
|
|
LFileSystem: TIdFTPBaseFileSystem;
|
|||
|
|
begin
|
|||
|
|
LContext := ASender.Context as TIdFTPServerContext;
|
|||
|
|
if LContext.IsAuthenticated(ASender) then begin
|
|||
|
|
LFilesystem := FTPFileSystem;
|
|||
|
|
if Assigned(FOnSetModifiedTime) or Assigned(LFileSystem) then begin
|
|||
|
|
LFileName := ASender.UnparsedParams;
|
|||
|
|
LTimeStr := Fetch(LFileName);
|
|||
|
|
LFileName := DoProcessPath(LContext, LFileName);
|
|||
|
|
DoOnSetModifiedTime(LContext, LFileName, LTimeStr);
|
|||
|
|
ASender.Reply.SetReply(213, IndyFormat('Modify=%s %s', [LTimeStr, LFileName])); {Do not translate}
|
|||
|
|
end else begin
|
|||
|
|
CmdSyntaxError(ASender);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandMFCT(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
LTimeStr, LFileName : String;
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
// under ARC, convert a weak reference to a strong reference before working with it
|
|||
|
|
LFileSystem: TIdFTPBaseFileSystem;
|
|||
|
|
begin
|
|||
|
|
LContext := TIdFTPServerContext(ASender.Context);
|
|||
|
|
if LContext.IsAuthenticated(ASender) then begin
|
|||
|
|
LFileSystem := FTPFileSystem;
|
|||
|
|
if Assigned(FOnSetCreationTime) or Assigned(LFileSystem) then begin
|
|||
|
|
LFileName := ASender.UnparsedParams;
|
|||
|
|
LTimeStr := Fetch(LFileName);
|
|||
|
|
LFileName := DoProcessPath(LContext, LFileName);
|
|||
|
|
DoOnSetCreationTime(LContext, LFileName, LTimeStr);
|
|||
|
|
ASender.Reply.SetReply(213, IndyFormat('CreateTime=%s %s', [LTimeStr, LFileName])); {Do not translate}
|
|||
|
|
end else begin
|
|||
|
|
CmdSyntaxError(ASender);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandMFF(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
LFacts : TStringList;
|
|||
|
|
LFileName : String;
|
|||
|
|
LValue : String;
|
|||
|
|
s : String;
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
LAttrib : UInt32;
|
|||
|
|
LAuth : Boolean;
|
|||
|
|
LDummyDate1, LDummyDate2 : TDateTime;
|
|||
|
|
LDate : TDateTime;
|
|||
|
|
LCHMOD : Integer;
|
|||
|
|
LDummy : String;
|
|||
|
|
begin
|
|||
|
|
LAuth := True;
|
|||
|
|
LDummy := ''; //empty value for passing a var in case we need to do that
|
|||
|
|
LContext := TIdFTPServerContext(ASender.Context);
|
|||
|
|
//this may need to change if we make more facts to modify
|
|||
|
|
if not Assigned(FOnSetModifiedTime) and not Assigned(FOnSetCreationTime) then begin
|
|||
|
|
CmdSyntaxError(ASender);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
s := '';
|
|||
|
|
if ASender.UnparsedParams = '' then begin
|
|||
|
|
CmdInvalidParamNum(ASender);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
if LContext.IsAuthenticated(ASender) then begin
|
|||
|
|
LFacts := TStringList.Create;
|
|||
|
|
try
|
|||
|
|
LFileName := ParseFacts(ASender.UnparsedParams, LFacts);
|
|||
|
|
LFileName := DoProcessPath(LContext, LFileName);
|
|||
|
|
if LFacts.Values['Modify'] <> '' then begin {Do not translate}
|
|||
|
|
if Assigned(FOnSetModifiedTime) then begin
|
|||
|
|
LValue := LFacts.Values['Modify']; {Do not translate}
|
|||
|
|
DoOnSetModifiedTime(LContext, LFileName, LValue);
|
|||
|
|
s := s + IndyFormat('Modify=%s;', [LValue]); {Do not translate}
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
if LFacts.Values['Create'] <> '' then begin {Do not translate}
|
|||
|
|
if Assigned(FOnSetCreationTime) then begin
|
|||
|
|
LValue := LFacts.Values['Create']; {Do not translate}
|
|||
|
|
DoOnSetCreationTime(LContext, LFileName, LValue);
|
|||
|
|
s := s + IndyFormat('Create=%s;', [LValue]); {Do not translate}
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
if LFacts.Values['Win32.ea'] <> '' then begin
|
|||
|
|
if Assigned(FOnSetATTRIB) then begin
|
|||
|
|
LValue := LFacts.Values['Win32.ea']; {Do not localize}
|
|||
|
|
LAttrib := IndyStrToInt(LValue);
|
|||
|
|
DoOnSetAttrib(LContext, LAttrib, LFileName, LAuth);
|
|||
|
|
LValue := '0x' + IntToHex(LAttrib, 8);
|
|||
|
|
s := s + IndyFormat('Win32.ea=%s;', [LValue]); {Do not translate}
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
if LFacts.Values['Unix.mode'] <> '' then begin
|
|||
|
|
LValue := LFacts.Values['Unix.mode']; {Do not localize}
|
|||
|
|
if Assigned(FOnSiteCHMOD) then begin
|
|||
|
|
If IsValidPermNumbers(LValue) then begin
|
|||
|
|
LCHMOD := IndyStrToInt(LValue);
|
|||
|
|
DoOnSiteCHMOD(LContext, LCHMOD, LFileName, LAuth);
|
|||
|
|
LValue := IndyFormat('%.4d', [LCHMOD]);
|
|||
|
|
s := s + IndyFormat('Unix.mode=%s;', [LValue]); {Do not translate}
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
if LFacts.Values['Unix.owner'] <> '' then begin {Do not localize}
|
|||
|
|
LValue := LFacts.Values['Unix.owner']; {Do not localize}
|
|||
|
|
if Assigned(FOnSiteCHOWN) then begin
|
|||
|
|
DoOnSiteCHOWN(LContext, LValue, LDummy, LFileName, LAuth);
|
|||
|
|
s := s + IndyFormat('Unix.owner=%s;', [LValue]); {Do not localize}
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
if LFacts.Values['Unix.group'] <> '' then begin {Do not localize}
|
|||
|
|
LValue := LFacts.Values['Unix.group']; {Do not localize}
|
|||
|
|
if Assigned(FOnSiteCHGRP) then begin
|
|||
|
|
DoOnSiteCHGRP(LContext, LValue, LFileName, LAuth);
|
|||
|
|
s := s + IndyFormat('Unix.group=%s;', [LValue]); {Do not localize}
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
if LFacts.Values['Windows.lastaccesstime'] <> '' then begin
|
|||
|
|
LValue := LFacts.Values['Windows.lastaccesstime'];
|
|||
|
|
if Assigned(FOnSiteUTIME) and (mlsdFileLastAccessTime in FMLSDFacts) then begin
|
|||
|
|
LDate := FTPMLSToGMTDateTime(LValue);
|
|||
|
|
LDummyDate1 := 0;
|
|||
|
|
LDummyDate2 := 0;
|
|||
|
|
FOnSiteUTIME(LContext, LFileName, LDate, LDummyDate1, LDummyDate2, LAuth);
|
|||
|
|
LValue := FTPGMTDateTimeToMLS(LDate);
|
|||
|
|
s := s + IndyFormat('Windows.lastaccesstime=%s;', [LValue]);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
if s <> '' then begin
|
|||
|
|
ASender.Reply.SetReply(213, s + ' ' + LFileName);
|
|||
|
|
end else begin
|
|||
|
|
ASender.Reply.SetReply(504, IndyFormat(RSFTPParamError, ['MFF'])); {Do not translate}
|
|||
|
|
end;
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(LFacts);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdFTPServer.GetMD5Checksum(ASender : TIdFTPServerContext; const AFileName : String ) : String;
|
|||
|
|
var
|
|||
|
|
LCalcStream : TStream;
|
|||
|
|
begin
|
|||
|
|
Result := '';
|
|||
|
|
DoOnMD5Cache(ASender, AFileName, Result);
|
|||
|
|
if Result = '' then begin
|
|||
|
|
LCalcStream := nil;
|
|||
|
|
DoOnCRCFile(ASender, AFileName, LCalcStream);
|
|||
|
|
if Assigned(LCalcStream) then try
|
|||
|
|
LCalcStream.Position := 0;
|
|||
|
|
Result := CalculateCheckSum(TIdHashMessageDigest5, LCalcStream, 0, LCalcStream.Size);
|
|||
|
|
DoOnMD5Verify(ASender, AFileName, Result);
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(LCalcStream);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandMMD5(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
LChecksum : String;
|
|||
|
|
LRes : String;
|
|||
|
|
LFiles : TStringList;
|
|||
|
|
LError : Boolean;
|
|||
|
|
i : Integer;
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
// under ARC, convert a weak reference to a strong reference before working with it
|
|||
|
|
LFileSystem: TIdFTPBaseFileSystem;
|
|||
|
|
begin
|
|||
|
|
LContext := ASender.Context as TIdFTPServerContext;
|
|||
|
|
if GetFIPSMode then begin
|
|||
|
|
CmdSyntaxError(ASender);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
LError := False;
|
|||
|
|
LChecksum := '';
|
|||
|
|
LRes := '';
|
|||
|
|
if LContext.IsAuthenticated(ASender) then begin
|
|||
|
|
LFileSystem := FTPFileSystem;
|
|||
|
|
if Assigned(FOnCRCFile) or Assigned(FOnMD5Cache) or Assigned(LFileSystem) then begin
|
|||
|
|
LFiles := TStringList.Create;
|
|||
|
|
try
|
|||
|
|
ParseQuotedArgs(ASender.UnparsedParams, LFiles);
|
|||
|
|
for i := 0 to LFiles.Count -1 do begin
|
|||
|
|
LChecksum := GetMD5Checksum(LContext, DoProcessPath(LContext, UnquotedStr(LFiles[i])));
|
|||
|
|
if LChecksum = '' then begin
|
|||
|
|
LError := True;
|
|||
|
|
Break;
|
|||
|
|
end;
|
|||
|
|
LRes := LRes + ',' + LFiles[i] + ' '+ LChecksum;
|
|||
|
|
end;
|
|||
|
|
IdDelete(LRes,1,1);
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(LFiles);
|
|||
|
|
end;
|
|||
|
|
if LError then begin
|
|||
|
|
//The http://www.potaroo.net/ietf/idref/draft-twine-ftpmd5/
|
|||
|
|
//draft didn't specify 550 as an error.
|
|||
|
|
CmdTwineFileActionAborted(ASender);
|
|||
|
|
end else begin
|
|||
|
|
ASender.Reply.SetReply(252, LRes);
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
CmdSyntaxError(ASender);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandMD5(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
LChecksum : String;
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
// under ARC, convert a weak reference to a strong reference before working with it
|
|||
|
|
LFileSystem: TIdFTPBaseFileSystem;
|
|||
|
|
begin
|
|||
|
|
LContext := TIdFTPServerContext(ASender.Context);
|
|||
|
|
if GetFIPSMode then begin
|
|||
|
|
CmdSyntaxError(ASender);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
LChecksum := '';
|
|||
|
|
if LContext.IsAuthenticated(ASender) then begin
|
|||
|
|
LFileSystem := FTPFileSystem;
|
|||
|
|
if Assigned(FOnCRCFile) or Assigned(LFileSystem) then begin
|
|||
|
|
LChecksum := GetMD5Checksum(LContext, DoProcessPath(LContext, ASender.UnparsedParams));
|
|||
|
|
if LChecksum = '' then begin
|
|||
|
|
CmdTwineFileActionAborted(ASender);
|
|||
|
|
end else begin
|
|||
|
|
ASender.Reply.SetReply(251, LChecksum);
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
CmdSyntaxError(ASender);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.DoOnMD5Verify(ASender: TIdFTPServerContext;
|
|||
|
|
const AFileName, ACheckSum: String);
|
|||
|
|
begin
|
|||
|
|
if Assigned(OnMD5Verify) then begin
|
|||
|
|
OnMD5Verify(ASender, AFileName, AChecksum);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.DoOnMD5Cache(ASender: TIdFTPServerContext;
|
|||
|
|
const AFileName: String; var VCheckSum: String);
|
|||
|
|
begin
|
|||
|
|
if Assigned(OnMD5Cache) then begin
|
|||
|
|
OnMD5Cache(ASender, AFileName, VCheckSum);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.DoDisconnect(AContext: TIdContext);
|
|||
|
|
var
|
|||
|
|
// under ARC, convert a weak reference to a strong reference before working with it
|
|||
|
|
LUserAccounts: TIdCustomUserManager;
|
|||
|
|
begin
|
|||
|
|
LUserAccounts := FUserAccounts;
|
|||
|
|
if Assigned(LUserAccounts) then begin
|
|||
|
|
LUserAccounts.UserDisconnected(TIdFTPServerContext(AContext).UserName);
|
|||
|
|
{$IFDEF USE_OBJECT_ARC}LUserAccounts := nil;{$ENDIF}
|
|||
|
|
end;
|
|||
|
|
inherited DoDisconnect(AContext);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.DoOnCRCFile(ASender: TIdFTPServerContext;
|
|||
|
|
const AFileName: String; var VStream: TStream);
|
|||
|
|
var
|
|||
|
|
// under ARC, convert a weak reference to a strong reference before working with it
|
|||
|
|
LFileSystem: TIdFTPBaseFileSystem;
|
|||
|
|
begin
|
|||
|
|
LFileSystem := FTPFileSystem;
|
|||
|
|
if Assigned(LFileSystem) then begin
|
|||
|
|
LFileSystem.GetCRCCalcStream(ASender, AFileName, VStream);
|
|||
|
|
end else if Assigned(FOnCRCFile) then begin
|
|||
|
|
FOnCRCFile(ASender, AFileName, VStream);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.DoOnCombineFiles(ASender: TIdFTPServerContext;
|
|||
|
|
const ATargetFileName: string; AParts: TStrings);
|
|||
|
|
var
|
|||
|
|
// under ARC, convert a weak reference to a strong reference before working with it
|
|||
|
|
LFileSystem: TIdFTPBaseFileSystem;
|
|||
|
|
begin
|
|||
|
|
LFileSystem := FTPFileSystem;
|
|||
|
|
if Assigned(LFileSystem) then begin
|
|||
|
|
LFileSystem.CombineFiles(ASender, ATargetFileName, AParts);
|
|||
|
|
end else if Assigned(FOnCombineFiles) then begin
|
|||
|
|
FOnCombineFiles(ASender, ATargetFileName, AParts);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.DoOnRenameFile(ASender: TIdFTPServerContext;
|
|||
|
|
const ARenameFromFile, ARenameToFile: string);
|
|||
|
|
var
|
|||
|
|
// under ARC, convert a weak reference to a strong reference before working with it
|
|||
|
|
LFileSystem: TIdFTPBaseFileSystem;
|
|||
|
|
begin
|
|||
|
|
LFileSystem := FTPFileSystem;
|
|||
|
|
if Assigned(LFileSystem) then begin
|
|||
|
|
LFileSystem.RenameFile(ASender, ARenameToFile);
|
|||
|
|
end else if Assigned(FOnRenameFile) then begin
|
|||
|
|
FOnRenameFile(ASender, ARenameFromFile, ARenameToFile);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.DoOnGetFileDate(ASender: TIdFTPServerContext;
|
|||
|
|
const AFilename: string; var VFileDate: TDateTime);
|
|||
|
|
var
|
|||
|
|
// under ARC, convert a weak reference to a strong reference before working with it
|
|||
|
|
LFileSystem: TIdFTPBaseFileSystem;
|
|||
|
|
begin
|
|||
|
|
LFileSystem := FTPFileSystem;
|
|||
|
|
if Assigned(LFileSystem) then begin
|
|||
|
|
LFileSystem.GetFileDate(ASender, AFileName, VFileDate);
|
|||
|
|
VFileDate := VFileDate - OffsetFromUTC;
|
|||
|
|
end else if Assigned(FOnGetFileDate) then begin
|
|||
|
|
FOnGetFileDate(ASender, AFileName, VFileDate);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.DoOnGetFileSize(ASender: TIdFTPServerContext;
|
|||
|
|
const AFilename: string; var VFileSize: Int64);
|
|||
|
|
var
|
|||
|
|
// under ARC, convert a weak reference to a strong reference before working with it
|
|||
|
|
LFileSystem: TIdFTPBaseFileSystem;
|
|||
|
|
begin
|
|||
|
|
LFileSystem := FTPFileSystem;
|
|||
|
|
if Assigned(LFileSystem) then begin
|
|||
|
|
LFileSystem.GetFileSize(ASender, AFileName, VFileSize);
|
|||
|
|
end else if Assigned(FOnGetFileSize) then begin
|
|||
|
|
FOnGetFileSize(ASender, AFileName, VFileSize);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.DoOnDeleteFile(ASender: TIdFTPServerContext;
|
|||
|
|
const APathName: string);
|
|||
|
|
var
|
|||
|
|
// under ARC, convert a weak reference to a strong reference before working with it
|
|||
|
|
LFileSystem: TIdFTPBaseFileSystem;
|
|||
|
|
begin
|
|||
|
|
LFileSystem := FTPFileSystem;
|
|||
|
|
if Assigned(LFileSystem) then begin
|
|||
|
|
LFileSystem.DeleteFile(ASender, APathName);
|
|||
|
|
end else if Assigned(FOnDeleteFile) then begin
|
|||
|
|
FOnDeleteFile(ASender, APathName);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.SetUseTLS(AValue: TIdUseTLS);
|
|||
|
|
begin
|
|||
|
|
inherited SetUseTLS(AValue);
|
|||
|
|
if AValue = utUseImplicitTLS then
|
|||
|
|
begin
|
|||
|
|
if DefaultDataPort = IdPORT_FTP_DATA then begin
|
|||
|
|
DefaultDataPort := IdPORT_ftps_data;
|
|||
|
|
end;
|
|||
|
|
end
|
|||
|
|
else if DefaultDataPort = IdPORT_ftps_data then begin
|
|||
|
|
DefaultDataPort := IdPORT_FTP_DATA;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.DisconUser(ASender: TIdCommand);
|
|||
|
|
begin
|
|||
|
|
ASender.Disconnect := True;
|
|||
|
|
ASender.Reply.SetReply(421, RSFTPClosingConnection);
|
|||
|
|
if Assigned(OnLoginFailureBanner) then begin
|
|||
|
|
OnLoginFailureBanner(TIdFTPServerContext(ASender.Context), ASender.Reply);
|
|||
|
|
ASender.Reply.SetReply(421, ASender.Reply.Text.Text);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.SetRFCReplyFormat(AReply: TIdReply);
|
|||
|
|
begin
|
|||
|
|
if AReply is TIdReplyFTP then begin
|
|||
|
|
TIdReplyFTP(AReply).ReplyFormat := rfIndentMidLines;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandSiteATTRIB(ASender : TIdCommand);
|
|||
|
|
var
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
LFileName,
|
|||
|
|
LAttrs : String;
|
|||
|
|
LAttrVal : UInt32;
|
|||
|
|
LPermitted : Boolean;
|
|||
|
|
|
|||
|
|
function ValidAttribStr(const AAttrib : String) : Boolean;
|
|||
|
|
var i : Integer;
|
|||
|
|
begin
|
|||
|
|
Result := TextStartsWith(AAttrib, '+');
|
|||
|
|
if Result then begin
|
|||
|
|
Result := Length(AAttrib)>1;
|
|||
|
|
if result then begin
|
|||
|
|
if AAttrib = '+N' then begin
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
for i := 2 to Length(AAttrib) do begin
|
|||
|
|
if not CharIsInSet(AAttrib,i,'RASH') then begin
|
|||
|
|
Result := False;
|
|||
|
|
break;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
begin
|
|||
|
|
LContext := ASender.Context as TIdFTPServerContext;
|
|||
|
|
if LContext.IsAuthenticated(ASender) then begin
|
|||
|
|
if Assigned(OnSetAttrib) then begin
|
|||
|
|
LFileName := ASender.UnparsedParams;
|
|||
|
|
LAttrs := Fetch(LFileName);
|
|||
|
|
LPermitted := True;
|
|||
|
|
LAttrs := UpperCase(LAttrs);
|
|||
|
|
if TextStartsWith(LAttrs, '+') then begin
|
|||
|
|
if ValidAttribStr(LAttrs) then begin
|
|||
|
|
LAttrVal := 0;
|
|||
|
|
ASender.Reply.Clear;
|
|||
|
|
ASender.Reply.SetReply(220,'');
|
|||
|
|
if IndyPos('R', LATTRS) > 0 then begin
|
|||
|
|
LAttrVal := LAttrVal or IdFILE_ATTRIBUTE_READONLY;
|
|||
|
|
ASender.Reply.Text.Add(RSFTPSiteATTRIBMsg+' : +FILE_ATTRIBUTE_READONLY'); {Do not localize}
|
|||
|
|
end;
|
|||
|
|
if IndyPos('A', LATTRS) > 0 then begin
|
|||
|
|
LAttrVal := LAttrVal or IdFILE_ATTRIBUTE_ARCHIVE;
|
|||
|
|
ASender.Reply.Text.Add(RSFTPSiteATTRIBMsg+' : +FILE_ATTRIBUTE_ARCHIVE'); {Do not localize}
|
|||
|
|
end;
|
|||
|
|
if IndyPos('S', LATTRS) > 0 then begin
|
|||
|
|
LAttrVal := LAttrVal or IdFILE_ATTRIBUTE_SYSTEM;
|
|||
|
|
ASender.Reply.Text.Add(RSFTPSiteATTRIBMsg+' : +FILE_ATTRIBUTE_SYSTEM'); {Do not localize}
|
|||
|
|
end;
|
|||
|
|
if IndyPos('H', LATTRS) > 0 then begin
|
|||
|
|
LAttrVal := LAttrVal or IdFILE_ATTRIBUTE_HIDDEN;
|
|||
|
|
ASender.Reply.Text.Add(RSFTPSiteATTRIBMsg+' : +FILE_ATTRIBUTE_HIDDEN'); {Do not localize}
|
|||
|
|
end;
|
|||
|
|
if IndyPos('N', LATTRS) > 0 then begin
|
|||
|
|
LAttrVal := LAttrVal or IdFILE_ATTRIBUTE_NORMAL;
|
|||
|
|
ASender.Reply.Text.Add(RSFTPSiteATTRIBMsg+' : +FILE_ATTRIBUTE_NORMAL'); {Do not localize}
|
|||
|
|
end;
|
|||
|
|
ASender.Reply.Text.Add(RSFTPSiteATTRIBMsg + IndyFormat(RSFTPSiteATTRIBDone, [IntToStr(Length(LAttrs)-1)]));
|
|||
|
|
LFileName := DoProcessPath(LContext, LFileName);
|
|||
|
|
DoOnSetATTRIB(LContext, LAttrVal, LFileName, LPermitted);
|
|||
|
|
end else begin
|
|||
|
|
ASender.Reply.SetReply(550,RSFTPSiteATTRIBInvalid);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
if not LPermitted then begin
|
|||
|
|
ASender.Reply.SetReply(553, RSFTPPermissionDenied);
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
ASender.Reply.SetReply(550,RSFTPSiteATTRIBInvalid);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
ASender.Reply.Assign(FReplyUnknownSITECommand);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandSiteUTIME(ASender: TIdCommand);
|
|||
|
|
|
|||
|
|
procedure TryNewFTPSyntax(AContext: TIdFTPServerContext; ALSender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
LgMTime : TDateTime;
|
|||
|
|
LgPermitted : Boolean;
|
|||
|
|
LFileName : String;
|
|||
|
|
LDummy1, LDummy2 : TDateTime;
|
|||
|
|
begin
|
|||
|
|
//this is for gFTP Syntax
|
|||
|
|
//such as: "SITE UTIME 20050815041129 /.bashrc"
|
|||
|
|
LgPermitted := True;
|
|||
|
|
if ALSender.Params.Count = 0 then begin
|
|||
|
|
CmdSyntaxError(ALSender);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
if IsValidTimeStamp(ALSender.Params[0]) then begin
|
|||
|
|
LFileName := ALSender.UnparsedParams;
|
|||
|
|
//This is local Time
|
|||
|
|
LgMTime := FTPMLSToGMTDateTime(Fetch(LFileName)) - OffsetFromUTC;
|
|||
|
|
LFileName := DoProcessPath(AContext, LFileName);
|
|||
|
|
if Assigned(FOnSiteUTIME) then
|
|||
|
|
begin
|
|||
|
|
//indicate that both creation time and last access time should not be set
|
|||
|
|
LDummy1 := 0;
|
|||
|
|
LDummy2 := 0;
|
|||
|
|
FOnSiteUTIME(AContext, LFileName, LDummy1, LgMTime, LDummy2, LgPermitted);
|
|||
|
|
end
|
|||
|
|
else if Assigned(FOnSetModifiedTime) then begin
|
|||
|
|
FOnSetModifiedTime(AContext, LFileName, LgMTime);
|
|||
|
|
end;
|
|||
|
|
if LgPermitted then begin
|
|||
|
|
ALSender.Reply.SetReply(200, RSFTPCHMODSuccessful);
|
|||
|
|
end else begin
|
|||
|
|
ALSender.Reply.SetReply(553, RSFTPPermissionDenied);
|
|||
|
|
end;
|
|||
|
|
end else
|
|||
|
|
begin
|
|||
|
|
CmdSyntaxError(ALSender);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
var
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
LPermitted : Boolean;
|
|||
|
|
LFileName : String;
|
|||
|
|
LIdx : Integer;
|
|||
|
|
LDateCount : Integer;
|
|||
|
|
LAccessTime, LModTime, LCreateTime : TDateTime;
|
|||
|
|
i : Integer;
|
|||
|
|
begin
|
|||
|
|
{
|
|||
|
|
This is used by NcFTP like this:
|
|||
|
|
|
|||
|
|
SITE UTIME test.txt 20050731224504 20050731041205 20050731035940 UTC
|
|||
|
|
|
|||
|
|
where the first date is the "Last Access Time"
|
|||
|
|
the second date is the "Last Modified Time"
|
|||
|
|
and the final date is the "Creation File Time"
|
|||
|
|
|
|||
|
|
I think the third parameter is optional.
|
|||
|
|
|
|||
|
|
The final parameter is "UTC"
|
|||
|
|
|
|||
|
|
gFTP does something different. It does something like:
|
|||
|
|
|
|||
|
|
SITE UTIME 20050815041129 /.bashrc
|
|||
|
|
|
|||
|
|
where the timestamp is probably in based on the local time.
|
|||
|
|
}
|
|||
|
|
LPermitted := True;
|
|||
|
|
LAccessTime := 0;
|
|||
|
|
LModTime := 0;
|
|||
|
|
LCreateTime := 0;
|
|||
|
|
LContext := ASender.Context as TIdFTPServerContext;
|
|||
|
|
if LContext.IsAuthenticated(ASender) then
|
|||
|
|
begin
|
|||
|
|
if Assigned(OnSiteUTIME) or Assigned(OnSetModifiedTime) or Assigned(OnSetCreationTime) then begin
|
|||
|
|
LDateCount := 0;
|
|||
|
|
LIdx := ASender.Params.Count - 1;
|
|||
|
|
if ASender.Params.Count > 2 then begin
|
|||
|
|
LPermitted := True;
|
|||
|
|
if TextIsSame(ASender.Params[LIdx], 'UTC') then begin
|
|||
|
|
//figure out how many dates we have and where the end of the filename is
|
|||
|
|
Dec(LIdx);
|
|||
|
|
Inc(LDateCount);
|
|||
|
|
if IsValidTimeStamp(ASender.Params[LIdx]) then begin
|
|||
|
|
Dec(LIdx);
|
|||
|
|
Inc(LDateCount);
|
|||
|
|
if IsValidTimeStamp(ASender.Params[LIdx]) then begin
|
|||
|
|
Dec(LIdx);
|
|||
|
|
Inc(LDateCount);
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
TryNewFTPSyntax(LContext, ASender);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
//now extract the date
|
|||
|
|
LAccessTime := FTPMLSToGMTDateTime(ASender.Params[LIdx]);
|
|||
|
|
if LDateCount > 1 then begin
|
|||
|
|
LModTime := FTPMLSToGMTDateTime(ASender.Params[LIdx+1]);
|
|||
|
|
end;
|
|||
|
|
if LDateCount > 2 then begin
|
|||
|
|
LCreateTime := FTPMLSToGMTDateTime(ASender.Params[LIdx+2]);
|
|||
|
|
end;
|
|||
|
|
//extract filename including any spaces
|
|||
|
|
LFileName := '';
|
|||
|
|
for i := 0 to LIdx-1 do begin
|
|||
|
|
LFileName := LFileName + ' ' + ASender.Params[i];
|
|||
|
|
end;
|
|||
|
|
IdDelete(LFileName,1,1);
|
|||
|
|
LFileName := DoProcessPath(LContext,LFileName);
|
|||
|
|
//now do it
|
|||
|
|
if Assigned(FOnSiteUTIME) then begin
|
|||
|
|
FOnSiteUTIME(LContext, LFileName, LAccessTime, LModTime, LCreateTime, LPermitted);
|
|||
|
|
end else begin
|
|||
|
|
if (LModTime <> 0) and Assigned(FOnSetModifiedTime) then begin
|
|||
|
|
FOnSetModifiedTime(LContext, LFileName, LModTime);
|
|||
|
|
end;
|
|||
|
|
if (LCreateTime <> 0) and Assigned(FOnSetCreationTime) then begin
|
|||
|
|
FOnSetCreationTime(LContext, LFileName, LCreateTime);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
if LPermitted then begin
|
|||
|
|
ASender.Reply.SetReply(200, RSFTPCHMODSuccessful);
|
|||
|
|
end else begin
|
|||
|
|
ASender.Reply.SetReply(553, RSFTPPermissionDenied);
|
|||
|
|
end;
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
TryNewFTPSyntax(LContext, ASender);
|
|||
|
|
// CmdNotImplemented(ASender);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.DoOnSiteCHGRP(ASender: TIdFTPServerContext;
|
|||
|
|
var AGroup: String; const AFileName: String; var VAUth: Boolean);
|
|||
|
|
begin
|
|||
|
|
if Assigned(FOnSiteCHGRP) then begin
|
|||
|
|
FOnSiteCHGRP(ASender, AGroup, AFileName, VAuth);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.DoOnSiteCHOWN(ASender: TIdFTPServerContext; var AOwner,
|
|||
|
|
AGroup: String; const AFileName: String; var VAUth: Boolean);
|
|||
|
|
begin
|
|||
|
|
if Assigned(FOnSiteCHOWN) then begin
|
|||
|
|
OnSiteCHOWN(ASender, AOwner, AGroup, AFileName, VAuth);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandSiteCHOWN(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
LPermitted : Boolean;
|
|||
|
|
LFileName : String;
|
|||
|
|
LOwner, LGroup : string;
|
|||
|
|
begin
|
|||
|
|
LContext := ASender.Context as TIdFTPServerContext;
|
|||
|
|
if LContext.IsAuthenticated(ASender) then begin
|
|||
|
|
if Assigned(OnSiteCHOWN) then begin
|
|||
|
|
LPermitted := True;
|
|||
|
|
LFileName := ASender.UnparsedParams;
|
|||
|
|
LGroup := Fetch(LFileName);
|
|||
|
|
LOwner := Fetch(LGroup,':');
|
|||
|
|
DoOnSiteCHOWN(LContext, LOwner, LGroup, DoProcessPath(LContext, LFileName), LPermitted);
|
|||
|
|
if LPermitted then begin
|
|||
|
|
ASender.Reply.SetReply(220, IndyFormat(RSFTPCmdSuccessful, [ASender.RawLine]));
|
|||
|
|
end else begin
|
|||
|
|
ASender.Reply.SetReply(553, RSFTPPermissionDenied);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandSiteCHGRP(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
LPermitted : Boolean;
|
|||
|
|
LFileName : String;
|
|||
|
|
LGroup : String;
|
|||
|
|
begin
|
|||
|
|
LContext := ASender.Context as TIdFTPServerContext;
|
|||
|
|
if LContext.IsAuthenticated(ASender) then begin
|
|||
|
|
if Assigned(FOnSiteCHGRP) then begin
|
|||
|
|
LPermitted := True;
|
|||
|
|
LFileName := ASender.UnparsedParams;
|
|||
|
|
LGroup := Fetch(LFileName);
|
|||
|
|
DoOnSiteCHGRP(LContext, LGroup, DoProcessPath(LContext, LFileName), LPermitted);
|
|||
|
|
if LPermitted then begin
|
|||
|
|
ASender.Reply.SetReply(200, IndyFormat(RSFTPCmdSuccessful, [ASender.RawLine]));
|
|||
|
|
end else begin
|
|||
|
|
ASender.Reply.SetReply(553, RSFTPPermissionDenied);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandSiteCHMOD(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
LPermitted : Boolean;
|
|||
|
|
LFileName : String;
|
|||
|
|
LPerms : String;
|
|||
|
|
LPermNo : Integer;
|
|||
|
|
// under ARC, convert a weak reference to a strong reference before working with it
|
|||
|
|
LFileSystem: TIdFTPBaseFileSystem;
|
|||
|
|
begin
|
|||
|
|
LContext := ASender.Context as TIdFTPServerContext;
|
|||
|
|
if LContext.IsAuthenticated(ASender) then begin
|
|||
|
|
LFileSystem := FTPFileSystem;
|
|||
|
|
if Assigned(OnSiteCHMOD ) or Assigned(LFileSystem) then begin
|
|||
|
|
LFileName := ASender.UnparsedParams;
|
|||
|
|
LPerms := Fetch(LFileName);
|
|||
|
|
If IsValidPermNumbers(LPerms) then begin
|
|||
|
|
LPermitted := True;
|
|||
|
|
LPermNo := IndyStrToInt(LPerms, 0);
|
|||
|
|
DoOnSiteCHMOD(LContext, LPermNo, DoProcessPath(LContext, LFileName), LPermitted);
|
|||
|
|
if LPermitted then begin
|
|||
|
|
ASender.Reply.SetReply(220, RSFTPCHMODSuccessful);
|
|||
|
|
end else begin
|
|||
|
|
ASender.Reply.SetReply(553, RSFTPPermissionDenied);
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
CmdNotImplemented(ASender);
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
ASender.Reply.Assign(FReplyUnknownSITECommand);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandSiteUMASK(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
LNewMask : Integer;
|
|||
|
|
LPermitted : Boolean;
|
|||
|
|
begin
|
|||
|
|
LContext := ASender.Context as TIdFTPServerContext;
|
|||
|
|
if LContext.IsAuthenticated(ASender) then begin
|
|||
|
|
if Assigned(FOnSiteUMASK) then begin
|
|||
|
|
if ASender.Params.Count > 0 then begin
|
|||
|
|
If IsValidPermNumbers(ASender.Params[0]) then begin
|
|||
|
|
LPermitted := True;
|
|||
|
|
LNewMask := IndyStrToInt(ASender.Params[0], 0);
|
|||
|
|
DoOnSiteUMASK(LContext, LNewMask, LPermitted);
|
|||
|
|
if LPermitted then begin
|
|||
|
|
ASender.Reply.SetReply(200, IndyFormat(RSFTPUMaskSet, [LNewMask, LContext.FUMask]));
|
|||
|
|
LContext.FUMask := LNewMask;
|
|||
|
|
end else begin
|
|||
|
|
ASender.Reply.SetReply(553, RSFTPPermissionDenied);
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
CmdNotImplemented(ASender);
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
ASender.Reply.SetReply(200, IndyFormat(RSFTPUMaskIs, [LContext.FUMask]));
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
CmdNotImplemented(ASender);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdFTPServer.IsValidPermNumbers(const APermNos: String): Boolean;
|
|||
|
|
const
|
|||
|
|
PERMDIGITS = '01234567';
|
|||
|
|
var
|
|||
|
|
i: Integer;
|
|||
|
|
begin
|
|||
|
|
Result := False;
|
|||
|
|
for i := 1 to Length(APermNos) do begin
|
|||
|
|
if not CharIsInSet(APermNos, i, PERMDIGITS) then begin
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
Result := True;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.DoOnSiteUMASK(ASender: TIdFTPServerContext;
|
|||
|
|
var VUMASK: Integer; var VAUth: Boolean);
|
|||
|
|
begin
|
|||
|
|
if Assigned(FOnSiteUMASK) then begin
|
|||
|
|
FOnSiteUMASK(ASender,VUMASK,VAUth);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.DoOnSetATTRIB(ASender: TIdFTPServerContext; var VAttr : UInt32; const AFileName : String; var VAUth : Boolean);
|
|||
|
|
begin
|
|||
|
|
if Assigned( FOnSetATTRIB) then begin
|
|||
|
|
FOnSetATTRIB(ASender, VAttr, AFileName, VAUth);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.DoOnSiteCHMOD(ASender: TIdFTPServerContext;
|
|||
|
|
var APermissions: Integer; const AFileName: String; var VAUth: Boolean);
|
|||
|
|
begin
|
|||
|
|
if Assigned(FOnSiteCHMOD) then begin
|
|||
|
|
FOnSiteCHMOD(ASender,APermissions,AFileName,VAUth);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandSiteDIRSTYLE(ASender: TIdCommand);
|
|||
|
|
//FMSDOSMode
|
|||
|
|
var
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
//SITE DIRSTYLE is only for MS-DOS formatted directory lists so
|
|||
|
|
//a program can flip to Unix directory list format. This is
|
|||
|
|
//for compatability purposes, ONLY.
|
|||
|
|
begin
|
|||
|
|
LContext := ASender.Context as TIdFTPServerContext;
|
|||
|
|
if (FDirFormat = ftpdfDOS) or
|
|||
|
|
((FDirFormat = ftpdfOSDependent) and (GOSType = otWindows)) then begin
|
|||
|
|
if LContext.IsAuthenticated(ASender) then begin
|
|||
|
|
if ASender.Params.Count = 0 then begin
|
|||
|
|
LContext.FMSDOSMode := not LContext.FMSDOSMode;
|
|||
|
|
if LContext.FMSDOSMode then begin
|
|||
|
|
ASender.Reply.SetReply(200, IndyFormat(RSFTPDirStyle, [RSFTPOn]));
|
|||
|
|
end else begin
|
|||
|
|
ASender.Reply.SetReply(200, IndyFormat(RSFTPDirStyle, [RSFTPOff]));
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
ASender.Reply.Assign(FReplyUnknownSITECommand);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandSiteHELP(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
s : String;
|
|||
|
|
LCmds : TStringList;
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
begin
|
|||
|
|
LContext := ASender.Context as TIdFTPServerContext;
|
|||
|
|
if LContext.IsAuthenticated(ASender) then begin
|
|||
|
|
s := RSFTPSITECmdsSupported+EOL;
|
|||
|
|
LCmds := TStringList.Create;
|
|||
|
|
try
|
|||
|
|
if Assigned(OnSetAttrib) then begin
|
|||
|
|
LCmds.Add('ATTRIB'); {Do not translate}
|
|||
|
|
end;
|
|||
|
|
if Assigned(OnSiteCHMOD) then begin
|
|||
|
|
LCmds.Add('CHMOD'); {Do not translate}
|
|||
|
|
end;
|
|||
|
|
if (FDirFormat = ftpdfDOS) or
|
|||
|
|
((FDirFormat = ftpdfOSDependent) and (GOSType = otWindows)) then begin
|
|||
|
|
LCmds.Add('DIRSTYLE'); {Do not translate}
|
|||
|
|
end;
|
|||
|
|
if Assigned(OnSiteUMASK) then begin
|
|||
|
|
LCmds.Add('UMASK'); {Do not translate}
|
|||
|
|
end;
|
|||
|
|
LCmds.Add('ZONE'); {Do not translate}
|
|||
|
|
s := s + HelpText(LCmds) + FEndOfHelpLine;
|
|||
|
|
ASender.Reply.SetReply(214, s);
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(LCmds);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdFTPServer.HelpText(Cmds: TStrings): String;
|
|||
|
|
var
|
|||
|
|
LRows : Integer;
|
|||
|
|
LMod : Integer;
|
|||
|
|
i : Integer;
|
|||
|
|
begin
|
|||
|
|
Result := '';
|
|||
|
|
if Cmds.Count =0 then begin
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
LRows := Cmds.Count div 6;
|
|||
|
|
LMod := Cmds.Count mod 6;
|
|||
|
|
if Cmds.Count < 6 then begin
|
|||
|
|
Result := ' ';
|
|||
|
|
for i := 0 to Cmds.Count -1 do begin
|
|||
|
|
Result := Result + IndyFormat('%-10s', [Cmds[i]]);
|
|||
|
|
end;
|
|||
|
|
Result := Result + CR;
|
|||
|
|
end else begin
|
|||
|
|
for i := 0 to (LRows -1) do begin
|
|||
|
|
if (i <= LMod-1) and (LMod<>0) then begin
|
|||
|
|
Result := Result + IndyFormat(' %-10s%-10s%-10s%-10s%-10s%-10s%-10s', {Do not translate}
|
|||
|
|
[ Cmds[i],Cmds[i+LRows],Cmds[(LRows*2)+i],
|
|||
|
|
Cmds[(LRows*3)+i],Cmds[(LRows*4)+i],Cmds[(LRows*5)+i],
|
|||
|
|
Cmds[(LRows*6)+i]])+CR;
|
|||
|
|
end else begin
|
|||
|
|
Result := Result + IndyFormat(' %-10s%-10s%-10s%-10s%-10s%-10s', {Do not translate}
|
|||
|
|
[ Cmds[i],Cmds[i+LRows],Cmds[(LRows*2)+i],
|
|||
|
|
Cmds[(LRows*3)+i],Cmds[(LRows*4)+i],Cmds[(LRows*5)+i]])+CR;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandSITE(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
LCmd : String;
|
|||
|
|
begin
|
|||
|
|
LCmd := ASender.UnparsedParams;
|
|||
|
|
ASender.Reply.Clear;
|
|||
|
|
ASender.PerformReply := False;
|
|||
|
|
if not FSITECommands.HandleCommand(ASender.Context, LCmd) then begin
|
|||
|
|
ASender.Reply.NumericCode := 500;
|
|||
|
|
CmdSyntaxError(ASender.Context, ASender.CommandHandler.Command + ' ' + LCmd, ASender.Reply);
|
|||
|
|
ASender.PerformReply := False;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdFTPServer.MLSFEATLine(const AFactMask: TIdMLSDAttrs;
|
|||
|
|
const AFacts: TIdFTPFactOutputs): String;
|
|||
|
|
begin
|
|||
|
|
Result := 'MLST size'; {Do not translate}
|
|||
|
|
//the * indicates if the option is selected for MLST
|
|||
|
|
if Size in AFacts then begin {Do not translate}
|
|||
|
|
Result := Result + '*;';
|
|||
|
|
end else begin
|
|||
|
|
Result := Result + ';'
|
|||
|
|
end;
|
|||
|
|
Result := Result + 'Type'; {Do not translate}
|
|||
|
|
if ItemType in AFacts then begin {Do not translate}
|
|||
|
|
Result := Result + '*;'; {Do not translate}
|
|||
|
|
end else begin
|
|||
|
|
Result := Result + ';';
|
|||
|
|
end;
|
|||
|
|
if mlsdPerms in FMLSDFacts then begin
|
|||
|
|
Result := Result + 'Perm'; {Do not translate}
|
|||
|
|
if Perm in AFacts then begin {Do not translate}
|
|||
|
|
Result := Result + '*;'; {Do not translate}
|
|||
|
|
end else begin
|
|||
|
|
Result := Result + ';';
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
if mlsdFileCreationTime in FMLSDFacts then begin
|
|||
|
|
Result := Result + 'Create'; {Do not translate}
|
|||
|
|
if CreateTime in AFacts then begin {Do not translate}
|
|||
|
|
Result := Result + '*;'; {Do not translate}
|
|||
|
|
end else begin
|
|||
|
|
Result := Result + ';';
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
Result := Result + 'Modify'; {Do not translate}
|
|||
|
|
if Modify in AFacts then begin
|
|||
|
|
Result := Result + '*;';
|
|||
|
|
end else begin
|
|||
|
|
Result := Result + ';';
|
|||
|
|
end;
|
|||
|
|
if mlsdUnixModes in FMLSDFacts then begin
|
|||
|
|
Result := Result + 'UNIX.mode'; {Do not translate}
|
|||
|
|
if UnixMODE in AFacts then begin {Do not translate}
|
|||
|
|
Result := Result + '*;'; {Do not translate}
|
|||
|
|
end else begin
|
|||
|
|
Result := Result + ';';
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
if mlsdUnixOwner in FMLSDFacts then
|
|||
|
|
begin
|
|||
|
|
Result := Result + 'UNIX.owner'; {Do not translate}
|
|||
|
|
if UnixOwner in AFacts then begin {Do not translate}
|
|||
|
|
Result := Result + '*;'; {Do not translate}
|
|||
|
|
end else begin
|
|||
|
|
Result := Result + ';';
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
if mlsdUnixGroup in FMLSDFacts then begin
|
|||
|
|
Result := Result + 'UNIX.group'; {Do not translate}
|
|||
|
|
if UnixGroup in AFacts then begin {Do not translate}
|
|||
|
|
Result := Result + '*;'; {Do not translate}
|
|||
|
|
end else begin
|
|||
|
|
Result := Result + ';';
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
if mlsdUniqueID in FMLSDFacts then begin
|
|||
|
|
Result := Result + 'Unique'; {Do not translate}
|
|||
|
|
if Unique in AFacts then begin {Do not translate}
|
|||
|
|
Result := Result + '*;'; {Do not translate}
|
|||
|
|
end else begin
|
|||
|
|
Result := Result + ';';
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
if mlsdFileLastAccessTime in FMLSDFacts then begin
|
|||
|
|
Result := Result + 'Windows.lastaccesstime'; {Do not translate}
|
|||
|
|
if CreateTime in AFacts then begin {Do not translate}
|
|||
|
|
Result := Result + '*;'; {Do not translate}
|
|||
|
|
end else begin
|
|||
|
|
Result := Result + ';';
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
if mlsdWin32Attributes in FMLSDFacts then begin
|
|||
|
|
Result := Result + 'Win32.ea'; {Do not translate}
|
|||
|
|
if WinAttribs in AFacts then begin {Do not translate}
|
|||
|
|
Result := Result + '*;'; {Do not translate}
|
|||
|
|
end else begin
|
|||
|
|
Result := Result + ';';
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
if mlsdWin32DriveType in FMLSDFacts then begin
|
|||
|
|
Result := Result + 'Win32.dt';
|
|||
|
|
if WinDriveType in AFacts then begin
|
|||
|
|
Result := Result + '*;'; {Do not localize}
|
|||
|
|
end else begin
|
|||
|
|
Result := Result + ';'; {Do not localize}
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
if mlstWin32DriveLabel in FMLSDFacts then begin
|
|||
|
|
Result := Result + 'Win32.dl';
|
|||
|
|
if WinDriveLabel in AFacts then begin
|
|||
|
|
Result := Result + '*;'; {Do not localize}
|
|||
|
|
end else begin
|
|||
|
|
Result := Result + ';'; {Do not localize}
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
if Length(Result)>0 then begin
|
|||
|
|
IdDelete(Result,Length(Result),1);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandCLNT(ASender: TIdCommand);
|
|||
|
|
begin
|
|||
|
|
if Assigned(FOnClientID) then begin
|
|||
|
|
FOnClientID(ASender.Context as TIdFTPServerContext, ASender.UnparsedParams);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.SetPASVBoundPortMax(const AValue: TIdPort);
|
|||
|
|
begin
|
|||
|
|
if FPASVBoundPortMin <> 0 then begin
|
|||
|
|
if AValue <= FPASVBoundPortMin then begin
|
|||
|
|
raise EIdFTPBoundPortMaxGreater.Create(RSFTPPASVBoundPortMaxMustBeGreater);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
FPASVBoundPortMax := AValue;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.SetPASVBoundPortMin(const AValue: TIdPort);
|
|||
|
|
begin
|
|||
|
|
if FPASVBoundPortMax <> 0 then begin
|
|||
|
|
if FPASVBoundPortMax <= AValue then begin
|
|||
|
|
raise EIdFTPBoundPortMinLess.Create(RSFTPPASVBoundPortMinMustBeLess);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
FPASVBoundPortMin := AValue;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.DoOnDataPortAfterBind(ASender: TIdFTPServerContext);
|
|||
|
|
begin
|
|||
|
|
if Assigned(FOnDataPortAfterBind) then begin
|
|||
|
|
FOnDataPortAfterBind(ASender);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.DoOnDataPortBeforeBind(ASender: TIdFTPServerContext);
|
|||
|
|
begin
|
|||
|
|
if Assigned(FOnDataPortBeforeBind) then begin
|
|||
|
|
FOnDataPortBeforeBind(ASender);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdFTPServer.FTPNormalizePath(const APath: String): String;
|
|||
|
|
{
|
|||
|
|
Microsoft IIS accepts both a "/" and a "\" as path/file name separators.
|
|||
|
|
We have to flatten this out so that our FTP server can behave like Microsoft IIS.
|
|||
|
|
|
|||
|
|
In Unix, a "\" is a valid filename character so we don't anything there.
|
|||
|
|
|
|||
|
|
This WILL cause a "\" to be treated differently in Unix and Win32. I submit that
|
|||
|
|
this is really desirable as both file systems are like apples and oranges.
|
|||
|
|
}
|
|||
|
|
begin
|
|||
|
|
case FPathProcessing of
|
|||
|
|
ftppDOS : Result := ReplaceAll(APath, '\', '/');
|
|||
|
|
ftpOSDependent :
|
|||
|
|
begin
|
|||
|
|
if GOSType = otWindows then begin
|
|||
|
|
Result := ReplaceAll(APath, '\', '/');
|
|||
|
|
end else begin
|
|||
|
|
Result := APath;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
else
|
|||
|
|
Result := APath;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdFTPServer.DoProcessPath(ASender: TIdFTPServerContext; const APath: TIdFTPFileName): TIdFTPFileName;
|
|||
|
|
begin
|
|||
|
|
if FPathProcessing <> ftppCustom then begin
|
|||
|
|
Result := FTPNormalizePath(APath);
|
|||
|
|
Result := ProcessPath(ASender.CurrentDir, Result); {Do not Localize}
|
|||
|
|
end else begin
|
|||
|
|
Result := APath;
|
|||
|
|
if Assigned(FOnCustomPathProcess) then begin
|
|||
|
|
FOnCustomPathProcess(ASender, Result);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdFTPServer.CDUPDir(AContext : TIdFTPServerContext) : String;
|
|||
|
|
const
|
|||
|
|
LCDUP_DOS = '..\';
|
|||
|
|
CDUP_UNIX = '../';
|
|||
|
|
begin
|
|||
|
|
case FPathProcessing of
|
|||
|
|
ftppDOS : Result := LCDUP_DOS;
|
|||
|
|
ftpOSDependent :
|
|||
|
|
if GOSType = otWindows then begin
|
|||
|
|
Result := LCDUP_DOS;
|
|||
|
|
end else begin
|
|||
|
|
Result := CDUP_UNIX;
|
|||
|
|
end;
|
|||
|
|
ftppCustom : Result := DoProcessPath(AContext, '..');
|
|||
|
|
else
|
|||
|
|
Result := CDUP_UNIX;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdFTPServer.DoSysType(ASender: TIdFTPServerContext): String;
|
|||
|
|
begin
|
|||
|
|
//We tie the SYST descriptor to the directory style for compatability
|
|||
|
|
//reasons. Some FTP clients use the SYST descriptor to determine what
|
|||
|
|
//type of FTP directory list parsing to do. I think TurboPower IPros does this.
|
|||
|
|
//Note that I personally do not find this to be sound as a general rule.
|
|||
|
|
case FDirFormat of
|
|||
|
|
ftpdfOSDependent :
|
|||
|
|
begin
|
|||
|
|
if GOSType = otWindows then begin
|
|||
|
|
Result := SYST_ID_NT;
|
|||
|
|
end else begin
|
|||
|
|
Result := SYST_ID_UNIX;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
ftpdfUnix, ftpdfEPLF : Result := SYST_ID_UNIX;
|
|||
|
|
ftpdfDOS : Result := SYST_ID_NT;
|
|||
|
|
ftpdfCustom : Result := FCustomSystID;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.DoOnCustomListDirectory(
|
|||
|
|
ASender: TIdFTPServerContext; const APath: string;
|
|||
|
|
ADirectoryListing: TStrings; const ACmd, ASwitches: String);
|
|||
|
|
begin
|
|||
|
|
if Assigned(OnCustomListDirectory) then begin
|
|||
|
|
OnCustomListDirectory(ASender,APath,ADirectoryListing,ACmd,ASwitches);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CmdNotImplemented(ASender: TIdCommand);
|
|||
|
|
begin
|
|||
|
|
ASender.Reply.SetReply(550, IndyFormat(RSFTPCmdNotImplemented, [ASender.CommandHandler.Command ]));
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CmdFileActionAborted(ASender: TIdCommand);
|
|||
|
|
begin
|
|||
|
|
ASender.Reply.SetReply(550, RSFTPFileActionAborted);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
//This is for where the client didn't provide a valid number of parameters for a command
|
|||
|
|
procedure TIdFTPServer.CmdInvalidParamNum(ASender: TIdCommand);
|
|||
|
|
begin
|
|||
|
|
ASender.Reply.SetReply(501, IndyFormat(RSFTPInvalidNumberArgs, [ASender.CommandHandler.Command]));
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
//This is for other command syntax issues.
|
|||
|
|
procedure TIdFTPServer.CmdInvalidParams(ASender: TIdCommand);
|
|||
|
|
begin
|
|||
|
|
ASender.Reply.SetReply(501, IndyFormat(RSFTPParamError, [ASender.CommandHandler.Command]));
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CmdTwineFileActionAborted(ASender: TIdCommand);
|
|||
|
|
begin
|
|||
|
|
ASender.Reply.SetReply(504, RSFTPFileActionAborted);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CmdCommandSuccessful(ASender: TIdCOmmand; const AReplyCode : Integer = 250);
|
|||
|
|
begin
|
|||
|
|
ASender.Reply.SetReply(AReplyCode, IndyFormat(RSFTPCmdSuccessful, [ASender.CommandHandler.Command]));
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandSSCN(ASender: TIdCommand);
|
|||
|
|
const
|
|||
|
|
REPLY_SSCN_ON = 'SSCN:CLIENT METHOD'; {do not localize}
|
|||
|
|
REPLY_SSCN_OFF = 'SSCN:SERVER METHOD'; {do not localize}
|
|||
|
|
var
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
begin
|
|||
|
|
if UseTLS = utNoTLSSupport then begin
|
|||
|
|
CmdNotImplemented(ASender);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
LContext := ASender.Context as TIdFTPServerContext;
|
|||
|
|
if LContext.IsAuthenticated(ASender) then begin
|
|||
|
|
if ASender.Params.Count = 0 then begin
|
|||
|
|
//check state
|
|||
|
|
if LContext.SSCNOn then begin
|
|||
|
|
ASender.Reply.SetReply(200, REPLY_SSCN_ON);
|
|||
|
|
end else begin
|
|||
|
|
ASender.Reply.SetReply(200, REPLY_SSCN_OFF);
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
//set state
|
|||
|
|
case PosInStrArray(ASender.Params[0], OnOffStates, False) of
|
|||
|
|
0 : //'ON'
|
|||
|
|
begin
|
|||
|
|
LContext.SSCNOn := True;
|
|||
|
|
ASender.Reply.SetReply(200, REPLY_SSCN_ON);
|
|||
|
|
end;
|
|||
|
|
1 : //'OFF'
|
|||
|
|
begin
|
|||
|
|
LContext.SSCNOn := False;
|
|||
|
|
ASender.Reply.SetReply(200, REPLY_SSCN_OFF);
|
|||
|
|
end;
|
|||
|
|
else
|
|||
|
|
ASender.Reply.SetReply(504, RSFTPInvalidForParam);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandCPSV(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
LIO : TIdSSLIOHandlerSocketBase;
|
|||
|
|
begin
|
|||
|
|
//CPSV must be used with SSL and can only be used with IPv4
|
|||
|
|
if (UseTLS = utNoTLSSupport) or
|
|||
|
|
(ASender.Context.Binding.IPVersion <> Id_IPv4) then begin
|
|||
|
|
CmdSyntaxError(ASender);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
CommandPASV(ASender);
|
|||
|
|
LContext := TIdFTPServerContext(ASender.Context);
|
|||
|
|
LIO := LContext.DataChannel.FDataChannel.IOHandler as TIdSSLIOHandlerSocketBase;
|
|||
|
|
//tell IOHandler to use ssl_Conntect
|
|||
|
|
LIO.IsPeer := False;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandSiteZONE(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
LMin : Integer;
|
|||
|
|
begin
|
|||
|
|
LMin := MinutesFromGMT;
|
|||
|
|
//plus must always be displayed for positive numbers
|
|||
|
|
if LMin < 0 then begin
|
|||
|
|
ASender.Reply.SetReply(210, IndyFormat('UTC%d', [MinutesFromGMT])); {do not localize}
|
|||
|
|
end else begin
|
|||
|
|
ASender.Reply.SetReply(210, IndyFormat('UTC+%d', [MinutesFromGMT])); {do not localize}
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandCheckSum(ASender: TIdCommand);
|
|||
|
|
const
|
|||
|
|
HashTypes: array[0..4] of TIdHashClass = (TIdHashCRC32, TIdHashMessageDigest5, TIdHashSHA1, TIdHashSHA256, TIdHashSHA512);
|
|||
|
|
var
|
|||
|
|
LCalcStream : TStream;
|
|||
|
|
LFileName, LCheckSum, LBuf : String;
|
|||
|
|
LBeginPos, LEndPos : TIdStreamSize;
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
LHashIdx: Integer;
|
|||
|
|
// under ARC, convert a weak reference to a strong reference before working with it
|
|||
|
|
LFileSystem: TIdFTPBaseFileSystem;
|
|||
|
|
begin
|
|||
|
|
if GetFIPSMode and
|
|||
|
|
(PosInStrArray(ASender.CommandHandler.Command, ['XCRC', 'XMD5']) > -1) then begin
|
|||
|
|
CmdSyntaxError(ASender);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
LFileSystem := FTPFileSystem;
|
|||
|
|
if Assigned(FOnCRCFile) or Assigned(LFileSystem) then begin
|
|||
|
|
LContext := TIdFTPServerContext(ASender.Context);
|
|||
|
|
if LContext.IsAuthenticated(ASender) then begin
|
|||
|
|
LBuf := ASender.UnparsedParams;
|
|||
|
|
if Pos('"', LBuf) > 0 then begin {do not localize}
|
|||
|
|
Fetch(LBuf, '"'); {do not localize}
|
|||
|
|
LFileName := Fetch(LBuf, '"'); {do not localize}
|
|||
|
|
end else begin
|
|||
|
|
LFileName := Fetch(LBuf);
|
|||
|
|
end;
|
|||
|
|
if LFileName = '' then begin
|
|||
|
|
CmdInvalidParamNum(ASender);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
LBuf := Trim(LBuf);
|
|||
|
|
if LBuf <> '' then begin
|
|||
|
|
LBeginPos := IndyStrToStreamSize(Fetch(LBuf), -1);
|
|||
|
|
if LBeginPos < 0 then begin
|
|||
|
|
CmdInvalidParams(ASender);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
LBuf := Trim(LBuf);
|
|||
|
|
if LBuf <> '' then begin
|
|||
|
|
LEndPos := IndyStrToStreamSize(Fetch(LBuf), -1);
|
|||
|
|
if LEndPos < 0 then begin
|
|||
|
|
CmdInvalidParams(ASender);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
LEndPos := -1;
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
LBeginPos := 0;
|
|||
|
|
LEndPos := -1;
|
|||
|
|
end;
|
|||
|
|
LCalcStream := nil;
|
|||
|
|
LFileName := DoProcessPath(LContext, LFileName);
|
|||
|
|
DoOnCRCFile(LContext, LFileName, LCalcStream);
|
|||
|
|
if Assigned(LCalcStream) then begin
|
|||
|
|
if LEndPos = -1 then begin
|
|||
|
|
LEndPos := LCalcStream.Size;
|
|||
|
|
end;
|
|||
|
|
try
|
|||
|
|
LCalcStream.Position := 0;
|
|||
|
|
LHashIdx := PosInStrArray(ASender.CommandHandler.Command, ['XCRC', 'XMD5', 'XSHA1','XSHA256','XSHA512'], False); {do not localize}
|
|||
|
|
LCheckSum := CalculateCheckSum(HashTypes[LHashIdx], LCalcStream, LBeginPos, LEndPos);
|
|||
|
|
ASender.Reply.SetReply(250, LCheckSum);
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(LCalcStream);
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
CmdFileActionAborted(ASender);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
CmdSyntaxError(ASender);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.DoOnFileExistCheck(AContext: TIdFTPServerContext;
|
|||
|
|
const AFileName: String; var VExist: Boolean);
|
|||
|
|
begin
|
|||
|
|
if Assigned(FOnFileExistCheck) then begin
|
|||
|
|
FOnFileExistCheck(AContext, AFileName, VExist);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandSPSV(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
LIP : String;
|
|||
|
|
LBPort : Word;
|
|||
|
|
LIPVer : TIdIPVersion;
|
|||
|
|
begin
|
|||
|
|
//just to keep the compiler happy
|
|||
|
|
LBPort := 0;
|
|||
|
|
if InternalPASV(ASender, LIP, LBPort, LIPVer) then begin
|
|||
|
|
ASender.Reply.SetReply(227, IntToStr(LBPort));
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdFTPServer.InternalPASV(ASender: TIdCommand; var VIP : String;
|
|||
|
|
var VPort: TIdPort; var VIPVersion : TIdIPVersion): Boolean;
|
|||
|
|
var
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
LBPortMin, LBPortMax: TIdPort;
|
|||
|
|
LDataChannel: TIdSimpleServer;
|
|||
|
|
begin
|
|||
|
|
Result := False;
|
|||
|
|
LContext := ASender.Context as TIdFTPServerContext;
|
|||
|
|
if LContext.IsAuthenticated(ASender) then begin
|
|||
|
|
if LContext.FEPSVAll then begin
|
|||
|
|
ASender.Reply.SetReply(501, IndyFormat(RSFTPNotAllowedAfterEPSVAll, [ASender.CommandHandler.Command]));
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
VIP := LContext.Connection.Socket.Binding.IP;
|
|||
|
|
VIPVersion := LContext.Binding.IPVersion;
|
|||
|
|
|
|||
|
|
if (FPASVBoundPortMin <> 0) and (FPASVBoundPortMax <> 0) then begin
|
|||
|
|
LBPortMin := FPASVBoundPortMin;
|
|||
|
|
LBPortMax := FPASVBoundPortMax;
|
|||
|
|
end else begin
|
|||
|
|
LBPortMin := FDefaultDataPort;
|
|||
|
|
LBPortMax := LBPortMin;
|
|||
|
|
end;
|
|||
|
|
DoOnPASVBeforeBind(LContext, VIP, LBPortMin, LBPortMax, VIPVersion);
|
|||
|
|
|
|||
|
|
LContext.CreateDataChannel(True);
|
|||
|
|
LDataChannel := TIdSimpleServer(LContext.FDataChannel.FDataChannel);
|
|||
|
|
LDataChannel.BoundIP := VIP;
|
|||
|
|
if LBPortMin = LBPortMax then begin
|
|||
|
|
LDataChannel.BoundPort := LBPortMin;
|
|||
|
|
LDataChannel.BoundPortMin := 0;
|
|||
|
|
LDataChannel.BoundPortMax := 0;
|
|||
|
|
end else begin
|
|||
|
|
LDataChannel.BoundPort := 0;
|
|||
|
|
LDataChannel.BoundPortMin := LBPortMin;
|
|||
|
|
LDataChannel.BoundPortMax := LBPortMax;
|
|||
|
|
end;
|
|||
|
|
LDataChannel.IPVersion := VIPVersion;
|
|||
|
|
LDataChannel.BeginListen;
|
|||
|
|
VIP := LDataChannel.Binding.IP;
|
|||
|
|
VPort := LDataChannel.Binding.Port;
|
|||
|
|
|
|||
|
|
LContext.FPASV := True;
|
|||
|
|
LContext.FDataPortDenied := False;
|
|||
|
|
Result := True;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.DoOnPASVBeforeBind(ASender: TIdFTPServerContext;
|
|||
|
|
var VIP: String; var VPortMin, VPortMax: TIdPort; const AIPVersion: TIdIPVersion);
|
|||
|
|
begin
|
|||
|
|
if Assigned(FOnPASVBeforeBind) then begin
|
|||
|
|
FOnPASVBeforeBind(ASender, VIP, VPortMin, VPortMax, AIPVersion);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.DoOnPASVReply(ASender: TIdFTPServerContext;
|
|||
|
|
var VIP: String; var VPort: TIdPort; const AIPVersion: TIdIPVersion);
|
|||
|
|
begin
|
|||
|
|
if Assigned(FOnPASVReply) then begin
|
|||
|
|
FOnPASVReply(ASender, VIP, VPort, AIPVersion);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdFTPServer.ReadCommandLine(AContext: TIdContext): string;
|
|||
|
|
var
|
|||
|
|
i : Integer;
|
|||
|
|
State: TIdFTPTelnetState;
|
|||
|
|
lb : Byte;
|
|||
|
|
LContext: TIdFTPServerContext;
|
|||
|
|
{ Receive the line in 8-bit initially so that .NET can then
|
|||
|
|
decode any UTF-8 data into a Unicode string afterwards if
|
|||
|
|
needed }
|
|||
|
|
LLine: TIdBytes;
|
|||
|
|
LReply: TIdBytes;
|
|||
|
|
Finished: Boolean;
|
|||
|
|
begin
|
|||
|
|
Result := '';
|
|||
|
|
LContext := AContext as TIdFTPServerContext;
|
|||
|
|
//we do it this way in case there's no data. We don't want to stop
|
|||
|
|
//a data channel operation if that's the case.
|
|||
|
|
AContext.Connection.IOHandler.CheckForDataOnSource(1);
|
|||
|
|
if AContext.Connection.IOHandler.InputBufferIsEmpty then begin
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
//
|
|||
|
|
SetLength(LLine, 0);
|
|||
|
|
SetLength(LReply, 0);
|
|||
|
|
Finished := False;
|
|||
|
|
|
|||
|
|
State := tsData;
|
|||
|
|
repeat
|
|||
|
|
lb := AContext.Connection.IOHandler.ReadByte;
|
|||
|
|
case State of
|
|||
|
|
tsData:
|
|||
|
|
begin
|
|||
|
|
case lb of
|
|||
|
|
$FF: //is a command
|
|||
|
|
begin
|
|||
|
|
State := tsIAC;
|
|||
|
|
end;
|
|||
|
|
$0D: //wait for the next character to see what to do
|
|||
|
|
begin
|
|||
|
|
State := tsCheckCR;
|
|||
|
|
end;
|
|||
|
|
else
|
|||
|
|
AppendByte(LLine, lb);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
tsCheckCR:
|
|||
|
|
begin
|
|||
|
|
case lb of
|
|||
|
|
$0: // preserve CR
|
|||
|
|
begin
|
|||
|
|
AppendByte(LLine, $0D);
|
|||
|
|
State := tsData;
|
|||
|
|
end;
|
|||
|
|
$0A:
|
|||
|
|
begin
|
|||
|
|
State := tsData;
|
|||
|
|
Finished := True;
|
|||
|
|
end;
|
|||
|
|
$FF: //unexpected IAC, just in case
|
|||
|
|
begin
|
|||
|
|
AppendByte(LLine, $0D);
|
|||
|
|
State := tsIAC;
|
|||
|
|
end;
|
|||
|
|
else
|
|||
|
|
ExpandBytes(LLine, Length(LLine), 2);
|
|||
|
|
LLine[Length(LLine)-2] := $0D;
|
|||
|
|
LLine[Length(LLine)-1] := lb;
|
|||
|
|
State := tsData;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
tsIAC:
|
|||
|
|
begin
|
|||
|
|
case lb of
|
|||
|
|
$F1, //no-operation - do nothing
|
|||
|
|
$F3: //break - do nothing for now
|
|||
|
|
begin
|
|||
|
|
State := tsData;
|
|||
|
|
end;
|
|||
|
|
$F4: //interrupt process - clear result and wait for data mark
|
|||
|
|
begin
|
|||
|
|
SetLength(LLine, 0);
|
|||
|
|
State := tsInterrupt;
|
|||
|
|
end;
|
|||
|
|
$F5: //abort output
|
|||
|
|
begin
|
|||
|
|
// note - the DM needs to be sent as OOB "Urgent" data
|
|||
|
|
|
|||
|
|
SetLength(LReply, 4);
|
|||
|
|
|
|||
|
|
// TELNET_IP
|
|||
|
|
LReply[0] := $FF;
|
|||
|
|
LReply[1] := $F4;
|
|||
|
|
|
|||
|
|
// TELNET_DM
|
|||
|
|
LReply[2] := $FF;
|
|||
|
|
LReply[3] := $F2;
|
|||
|
|
|
|||
|
|
AContext.Connection.IOHandler.Write(LReply);
|
|||
|
|
SetLength(LReply, 0);
|
|||
|
|
|
|||
|
|
State := tsData;
|
|||
|
|
end;
|
|||
|
|
$F6: //are you there - do nothing for now
|
|||
|
|
begin
|
|||
|
|
State := tsData;
|
|||
|
|
end;
|
|||
|
|
$F7: //erase character
|
|||
|
|
begin
|
|||
|
|
i := Length(LLine);
|
|||
|
|
if i > 0 then begin
|
|||
|
|
SetLength(LLine, i-1);
|
|||
|
|
end;
|
|||
|
|
State := tsData;
|
|||
|
|
end;
|
|||
|
|
$F8 : //erase line
|
|||
|
|
begin
|
|||
|
|
SetLength(LLine, 0);
|
|||
|
|
State := tsData;
|
|||
|
|
end;
|
|||
|
|
$F9 : //go ahead - do nothing for now
|
|||
|
|
begin
|
|||
|
|
State := tsData;
|
|||
|
|
end;
|
|||
|
|
$FA : //begin sub-negotiation
|
|||
|
|
begin
|
|||
|
|
State := tsNegotiate;
|
|||
|
|
end;
|
|||
|
|
$FB : //I will use
|
|||
|
|
begin
|
|||
|
|
State := tsWill;
|
|||
|
|
end;
|
|||
|
|
$FC : //you won't use
|
|||
|
|
begin
|
|||
|
|
State := tsWont;
|
|||
|
|
end;
|
|||
|
|
$FD : //please, you use option
|
|||
|
|
begin
|
|||
|
|
State := tsDo;
|
|||
|
|
end;
|
|||
|
|
$FE : //please, you stop option
|
|||
|
|
begin
|
|||
|
|
State := tsDont;
|
|||
|
|
end;
|
|||
|
|
$FF : //data $FF
|
|||
|
|
begin
|
|||
|
|
AppendByte(LLine, $FF);
|
|||
|
|
State := tsData;
|
|||
|
|
end;
|
|||
|
|
else
|
|||
|
|
// unknown command, ignore
|
|||
|
|
State := tsData;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
tsWill:
|
|||
|
|
begin
|
|||
|
|
SetLength(LReply, 3);
|
|||
|
|
|
|||
|
|
// TELNET_WONT
|
|||
|
|
LReply[0] := $FF;
|
|||
|
|
LReply[1] := $FC;
|
|||
|
|
LReply[2] := lb;
|
|||
|
|
|
|||
|
|
AContext.Connection.IOHandler.Write(LReply);
|
|||
|
|
SetLength(LReply, 0);
|
|||
|
|
|
|||
|
|
State := tsData;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
tsDo:
|
|||
|
|
begin
|
|||
|
|
SetLength(LReply, 3);
|
|||
|
|
|
|||
|
|
// TELNET_DONT
|
|||
|
|
LReply[0] := $FF;
|
|||
|
|
LReply[1] := $FE;
|
|||
|
|
LReply[2] := lb;
|
|||
|
|
|
|||
|
|
AContext.Connection.IOHandler.Write(LReply);
|
|||
|
|
SetLength(LReply, 0);
|
|||
|
|
|
|||
|
|
State := tsData;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
tsWont,
|
|||
|
|
tsDont:
|
|||
|
|
begin
|
|||
|
|
State := tsData;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
tsNegotiate:
|
|||
|
|
begin
|
|||
|
|
State := tsNegotiateData;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
tsNegotiateData:
|
|||
|
|
begin
|
|||
|
|
case lb of
|
|||
|
|
$FF: //is a command?
|
|||
|
|
begin
|
|||
|
|
State := tsNegotiateIAC;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
tsNegotiateIAC:
|
|||
|
|
begin
|
|||
|
|
case lb of
|
|||
|
|
$F0: //end sub-negotiation
|
|||
|
|
begin
|
|||
|
|
State := tsData;
|
|||
|
|
end;
|
|||
|
|
else
|
|||
|
|
State := tsNegotiateData;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
tsInterrupt:
|
|||
|
|
begin
|
|||
|
|
case lb of
|
|||
|
|
$FF: //is a command?
|
|||
|
|
begin
|
|||
|
|
State := tsInterruptIAC;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
tsInterruptIAC:
|
|||
|
|
begin
|
|||
|
|
case lb of
|
|||
|
|
$F2: //data mark
|
|||
|
|
begin
|
|||
|
|
State := tsData;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
else
|
|||
|
|
State := tsData;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
until Finished or (not AContext.Connection.IOHandler.Connected);
|
|||
|
|
|
|||
|
|
//The last char was #13, we have to make sure that we remove a trailing
|
|||
|
|
//#10 if it exists so that it doesn't appear in the next line.
|
|||
|
|
if (lb = $0D) and (State = tsData) then
|
|||
|
|
begin
|
|||
|
|
i := AContext.Connection.IOHandler.InputBuffer.Size;
|
|||
|
|
if i > 0 then begin
|
|||
|
|
lb := AContext.Connection.IOHandler.InputBuffer.PeekByte(i - 1);
|
|||
|
|
if lb = $0A then begin
|
|||
|
|
AContext.Connection.IOHandler.ReadByte;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
Result := BytesToString(LLine, 0, MaxInt, LContext.Connection.IOHandler.DefStringEncoding);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.DoReplyUnknownCommand(AContext: TIdContext; ALine: string);
|
|||
|
|
begin
|
|||
|
|
CmdSyntaxError(AContext, ALine);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.DoTerminateContext(AContext: TIdContext);
|
|||
|
|
begin
|
|||
|
|
try
|
|||
|
|
TIdFTPServerContext(AContext).KillDataChannel;
|
|||
|
|
finally
|
|||
|
|
inherited DoTerminateContext(AContext);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CmdSyntaxError(AContext: TIdContext; ALine: string; const AReply : TIdReply = nil);
|
|||
|
|
var
|
|||
|
|
LTmp : String;
|
|||
|
|
LReply : TIdReply;
|
|||
|
|
begin
|
|||
|
|
//First make the first word upper-case
|
|||
|
|
LTmp := UpCaseFirstWord(ALine);
|
|||
|
|
try
|
|||
|
|
if Assigned(AReply) then begin
|
|||
|
|
LReply := AReply;
|
|||
|
|
end else begin
|
|||
|
|
LReply := FReplyClass.CreateWithReplyTexts(nil, ReplyTexts);
|
|||
|
|
LReply.Assign(ReplyUnknownCommand);
|
|||
|
|
end;
|
|||
|
|
LReply.Text.Clear;
|
|||
|
|
LReply.Text.Add(IndyFormat(RSFTPCmdNotRecognized, [LTmp]));
|
|||
|
|
AContext.Connection.IOHandler.Write(LReply.FormattedReply);
|
|||
|
|
finally
|
|||
|
|
if not Assigned(AReply) then begin
|
|||
|
|
FreeAndNil(LReply);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CmdSyntaxError(ASender: TIdCommand);
|
|||
|
|
begin
|
|||
|
|
CmdSyntaxError(ASender.Context, ASender.RawLine, FReplyUnknownCommand );
|
|||
|
|
ASender.PerformReply := False;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandSecRFC(ASender: TIdCommand);
|
|||
|
|
//stub for RFC 2228 commands that we don't implement as
|
|||
|
|
//part of the SSL framework.
|
|||
|
|
begin
|
|||
|
|
if IOHandler is TIdServerIOHandlerSSLBase then begin
|
|||
|
|
CmdNotImplemented(ASender);
|
|||
|
|
end else begin
|
|||
|
|
CmdSyntaxError(ASender);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandOptsMLST(ASender: TIdCommand);
|
|||
|
|
const
|
|||
|
|
LVALIDOPTS : array [0..12] of string =
|
|||
|
|
('type', 'size', 'modify',
|
|||
|
|
'UNIX.mode', 'UNIX.owner', 'UNIX.group',
|
|||
|
|
'unique', 'perm', 'create',
|
|||
|
|
'windows.lastaccesstime','win32.ea','win32.dt','win32.dl'); {Do not localize}
|
|||
|
|
var
|
|||
|
|
s: string;
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
|
|||
|
|
function ParseMLSParms(ASvr : TIdFTPServer; const AParms : String) : TIdFTPFactOutputs;
|
|||
|
|
var
|
|||
|
|
Ls : String;
|
|||
|
|
begin
|
|||
|
|
Result := [];
|
|||
|
|
Ls := UpperCase(AParms);
|
|||
|
|
while Ls <> '' do begin
|
|||
|
|
case PosInStrArray(Fetch(Ls,';'), LVALIDOPTS, False) of
|
|||
|
|
0 : Result := Result + [ItemType]; //type
|
|||
|
|
1 : Result := Result + [Size]; //size
|
|||
|
|
2 : Result := Result + [Modify]; //modify
|
|||
|
|
3 : if mlsdUnixModes in ASvr.FMLSDFacts then begin
|
|||
|
|
Result := Result + [UnixMODE]; //UnixMode
|
|||
|
|
end;
|
|||
|
|
4 : if mlsdUnixOwner in ASvr.FMLSDFacts then begin
|
|||
|
|
Result := Result + [UnixOwner]; //UNIX.owner
|
|||
|
|
end;
|
|||
|
|
5 : if mlsdUnixGroup in ASvr.FMLSDFacts then begin
|
|||
|
|
Result := Result + [UnixGroup]; //UNIX.group
|
|||
|
|
end;
|
|||
|
|
6 : if mlsdUniqueID in ASvr.FMLSDFacts then begin //Unique
|
|||
|
|
Result := Result + [Unique];
|
|||
|
|
end;
|
|||
|
|
7 : if mlsdPerms in ASvr.FMLSDFacts then begin //perm
|
|||
|
|
Result := Result + [Perm];
|
|||
|
|
end;
|
|||
|
|
8 : if mlsdFileCreationTime in ASvr.FMLSDFacts then begin
|
|||
|
|
Result := Result + [CreateTime];
|
|||
|
|
end;
|
|||
|
|
9 : if mlsdFileLastAccessTime in ASvr.FMLSDFacts then begin
|
|||
|
|
Result := Result + [LastAccessTime];
|
|||
|
|
end;
|
|||
|
|
10 : if mlsdWin32Attributes in ASvr.FMLSDFacts then begin
|
|||
|
|
Result := Result + [WinAttribs];
|
|||
|
|
end;
|
|||
|
|
11 : if mlsdWin32DriveType in ASvr.MLSDFacts then begin
|
|||
|
|
Result := Result + [WinDriveType];
|
|||
|
|
end;
|
|||
|
|
12 : if mlstWin32DriveLabel in ASvr.MLSDFacts then begin
|
|||
|
|
Result := Result + [WinDriveLabel];
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function SetToOptsStr(AFacts : TIdFTPFactOutputs) : String;
|
|||
|
|
begin
|
|||
|
|
Result := '';
|
|||
|
|
if Size in AFacts then begin {Do not translate}
|
|||
|
|
Result := Result + 'size;'; {Do not localize}
|
|||
|
|
end;
|
|||
|
|
if ItemType in AFacts then begin {Do not translate}
|
|||
|
|
Result := Result + 'type;'; {Do not translate}
|
|||
|
|
end;
|
|||
|
|
if Perm in AFacts then begin {Do not translate}
|
|||
|
|
Result := Result + 'perm;'; {Do not translate}
|
|||
|
|
end;
|
|||
|
|
if CreateTime in AFacts then begin {Do not translate}
|
|||
|
|
Result := Result + 'create;'; {Do not translate}
|
|||
|
|
end;
|
|||
|
|
if Modify in AFacts then begin
|
|||
|
|
Result := Result + 'modify;'; {Do not translate}
|
|||
|
|
end;
|
|||
|
|
if UnixMODE in AFacts then begin {Do not translate}
|
|||
|
|
Result := Result + 'UNIX.mode;'; {Do not translate}
|
|||
|
|
end;
|
|||
|
|
if UnixOwner in AFacts then begin{Do not translate}
|
|||
|
|
Result := Result + 'UNIX.owner;'; {Do not translate}
|
|||
|
|
end;
|
|||
|
|
if UnixGroup in AFacts then begin {Do not translate}
|
|||
|
|
Result := Result + 'UNIX.group;'; {Do not translate}
|
|||
|
|
end;
|
|||
|
|
if Unique in AFacts then begin {Do not translate}
|
|||
|
|
Result := Result + 'unique;'; {Do not translate}
|
|||
|
|
end;
|
|||
|
|
if LastAccessTime in AFacts then begin
|
|||
|
|
Result := Result + 'windows.lastaccesstime;'; {Do not translate}
|
|||
|
|
end;
|
|||
|
|
if IdFTPListOutput.WinAttribs in AFacts then begin
|
|||
|
|
Result := Result + 'win32.ea;'; {Do not translate}
|
|||
|
|
end;
|
|||
|
|
if IdFTPListOutput.WinDriveType in AFacts then begin
|
|||
|
|
Result := Result + 'Win32.dt;'; {Do not localize}
|
|||
|
|
end;
|
|||
|
|
if IdFTPListOutput.WinDriveLabel in AFacts then begin
|
|||
|
|
Result := Result + 'Win32.dl;'; {Do not localize}
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
begin
|
|||
|
|
LContext := ASender.Context as TIdFTPServerContext;
|
|||
|
|
s := ASender.UnparsedParams;
|
|||
|
|
if IndyPos(' ', s) = 0 then begin
|
|||
|
|
LContext.MLSOpts := ParseMLSParms(Self, Trim(s));
|
|||
|
|
//the string is standardized format
|
|||
|
|
ASender.Reply.SetReply(200, Trim(IndyFormat('MLST OPTS %s', [SetToOptsStr(LContext.MLSOpts)]))); {Do not Localize}
|
|||
|
|
end else begin
|
|||
|
|
ASender.Reply.SetReply(501, IndyFormat(RSFTPInvalidOps, ['MLST'])); {Do not Localize}
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandOptsMODEZ(ASender: TIdCommand);
|
|||
|
|
const
|
|||
|
|
OPT_NAMES : Array[0..4] of String =
|
|||
|
|
('ENGINE','LEVEL','METHOD','BLOCKSIZE','EXTRA'); {do not localize}
|
|||
|
|
var
|
|||
|
|
s: string;
|
|||
|
|
LOptName, LOptVal : String;
|
|||
|
|
LContext : TIdFTPServerContext;
|
|||
|
|
LFirstPar : Boolean;
|
|||
|
|
LError : Boolean;
|
|||
|
|
LNoVal : Integer;
|
|||
|
|
LReset : Boolean;
|
|||
|
|
|
|||
|
|
procedure ReportSettings(ACxt : TIdFTPServerContext; AReply : TIdReply);
|
|||
|
|
begin
|
|||
|
|
AReply.NumericCode := 200;
|
|||
|
|
AReply.Text.Clear;
|
|||
|
|
AReply.Text.Add('MODE Z ENGINE set to ZLIB.'); {do not localize}
|
|||
|
|
AReply.Text.Add('MODE Z LEVEL set to ' + IntToStr(ACxt.FZLibCompressionLevel) + '.'); {do not localize}
|
|||
|
|
AReply.Text.Add('MODE Z METHOD set to ' + IntToStr(DEF_ZLIB_METHOD) + '.'); {do not localize}
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure SyntaxError(AReply : TIdCommand);
|
|||
|
|
var
|
|||
|
|
LOpts : String;
|
|||
|
|
begin
|
|||
|
|
//drop the OPTS part of the command for display
|
|||
|
|
LOpts := ASender.RawLine;
|
|||
|
|
Fetch(LOpts);
|
|||
|
|
LOpts := TrimLeft(LOpts);
|
|||
|
|
ASender.Reply.SetReply(501, IndyFormat(RSFTPInvalidOps, [LOpts]));
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
begin
|
|||
|
|
LFirstPar := True;
|
|||
|
|
LReset := True;
|
|||
|
|
LError := True;
|
|||
|
|
LContext := ASender.Context as TIdFTPServerContext;
|
|||
|
|
s := Trim(ASender.UnparsedParams);
|
|||
|
|
if s = '' then begin
|
|||
|
|
LContext.ResetZLibSettings;
|
|||
|
|
ReportSettings(LContext, ASender.Reply);
|
|||
|
|
end;
|
|||
|
|
repeat
|
|||
|
|
LOptName := Fetch(s);
|
|||
|
|
if s = '' then begin
|
|||
|
|
if LFirstPar then begin
|
|||
|
|
SyntaxError(ASender);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
LOptVal := Fetch(s);
|
|||
|
|
if Trim(s) <> '' then begin
|
|||
|
|
//if there's more, than we see if there's a valid option.
|
|||
|
|
LFirstPar := False;
|
|||
|
|
end;
|
|||
|
|
if LFirstPar and (PosInStrArray(LOptName, OPT_NAMES, False) = -1) then begin
|
|||
|
|
SyntaxError(ASender);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
LFirstPar := False;
|
|||
|
|
case PosInStrArray(LOptName, OPT_NAMES, False) of
|
|||
|
|
0 : //'ENGINE' - we only support ZLIB
|
|||
|
|
begin
|
|||
|
|
LError := False;
|
|||
|
|
end;
|
|||
|
|
1 : begin //,'LEVEL', - implemented
|
|||
|
|
LNoVal := IndyStrToInt(LOptVal, -1);
|
|||
|
|
if (LNoVal > -1) and (LNoVal < 8) then begin
|
|||
|
|
LContext.FZLibCompressionLevel := LNoVal;
|
|||
|
|
LReset := False;
|
|||
|
|
LError := False;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
2 : begin //'METHOD', - not implemented - jst do syntax check
|
|||
|
|
LNoVal := IndyStrToInt(LOptVal, -1);
|
|||
|
|
if LNoVal <> -1 then begin
|
|||
|
|
LError := False;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
3 : begin ///'BLOCKSIZE', -not implemented - just do syntax check
|
|||
|
|
LNoVal := IndyStrToInt(LOptVal, -1);
|
|||
|
|
if LNoVal <> -1 then begin
|
|||
|
|
LError := False;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
4 : begin //'EXTRA') - not implemented - just do syntax check
|
|||
|
|
if PosInStrArray(LOptVal, OnOffStates, False) > -1 then begin
|
|||
|
|
LError := False;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
until (s = '');
|
|||
|
|
|
|||
|
|
if LError then begin
|
|||
|
|
SyntaxError(ASender);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
if LReset then begin
|
|||
|
|
LContext.ResetZLibSettings;
|
|||
|
|
end;
|
|||
|
|
ReportSettings(LContext, ASender.Reply);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServer.CommandOptsUTF8(ASender: TIdCommand);
|
|||
|
|
var
|
|||
|
|
s: String;
|
|||
|
|
LContext: TIdFTPServerContext;
|
|||
|
|
|
|||
|
|
procedure SyntaxError(AReply : TIdCommand);
|
|||
|
|
var
|
|||
|
|
LOpts : String;
|
|||
|
|
begin
|
|||
|
|
//drop the OPTS part of the command for display
|
|||
|
|
LOpts := ASender.RawLine;
|
|||
|
|
Fetch(LOpts);
|
|||
|
|
LOpts := TrimLeft(LOpts);
|
|||
|
|
ASender.Reply.SetReply(501, IndyFormat(RSFTPInvalidOps, [LOpts]));
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
begin
|
|||
|
|
LContext := ASender.Context as TIdFTPServerContext;
|
|||
|
|
s := Trim(ASender.UnparsedParams);
|
|||
|
|
|
|||
|
|
if TextIsSame(ASender.CommandHandler.Command, 'UTF-8') then begin
|
|||
|
|
// OPTS UTF-8 <NLST>
|
|||
|
|
// http://www.ietf.org/proceedings/02nov/I-D/draft-ietf-ftpext-utf-8-option-00.txt
|
|||
|
|
if s = '' then begin
|
|||
|
|
LContext.NLSTUtf8 := False; // disable UTF-8 over data connection
|
|||
|
|
end
|
|||
|
|
else if TextIsSame(s, 'NLST') then begin
|
|||
|
|
LContext.NLSTUtf8 := True; // enable UTF-8 over data connection
|
|||
|
|
end else begin
|
|||
|
|
SyntaxError(ASender);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
// enable UTF-8 over control connection
|
|||
|
|
LContext.Connection.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8;
|
|||
|
|
end else begin
|
|||
|
|
// OPTS UTF8 <ON|OFF>
|
|||
|
|
// non-standard Microsoft IE implementation!!!!
|
|||
|
|
case PosInStrArray(s, OnOffStates, False) of
|
|||
|
|
0: begin // 'ON'
|
|||
|
|
LContext.NLSTUtf8 := True;
|
|||
|
|
LContext.Connection.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8;
|
|||
|
|
end;
|
|||
|
|
1: begin // 'OFF'
|
|||
|
|
LContext.NLSTUtf8 := False;
|
|||
|
|
LContext.Connection.IOHandler.DefStringEncoding := IndyTextEncoding_8Bit;
|
|||
|
|
end;
|
|||
|
|
else
|
|||
|
|
begin
|
|||
|
|
SyntaxError(ASender);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
ASender.Reply.NumericCode := 200;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdFTPServer.IgnoreLastPathDelim(const APath: String): String;
|
|||
|
|
//This internal function is needed because path processing is different in Windows
|
|||
|
|
//than in Linux. The path separators on a FTP server on either system will be different.
|
|||
|
|
//
|
|||
|
|
//On Windows machines, both '/' and '\'
|
|||
|
|
//
|
|||
|
|
//On a Linux machine, a FTP server would probably only use '/' because '\' is a valid
|
|||
|
|
//filename char.
|
|||
|
|
var
|
|||
|
|
i : Integer;
|
|||
|
|
LPathProcessing : TIdFTPPathProcessing;
|
|||
|
|
begin
|
|||
|
|
Result := APath;
|
|||
|
|
i := Length(Result);
|
|||
|
|
if FPathProcessing <> ftpOSDependent then begin
|
|||
|
|
LPathProcessing := FPathProcessing;
|
|||
|
|
end else begin
|
|||
|
|
case GOSType of
|
|||
|
|
otUnix :
|
|||
|
|
begin
|
|||
|
|
LPathProcessing := ftppUnix;
|
|||
|
|
end;
|
|||
|
|
otUnknown :
|
|||
|
|
begin
|
|||
|
|
LPathProcessing := ftppCustom;
|
|||
|
|
end
|
|||
|
|
else
|
|||
|
|
LPathProcessing := ftppDOS;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
case LPathProcessing of
|
|||
|
|
ftppDOS :
|
|||
|
|
begin
|
|||
|
|
if Result <>'' then begin
|
|||
|
|
if CharIsInSet(Result, i, '/\') then begin
|
|||
|
|
IdDelete(Result, i, 1);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
ftppUnix :
|
|||
|
|
begin
|
|||
|
|
if Result <>'' then begin
|
|||
|
|
if TextEndsWith(Result, '/') then begin
|
|||
|
|
IdDelete(Result, i, 1);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
ftppCustom :
|
|||
|
|
begin
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
//Done so that something like "cd /" or "cd \" will go to
|
|||
|
|
//the main directory
|
|||
|
|
if Result = '' then begin
|
|||
|
|
Result := '/';
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdFTPServer.SupportTaDirSwitches(AContext : TIdFTPServerContext): Boolean;
|
|||
|
|
begin
|
|||
|
|
Result := True;
|
|||
|
|
case FDirFormat of
|
|||
|
|
ftpdfCustom, ftpdfEPLF:
|
|||
|
|
Result := False;
|
|||
|
|
ftpdfDOS:
|
|||
|
|
Result := not AContext.FMSDOSMode;
|
|||
|
|
ftpdfOSDependent:
|
|||
|
|
if (GOSType = otWindows) or (GOSType = otDotNET) then begin
|
|||
|
|
Result := not AContext.FMSDOSMode;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
{ TIdFTPSecurityOptions }
|
|||
|
|
|
|||
|
|
procedure TIdFTPSecurityOptions.Assign(Source: TPersistent);
|
|||
|
|
var
|
|||
|
|
LSrc : TIdFTPSecurityOptions;
|
|||
|
|
begin
|
|||
|
|
if Source is TIdFTPSecurityOptions then begin
|
|||
|
|
LSrc := Source as TIdFTPSecurityOptions;
|
|||
|
|
|
|||
|
|
BlockAllPORTTransfers := LSrc.BlockAllPORTTransfers;
|
|||
|
|
DisableSTATCommand := LSrc.DisableSTATCommand;
|
|||
|
|
DisableSYSTCommand := LSrc.DisableSYSTCommand;
|
|||
|
|
PasswordAttempts := LSrc.PasswordAttempts;
|
|||
|
|
InvalidPassDelay := LSrc.InvalidPassDelay;
|
|||
|
|
NoReservedRangePORT := LSrc.NoReservedRangePORT;
|
|||
|
|
RequirePASVFromSameIP := LSrc.RequirePASVFromSameIP;
|
|||
|
|
RequirePORTFromSameIP := LSrc.RequirePORTFromSameIP;
|
|||
|
|
PermitCCC := LSrc.PermitCCC;
|
|||
|
|
end else begin
|
|||
|
|
inherited Assign(Source);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
constructor TIdFTPSecurityOptions.Create;
|
|||
|
|
begin
|
|||
|
|
inherited Create;
|
|||
|
|
//limit login attempts - some hackers will try guessing passwords from a dictionary
|
|||
|
|
PasswordAttempts := DEF_FTP_PASSWORDATTEMPTS;
|
|||
|
|
//should slow-down a password guessing attack - note those dictionaries
|
|||
|
|
InvalidPassDelay := DEF_FTP_INVALIDPASS_DELAY;
|
|||
|
|
//client IP Address is the only one that we will accept a PASV
|
|||
|
|
//transfer from
|
|||
|
|
//http://cr.yp.to/ftp/security.html
|
|||
|
|
RequirePASVFromSameIP := DEF_FTP_PASV_SAME_IP;
|
|||
|
|
//Accept port transfers from the same IP address as the client -
|
|||
|
|
//should prevent bounce attacks
|
|||
|
|
RequirePORTFromSameIP := DEF_FTP_PORT_SAME_IP;
|
|||
|
|
//Do not accept port requests to ports in the reserved range. That is dangerous on some systems
|
|||
|
|
NoReservedRangePORT := DEF_FTP_NO_RESERVED_PORTS;
|
|||
|
|
//Do not accept any PORT transfers at all. This is a little extreme but reduces troubles further.
|
|||
|
|
//This will break the the Win32 console clients and a number of other programs.
|
|||
|
|
BlockAllPORTTransfers := DEF_FTP_BLOCK_ALL_PORTS;
|
|||
|
|
//Disable SYST command. SYST usually gives the system description.
|
|||
|
|
//Disabling it may make it harder for a trouble maker to know about your computer
|
|||
|
|
//but will not be a complete security solution. See http://www.sans.org/rr/infowar/fingerprint.php for details
|
|||
|
|
//On the other hand, disabling it will break RFC 959 complience and may break some FTP programs.
|
|||
|
|
DisableSYSTCommand := DEF_FTP_DISABLE_SYST;
|
|||
|
|
//Disable STAT command. STAT gives freeform information about the connection status.
|
|||
|
|
// http://www.sans.org/rr/infowar/fingerprint.php advises administrators to disable this
|
|||
|
|
//because servers tend to give distinct patterns of information and some trouble makers
|
|||
|
|
//can figure out what type of server you are running simply with this.
|
|||
|
|
DisableSTATCommand := DEF_FTP_DISABLE_STAT;
|
|||
|
|
//Permit CCC command when using TLS with FTP to clear the control connection.
|
|||
|
|
//That may be helpful for someone behind a NAT where an IP address can NOT be altered by the NAT
|
|||
|
|
//when using SSL. On the other hand, some administrators may NOT permit this for security reasons.
|
|||
|
|
//That's a debate I'll leave up to the programmer in hopes that they will pass it to the user.
|
|||
|
|
PermitCCC := DEF_FTP_PERMIT_CCC;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
{ TIdDataChannel }
|
|||
|
|
|
|||
|
|
constructor TIdDataChannel.Create(APASV: Boolean; AControlContext: TIdFTPServerContext;
|
|||
|
|
const ARequirePASVFromSameIP: Boolean; AServer: TIdFTPServer);
|
|||
|
|
var
|
|||
|
|
LIO: TIdIOHandlerSocket;
|
|||
|
|
LDataChannelSvr: TIdSimpleServer;
|
|||
|
|
LDataChannelCli: TIdTCPClient;
|
|||
|
|
begin
|
|||
|
|
inherited Create;
|
|||
|
|
FNegotiateTLS := False;
|
|||
|
|
FOKReply := TIdReplyRFC.Create(nil);
|
|||
|
|
FErrorReply := TIdReplyRFC.Create(nil);
|
|||
|
|
FReply := TIdReplyRFC.Create(nil);
|
|||
|
|
FRequirePASVFromSameIP := ARequirePASVFromSameIP;
|
|||
|
|
FControlContext := AControlContext;
|
|||
|
|
FServer := AServer;
|
|||
|
|
|
|||
|
|
// RLebeau: do not set both BoundPortMin/Max and BoundPort at the same time.
|
|||
|
|
// If they are all non-zero, BoundPort will take priority in TIdSocketHandle.
|
|||
|
|
// The DefaultDataPort property should not be assigned to zero in order to
|
|||
|
|
// support Active-mode transfers, but doing so will cause BoundPortMin/Max
|
|||
|
|
// to be ignored for Passive-mode transfers. So assign them in an either-or
|
|||
|
|
// manner.
|
|||
|
|
|
|||
|
|
if APASV then begin
|
|||
|
|
FDataChannel := TIdSimpleServer.Create(nil);
|
|||
|
|
LDataChannelSvr := TIdSimpleServer(FDataChannel);
|
|||
|
|
LDataChannelSvr.BoundIP := FControlContext.Connection.Socket.Binding.IP;
|
|||
|
|
if (AServer.PASVBoundPortMin <> 0) and (AServer.PASVBoundPortMax <> 0) then begin
|
|||
|
|
LDataChannelSvr.BoundPortMin := AServer.PASVBoundPortMin;
|
|||
|
|
LDataChannelSvr.BoundPortMax := AServer.PASVBoundPortMax;
|
|||
|
|
end else begin
|
|||
|
|
LDataChannelSvr.BoundPort := AServer.DefaultDataPort;
|
|||
|
|
end;
|
|||
|
|
LDataChannelSvr.IPVersion := FControlContext.Binding.IPVersion;
|
|||
|
|
LDataChannelSvr.OnBeforeBind := AControlContext.PortOnBeforeBind;
|
|||
|
|
LDataChannelSvr.OnAfterBind := AControlContext.PortOnAfterBind;
|
|||
|
|
end else begin
|
|||
|
|
FDataChannel := TIdTCPClient.Create(nil);
|
|||
|
|
//the TCPClient for the dataport must be bound to a default port
|
|||
|
|
LDataChannelCli := TIdTCPClient(FDataChannel);
|
|||
|
|
LDataChannelCli.BoundIP := FControlContext.Connection.Socket.Binding.IP;
|
|||
|
|
LDataChannelCli.BoundPort := AServer.DefaultDataPort;
|
|||
|
|
LDataChannelCli.IPVersion := FControlContext.Binding.IPVersion;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
if AControlContext.Server.IOHandler is TIdServerIOHandlerSSLBase then begin
|
|||
|
|
if APASV then begin
|
|||
|
|
LIO := TIdServerIOHandlerSSLBase(AServer.IOHandler).MakeFTPSvrPasv;
|
|||
|
|
end else begin
|
|||
|
|
LIO := TIdServerIOHandlerSSLBase(AServer.IOHandler).MakeFTPSvrPort;
|
|||
|
|
end;
|
|||
|
|
(LIO as TIdSSLIOHandlerSocketBase).PassThrough := True;
|
|||
|
|
// always uses a ssl iohandler, but passthrough is true...
|
|||
|
|
end else begin
|
|||
|
|
LIO := FServer.IOHandler.MakeClientIOHandler(nil) as TIdIOHandlerSocket;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
LIO.OnBeforeBind := AControlContext.PortOnBeforeBind;
|
|||
|
|
LIO.OnAfterBind := AControlContext.PortOnAfterBind;
|
|||
|
|
FDataChannel.IOHandler := LIO;
|
|||
|
|
|
|||
|
|
if LIO is TIdSSLIOHandlerSocketBase then begin
|
|||
|
|
case AControlContext.DataProtection of
|
|||
|
|
ftpdpsClear: begin
|
|||
|
|
TIdSSLIOHandlerSocketBase(LIO).PassThrough := True;
|
|||
|
|
end;
|
|||
|
|
ftpdpsPrivate: begin
|
|||
|
|
FNegotiateTLS := True;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
destructor TIdDataChannel.Destroy;
|
|||
|
|
begin
|
|||
|
|
FreeAndNil(FOKReply);
|
|||
|
|
FreeAndNil(FErrorReply);
|
|||
|
|
FreeAndNil(FReply);
|
|||
|
|
{$IFNDEF USE_OBJECT_ARC}
|
|||
|
|
FDataChannel.IOHandler.Free;
|
|||
|
|
{$ENDIF}
|
|||
|
|
FDataChannel.IOHandler := nil;
|
|||
|
|
FreeAndNil(FDataChannel);
|
|||
|
|
inherited Destroy;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdDataChannel.GetPeerIP: String;
|
|||
|
|
begin
|
|||
|
|
Result := '';
|
|||
|
|
if Assigned(FDataChannel) then begin
|
|||
|
|
if Assigned(FDataChannel.Socket) then begin
|
|||
|
|
if Assigned(FDataChannel.Socket.Binding) then begin
|
|||
|
|
Result := FDataChannel.Socket.Binding.PeerIP;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdDataChannel.GetPeerPort: TIdPort;
|
|||
|
|
begin
|
|||
|
|
Result := 0;
|
|||
|
|
if Assigned(FDataChannel) then begin
|
|||
|
|
if Assigned(FDataChannel.Socket) then begin
|
|||
|
|
if Assigned(FDataChannel.Socket.Binding) then begin
|
|||
|
|
Result := FDataChannel.Socket.Binding.PeerPort;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdDataChannel.GetLocalIP: String;
|
|||
|
|
begin
|
|||
|
|
Result := '';
|
|||
|
|
if Assigned(FDataChannel) then begin
|
|||
|
|
if Assigned(FDataChannel.Socket) then begin
|
|||
|
|
if Assigned(FDataChannel.Socket.Binding) then begin
|
|||
|
|
Result := FDataChannel.Socket.Binding.IP;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdDataChannel.GetLocalPort: TIdPort;
|
|||
|
|
begin
|
|||
|
|
Result := 0;
|
|||
|
|
if Assigned(FDataChannel) then begin
|
|||
|
|
if Assigned(FDataChannel.Socket) then begin
|
|||
|
|
if Assigned(FDataChannel.Socket.Binding) then begin
|
|||
|
|
Result := FDataChannel.Socket.Binding.Port;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdDataChannel.InitOperation(const AConnectMode : Boolean = False);
|
|||
|
|
var
|
|||
|
|
LIO : TIdSSLIOHandlerSocketBase;
|
|||
|
|
begin
|
|||
|
|
try
|
|||
|
|
if FDataChannel is TIdSimpleServer then begin
|
|||
|
|
TIdSimpleServer(FDataChannel).Listen;
|
|||
|
|
if FRequirePASVFromSameIP then begin
|
|||
|
|
{//BGO}
|
|||
|
|
if FControlContext.Binding.PeerIP <> TIdSimpleServer(FDataChannel).Binding.PeerIP then begin
|
|||
|
|
TIdFTPServerContext(FControlContext).FDataPortDenied := True;
|
|||
|
|
ErrorReply.SetReply(504, RSFTPSameIPAddress);
|
|||
|
|
FControlContext.Connection.IOHandler.Write(ErrorReply.FormattedReply);
|
|||
|
|
TIdSimpleServer(FDataChannel).Disconnect(False);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
{//BGO}
|
|||
|
|
if FNegotiateTLS then begin
|
|||
|
|
LIO := FDataChannel.IOHandler as TIdSSLIOHandlerSocketBase;
|
|||
|
|
if AConnectMode then begin
|
|||
|
|
LIO.IsPeer := False;
|
|||
|
|
end;
|
|||
|
|
LIO.Passthrough := False;
|
|||
|
|
end;
|
|||
|
|
end
|
|||
|
|
else if FDataChannel is TIdTCPClient then begin
|
|||
|
|
TIdTCPClient(FDataChannel).Connect;
|
|||
|
|
if FNegotiateTLS then begin
|
|||
|
|
LIO := FDataChannel.IOHandler as TIdSSLIOHandlerSocketBase;
|
|||
|
|
if AConnectMode then begin
|
|||
|
|
LIO.IsPeer := False;
|
|||
|
|
end;
|
|||
|
|
LIO.Passthrough := False;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
except
|
|||
|
|
FControlContext.Connection.IOHandler.Write(FErrorReply.FormattedReply); //426
|
|||
|
|
raise;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdDataChannel.SetErrorReply(const AValue: TIdReplyRFC);
|
|||
|
|
begin
|
|||
|
|
FErrorReply.Assign(AValue);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdDataChannel.SetOKReply(const AValue: TIdReplyRFC);
|
|||
|
|
begin
|
|||
|
|
FOKReply.Assign(AValue);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServerContext.PortOnAfterBind(ASender: TObject);
|
|||
|
|
begin
|
|||
|
|
FServer.DoOnDataPortAfterBind(Self);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServerContext.PortOnBeforeBind(ASender: TObject);
|
|||
|
|
begin
|
|||
|
|
FServer.DoOnDataPortBeforeBind(Self);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdFTPServerContext.ResetZLibSettings;
|
|||
|
|
begin
|
|||
|
|
//Settings specified by
|
|||
|
|
// http://www.ietf.org/internet-drafts/draft-preston-ftpext-deflate-00.txt
|
|||
|
|
FZLibCompressionLevel := DEF_ZLIB_COMP_LEVEL;
|
|||
|
|
FZLibWindowBits := DEF_ZLIB_WINDOW_BITS; //-15 - no extra headers
|
|||
|
|
FZLibMemLevel := DEF_ZLIB_MEM_LEVEL;
|
|||
|
|
FZLibStratagy := DEF_ZLIB_STRATAGY; // - default
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
end.
|