New BSD SysLog sender with RFC-5424 support

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

slogsend.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 001.002.004 |
+| Project : Ararat Synapse                                       | 002.000.000 |
 |==============================================================================|
 | Content: SysLog client                                                       |
 |==============================================================================|
@@ -45,7 +45,7 @@
 
 {:@abstract(BSD SYSLOG protocol)
 
-Used RFC: RFC-3164
+Used RFC: RFC-3164, RFC-5424 (millisecond grade timestamp, nonASCII support)
 }
 
 {$IFDEF FPC}
@@ -91,6 +91,9 @@ const
   FCL_Local7 = 23;
 
 type
+  {:@abstract(Define Syslog versions)}
+  TSyslogVersion = (RFC3164, RFC5424);
+
   {:@abstract(Define possible priority of Syslog message)}
   TSyslogSeverity = (Emergency, Alert, Critical, Error, Warning, Notice, Info,
     Debug);
@@ -98,31 +101,46 @@ type
   {:@abstract(encoding or decoding of SYSLOG message)}
   TSyslogMessage = class(TObject)
   private
-    FFacility:Byte;
+    FVersion: TSyslogVersion;
-    FSeverity:TSyslogSeverity;
+    FFacility: Byte;
-    FDateTime:TDateTime;
+    FSeverity: TSyslogSeverity;
-    FTag:String;
+    FDateTime: TDateTime;
-    FMessage:String;
+    FTag: String;
-    FLocalIP:String;
+    FMessage: String;
-    function GetPacketBuf:String;
+    FLocalIP: String;
-    procedure SetPacketBuf(Value:String);
+    FProcID: string;
+    FMsgID: string;
+    function GetPacketBuf: AnsiString;
+    procedure SetPacketBuf(Value: AnsiString);
   public
     {:Reset values to defaults}
     procedure Clear;
-  published
+
+    {:Define packet format version.}
+    property Version: TSyslogVersion read FVersion write FVersion;
+
     {:Define facilicity of Syslog message. For specify you may use predefined
      FCL_* constants. Default is "FCL_Local0".}
-    property Facility:Byte read FFacility write FFacility;
+    property Facility: Byte read FFacility write FFacility;
 
     {:Define possible priority of Syslog message. Default is "Debug".}
-    property Severity:TSyslogSeverity read FSeverity write FSeverity;
+    property Severity: TSyslogSeverity read FSeverity write FSeverity;
 
     {:date and time of Syslog message}
-    property DateTime:TDateTime read FDateTime write FDateTime;
+    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;
+    property Tag: String read FTag write FTag;
+
+    {:alias to Tag}
+    property AppName: String read FTag write FTag;
+
+    {:Identification of logging process, like handle of process, transaction ID, etc.}
+    property ProcID: String read FProcID write FProcID;
+
+    {:Identification of message type category. Messages with same ID should have same semantic.}
+    property MsgID: String read FMsgID write FMsgID;
 
     {:Text of your message for log.}
     property LogMessage:String read FMessage write FMessage;
@@ -130,8 +148,9 @@ type
     {:IP address of message sender.}
     property LocalIP:String read FLocalIP write FLocalIP;
 
