Improved command-line argument parsing, which will make my job easier
when I'll introduce the /CONFIG, /WORKDIR arguments. Now not
only the first argument is parsed, but all of them.
I've also edited todo.txt to reflect my vision better of further
development.
This is Release Candidate 1.
modified: Common.pas
modified: MgSMTP.pas
new file: buildall.bat
modified: todo.txt
- constructor Create(RawArguments: TStringArray; AllowedPrefixes: TStringArray = []);
+ constructor Create(RawArguments: array of string; AllowedPrefixes: array of string);
destructor Destroy; override;
private
Arguments: array of TArgument;
destructor Destroy; override;
private
Arguments: array of TArgument;
- procedure ParseArgument(Arg: string; const AllowedPrefixes: TStringArray);
+ procedure ParseArgument(Arg: string; const AllowedPrefixes: array of string);
public
function GetArgument(ID: integer): TArgument;
function IsPresent(ArgumentName: string): boolean;
function GetValue(ArgumentName: string; DefValue: string = ''): string;
public
function GetArgument(ID: integer): TArgument;
function IsPresent(ArgumentName: string): boolean;
function GetValue(ArgumentName: string; DefValue: string = ''): string;
- function ValidateArguments(ValidArguments: TStringArray): integer;
+ function ValidateArguments(ValidArguments: array of string): integer;
{ Unit-private functions/prodecures: }
{ Unit-private functions/prodecures: }
+function InStringArray(const S: string; const SA: array of string): boolean;
+var i: integer;
+begin
+ i:= 0;
+ while (i < Length(SA)) and (SA[i] <> S) do Inc(i);
+ Result:= i < Length(SA);
+end;
+
function MakeTimeOffsetStr(TimeOffset: integer): string;
var CorrS: string; CorrI: integer;
begin
function MakeTimeOffsetStr(TimeOffset: integer): string;
var CorrS: string; CorrI: integer;
begin
+function CmdlineToStringArray: TStringArray;
+var i: integer;
+begin
+ SetLength(Result, ParamCount);
+ for i:= 1 to ParamCount do
+ Result[i-1]:= ParamStr(i);
+end;
+
function UnixTimeStamp(DateTime: TDateTime): TUnixTimeStamp;
begin
{Result:= Trunc((DateTime - EncodeDate(1970, 1 ,1)) * 24 * 60 * 60);}
function UnixTimeStamp(DateTime: TDateTime): TUnixTimeStamp;
begin
{Result:= Trunc((DateTime - EncodeDate(1970, 1 ,1)) * 24 * 60 * 60);}
{ Object constructors/destructors: }
{ Object constructors/destructors: }
-constructor TArgumentParser.Create(RawArguments: TStringArray; AllowedPrefixes: TStringArray = []);
+constructor TArgumentParser.Create(RawArguments: array of string; AllowedPrefixes: array of string);
var i: integer;
begin
for i:= 0 to Length(RawArguments) - 1 do
var i: integer;
begin
for i:= 0 to Length(RawArguments) - 1 do
-procedure TArgumentParser.ParseArgument(Arg: string; const AllowedPrefixes: TStringArray);
+procedure TArgumentParser.ParseArgument(Arg: string; const AllowedPrefixes: array of string);
var i, n: integer; found: boolean;
begin
{ Strip prefix if present. }
var i, n: integer; found: boolean;
begin
{ Strip prefix if present. }
-function TArgumentParser.ValidateArguments(ValidArguments: TStringArray): integer;
+function TArgumentParser.ValidateArguments(ValidArguments: array of string): integer;
{ Returns -1 if all arguments are valid. Otherwise, returns the ID of the first
invalid parameter. }
var i: integer;
begin
i:= 0;
{ Returns -1 if all arguments are valid. Otherwise, returns the ID of the first
invalid parameter. }
var i: integer;
begin
i:= 0;
- while (i < Length(Arguments)) and (Arguments[i] in ValidArguments) do
+ while (i < Length(Arguments)) and InStringArray(Arguments[i].Option, ValidArguments) do
- if i < Length(Arguments) then
+ if i >= Length(Arguments) then
Result:= -1
else
Result:= i;
Result:= -1
else
Result:= i;
+ ArgumentPrefixes: array[0..2] of string = ('/', '--', '-');
+ ValidArguments: array[0..4] of string = ('?', 'HELP', 'INSTALL', 'UNINSTALL', 'USERMODE');
+
{ For development test builds, you can add a developer comment here to
document what bugfix/feature are you testing with the actual build.
This will be logged to help you differentiate outputs of subsequent
builds in your logs. If left empty, it won't be added to the logs. }
{ For development test builds, you can add a developer comment here to
document what bugfix/feature are you testing with the actual build.
This will be logged to help you differentiate outputs of subsequent
builds in your logs. If left empty, it won't be added to the logs. }
- DEVCOMMENT = 'Testing new parameters';
+ DEVCOMMENT = 'Release Candidate 1';
+ Cmdline: TArgumentParser;
Config: TINIFile;
hSCManager, hService: THandle;
hSvcStatusHandle: THandle;
SvcStatus: TServiceStatus;
ServiceMode, Stopping: boolean;
Config: TINIFile;
hSCManager, hService: THandle;
hSvcStatusHandle: THandle;
SvcStatus: TServiceStatus;
ServiceMode, Stopping: boolean;
+ WrongArgument: integer;
procedure AddDevComment(Log: TStreamLogger);
procedure AddDevComment(Log: TStreamLogger);
Out.writeln;
{ TODO: Process arguments here. }
Out.writeln;
{ TODO: Process arguments here. }
+ Cmdline:= TArgumentParser.Create(CmdlineToStringArray, ArgumentPrefixes);
+ WrongArgument:= Cmdline.ValidateArguments(ValidArguments);
- ServiceMode:= false;
-
- if ParamCount > 0 then begin
+ if WrongArgument = -1 then begin
- if UpperCase(ParamStr(1)) = '/USERMODE' then begin
- Out.writeln('Starting MgSMTP in user mode...');
- Service(0, nil);
- end
- else if ParamStr(1) = '/?' then begin
+ if Cmdline.IsPresent('?') or Cmdline.IsPresent('HELP') then begin
Out.writeln('Supported arguments:');
Out.writeln('/INSTALL - registers the actual MgSMTP binary');
Out.writeln(' as a Windows service.');
Out.writeln('Supported arguments:');
Out.writeln('/INSTALL - registers the actual MgSMTP binary');
Out.writeln(' as a Windows service.');
Out.writeln('https://sourceforge.net/projects/mgsmtp/');
end
Out.writeln('https://sourceforge.net/projects/mgsmtp/');
end
- else if (UpperCase(ParamStr(1)) = '/INSTALL') or (UpperCase(ParamStr(1)) = '/UNINSTALL') then begin
+ else if (Cmdline.IsPresent('INSTALL') or Cmdline.IsPresent('UNINSTALL')) then begin
{ Register / unregister service. }
hSCManager:= OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
if hSCManager <> 0 then begin
{ Register / unregister service. }
hSCManager:= OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
if hSCManager <> 0 then begin
- if UpperCase(ParamStr(1)) = '/INSTALL' then begin
+ if Cmdline.IsPresent('INSTALL') then begin
if CreateService(hSCManager, 'MgSMTP', 'MegaBrutal''s SMTP Server (MgSMTP)', SC_MANAGER_ALL_ACCESS,
SERVICE_WIN32_OWN_PROCESS,
SERVICE_AUTO_START, SERVICE_ERROR_NORMAL,
if CreateService(hSCManager, 'MgSMTP', 'MegaBrutal''s SMTP Server (MgSMTP)', SC_MANAGER_ALL_ACCESS,
SERVICE_WIN32_OWN_PROCESS,
SERVICE_AUTO_START, SERVICE_ERROR_NORMAL,
else
Out.writeln('CreateService failed!');
end
else
Out.writeln('CreateService failed!');
end
- else if UpperCase(ParamStr(1)) = '/UNINSTALL' then begin
+ else if Cmdline.IsPresent('UNINSTALL') then begin
hService:= OpenService(hSCManager, 'MgSMTP', SC_MANAGER_ALL_ACCESS);
if hService <> 0 then begin
if DeleteService(hService) then
hService:= OpenService(hSCManager, 'MgSMTP', SC_MANAGER_ALL_ACCESS);
if hService <> 0 then begin
if DeleteService(hService) then
Out.writeln('DeleteService failed!');
end
else Out.writeln('OpenService failed!');
Out.writeln('DeleteService failed!');
end
else Out.writeln('OpenService failed!');
- end
- else Out.writeln('Unknown parameter.');
end
else Out.writeln('OpenSCManager failed!');
end
end
else Out.writeln('OpenSCManager failed!');
end
- else Out.writeln('Unknown parameter specified!');
+
+ else begin
+ if Cmdline.IsPresent('USERMODE') then begin
+ Out.writeln('Starting MgSMTP in user mode...');
+ Service(0, nil);
+ end
+ else begin
+ Out.writeln('Trying to contact Service Control Manager...');
+ Out.writeln('(If you see this message on console, you tried to');
+ Out.writeln('start up the program incorrectly. Your current');
+ Out.writeln('attempt will fail, or it may hang under Wine.');
+ Out.writeln;
+ ServiceMode:= true;
+ if not StartServiceCtrlDispatcher(ServiceTable) then begin
+ ServiceMode:= false;
+ Out.writeln('Failed!');
+ Out.writeln;
+ Out.writeln('You need to start MgSMTP as a service,');
+ Out.writeln('or supply proper arguments!');
+ Out.writeln('Issue with /? for more information.');
+ end;
+ end;
+ end
+
- Out.writeln('Trying to contact Service Control Manager...');
- ServiceMode:= true;
- if not StartServiceCtrlDispatcher(ServiceTable) then begin
- ServiceMode:= false;
- Out.writeln('Failed!');
- Out.writeln;
- Out.writeln('You need to start MgSMTP as a service,');
- Out.writeln('or supply proper arguments!');
- Out.writeln('Issue with /? for more information.');
- end;
+ Out.writeln('Invalid argument: ' + Cmdline.GetArgument(WrongArgument).Option + '!');
--- /dev/null
+@echo off
+del mgsmtp.exe mgsmtp64.exe
+echo Building for Win32...
+echo.
+del *.o *.ppu *.a
+fpc -omgsmtp.exe MgSMTP.pas
+echo Building for Win64...
+echo.
+del *.o *.ppu *.a
+ppcrossx64 -omgsmtp64.exe MgSMTP.pas
\ No newline at end of file
- Log outgoing SMTP transactions
- Show delivery thread IDs
- Watchdog for delivery threads
- Log outgoing SMTP transactions
- Show delivery thread IDs
- Watchdog for delivery threads
-- IPv6
-- Bind to user-specified IPs
- VRFY?
- Show authenticated user in "Received" headers
- Delivery threads should finish sooner
- VRFY?
- Show authenticated user in "Received" headers
- Delivery threads should finish sooner
+- Ensure random spool object names
+- DNSBL
- Option to disable MX lookups
- Option to disable MX lookups
-- Ensure random spool object names
+- Separate config files or work directories supplied in parameters
- Process CTRL-C properly to quit from user mode gracefully
- Process CTRL-C properly to quit from user mode gracefully
+- IPv6
+- Bind to user-specified IPs
v0.9s:
+ Change "Client disconnected, and thread exited successfully." to "Client disconnected."
v0.9s:
+ Change "Client disconnected, and thread exited successfully." to "Client disconnected."
+ Fix service mode not working when compiled with FPC 2.6.2!
+ Alternate mailbox names with + signs (e.g. "megabrutal+games@domain")
+ Domain-scope mailbox settings
+ Fix service mode not working when compiled with FPC 2.6.2!
+ Alternate mailbox names with + signs (e.g. "megabrutal+games@domain")
+ Domain-scope mailbox settings
-- Separate config files or work directories supplied in parameters
+ Improved Wine compatibility
+ Consistent handling of local/relay spool objects
+ Implement Win64 support
+ Fix PRESHUTDOWN
+ Enforce ASCII printable characters in commands
+ Developer comment for test/debug builds
+ Improved Wine compatibility
+ Consistent handling of local/relay spool objects
+ Implement Win64 support
+ Fix PRESHUTDOWN
+ Enforce ASCII printable characters in commands
+ Developer comment for test/debug builds
+- More efficient command-line parsing