Release 33

git-svn-id: https://svn.code.sf.net/p/synalist/code/trunk@72 7c85be65-684b-0410-a082-b2ed4fbef004

slogsend.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 001.001.006 |
+| Project : Ararat Synapse                                       | 001.002.000 |
 |==============================================================================|
 | Content: SysLog client                                                       |
 |==============================================================================|
@@ -37,12 +37,16 @@
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
+|    Christian Brosius                                                         |
 |==============================================================================|
 | History: see HISTORY.HTM from distribution package                           |
 |          (Found at URL: http://www.ararat.cz/synapse/)                       |
 |==============================================================================}
 
-// RFC-3164
+{:@abstract(BSD SYSLOG protocol)
+
+Used RFC: RFC-3164
+}
 
 {$IFDEF FPC}
   {$MODE DELPHI}
@@ -87,78 +91,214 @@ const
   FCL_Local7 = 23;
 
 type
+  {:@abstract(Define possible priority of Syslog message)}
   TSyslogSeverity = (Emergency, Alert, Critical, Error, Warning, Notice, Info,
     Debug);
 
+  {:@abstract(encoding or decoding of SYSLOG message)}
+  TSyslogMessage = class(TObject)
+  private
+    FFacility:Byte;
+    FSeverity:TSyslogSeverity;
+    FDateTime:TDateTime;
+    FTag:String;
+    FMessage:String;
+    FLocalIP:String;
+    function GetPacketBuf:String;
+    procedure SetPacketBuf(Value:String);
+  public
+    {:Reset values to defaults}
+    procedure Clear;
+  published
+    {:Define facilicity of Syslog message. For specify you may use predefined
+     FCL_* constants. Default is "FCL_Local0".}
+    property Facility:Byte read FFacility write FFacility;
+
+    {:Define possible priority of Syslog message. Default is "Debug".}
+    property Severity:TSyslogSeverity read FSeverity write FSeverity;
+
+    {:date and time of Syslog message}
+    property DateTime:TDateTime read FDateTime write FDateTime;
+
+    {:This is used for identify process of this message. Default is filename
+     of your executable file.}
+    property Tag:String read FTag write FTag;
+
+    {:Text of your message for log.}
+    property LogMessage:String read FMessage write FMessage;
+
+    {:IP address of message sender.}
+    property LocalIP:String read FLocalIP write FLocalIP;
+
+    {:This property holds encoded binary SYSLOG packet}
+    property PacketBuf:String read GetPacketBuf write SetPacketBuf;
+  end;
+
+  {:@abstract(This object implement BSD SysLog client)
+
+   Note: Are you missing properties for specify server address and port? Look to
+   parent @link(TSynaClient) too!}
   TSyslogSend = class(TSynaClient)
   private
     FSock: TUDPBlockSocket;
-    FFacility: Byte;
-    FSeverity: TSyslogSeverity;
-    FTag: string;
-    FMessage: string;
+    FSysLogMessage: TSysLogMessage;
   public
     constructor Create;
     destructor Destroy; override;
+    {:Send Syslog UDP packet defined by @link(SysLogMessage).}
     function DoIt: Boolean;
   published
-    property Facility: Byte read FFacility Write FFacility;
-    property Severity: TSyslogSeverity read FSeverity Write FSeverity;
-    property Tag: string read FTag Write FTag;
-    property LogMessage: string read FMessage Write FMessage;
+    {:Syslog message for send}
+    property SysLogMessage:TSysLogMessage read FSysLogMessage write FSysLogMessage;
   end;
 
+{:Simply send packet to specified Syslog server.}
 function ToSysLog(const SyslogServer: string; Facil: Byte;
   Sever: TSyslogSeverity; const Content: string): Boolean;
 
 implementation
 