-    {:This property holds encoded binary SYSLOG packet}
+    {:This property holds encoded binary SYSLOG packet.
-    property PacketBuf:String read GetPacketBuf write SetPacketBuf;
+      Note: writing is deprecated and working for RFC3164 only.}
+    property PacketBuf: AnsiString read GetPacketBuf write SetPacketBuf;
   end;
 
   {:@abstract(This object implement BSD SysLog client)
@@ -147,28 +166,57 @@ type
     destructor Destroy; override;
     {:Send Syslog UDP packet defined by @link(SysLogMessage).}
     function DoIt: Boolean;
-  published
     {:Syslog message for send}
     property SysLogMessage:TSysLogMessage read FSysLogMessage write FSysLogMessage;
   end;
 
-{:Simply send packet to specified Syslog server.}
+{:Simply send old RFC-3164 packet to specified Syslog server.}
 function ToSysLog(const SyslogServer: string; Facil: Byte;
   Sever: TSyslogSeverity; const Content: string): Boolean;
 
+{:Simply send RFC-5424 version 1 packet to specified Syslog server.}
+function ToSysLog1(const SyslogServer: string; Facil: Byte;
+  Sever: TSyslogSeverity; const ProcID, MsgID, Content: string): Boolean;
+
 implementation
 
-function TSyslogMessage.GetPacketBuf:String;
+function TSyslogMessage.GetPacketBuf: AnsiString;
+var
+  s: ansistring;
 begin
-  Result := '<' + IntToStr((FFacility * 8) + Ord(FSeverity)) + '>';
+  case FVersion of
-  Result := Result + CDateTime(FDateTime) + ' ';
+    RFC3164:
-  Result := Result + FLocalIP + ' ';
+      begin
-  Result := Result + FTag + ': ' + FMessage;
+        Result := '<' + IntToStr((FFacility * 8) + Ord(FSeverity)) + '>';
+        Result := Result + CDateTime(FDateTime) + ' ';
+        Result := Result + FLocalIP + ' ';
+        Result := Result + FTag + ': ' + FMessage;
+      end;
+    RFC5424:
+      begin
+        Result := '<' + IntToStr((FFacility * 8) + Ord(FSeverity)) + '>1 ';
+        Result := Result + Rfc3339DateTime(FDateTime) + ' ';
+        Result := Result + FLocalIP + ' ';
+        if FTag = '' then s := '-'
+          else s := FTag;
+        Result := Result + FTag + ' ';
+        if FProcID = '' then s := '-'
+          else s := FProcID;
+        Result := Result + FProcID + ' ';
+        if FMsgID = '' then s := '-'
+          else s := FMsgID;
+        Result := Result + FMsgID + ' ';
+        Result := Result + '- '; //structured data not implemented yet
+        Result := Result + #$EF#$BB#$BF + AnsiToUtf8(FMessage); //BOM and UTF8 encoded text
+      end;
+    else
+      Result := '';
+  end;
 end;
 
-procedure TSyslogMessage.SetPacketBuf(Value:String);
+procedure TSyslogMessage.SetPacketBuf(Value: AnsiString);
-var StrBuf:String;
+var StrBuf: AnsiString;
-    IntBuf,Pos:Integer;
+    IntBuf, Pos: Integer;
 begin
   if Length(Value) < 1 then exit;
   Pos := 1;
@@ -251,11 +299,14 @@ end;
 
 procedure TSysLogMessage.Clear;
 begin
+  FVersion := RFC3164;
   FFacility := FCL_Local0;
   FSeverity := Debug;
   FTag := ExtractFileName(ParamStr(0));
+  FProcID := '';
+  FMsgID := '';
   FMessage := '';
-  FLocalIP  := '0.0.0.0';
+  FLocalIP := '0.0.0.0';
 end;
 
 //------------------------------------------------------------------------------
@@ -266,6 +317,7 @@ begin
   FSock := TUDPBlockSocket.Create;
   FSock.Owner := self;
   FSysLogMessage := TSysLogMessage.Create;
+  FSysLogMessage.Clear;
   FTargetPort := cSysLogProtocol;
 end;
 
@@ -277,16 +329,19 @@ begin
 end;
 
 function TSyslogSend.DoIt: Boolean;
+var
+  s: ansistring;
 begin
   Result := False;
   FSysLogMessage.LocalIP := Fsock.ResolveIPToName(FSock.Localname);
   FSysLogMessage.DateTime := Now;
-  if Length(FSysLogMessage.PacketBuf) <= 1024 then
+  s := FSysLogMessage.PacketBuf;
-  begin
+  if FSysLogMessage.Version = RFC3164 then
-    FSock.Connect(FTargetHost, FTargetPort);
+    if Length(s) > 1024 then
-    FSock.SendString( {$IFDEF UNICODE} AnsiString {$ENDIF} (FSysLogMessage.PacketBuf));
+      exit; //old format does not allow larger size!
-    Result := FSock.LastError = 0;
+  FSock.Connect(FTargetHost, FTargetPort);
-  end;
+  FSock.SendString(s);
+  Result := FSock.LastError = 0;
 end;
 
 {==============================================================================}
@@ -296,7 +351,8 @@ function ToSysLog(const SyslogServer: string; Facil: Byte;
 begin
   with TSyslogSend.Create do
     try
-      TargetHost :=SyslogServer;
+      TargetHost := SyslogServer;
+      SysLogMessage.Version := RFC3164;
       SysLogMessage.Facility := Facil;
       SysLogMessage.Severity := Sever;
       SysLogMessage.LogMessage := Content;
@@ -306,4 +362,23 @@ begin
     end;
 end;
 
+function ToSysLog1(const SyslogServer: string; Facil: Byte;
+  Sever: TSyslogSeverity; const ProcID, MsgID, Content: string): Boolean;
+begin
+  with TSyslogSend.Create do
+    try
+      TargetHost := SyslogServer;
+      SysLogMessage.Version := RFC5424;
+      SysLogMessage.Facility := Facil;
+      SysLogMessage.Severity := Sever;
+      SysLogMessage.ProcID := ProcID;
+      SysLogMessage.MsgID := MsgID;
+      SysLogMessage.LogMessage := Content;
+      Result := DoIt;
+    finally
+      Free;
+    end;
+end;
+
+
 end.