source: trunk/Packages/synapse/slogsend.pas

Last change on this file was 5, checked in by chronos, 13 years ago
  • Added: Required packages.
File size: 10.0 KB
Line 
1{==============================================================================|
2| Project : Ararat Synapse | 001.002.002 |
3|==============================================================================|
4| Content: SysLog client |
5|==============================================================================|
6| Copyright (c)1999-2003, Lukas Gebauer |
7| All rights reserved. |
8| |
9| Redistribution and use in source and binary forms, with or without |
10| modification, are permitted provided that the following conditions are met: |
11| |
12| Redistributions of source code must retain the above copyright notice, this |
13| list of conditions and the following disclaimer. |
14| |
15| Redistributions in binary form must reproduce the above copyright notice, |
16| this list of conditions and the following disclaimer in the documentation |
17| and/or other materials provided with the distribution. |
18| |
19| Neither the name of Lukas Gebauer nor the names of its contributors may |
20| be used to endorse or promote products derived from this software without |
21| specific prior written permission. |
22| |
23| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
24| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
25| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
26| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
27| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
28| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
29| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
30| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
31| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
32| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
33| DAMAGE. |
34|==============================================================================|
35| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
36| Portions created by Lukas Gebauer are Copyright (c)2001-2003. |
37| All Rights Reserved. |
38|==============================================================================|
39| Contributor(s): |
40| Christian Brosius |
41|==============================================================================|
42| History: see HISTORY.HTM from distribution package |
43| (Found at URL: http://www.ararat.cz/synapse/) |
44|==============================================================================}
45
46{:@abstract(BSD SYSLOG protocol)
47
48Used RFC: RFC-3164
49}
50
51{$IFDEF FPC}
52 {$MODE DELPHI}
53{$ENDIF}
54{$Q-}
55{$H+}
56
57unit slogsend;
58
59interface
60
61uses
62 SysUtils, Classes,
63 blcksock, synautil;
64
65const
66 cSysLogProtocol = '514';
67
68 FCL_Kernel = 0;
69 FCL_UserLevel = 1;
70 FCL_MailSystem = 2;
71 FCL_System = 3;
72 FCL_Security = 4;
73 FCL_Syslogd = 5;
74 FCL_Printer = 6;
75 FCL_News = 7;
76 FCL_UUCP = 8;
77 FCL_Clock = 9;
78 FCL_Authorization = 10;
79 FCL_FTP = 11;
80 FCL_NTP = 12;
81 FCL_LogAudit = 13;
82 FCL_LogAlert = 14;
83 FCL_Time = 15;
84 FCL_Local0 = 16;
85 FCL_Local1 = 17;
86 FCL_Local2 = 18;
87 FCL_Local3 = 19;
88 FCL_Local4 = 20;
89 FCL_Local5 = 21;
90 FCL_Local6 = 22;
91 FCL_Local7 = 23;
92
93type
94 {:@abstract(Define possible priority of Syslog message)}
95 TSyslogSeverity = (Emergency, Alert, Critical, Error, Warning, Notice, Info,
96 Debug);
97
98 {:@abstract(encoding or decoding of SYSLOG message)}
99 TSyslogMessage = class(TObject)
100 private
101 FFacility:Byte;
102 FSeverity:TSyslogSeverity;
103 FDateTime:TDateTime;
104 FTag:String;
105 FMessage:String;
106 FLocalIP:String;
107 function GetPacketBuf:String;
108 procedure SetPacketBuf(Value:String);
109 public
110 {:Reset values to defaults}
111 procedure Clear;
112 published
113 {:Define facilicity of Syslog message. For specify you may use predefined
114 FCL_* constants. Default is "FCL_Local0".}
115 property Facility:Byte read FFacility write FFacility;
116
117 {:Define possible priority of Syslog message. Default is "Debug".}
118 property Severity:TSyslogSeverity read FSeverity write FSeverity;
119
120 {:date and time of Syslog message}
121 property DateTime:TDateTime read FDateTime write FDateTime;
122
123 {:This is used for identify process of this message. Default is filename
124 of your executable file.}
125 property Tag:String read FTag write FTag;
126
127 {:Text of your message for log.}
128 property LogMessage:String read FMessage write FMessage;
129
130 {:IP address of message sender.}
131 property LocalIP:String read FLocalIP write FLocalIP;
132
133 {:This property holds encoded binary SYSLOG packet}
134 property PacketBuf:String read GetPacketBuf write SetPacketBuf;
135 end;
136
137 {:@abstract(This object implement BSD SysLog client)
138
139 Note: Are you missing properties for specify server address and port? Look to
140 parent @link(TSynaClient) too!}
141 TSyslogSend = class(TSynaClient)
142 private
143 FSock: TUDPBlockSocket;
144 FSysLogMessage: TSysLogMessage;
145 public
146 constructor Create;
147 destructor Destroy; override;
148 {:Send Syslog UDP packet defined by @link(SysLogMessage).}
149 function DoIt: Boolean;
150 published
151 {:Syslog message for send}
152 property SysLogMessage:TSysLogMessage read FSysLogMessage write FSysLogMessage;
153 end;
154
155{:Simply send packet to specified Syslog server.}
156function ToSysLog(const SyslogServer: string; Facil: Byte;
157 Sever: TSyslogSeverity; const Content: string): Boolean;
158
159implementation
160
161function TSyslogMessage.GetPacketBuf:String;
162begin
163 Result := '<' + IntToStr((FFacility * 8) + Ord(FSeverity)) + '>';
164 Result := Result + CDateTime(FDateTime) + ' ';
165 Result := Result + FLocalIP + ' ';
166 Result := Result + FTag + ': ' + FMessage;
167end;
168
169procedure TSyslogMessage.SetPacketBuf(Value:String);
170var StrBuf:String;
171 IntBuf,Pos:Integer;
172begin
173 if Length(Value) < 1 then exit;
174 Pos := 1;
175 if Value[Pos] <> '<' then exit;
176 Inc(Pos);
177 // Facility and Severity
178 StrBuf := '';
179 while (Value[Pos] <> '>')do
180 begin
181 StrBuf := StrBuf + Value[Pos];
182 Inc(Pos);
183 end;
184 IntBuf := StrToInt(StrBuf);
185 FFacility := IntBuf div 8;
186 case (IntBuf mod 8)of
187 0:FSeverity := Emergency;
188 1:FSeverity := Alert;
189 2:FSeverity := Critical;
190 3:FSeverity := Error;
191 4:FSeverity := Warning;
192 5:FSeverity := Notice;
193 6:FSeverity := Info;
194 7:FSeverity := Debug;
195 end;
196 // DateTime
197 Inc(Pos);
198 StrBuf := '';
199 // Month
200 while (Value[Pos] <> ' ')do
201 begin
202 StrBuf := StrBuf + Value[Pos];
203 Inc(Pos);
204 end;
205 StrBuf := StrBuf + Value[Pos];
206 Inc(Pos);
207 // Day
208 while (Value[Pos] <> ' ')do
209 begin
210 StrBuf := StrBuf + Value[Pos];
211 Inc(Pos);
212 end;
213 StrBuf := StrBuf + Value[Pos];
214 Inc(Pos);
215 // Time
216 while (Value[Pos] <> ' ')do
217 begin
218 StrBuf := StrBuf + Value[Pos];
219 Inc(Pos);
220 end;
221 FDateTime := DecodeRFCDateTime(StrBuf);
222 Inc(Pos);
223
224 // LocalIP
225 StrBuf := '';
226 while (Value[Pos] <> ' ')do
227 begin
228 StrBuf := StrBuf + Value[Pos];
229 Inc(Pos);
230 end;
231 FLocalIP := StrBuf;
232 Inc(Pos);
233 // Tag
234 StrBuf := '';
235 while (Value[Pos] <> ':')do
236 begin
237 StrBuf := StrBuf + Value[Pos];
238 Inc(Pos);
239 end;
240 FTag := StrBuf;
241 // LogMessage
242 Inc(Pos);
243 StrBuf := '';
244 while (Pos <= Length(Value))do
245 begin
246 StrBuf := StrBuf + Value[Pos];
247 Inc(Pos);
248 end;
249 FMessage := TrimSP(StrBuf);
250end;
251
252procedure TSysLogMessage.Clear;
253begin
254 FFacility := FCL_Local0;
255 FSeverity := Debug;
256 FTag := ExtractFileName(ParamStr(0));
257 FMessage := '';
258 FLocalIP := '0.0.0.0';
259end;
260
261//------------------------------------------------------------------------------
262
263constructor TSyslogSend.Create;
264begin
265 inherited Create;
266 FSock := TUDPBlockSocket.Create;
267 FSysLogMessage := TSysLogMessage.Create;
268 FTargetPort := cSysLogProtocol;
269end;
270
271destructor TSyslogSend.Destroy;
272begin
273 FSock.Free;
274 FSysLogMessage.Free;
275 inherited Destroy;
276end;
277
278function TSyslogSend.DoIt: Boolean;
279var
280 L: TStringList;
281begin
282 Result := False;
283 L := TStringList.Create;
284 try
285 FSock.ResolveNameToIP(FSock.Localname, L);
286 if L.Count < 1 then
287 FSysLogMessage.LocalIP := '0.0.0.0'
288 else
289 FSysLogMessage.LocalIP := L[0];
290 finally
291 L.Free;
292 end;
293 FSysLogMessage.DateTime := Now;
294 if Length(FSysLogMessage.PacketBuf) <= 1024 then
295 begin
296 FSock.Connect(FTargetHost, FTargetPort);
297 FSock.SendString(FSysLogMessage.PacketBuf);
298 Result := FSock.LastError = 0;
299 end;
300end;
301
302{==============================================================================}
303
304function ToSysLog(const SyslogServer: string; Facil: Byte;
305 Sever: TSyslogSeverity; const Content: string): Boolean;
306begin
307 with TSyslogSend.Create do
308 try
309 TargetHost :=SyslogServer;
310 SysLogMessage.Facility := Facil;
311 SysLogMessage.Severity := Sever;
312 SysLogMessage.LogMessage := Content;
313 Result := DoIt;
314 finally
315 Free;
316 end;
317end;
318
319end.
Note: See TracBrowser for help on using the repository browser.