This is an example of an FTP Serv-U DLL for event notification
AND client access verification, written for Borland's Delphi.
Please read the comments in the source code for additional
information.
If you have any comments or spot any bugs, please let me know
(contact information is listed at the end of this document).
Hope this helps!
- Bill Sorensen
Installation:
After building the project, copy the DLL to your Serv-U directory.
Add the following to your SERV-U.INI:
[EXTERNAL]
ClientCheckDLL1=SUExampl.DLL
EventHookDLL1=SUExampl.DLL
Legalese:
The source code is copyright (c) 1999 ASI/EDI Inc. All rights reserved.
It may be distributed for educational purposes so long as this text
file is included in the distribution. Derivative works may be created
from it, but must contain a valid ASI/EDI copyright notice, such as
"portions of this application contain copyrighted (c) material of
ASI/EDI Inc."
ASI/EDI Inc. and the author expressly disclaim any warranty,
express or implied, for this code and documentation.
Use it at your own risk.
FTP Serv-U is copyright (c) 1995-1998 Cat Soft.
ASI/EDI is not affiliated with Cat Soft, and Cat Soft is not
responsible for errors in or support of this source code.
No infringement on trademarks is intended.
The Author:
Written by Bill Sorensen (tzimisce@mwaccess.net - soon to change -
see www.Will.brinet.net for updated email information).
Information on ASI/EDI is available at: www.asiedi.com
[September 21, 1999]
----------------------------------------------------
SUExampl.dpr
----------------------------------------------------
library SUExampl;
{$IMAGEBASE $44FA0000}
uses
SysUtils,
SUMain in 'SUMain.pas',
ServUEvt in 'ServUEvt.pas',
ServUCli in 'ServUCli.pas',
SUEvents in 'SUEvents.pas',
SULog in 'SULog.pas';
exports
HandleEventHook, HandleClientEvent;
begin
InitializeLibrary;
end.
----------------------------------------------------
SUMain.pas
----------------------------------------------------
(*
Description : Main module of a Serv-U FTP Server (v2.5a, 32-bit) DLL
for event notification AND client access verification.
Tested under Delphi 4, update pack 3.
Notes : IMPORTANT - Avoid displaying dialogs or any other windows!
These can cause reentrancy in the DLL (due to message
dispatching)!
For this example, I'm assuming you have a C:/TEMP directory.
I'm not handling directory rights here. It's easiest
to set up a default user in Serv-U with appropriate rights
to the parent directory of the users' directories, then
inherit rights to sub-dirs. Be sure to turn on
"Show path relative to homedir" in Serv-U.
Use SessionID to keep track of state, if necessary.
Copyright (c) 1999 ASI/EDI, Inc. All rights reserved.
WES 07/15/99 Initial Version
*)
unit SUMain;
interface
uses
Windows, SysUtils, ServUEvt, ServUCli;
procedure InitializeLibrary;
// Executed when DLL is loaded.
procedure ExitingLibrary;
// Executed when DLL is unloaded (actually, detached from calling process).
procedure LibraryProc(iReason: Integer);
// Internal. Equivalent to DLLEntryPoint.
function HandleEventHook(pEventStruc: TPRFTPEventStr): Word; stdcall;
// Exported callback function - note that CALLBACK is defined as stdcall
// in C's windef.h.
function HandleClientEvent(pEventStruc: TPRClientEventStr): LongBool; cdecl;
// Exported function.
procedure LogErrorMessage(const sErrorMessage: String);
// Beeps and logs error message.
implementation
uses
SUEvents, SULog;
procedure InitializeLibrary;
begin
DLLProc := @LibraryProc; // ensures that ExitingLibrary will be called
try { except }
InitializeLog;
LogIt('FTP server started');
// Your initialization code would go here.
except
on E: Exception do
LogErrorMessage(E.Message);
end; { try..except }
end;
procedure ExitingLibrary;
begin
try { except }
LogIt('FTP server shutdown');
// Your cleanup code would go here.
except
on E: Exception do
LogErrorMessage(E.Message);
end; { try..except }
end;
procedure LibraryProc(iReason: Integer);
begin
if iReason = DLL_PROCESS_DETACH then
ExitingLibrary;
end;
function HandleEventHook(pEventStruc: TPRFTPEventStr): Word;
begin
Result := REVNT_None;
try { except }
case pEventStruc^.Event of
EVNT_Connect : OnConnection(pEventStruc^);
EVNT_Close : OnConnectionClose(pEventStruc^);
EVNT_EndUp : OnUploadSuccess(pEventStruc^);
EVNT_EndDown : OnDownloadSuccess(pEventStruc^);
EVNT_AbortUp,
EVNT_AbortDown : OnTransferFailure(pEventStruc^);
// no else
end; { case }
except
on E: Exception do
LogErrorMessage(E.Message);
end; { try..except }
end;
function HandleClientEvent(pEventStruc: TPRClientEventStr): LongBool;
begin
Result := CLIENT_EVENT_NOT_HANDLED;
try { except }
case pEventStruc^.Event of
SRVU_HomeDir : Result := OnRequestHomeDir(pEventStruc^);
SRVU_Password : Result := OnVerifyPassword(pEventStruc^);
// no else
end; { case }
except
on E: Exception do
LogErrorMessage(E.Message);
end; { try..except }
end;
procedure LogErrorMessage(const sErrorMessage: String);
begin
try { except }
MessageBeep(MB_ICONEXCLAMATION); // Make this play a loud WAV file.
LogIt('ERROR: ' + sErrorMessage);
except
// No exceptions allowed here.
end; { try..except }
end;
end.
----------------------------------------------------
ServUEvt.pas
----------------------------------------------------
(*
Description : Serv-U FTP Server (v2.5a, 32-bit) DLL includes/defines
for event notification and hooking.
Copyright (c) 1999 ASI/EDI, Inc. All rights reserved.
WES 07/15/99 Initial Version
*)
unit ServUEvt;
interface
uses
Windows;
type
// HandleEventHook parameter
TPRFTPEventStr = ^TRFTPEventStr;
// Event notification structure
TRFTPEventStr = record
// event info
Event: DWORD; // event code
SubEvent: DWORD; // sub-event code
// user info
SessionID: DWORD; // unique ID of the FTP session
User: Array[0..40-1] of Char; // user name
ClientIP: Array[0..16-1] of Char; // IP address of client
DomainIP: Array[0..16-1] of Char; // server IP address the client connected to
// event attributes
Duration: DWORD; // duration of events (in seconds)
Size: DWORD; // size of object (i.e. file)
// hook info
hWindow: HWND; // window handle to post decision to
Message: UINT; // message to post
pReplyText: PChar; // pointer to text to send to user
// scratch pad area
AuxOne: Array[0..512-1] of Char; // auxiliary area one
AuxTwo: Array[0..512-1] of Char; // auxiliary area two
// domain info
DomainPort: DWORD; // server port the client connected to
DomainID: DWORD; // unique ID for the domain the client connected to
// more size info
HiSize: DWORD; // high 32 bits of size info (full size is 64 bit value)
end; { record RFTPEventStr }
const
// HandleEventHook return codes
REVNT_None = 0; // nothing
REVNT_Proceed = 1; // let event pass
REVNT_Abort = 2; // stop event
REVNT_Suspend = 3; // suspend event until decision is made
// Serv-U notification event codes
EVNT_None = 0; // none
EVNT_IPName = 1; // symbolic IP name available
EVNT_Connect = 2; // connection was made
EVNT_Close = 3; // closed connection
EVNT_BouncedIP = 4; // bounced client because of IP address
EVNT_TooMany = 5; // bounced user because there are too many
EVNT_WrongPass = 6; // too many times wrong password
EVNT_TimeOut = 7; // connection timed out
EVNT_Login = 8; // user logged in
EVNT_StartUp = 9; // start upload of file
EVNT_EndUp = 10; // successful upload of file
EVNT_StartDown = 11; // start of download of file
EVNT_EndDown = 12; // successful download of file
EVNT_AbortUp = 13; // aborted upload
EVNT_AbortDown = 14; // aborted download
EVNT_Rename = 15; // renamed file/dir
EVNT_DelFile = 16; // deleted file
EVNT_DelDir = 17; // deleted dir
EVNT_ChgDir = 18; // changed working directory
EVNT_MakeDir = 19; // created directory
EVNT_ProgUp = 20; // progress of upload
EVNT_ProgDown = 21; // progress of download
EVNT_Maintenance = 22;// user switching to maintenance mode
// Serv-U hook event codes
EVNT_HookDown = 100; // hook for file downloads
EVNT_HookUp = 101; // hook for file uploads
EVNT_HookAppend = 102; // hook for append file upload
EVNT_HookUnique = 103; // hook for unique name upload
EVNT_HookRename = 104; // hook for rename file/dir
EVNT_HookDelFile = 105; // hook for delete file
EVNT_HookDelDir = 106; // hook for delete dir
EVNT_HookMkd = 107; // hook for make directory
EVNT_HookSite = 108; // hook for the SITE command
EVNT_HookChgDir = 109; // hook for change dir command
EVNT_HookCommand = 110; // hook for raw FTP command
EVNT_HookReply = 111; // hook for raw FTP reply
// Serv-U sub-event codes
SEVNT_None = 0; // no sub-event
SEVNT_ErrWrite = 1; // problem writing to disk
SEVNT_ErrRead = 2; // problem reading from disk
SEVNT_ErrQuota = 3; // insufficient disk quota
SEVNT_ErrTOut = 4; // packet timed out
SEVNT_ErrAbort = 5; // user aborted transfer
SEVNT_ErrUnknown = 6; // unknown error
SEVNT_ErrClose = 7; // data connection closed unexpectedly
SEVNT_System = 8; // switching to SYSTEM maintenance mode
SEVNT_Group = 9; // switching to GROUP maintenance mode
SEVNT_Domain =10; // switching to DOMAIN maintenance mode
SEVNT_ReadOnly =11; // user switching to READ-ONLY maintenance mode
implementation
end.
----------------------------------------------------
ServUCli.pas
----------------------------------------------------
(*
Description : Serv-U FTP Server (v4.1, 32-bit) DLL includes/defines
for client access verification.
Copyright (c) 1999 ASI/EDI, Inc. All rights reserved.
Copyright (c) 2003 Icebird
WES 08/03/99 Initial Version
*)
unit ServUCli;
interface
uses
Windows;
type
// HandleClientEvent parameter
TPRClientEventStr = ^TRClientEventStr;
// Client event structure
TRClientEventStr = record
Event : DWORD; // event code
Flag : DWORD; // meaning of flag depends on event
User : Array[0..40-1] of Char; // user name
Aux : Array[0..512-1] of Char; // auxiliary area, depends on event
HostIP : Array[0..16-1] of Char; // server IP home
SessionID : DWORD; // unique ID of the FTP session
DomainID: DWORD; // unique ID for the domain the client connected to
DomainPort: DWORD; // server domain port number the client connected to
end; { record TRClientEventStr }
const
// Return values for HandleClientEvent
CLIENT_EVENT_HANDLED : LongBool = True;
CLIENT_EVENT_NOT_HANDLED : LongBool = False;
// Flag values in TRClientEventStr for SRVU_Password event
FLAG_ALLOW_LOGIN : DWORD = 1;
FLAG_DENY_LOGIN : DWORD = 0;
// Flag values in TRClientEventStr for SRVU_HomeDir event
FLAG_FOUND_HOMEDIR : DWORD = 1;
FLAG_NO_HOMEDIR : DWORD = 0;
// Serv-U client event codes
SRVU_LoginMesFile = 1; // get login message file
SRVU_HomeDir = 2; // get home dir
SRVU_Password = 3; // verify password
SRVU_IPAccess = 4; // verify IP access
SRVU_WriteFile = 5; // verify write access
SRVU_ReadFile = 6; // verify read access
SRVU_ModifyFile = 7; // verify mod./del. file access
SRVU_ExecProg = 8; // verify execute access
SRVU_ListDir = 9; // verify dir listing access
SRVU_ChangeDir = 10; // verify dir change access
SRVU_DeleteDir = 11; // verify dir delete access
SRVU_CreateDir = 12; // verify dir create access
SRVU_HideHidden = 13; // get setting for 'hide hidden files'
SRVU_RelPaths = 14; // get setting for 'relative paths'
SRVU_RatioType = 15; // get setting for type of ratios
SRVU_RatioDown = 16; // get setting for download ratio
SRVU_RatioUp = 17; // get setting for upload ratio
SRVU_RatioCredit = 18; // get/adjust ratio credit setting
SRVU_RatioFree = 19; // verify if file is free for ratios
SRVU_QuotaEnable = 20; // verify if disk quota is enabled
SRVU_QuotaChange = 21; // change in disk quota
SRVU_QuotaMax = 22; // maximum disk quota
SRVU_AlwaysLogin = 23; // always allow login
SRVU_OneLoginPerIP = 24; // allow one login per user/IP pair
SRVU_LogClientIP = 25; // log client from this IP address
SRVU_SpeedLimit = 26; // maximum transfer speed
SRVU_PassChange = 27; // change user's password
SRVU_TimeOut = 28; // get user time-out value
SRVU_MaxUsers = 29; // max. no. of users for account
SRVU_PassChallenge = 30; // get password challenge if needed
SRVU_Connect = 31; // information only: client connected
SRVU_Close = 32; // information only: client disconnected
SRVU_MaxLoginPerIP = 33; // max. no. of logins from same IP for user
SRVU_VerifyPasswd = 34; // verify old password before changing it
SRVU_AppendFile = 35; // verify append file access
SRVU_SignOnMes = 36; // get signon message file
SRVU_SignOffMes = 37; // get signoff message file
SRVU_Maintenance = 38; // switch to maintenance mode
SRVU_SessionTimeOut= 39; // session time-out
implementation
end.
----------------------------------------------------
SUEvents.pas
----------------------------------------------------
(*
Description : FTP server event handlers.
Copyright (c) 1999 ASI/EDI, Inc. All rights reserved.
WES 08/19/99 Initial Version
*)
unit SUEvents;
interface
uses
Windows, SysUtils, ServUEvt, ServUCli;
procedure OnConnection(const EventStruc: TRFTPEventStr);
// Fires before OnVerifyPassword.
procedure OnConnectionClose(const EventStruc: TRFTPEventStr);
// Called from HandleEventHook, as HandleClientEvent client disconnect
// doesn't fire if server was dropped!
procedure OnUploadSuccess(const EventStruc: TRFTPEventStr);
procedure OnDownloadSuccess(const EventStruc: TRFTPEventStr);
procedure OnTransferFailure(const EventStruc: TRFTPEventStr);
function OnRequestHomeDir(var ClientEventStruc: TRClientEventStr): LongBool;
// Fires after OnVerifyPassword.
// Note - does NOT fire if home dir present in Serv-U user setup!
function OnVerifyPassword(var ClientEventStruc: TRClientEventStr): LongBool;
// Note - does NOT fire after VALID password entered
// based on setup in Serv-U!
implementation
uses
SULog;
procedure OnConnection(const EventStruc: TRFTPEventStr);
begin
LogIt('Client connected');
// Your code here.
end;
procedure OnConnectionClose(const EventStruc: TRFTPEventStr);
begin
LogIt('Connection closed');
// Your code here.
end;
procedure OnUploadSuccess(const EventStruc: TRFTPEventStr);
var
sUploadedFile : String;
begin
sUploadedFile := EventStruc.AuxOne;
LogIt(Format('File %s uploaded successfully',[sUploadedFile]));
// Your code here.
end;
procedure OnDownloadSuccess(const EventStruc: TRFTPEventStr);
var
sFileFullPath : String;
begin
sFileFullPath := EventStruc.AuxOne;
LogIt(Format('File %s downloaded successfully',[sFileFullPath]));
// Your code here.
end;
procedure OnTransferFailure(const EventStruc: TRFTPEventStr);
var
sUploadOrDownload : String;
sFileName : String;
sTransferMode : String;
sError : String;
begin
if EventStruc.Event = EVNT_AbortUp then
sUploadOrDownload := 'upload'
else
sUploadOrDownload := 'download';
// Note that I'm stripping out the path here
// to make the error message more legible.
// If we wanted to delete the file, it's easiest to let Serv-U do it.
sFileName := ExtractFileName(EventStruc.AuxOne);
sTransferMode := EventStruc.AuxTwo;
case EventStruc.SubEvent of
SEVNT_None : sError := 'no error specified';
SEVNT_ErrWrite : sError := 'error writing to disk';
SEVNT_ErrRead : sError := 'error reading from disk';
SEVNT_ErrQuota : sError := 'insufficient disk quota';
SEVNT_ErrTOut : sError := 'packet timed out';
SEVNT_ErrAbort : sError := 'user abort';
SEVNT_ErrUnknown : sError := 'unknown error';
SEVNT_ErrClose : sError := 'connection closed';
else
sError := '????';
end; { case }
LogIt(Format('Failed %s (%s) - file %s, mode %s',
[sUploadOrDownload,sError,sFileName,sTransferMode]));
// Your error logging (or whatever) code here.
end;
function OnRequestHomeDir(var ClientEventStruc: TRClientEventStr): LongBool;
var
sHomeDirFullPath : String;
begin
sHomeDirFullPath := 'C:/TEMP'; // Database lookup, whatever - your code here.
StrCopy(ClientEventStruc.Aux,PChar(sHomeDirFullPath));
ClientEventStruc.Flag := FLAG_FOUND_HOMEDIR;
Result := CLIENT_EVENT_HANDLED;
end;
function OnVerifyPassword(var ClientEventStruc: TRClientEventStr): LongBool;
var
sEnteredPassword : String;
sCorrectCaseUser : String;
bOkToLogin : Boolean;
begin
Result := CLIENT_EVENT_NOT_HANDLED;
sEnteredPassword := ClientEventStruc.Aux;
// OnVerifyPassword is generally called twice - once after username is
// entered but before password is entered (blank password), then
// again when password is actually entered. Serv-U won't let 'em
// in with a blank password (if it's set up correctly), so this is safe.
if Length(sEnteredPassword) > 0 then
begin
// Note that User is uppercased, and we may want the case-sensitive
// login name.
// This is available in Aux following the password and a null byte.
// NOTE - if no username was entered, sCorrectCaseUser will be '(none)'.
sCorrectCaseUser :=
PChar(@ClientEventStruc.Aux[StrLen(ClientEventStruc.Aux) + 1]);
LogIt(Format('User: %s Password: %s',
[sCorrectCaseUser,sEnteredPassword]));
bOkToLogin := True; // Database lookup, whatever - your code here.
if bOkToLogin then
ClientEventStruc.Flag := FLAG_ALLOW_LOGIN
else
ClientEventStruc.Flag := FLAG_DENY_LOGIN;
Result := CLIENT_EVENT_HANDLED;
end; { if }
end;
end.
----------------------------------------------------
SULog.pas
----------------------------------------------------
(*
Description : Debugging/logging routines.
Copyright (c) 1999 ASI/EDI, Inc. All rights reserved.
WES 12/30/98 Initial Version
*)
unit SULog;
interface
const
FILENAME_LOG = 'C:/FTPLOG.TXT';
procedure InitializeLog;
// Erases FILENAME_LOG if it exists.
procedure LogIt(const sLogText: String);
// Calls LogToFile for FILENAME_LOG.
procedure LogToFile(const sLogText: String; sFileName: String);
// Writes a string plus carriage-return+linefeed to a text file.
// File is appended to if it existed, created otherwise.
// Buffer is flushed and file is closed before function returns.
// Exception raised on error.
implementation
uses
SysUtils;
procedure InitializeLog;
begin
if FileExists(FILENAME_LOG) then
DeleteFile(FILENAME_LOG);
end;
procedure LogIt(const sLogText: String);
begin
LogToFile(sLogText,FILENAME_LOG);
end;
procedure LogToFile(const sLogText: String; sFileName: String);
var
F : TextFile;
begin
sFileName := SysUtils.Trim(sFileName);
if sFileName = '' then
raise EInOutError.Create('Blank file name passed to LogToFile');
AssignFile(F,sFileName);
if FileExists(sFileName) then
Append(F)
else
Rewrite(F);
// Yes, the Append/Rewrite should be outside the try block.
try { finally }
Writeln(F,sLogText);
Flush(F); // just in case
finally
CloseFile(F);
end; { try..finally }
end;
end.