-constructor TSyslogSend.Create;
+function TSyslogMessage.GetPacketBuf:String;
+begin
+  Result := '<' + IntToStr((FFacility * 8) + Ord(FSeverity)) + '>';
+  Result := Result + CDateTime(FDateTime) + ' ';
+  Result := Result + FLocalIP + ' ';
+  Result := Result + FTag + ': ' + FMessage;
+end;
+
+procedure TSyslogMessage.SetPacketBuf(Value:String);
+var StrBuf:String;
+    IntBuf,Pos:Integer;
+begin
+  if Length(Value) < 1 then exit;
+  Pos := 1;
+  if Value[Pos] <> '<' then exit;
+  Inc(Pos);
+  // Facility and Severity
+  StrBuf := '';
+  while (Value[Pos] <> '>')do
+  begin
+    StrBuf := StrBuf + Value[Pos];
+    Inc(Pos);
+  end;
+  IntBuf := StrToInt(StrBuf);
+  FFacility := IntBuf div 8;
+  case (IntBuf mod 8)of
+    0:FSeverity := Emergency;
+    1:FSeverity := Alert;
+    2:FSeverity := Critical;
+    3:FSeverity := Error;
+    4:FSeverity := Warning;
+    5:FSeverity := Notice;
+    6:FSeverity := Info;
+    7:FSeverity := Debug;
+  end;
+  // DateTime
+  Inc(Pos);
+  StrBuf := '';
+    // Month
+  while (Value[Pos] <> ' ')do
+    begin
+      StrBuf := StrBuf + Value[Pos];
+      Inc(Pos);
+    end;
+    StrBuf := StrBuf + Value[Pos];
+    Inc(Pos);
+    // Day
+  while (Value[Pos] <> ' ')do
+    begin
+      StrBuf := StrBuf + Value[Pos];
+      Inc(Pos);
+    end;
+    StrBuf := StrBuf + Value[Pos];
+    Inc(Pos);
+    // Time
+  while (Value[Pos] <> ' ')do
+    begin
+      StrBuf := StrBuf + Value[Pos];
+      Inc(Pos);
+    end;
+  FDateTime := DecodeRFCDateTime(StrBuf);
+  Inc(Pos);
+
+  // LocalIP
+  StrBuf := '';
+  while (Value[Pos] <> ' ')do
+    begin
+      StrBuf := StrBuf + Value[Pos];
+      Inc(Pos);
+    end;
+  FLocalIP := StrBuf;
+  Inc(Pos);
+  // Tag
+  StrBuf := '';
+  while (Value[Pos] <> ' ')do
+    begin
+      StrBuf := StrBuf + Value[Pos];
+      Inc(Pos);
+    end;
+  FTag := StrBuf;
+  // LogMessage
+  Inc(Pos);
+  StrBuf := '';
+  while (Pos <= Length(Value))do
+    begin
+      StrBuf := StrBuf + Value[Pos];
+      Inc(Pos);
+    end;
+  FMessage := StrBuf;
+end;
+
+procedure TSysLogMessage.Clear;
 begin
-  inherited Create;
-  FSock := TUDPBlockSocket.Create;
-  FTargetPort := cSysLogProtocol;
   FFacility := FCL_Local0;
   FSeverity := Debug;
   FTag := ExtractFileName(ParamStr(0));
   FMessage := '';
+  FLocalIP  := '0.0.0.0';
+end;
+
+//------------------------------------------------------------------------------
+
+constructor TSyslogSend.Create;
+begin
+  inherited Create;
+  FSock := TUDPBlockSocket.Create;
+  FSysLogMessage := TSysLogMessage.Create;
+  FTargetPort := cSysLogProtocol;
 end;
 
 destructor TSyslogSend.Destroy;
 begin
   FSock.Free;
+  FSysLogMessage.Free;
   inherited Destroy;
 end;
 
 function TSyslogSend.DoIt: Boolean;
 var
-  Buf: string;
-  S: string;
   L: TStringList;
 begin
   Result := False;
-  Buf := '<' + IntToStr((FFacility * 8) + Ord(FSeverity)) + '>';
-  Buf := Buf + CDateTime(now) + ' ';
   L := TStringList.Create;
   try
     FSock.ResolveNameToIP(FSock.Localname, L);
     if L.Count < 1 then
-      S := '0.0.0.0'
+      FSysLogMessage.LocalIP := '0.0.0.0'
     else
-      S := L[0];
+      FSysLogMessage.LocalIP := L[0];
   finally
     L.Free;
   end;
-  Buf := Buf + S + ' ';
-  Buf := Buf + Tag + ': ' + FMessage;
-  if Length(Buf) <= 1024 then
+  FSysLogMessage.DateTime := Now;
+  if Length(FSysLogMessage.PacketBuf) <= 1024 then
   begin
     FSock.EnableReuse(True);
     Fsock.Bind(FIPInterface, FTargetPort);
     if FSock.LastError <> 0 then
       FSock.Bind(FIPInterface, cAnyPort);
     FSock.Connect(FTargetHost, FTargetPort);
-    FSock.SendString(Buf);
+    FSock.SendString(FSysLogMessage.PacketBuf);
     Result := FSock.LastError = 0;
   end;
 end;
@@ -171,9 +311,9 @@ begin
   with TSyslogSend.Create do
     try
       TargetHost :=SyslogServer;
-      Facility := Facil;
-      Severity := Sever;
-      LogMessage := Content;
+      SysLogMessage.Facility := Facil;
+      SysLogMessage.Severity := Sever;
+      SysLogMessage.LogMessage := Content;
       Result := DoIt;
     finally
       Free;