home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2005 June / PCpro_2005_06.ISO / files / opensource / xamp / xampp-win32.exe / xampp / sendmail.dpr < prev    next >
Encoding:
Text File  |  2005-02-11  |  8.9 KB  |  345 lines
  1. program sendmail;
  2.  
  3. {
  4.  
  5.   fake sendmail for windows
  6.  
  7.   Copyright (c) 2004-2005, Byron Jones, sendmail@glob.com.au
  8.   All rights reserved.
  9.  
  10.   requires indy 9 or higher
  11.  
  12.   version 10
  13.     - added support for specifying a different smtp port
  14.  
  15.   version 9
  16.     - added force_sender
  17.  
  18.   version 8
  19.     - *really* fixes broken smtp auth
  20.  
  21.   version 7
  22.     - fixes broken smtp auth
  23.  
  24.   version 6
  25.     - correctly quotes MAIL FROM and RCPT TO addresses in <>
  26.  
  27.   version 5
  28.     - now sends the message unchanged (rather than getting indy
  29.       to regenerate it)
  30.  
  31.   version 4
  32.     - added debug_logfile parameter
  33.     - improved error messages
  34.  
  35.   version 3
  36.     - smtp authentication support
  37.     - clearer error message when missing from or to address
  38.     - optional error logging
  39.     - adds date header if missing
  40.  
  41.   version 2
  42.     - reads default domain from registry (.ini setting overrides)
  43.  
  44.   version 1
  45.     - initial release
  46.  
  47.   Redistribution and use in source and binary forms, with or without
  48.   modification, are permitted provided that the following conditions
  49.   are met:
  50.  
  51.     * Redistributions of source code must retain the above copyright
  52.       notice, this list of conditions and the following disclaimer.
  53.  
  54.     * Redistributions in binary form must reproduce the above copyright
  55.       notice, this list of conditions and the following disclaimer in the
  56.       documentation and/or other materials provided with the distribution.
  57.  
  58.     * Neither the name of the glob nor the names of its contributors may
  59.       be used to endorse or promote products derived from this software
  60.       without specific prior written permission.
  61.  
  62.   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
  63.   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
  64.   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
  65.   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
  66.   OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
  67.   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
  68.   LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
  69.   DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
  70.   THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
  71.   (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
  72.   OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  73.  
  74. }
  75.  
  76. {$APPTYPE CONSOLE}
  77.  
  78. uses
  79.   Windows, Classes, SysUtils, Registry, IniFiles, IDSmtp, IdMessage, IdEmailAddress, IdLogFile, IdGlobal;
  80.  
  81. // ---------------------------------------------------------------------------
  82.  
  83. procedure writeToLog(const logFilename, logMessage: string);
  84. var
  85.   f: TextFile;
  86. begin
  87.   AssignFile(f, logFilename);
  88.   try
  89.  
  90.     if (not FileExists(logFilename)) then
  91.     begin
  92.       ForceDirectories(ExtractFilePath(logFilename));
  93.       Rewrite(f);
  94.     end
  95.     else
  96.       Append(f);
  97.  
  98.     writeln(f, '[' + DateTimeToStr(Now) + '] ' + stringReplace(logMessage, #13#10, ' ', [rfReplaceAll]));
  99.     closeFile(f);
  100.  
  101.   except
  102.     on e:Exception do
  103.       writeln('sendmail: error writing to ' + logFilename + ': ' + logMessage);
  104.   end;
  105. end;
  106.  
  107. // ---------------------------------------------------------------------------
  108.  
  109. function appendDomain(const address, domain: string): string;
  110. begin
  111.   Result := address;
  112.   if (Pos('@', address) <> 0) then
  113.     Exit;
  114.   Result := Result + '@' + domain;
  115. end;
  116.  
  117. // ---------------------------------------------------------------------------
  118.  
  119. var
  120.  
  121.   smtpServer    : string;
  122.   defaultDomain : string;
  123.   messageContent: string;
  124.   errorLogFile  : string;
  125.   debugLogFile  : string;
  126.   authUsername  : string;
  127.   authPassword  : string;
  128.   forceSender   : string;
  129.  
  130.   i    : integer;
  131.   s    : string;
  132.   found: boolean;
  133.   ss   : TStringStream;
  134.   msg  : TIdMessage;
  135.   debug: TIdLogFile;
  136.   sl   : TStringList;
  137.  
  138. begin
  139.  
  140.   // check parameters to make sure "-t" was provided
  141.  
  142.   found := False;
  143.   for i := 1 to ParamCount do
  144.     if (ParamStr(i) = '-t') then
  145.     begin
  146.       found := True;
  147.       break;
  148.     end;
  149.  
  150.   if (not found) then
  151.   begin
  152.     writeln('sendmail requires -t parameter');
  153.     halt(1);
  154.   end;
  155.  
  156.   // read default domain from registry
  157.  
  158.   with TRegistry.Create do
  159.   try
  160.     RootKey := HKEY_LOCAL_MACHINE;
  161.     if (OpenKeyReadOnly('\SYSTEM\CurrentControlSet\Services\Tcpip\Parameters')) then
  162.       defaultDomain := ReadString('Domain');
  163.   finally
  164.     Free;
  165.   end;
  166.  
  167.   // read ini
  168.  
  169.   with TIniFile.Create(ChangeFileExt(ParamStr(0), '.ini')) do
  170.   try
  171.  
  172.     smtpServer    := ReadString('sendmail', 'smtp_server',    'mail.mydomain.com');
  173.     defaultDomain := ReadString('sendmail', 'default_domain', defaultDomain);
  174.     errorLogFile  := ReadString('sendmail', 'error_logfile',  '');
  175.     debugLogFile  := ReadString('sendmail', 'debug_logfile',  '');
  176.     authUsername  := ReadString('sendmail', 'auth_username',  '');
  177.     authPassword  := ReadString('sendmail', 'auth_password',  '');
  178.     forceSender   := ReadString('sendmail', 'force_sender',   '');
  179.  
  180.     if (smtpServer = 'mail.mydomain.com') or (defaultDomain = 'mydomain.com') then
  181.     begin
  182.       writeln('you must configure the smtp_server and default_domain in ' + fileName);
  183.       halt(1);
  184.     end;
  185.  
  186.   finally
  187.     Free;
  188.   end;
  189.  
  190.   if (errorLogFile <> '') and (ExtractFilePath(errorLogFile) = '') then
  191.     errorLogFile := ExtractFilePath(ParamStr(0)) + errorLogFile;
  192.  
  193.   if (debugLogFile <> '') and (ExtractFilePath(debugLogFile) = '') then
  194.     debugLogFile := ExtractFilePath(ParamStr(0)) + debugLogFile;
  195.  
  196.   // read email from stdin
  197.  
  198.   messageContent := '';
  199.   while (not eof(Input)) do
  200.   begin
  201.     readln(Input, s);
  202.     messageContent := messageContent + s + #13#10;
  203.   end;
  204.  
  205.   if (debugLogFile <> '') then
  206.   begin
  207.     sl := TStringList.Create;
  208.     try
  209.       sl.Text := messageContent;
  210.       for i := 0 to sl.Count - 1 do
  211.         writeToLog(debugLogFile, sl[i]);
  212.     finally
  213.       sl.Free;
  214.     end;
  215.   end;
  216.  
  217.   // deliver message
  218.  
  219.   try
  220.  
  221.     // load message into stream (TidMessage expects message to end in ".")
  222.  
  223.     ss  := TStringStream.Create(messageContent + #13#10'.'#13#10);
  224.     msg := nil;
  225.  
  226.     try
  227.  
  228.       // load message
  229.  
  230.       msg := TIdMessage.Create(nil);
  231.       msg.LoadFromStream(ss);
  232.  
  233.       // check for from and to
  234.  
  235.       if (forceSender = '') and (Msg.From.Address = '') then
  236.         raise Exception.Create('email is missing sender''s address');
  237.       if (Msg.Recipients.Count = 0) then
  238.         raise Exception.Create('email is missing recipient''s address');
  239.  
  240.       with TIdSMTP.Create(nil) do
  241.       try
  242.  
  243.         if (debugLogFile <> '') then
  244.         begin
  245.           debug          := TIdLogFile.Create(nil);
  246.           debug.FileName := debugLogFile;
  247.           debug.Active   := True;
  248.           Intercept      := debug;
  249.         end;
  250.  
  251.         // set host, port
  252.  
  253.         i := pos(':', smtpServer);
  254.         if (i = 0) then
  255.         begin
  256.           host := smtpServer;
  257.           port := 25;
  258.         end
  259.         else
  260.         begin
  261.           host := copy(smtpServer, 1, i - 1);
  262.           port := strToIntDef(copy(smtpServer, i + 1, length(smtpServer)), 25);
  263.         end;
  264.  
  265.         // connect to server
  266.  
  267.         Connect(10 * 1000);
  268.  
  269.         // authentication
  270.  
  271.         if (authUsername <> '') then
  272.         begin
  273.           AuthenticationType := atLogin;
  274.           Username := authUsername;
  275.           Password := authPassword;
  276.           Authenticate;
  277.         end;
  278.  
  279.         // sender and recipients
  280.  
  281.         if (forceSender = '') then
  282.           SendCmd('MAIL FROM: <' + appendDomain(Msg.From.Address, defaultDomain) + '>', [250])
  283.         else
  284.           SendCmd('MAIL FROM: <' + appendDomain(forceSender, defaultDomain) + '>', [250]);
  285.  
  286.         for i := 0 to msg.Recipients.Count - 1 do
  287.           SendCmd('RCPT TO: <' + appendDomain(Msg.Recipients[i].Address, defaultDomain) + '>', [250]);
  288.  
  289.         // start message content
  290.  
  291.         SendCmd('DATA', [354]);
  292.  
  293.         // add date header if missing
  294.  
  295.         if (Msg.Headers.Values['date'] = '') then
  296.           writeln('Date: ' + DateTimeToInternetStr(Now));
  297.  
  298.         // send message line by line
  299.  
  300.         sl := TStringList.Create;
  301.         try
  302.           sl.Text := messageContent;
  303.           for i := 0 to sl.Count - 1 do
  304.           begin
  305.             if (i = 0) and (sl[i] = '') then
  306.               continue;
  307.             writeln(sl[i]);
  308.           end;
  309.         finally
  310.           sl.Free;
  311.         end;
  312.  
  313.         // done
  314.  
  315.         SendCmd('.', [250]);
  316.         SendCmd('QUIT');
  317.  
  318.       finally
  319.         Free;
  320.       end;
  321.  
  322.     finally
  323.       msg.Free;
  324.       ss.Free;
  325.     end;
  326.  
  327.   except
  328.     on e:Exception do
  329.     begin
  330.  
  331.       writeln('sendmail: error during delivery: ' + e.message);
  332.  
  333.       if (errorLogFile <> '') then
  334.         writeToLog(errorLogFile, e.Message);
  335.  
  336.       if (debugLogFile <> '') then
  337.         writeToLog(debugLogFile, e.Message);
  338.  
  339.       halt(1);
  340.     end;
  341.   end;
  342.  
  343. end.
  344.  
  345.