MgSMTP.pas

   1 {
   2    MegaBrutal's SMTP Server (MgSMTP)
   3    Copyright (C) 2010-2014 MegaBrutal
   4
   5    This program is free software: you can redistribute it and/or modify
   6    it under the terms of the GNU Affero General Public License as published by
   7    the Free Software Foundation, either version 3 of the License, or
   8    (at your option) any later version.
   9
  10    This program is distributed in the hope that it will be useful,
  11    but WITHOUT ANY WARRANTY; without even the implied warranty of
  12    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13    GNU Affero General Public License for more details.
  14
  15    You should have received a copy of the GNU Affero General Public License
  16    along with this program.  If not, see <http://www.gnu.org/licenses/>.
  17 }
  18
  19
  20 {$MODE DELPHI}
  21 {$APPTYPE CONSOLE}
  22
  23 program MgSMTP;
  24 uses Windows, SysUtils, INIFiles, EINIFiles,
  25      Common, Log, Spool, Listener, Mailbox, Relay, Policies;
  26
  27
  28 function RegisterServiceCtrlHandlerEx(lpServiceName: LPCSTR; lpHandlerProc: pointer; lpContext: LPVOID): SERVICE_STATUS_HANDLE; stdcall; external 'advapi32.dll' name 'RegisterServiceCtrlHandlerExA';
  29 procedure Service(Argc: dword; Argv: pointer); stdcall; forward;
  30
  31 const
  32
  33    ServiceTable: array[0..1] of TServiceTableEntry =
  34       (
  35          (
  36             lpServiceName: 'MgSMTP';
  37             lpServiceProc: @Service;
  38          ),
  39          (
  40             lpServiceName: nil;
  41             lpServiceProc: nil;
  42          )
  43       );
  44
  45    { For development test builds, you can add a developer comment here to
  46      document what bugfix/feature are you testing with the actual build.
  47      This will be logged to help you differentiate outputs of subsequent
  48      builds in your logs. If left empty, it won't be added to the logs. }
  49    DEVCOMMENT  =  'Testing new parameters';
  50
  51 var
  52
  53    Config: TINIFile;
  54    hSCManager, hService: THandle;
  55    hSvcStatusHandle: THandle;
  56    SvcStatus: TServiceStatus;
  57    ServiceMode, Stopping: boolean;
  58
  59
  60 procedure AddDevComment(Log: TStreamLogger);
  61 begin
  62    if DEVCOMMENT <> '' then begin
  63       Log.writeln('Build: ' + {$INCLUDE %DATE%} + ' ' + {$INCLUDE %TIME%});
  64       Log.writeln('Developer note: ' + DEVCOMMENT);
  65    end;
  66 end;
  67
  68 procedure ReportSvcStatus(CurrentState, WinExitCode, WaitHint: dword);
  69 { Report a service status to the Windows SCM. }
  70 begin
  71    if ServiceMode then begin
  72       SvcStatus.dwCurrentState:= CurrentState;
  73       SvcStatus.dwWaitHint:= WaitHint;
  74       if WinExitCode <> 0 then begin
  75          SvcStatus.dwWin32ExitCode:= ERROR_SERVICE_SPECIFIC_ERROR;
  76          SvcStatus.dwServiceSpecificExitCode:= WinExitCode;
  77       end
  78       else begin
  79          SvcStatus.dwWin32ExitCode:= NO_ERROR;
  80       end;
  81
  82       if CurrentState = SERVICE_START_PENDING then
  83          SvcStatus.dwControlsAccepted:= 0
  84       else begin
  85          if GetWinMajorVersion >= 6 then begin
  86             SvcStatus.dwControlsAccepted:=
  87                SERVICE_ACCEPT_STOP or SERVICE_ACCEPT_SHUTDOWN or SERVICE_ACCEPT_PRESHUTDOWN;
  88          end
  89          else begin
  90             SvcStatus.dwControlsAccepted:=
  91                SERVICE_ACCEPT_STOP or SERVICE_ACCEPT_SHUTDOWN;
  92          end;
  93       end;
  94
  95       if (CurrentState = SERVICE_RUNNING) or (CurrentState = SERVICE_STOPPED) then
  96          SvcStatus.dwCheckPoint:= 0
  97       else
  98          Inc(SvcStatus.dwCheckPoint);
  99
 100       SetServiceStatus(hSvcStatusHandle, SvcStatus);
 101    end;
 102 end;
 103
 104 procedure SvcCtrlHandlerEx(Ctrl, EventType: dword; EventData, Context: pointer); stdcall;
 105 { Receive a service control code from the Windows SCM, and handle it. }
 106 begin
 107    case Ctrl of
 108    SERVICE_CONTROL_STOP,
 109    SERVICE_CONTROL_SHUTDOWN,
 110    SERVICE_CONTROL_PRESHUTDOWN:
 111    begin
 112       Out.writeln('Received service control: ' + GetServiceCodeStr(Ctrl));
 113       ReportSvcStatus(SERVICE_STOP_PENDING, 0, 1500);
 114       Stopping:= true;
 115    end;
 116
 117    SERVICE_CONTROL_INTERROGATE:
 118       ReportSvcStatus(SERVICE_RUNNING, 0, 0);
 119
 120    else begin
 121       Out.writeln('Received unknown service control: ' + IntToStr(Ctrl));
 122       ReportSvcStatus(SERVICE_STOPPED, 1, 0);
 123       Stopping:= true;
 124    end;
 125    end;
 126 end;
 127
 128 procedure Service(Argc: dword; Argv: pointer); stdcall;
 129 var ProposedExitCode: integer;
 130 begin
 131    ProposedExitCode:= 0;
 132    Stopping:= false;
 133    SetLastError(0);
 134
 135    if ServiceMode then
 136       hSvcStatusHandle:= RegisterServiceCtrlHandlerEx('MgSMTP', @SvcCtrlHandlerEx, nil);
 137
 138    if ServiceMode and (hSvcStatusHandle = 0) then
 139       Out.writeln('RegisterServiceCtrlHandlerEx failed!'#13#10'Error code: ' + IntToStr(GetLastError))
 140    else begin
 141       SvcStatus.dwServiceType:= SERVICE_WIN32_OWN_PROCESS;
 142       SvcStatus.dwServiceSpecificExitCode:= 0;
 143       SvcStatus.dwCheckPoint:= 0;
 144
 145       ReportSvcStatus(SERVICE_START_PENDING, 0, 1000);
 146
 147       if ServiceMode then Out.writeln('Started in service mode.');
 148
 149       Randomize;
 150       SetCurrentDir(ExtractFilePath(ParamStr(0)));
 151
 152       if not DirectoryExists('mail')  then CreateDir('mail');
 153       if not DirectoryExists('spool') then CreateDir('spool');
 154
 155       if FileExists('mgsmtp_server.ini') then begin
 156
 157          Config:= TExtBoolINIFile.Create('mgsmtp_server.ini');
 158
 159          if Config.ReadString('Server', 'Name', '') <> '' then begin
 160             MainServerConfig:= TMainServerConfig.Create(Config);
 161             Logger:=           TLogger.Create(Config);
 162             MailboxManager:=   TMailboxManager.Create(Config);
 163             RelayManager:=     TRelayManager.Create(Config);
 164             SpoolManager:=     TSpoolManager.Create(Config);
 165             PolicyManager:=    TPolicyManager.Create(Config);
 166
 167             if Config.ReadBool('Spool', 'KeepProcessedEnvelopes', false)
 168             or Config.ReadBool('Spool', 'KeepProcessedEMails', false) then
 169                if not DirectoryExists('processed') then CreateDir('processed');
 170
 171             Config.Free;
 172
 173             AddDevComment(Logger);
 174             Logger.AddStdLine('Primary server name: ' + MainServerConfig.Name);
 175             Logger.AddStdLine('FCrDNS policy: ' + FCrDNSPolicyToStr(PolicyManager.FCrDNSPolicy));
 176             if MailboxManager.DomainSpecific then
 177                Logger.AddStdLine('Domain-specific mailbox support is enabled.');
 178
 179             if not MailboxManager.Verify('postmaster') then
 180                ProposedExitCode:= 3;
 181
 182             if SpoolManager.DeliveryThreadNumber > Length(GetAlphabetStr) then
 183                ProposedExitCode:= 4;
 184
 185             if ProposedExitCode = 0 then begin
 186                SpoolManager.StartDeliveryThreads;
 187                StartListeners;
 188
 189                ReportSvcStatus(SERVICE_RUNNING, 0, 0);
 190                while not Stopping do Sleep(1000);
 191
 192                ReportSvcStatus(SERVICE_STOP_PENDING, 0, SpoolManager.ThreadWait * 2);
 193
 194                StopListeners;
 195                SpoolManager.StopDeliveryThreads;
 196             end
 197             else begin
 198                case ProposedExitCode of
 199                3: Logger.AddStdLine('Error: Mandatory mailbox missing. Create a mailbox for "postmaster"!');
 200                4: Logger.AddStdLine('Error: The maximum allowed number of delivery threads is ' + IntToStr(Length(GetAlphabetStr)) + '.');
 201                end;
 202                ReportSvcStatus(SERVICE_STOPPED, ProposedExitCode, 0);
 203             end;
 204
 205             ReportSvcStatus(SERVICE_STOP_PENDING, 0, 2000);
 206
 207             Logger.AddStdLine('Clean shutdown.');
 208
 209             PolicyManager.Free;
 210             SpoolManager.Free;
 211             RelayManager.Free;
 212             MailboxManager.Free;
 213             Logger.Free;
 214             MainServerConfig.Free;
 215             ReportSvcStatus(SERVICE_STOPPED, 0, 0);
 216          end
 217          else begin
 218             Config.Free;
 219             Out.writeln('Error: Server/Name is a mandatory configuration entry.'#13#10
 220                + 'Please configure the application properly, refer to the manual.');
 221             ReportSvcStatus(SERVICE_STOPPED, 2, 0);
 222          end;
 223       end
 224       else begin
 225          Out.writeln('Error: Missing configuration file.');
 226          ReportSvcStatus(SERVICE_STOPPED, 1, 0);
 227       end;
 228    end;
 229 end;
 230
 231
 232 begin
 233    Out.writeln('MegaBrutal''s SMTP Server, version ' + VERSION_STR + ', ' + IntToStr(PLATFORM_BITS) + ' bits');
 234    Out.writeln('Copyright (C) 2010-2014 MegaBrutal');
 235    AddDevComment(Out);
 236    Out.writeln;
 237
 238    { TODO: Process arguments here. }
 239
 240    ServiceMode:= false;
 241
 242    if ParamCount > 0 then begin
 243
 244       if UpperCase(ParamStr(1)) = '/USERMODE' then begin
 245          Out.writeln('Starting MgSMTP in user mode...');
 246          Service(0, nil);
 247       end
 248
 249       else if ParamStr(1) = '/?' then begin
 250          Out.writeln('Supported arguments:');
 251          Out.writeln('/INSTALL   - registers the actual MgSMTP binary');
 252          Out.writeln('             as a Windows service.');
 253          Out.writeln('/UNINSTALL - unregisters the MgSMTP service.');
 254          Out.writeln('/USERMODE  - starts MgSMTP in user mode');
 255          Out.writeln('             (not recommended, should be only');
 256          Out.writeln('             used for debugging).');
 257          Out.writeln;
 258          Out.writeln('For more information on usage, see readme.txt.');
 259          Out.writeln('For license details, see license.txt.');
 260          Out.writeln;
 261          Out.writeln('If you can''t find any of these files, you');
 262          Out.writeln('don''t have the complete distribution of');
 263          Out.writeln('this software. In that case, download a');
 264          Out.writeln('proper distribution from SourceForge:');
 265          Out.writeln('https://sourceforge.net/projects/mgsmtp/');
 266       end
 267
 268       else if (UpperCase(ParamStr(1)) = '/INSTALL') or (UpperCase(ParamStr(1)) = '/UNINSTALL') then begin
 269          { Register / unregister service. }
 270          hSCManager:= OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
 271          if hSCManager <> 0 then begin
 272             if UpperCase(ParamStr(1)) = '/INSTALL' then begin
 273                if CreateService(hSCManager, 'MgSMTP', 'MegaBrutal''s SMTP Server (MgSMTP)', SC_MANAGER_ALL_ACCESS,
 274                   SERVICE_WIN32_OWN_PROCESS,
 275                   SERVICE_AUTO_START, SERVICE_ERROR_NORMAL,
 276                   PChar(ParamStr(0)),
 277                   nil,
 278                   nil,
 279                   nil,
 280                   nil,
 281                   nil) <> 0 then
 282                      Out.writeln('Service registered successfully.')
 283                   else
 284                      Out.writeln('CreateService failed!');
 285             end
 286             else if UpperCase(ParamStr(1)) = '/UNINSTALL' then begin
 287                hService:= OpenService(hSCManager, 'MgSMTP', SC_MANAGER_ALL_ACCESS);
 288                if hService <> 0 then begin
 289                   if DeleteService(hService) then
 290                      Out.writeln('Service unregistered successfully.')
 291                   else
 292                      Out.writeln('DeleteService failed!');
 293                end
 294                else Out.writeln('OpenService failed!');
 295             end
 296             else Out.writeln('Unknown parameter.');
 297          end
 298          else Out.writeln('OpenSCManager failed!');
 299       end
 300       else Out.writeln('Unknown parameter specified!');
 301    end
 302    else begin
 303
 304       Out.writeln('Trying to contact Service Control Manager...');
 305       ServiceMode:= true;
 306       if not StartServiceCtrlDispatcher(ServiceTable) then begin
 307          ServiceMode:= false;
 308          Out.writeln('Failed!');
 309          Out.writeln;
 310          Out.writeln('You need to start MgSMTP as a service,');
 311          Out.writeln('or supply proper arguments!');
 312          Out.writeln('Issue with /? for more information.');
 313       end;
 314
 315    end;
 316 end.