From 88a68e0a04836cb74cbfcdc16b7fdbf06b90dd56 Mon Sep 17 00:00:00 2001 From: michael Date: Wed, 19 Feb 2003 20:25:16 +0000 Subject: [PATCH] + Added event log --- fcl/Makefile | 55 +++++++- fcl/Makefile.fpc | 2 +- fcl/go32v2/eventlog.inc | 29 ++++ fcl/inc/eventlog.pp | 293 ++++++++++++++++++++++++++++++++++++++++ fcl/inc/felog.inc | 70 ++++++++++ fcl/os2/eventlog.inc | 29 ++++ fcl/tests/Makefile | 51 ++++++- fcl/tests/Makefile.fpc | 2 +- fcl/tests/README | 18 +-- fcl/tests/tstelcmd.pp | 25 ++++ fcl/tests/tstelgtk.pp | 158 ++++++++++++++++++++++ fcl/unix/eventlog.inc | 125 +++++++++++++++++ fcl/win32/eventlog.inc | 142 +++++++++++++++++++ fcl/win32/fclel.mc | 79 +++++++++++ fcl/win32/fclel.rc | 2 + fcl/win32/fclel.res | Bin 0 -> 324 bytes 16 files changed, 1064 insertions(+), 16 deletions(-) create mode 100644 fcl/go32v2/eventlog.inc create mode 100644 fcl/inc/eventlog.pp create mode 100644 fcl/inc/felog.inc create mode 100644 fcl/os2/eventlog.inc create mode 100644 fcl/tests/tstelcmd.pp create mode 100644 fcl/tests/tstelgtk.pp create mode 100644 fcl/unix/eventlog.inc create mode 100644 fcl/win32/eventlog.inc create mode 100644 fcl/win32/fclel.mc create mode 100644 fcl/win32/fclel.rc create mode 100644 fcl/win32/fclel.res diff --git a/fcl/Makefile b/fcl/Makefile index 6c7d7a2ada..75d03ce603 100644 --- a/fcl/Makefile +++ b/fcl/Makefile @@ -1,8 +1,8 @@ # -# Don't edit, this file is generated by FPCMake Version 1.1 [2002/05/22] +# Don't edit, this file is generated by FPCMake Version 1.1 [2002/10/05] # default: all -MAKEFILETARGETS=linux go32v2 win32 os2 freebsd beos netbsd amiga atari sunos qnx netware +MAKEFILETARGETS=linux go32v2 win32 os2 freebsd beos netbsd amiga atari sunos qnx netware openbsd wdosx override PATH:=$(subst \,/,$(PATH)) ifeq ($(findstring ;,$(PATH)),) inUnix=1 @@ -42,6 +42,9 @@ endif ifeq ($(OS_TARGET),netbsd) BSDhier=1 endif +ifeq ($(OS_TARGET),openbsd) +BSDhier=1 +endif ifdef inUnix BATCHEXT=.sh else @@ -55,6 +58,9 @@ ifdef inUnix PATHSEP=/ else PATHSEP:=$(subst /,\,/) +ifneq ($(findstring sh.exe,$(SHELL)),) +PATHSEP=/ +endif endif ifdef PWD BASEDIR:=$(subst \,/,$(shell $(PWD))) @@ -137,6 +143,16 @@ ifndef OS_TARGET OS_TARGET:=$(shell $(FPC) -iTO) endif endif +ifndef CPU_TARGET +ifdef CPU_TARGET_DEFAULT +CPU_TARGET=$(CPU_TARGET_DEFAULT) +endif +endif +ifndef OS_TARGET +ifdef OS_TARGET_DEFAULT +OS_TARGET=$(OS_TARGET_DEFAULT) +endif +endif FULL_TARGET=$(CPU_TARGET)-$(OS_TARGET) FULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE) ifneq ($(FULL_TARGET),$(FULL_SOURCE)) @@ -199,7 +215,7 @@ PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/ext override PACKAGE_NAME=fcl override PACKAGE_VERSION=1.0.6 override TARGET_DIRS+=xml db shedit -override TARGET_UNITS+=classes contnrs inifiles ezcgi pipes rtfpars idea base64 gettext iostream zstream cachecls xmlreg registry +override TARGET_UNITS+=classes contnrs inifiles ezcgi pipes rtfpars idea base64 gettext iostream zstream cachecls xmlreg registry eventlog ifeq ($(OS_TARGET),linux) override TARGET_UNITS+=process asyncio ssockets http resolve endif @@ -212,6 +228,9 @@ endif ifeq ($(OS_TARGET),netbsd) override TARGET_UNITS+=process asyncio ssockets http endif +ifeq ($(OS_TARGET),openbsd) +override TARGET_UNITS+=process asyncio ssockets http +endif override TARGET_RSTS+=classes ssockets cachecls resolve override TARGET_EXAMPLEDIRS+=tests override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil @@ -233,6 +252,9 @@ endif ifeq ($(OS_TARGET),qnx) override COMPILER_INCLUDEDIR+=posix endif +ifeq ($(OS_TARGET),openbsd) +override COMPILER_INCLUDEDIR+=unix +endif override COMPILER_SOURCEDIR+=$(OS_TARGET) inc override COMPILER_TARGETDIR+=$(OS_TARGET) ifdef REQUIRE_UNITSDIR @@ -251,6 +273,9 @@ endif ifeq ($(OS_TARGET),netbsd) UNIXINSTALLDIR=1 endif +ifeq ($(OS_TARGET),openbsd) +UNIXINSTALLDIR=1 +endif ifeq ($(OS_TARGET),sunos) UNIXINSTALLDIR=1 endif @@ -267,6 +292,9 @@ endif ifeq ($(OS_SOURCE),netbsd) UNIXINSTALLDIR=1 endif +ifeq ($(OS_SOURCE),openbsd) +UNIXINSTALLDIR=1 +endif ifeq ($(OS_TARGET),sunos) UNIXINSTALLDIR=1 endif @@ -482,6 +510,12 @@ HASSHAREDLIB=1 FPCMADE=fpcmade.netbsd ZIPSUFFIX=netbsd endif +ifeq ($(OS_TARGET),openbsd) +EXEEXT= +HASSHAREDLIB=1 +FPCMADE=fpcmade.openbsd +ZIPSUFFIX=openbsd +endif ifeq ($(OS_TARGET),win32) PPUEXT=.ppw OEXT=.ow @@ -847,6 +881,17 @@ ifeq ($(OS_TARGET),netware) REQUIRE_PACKAGES_RTL=1 REQUIRE_PACKAGES_PASZLIB=1 endif +ifeq ($(OS_TARGET),openbsd) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_PASZLIB=1 +REQUIRE_PACKAGES_INET=1 +REQUIRE_PACKAGES_MYSQL=1 +REQUIRE_PACKAGES_IBASE=1 +endif +ifeq ($(OS_TARGET),wdosx) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_PASZLIB=1 +endif ifdef REQUIRE_PACKAGES_RTL PACKAGEDIR_RTL:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/$(OS_TARGET)/Makefile.fpc,$(PACKAGESDIR)))))) ifneq ($(PACKAGEDIR_RTL),) @@ -983,6 +1028,9 @@ endif ifneq ($(OS_TARGET),$(OS_SOURCE)) override FPCOPT+=-T$(OS_TARGET) endif +ifeq ($(OS_SOURCE),openbsd) +override FPCOPT+=-FD$(NEW_BINUTILS_PATH) +endif ifdef UNITDIR override FPCOPT+=$(addprefix -Fu,$(UNITDIR)) endif @@ -1383,6 +1431,7 @@ fpc_baseinfo: @$(ECHO) Rm........ $(RMPROG) @$(ECHO) GInstall.. $(GINSTALL) @$(ECHO) Echo...... $(ECHO) + @$(ECHO) Shell..... $(SHELL) @$(ECHO) Date...... $(DATE) @$(ECHO) FPCMake... $(FPCMAKE) @$(ECHO) PPUMove... $(PPUMOVE) diff --git a/fcl/Makefile.fpc b/fcl/Makefile.fpc index e7f9b5467f..40afbdda01 100644 --- a/fcl/Makefile.fpc +++ b/fcl/Makefile.fpc @@ -19,7 +19,7 @@ units=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszl [target] dirs=xml db shedit -units=classes contnrs inifiles ezcgi pipes rtfpars idea base64 gettext iostream zstream cachecls xmlreg registry +units=classes contnrs inifiles ezcgi pipes rtfpars idea base64 gettext iostream zstream cachecls xmlreg registry eventlog units_freebsd=process asyncio ssockets http units_netbsd=process asyncio ssockets http units_openbsd=process asyncio ssockets http diff --git a/fcl/go32v2/eventlog.inc b/fcl/go32v2/eventlog.inc new file mode 100644 index 0000000000..9af82b21c2 --- /dev/null +++ b/fcl/go32v2/eventlog.inc @@ -0,0 +1,29 @@ +{ + $Id$ + This file is part of the Free Pascal run time library. + Copyright (c) 2003 by the Free Pascal development team + + DOS event logging facility. + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} + +{ --------------------------------------------------------------------- + Include event log that maps to file event log. + ---------------------------------------------------------------------} + +{$i felog.inc} + +{ + $Log$ + Revision 1.1 2003-02-19 20:25:16 michael + + Added event log + +} + \ No newline at end of file diff --git a/fcl/inc/eventlog.pp b/fcl/inc/eventlog.pp new file mode 100644 index 0000000000..eb0eee42fb --- /dev/null +++ b/fcl/inc/eventlog.pp @@ -0,0 +1,293 @@ +{ + $Id$ + This file is part of the Free Pascal run time library. + Copyright (c) 2003 by the Free Pascal development team + + Cross-platform event logging facility. + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} + +{$mode objfpc} +{$h+} +unit eventlog; + +interface + +uses SysUtils,Classes; + +Type + TEventType = (etCustom,etInfo,etWarning,etError,etDebug); + TLogType = (ltSystem,ltFile); + + TEventLog = Class(TComponent) + Private + FEventIDOffset : DWord; + FLogHandle : Pointer; + FStream : TFileStream; + FActive: Boolean; + FIdentification: String; + FDefaultEventType: TEventType; + FLogtype: TLogType; + FFileName: String; + FTimeStampFormat: String; + FCustomLogType: Word; + procedure SetActive(const Value: Boolean); + procedure SetIdentification(const Value: String); + procedure SetlogType(const Value: TLogType); + procedure ActivateLog; + procedure DeActivateLog; + procedure ActivateFileLog; + procedure SetFileName(const Value: String); + procedure ActivateSystemLog; + function DefaultFileName: String; + procedure WriteFileLog(EventType : TEventType; Msg: String); + procedure WriteSystemLog(EventType: TEventType; Msg: String); + procedure DeActivateFileLog; + procedure DeActivateSystemLog; + procedure CheckIdentification; + function MapTypeToEvent(EventType: TEventType): DWord; + Protected + Procedure CheckInactive; + Procedure EnsureActive; + Public + Destructor Destroy; override; + Function EventTypeToString(E : TEventType) : String; + Function RegisterMessageFile(AFileName : String) : Boolean; virtual; + Function MapTypeToCategory(EventType : TEventType) : Word; + Function MapTypeToEventID(EventType : TEventType) : DWord; + Procedure Log (EventType : TEventType; Msg : String); {$ifndef fpc }Overload;{$endif} + Procedure Log (EventType : TEventType; Fmt : String; Args : Array of const); {$ifndef fpc }Overload;{$endif} + Procedure Log (Msg : String); {$ifndef fpc }Overload;{$endif} + Procedure Log (Fmt : String; Args : Array of const); {$ifndef fpc }Overload;{$endif} + Procedure Warning (Msg : String); {$ifndef fpc }Overload;{$endif} + Procedure Warning (Fmt : String; Args : Array of const); {$ifndef fpc }Overload;{$endif} + Procedure Error (Msg : String); {$ifndef fpc }Overload;{$endif} + Procedure Error (Fmt : String; Args : Array of const); {$ifndef fpc }Overload;{$endif} + Procedure Debug (Msg : String); {$ifndef fpc }Overload;{$endif} + Procedure Debug (Fmt : String; Args : Array of const); {$ifndef fpc }Overload;{$endif} + Procedure Info (Msg : String); {$ifndef fpc }Overload;{$endif} + Procedure Info (Fmt : String; Args : Array of const); {$ifndef fpc }Overload;{$endif} + Property Identification : String Read FIdentification Write SetIdentification; + Property LogType : TLogType Read Flogtype Write SetlogType; + Property Active : Boolean Read FActive write SetActive; + Property DefaultEventType : TEventType Read FDEfaultEventType Write FDefaultEventType; + Property FileName : String Read FFileName Write SetFileName; + Property TimeStampFormat : String Read FTimeStampFormat Write FTimeStampFormat; + Property CustomLogType : Word Read FCustomLogType Write FCustomLogType; + Property EventIDOffset : DWord Read FEventIDOffset Write FEventIDOffset; + End; + + ELogError = Class(Exception); + +Resourcestring + + SLogInfo = 'Info'; + SLogWarning = 'Warning'; + SLogError = 'Error'; + SLogDebug = 'Debug'; + SLogCustom = 'Custom (%d)'; + +implementation + +{$i eventlog.inc} + +{ TEventLog } + +Resourcestring + SErrOperationNotAllowed = 'Operation not allowed when eventlog is active.'; + +procedure TEventLog.CheckInactive; +begin + If Active then + Raise ELogError.Create(SErrOperationNotAllowed); +end; + +procedure TEventLog.Debug(Fmt: String; Args: array of const); +begin + Debug(Format(Fmt,Args)); +end; + +procedure TEventLog.Debug(Msg: String); +begin + Log(etDebug,Msg); +end; + +procedure TEventLog.EnsureActive; +begin + If Not Active then + Active:=True; +end; + +procedure TEventLog.Error(Fmt: String; Args: array of const); +begin + Error(Format(Fmt,Args)); +end; + +procedure TEventLog.Error(Msg: String); +begin + Log(etError,Msg); +end; + +procedure TEventLog.Info(Fmt: String; Args: array of const); +begin + Info(Format(Fmt,Args)); +end; + +procedure TEventLog.Info(Msg: String); +begin + Log(etInfo,Msg); +end; + +procedure TEventLog.Log(Msg: String); +begin + Log(DefaultEventType,msg); +end; + +procedure TEventLog.Log(EventType: TEventType; Fmt: String; + Args: array of const); +begin + Log(EventType,Format(Fmt,Args)); +end; + +procedure TEventLog.Log(EventType: TEventType; Msg: String); +begin + EnsureActive; + Case FlogType of + ltFile : WriteFileLog(EventType,Msg); + ltSystem : WriteSystemLog(EventType,Msg); + end; +end; + +procedure TEventLog.WriteFileLog(EventType : TEventType; Msg : String); + +Var + S,TS,T : String; + +begin + If FTimeStampFormat='' then + FTimeStampFormat:='yyyy-mm-dd hh:nn:ss.zzz'; + TS:=FormatDateTime(FTimeStampFormat,Now); + T:=EventTypeToString(EventType); + S:=Format('%s [%s %s] %s%s',[Identification,TS,T,Msg,LineEnding]); + FStream.Write(S[1],Length(S)); +end; + +procedure TEventLog.Log(Fmt: String; Args: array of const); +begin + Log(Format(Fmt,Args)); +end; + +procedure TEventLog.SetActive(const Value: Boolean); +begin + If Value<>FActive then + begin + If Value then + ActivateLog + else + DeActivateLog; + FActive:=Value; + end; +end; + +Procedure TEventLog.ActivateLog; + +begin + Case FLogType of + ltFile : ActivateFileLog; + ltSystem : ActivateSystemLog; + end; +end; + +Procedure TEventLog.DeActivateLog; + +begin + Case FLogType of + ltFile : DeActivateFileLog; + ltSystem : DeActivateSystemLog; + end; +end; + +Procedure TEventLog.ActivateFileLog; + +begin + If (FFileName='') then + FFileName:=DefaultFileName; + // This will raise an exception if the file cannot be opened for writing ! + FStream:=TFileStream.Create(FFileName,fmCreate or fmShareDenyWrite); +end; + +Procedure TEventLog.DeActivateFileLog; + +begin + FStream.Free; + FStream:=Nil; +end; + + +procedure TEventLog.SetIdentification(const Value: String); +begin + FIdentification := Value; +end; + +procedure TEventLog.SetlogType(const Value: TLogType); +begin + CheckInactive; + Flogtype := Value; +end; + +procedure TEventLog.Warning(Fmt: String; Args: array of const); +begin + Warning(Format(Fmt,Args)); +end; + +procedure TEventLog.Warning(Msg: String); +begin + Log(etWarning,Msg); +end; + +procedure TEventLog.SetFileName(const Value: String); +begin + CheckInactive; + FFileName := Value; +end; + +Procedure TEventLog.CheckIdentification; + +begin + If (Identification='') then + Identification:=ChangeFileExt(ExtractFileName(Paramstr(0)),''); +end; + +Function TEventLog.EventTypeToString(E : TEventType) : String; + +begin + Case E of + etInfo : Result:=SLogInfo; + etWarning : Result:=SLogWarning; + etError : Result:=SLogError; + etDebug : Result:=SLogDebug; + etCustom : Result:=Format(SLogCustom,[CustomLogType]); + end; +end; + +destructor TEventLog.Destroy; +begin + Active:=False; + inherited; +end; + +end. + +{ + $Log$ + Revision 1.1 2003-02-19 20:25:16 michael + + Added event log + +} diff --git a/fcl/inc/felog.inc b/fcl/inc/felog.inc new file mode 100644 index 0000000000..fafaad3cd1 --- /dev/null +++ b/fcl/inc/felog.inc @@ -0,0 +1,70 @@ +{ + $Id$ + This file is part of the Free Pascal run time library. + Copyright (c) 2003 by the Free Pascal development team + + Generic implementation of 'system log' event mechanism which maps to file log. + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} + +Function TEventLog.DefaultFileName : String; + +begin + Result:=ChangeFileExt(ExtractFileName(Paramstr(0)),'.log'); +end; + +Procedure TEventLog.ActivateSystemLog; + +begin + CheckIdentification; + ActivateFileLog; +end; + +Procedure TEventLog.DeActivateSystemLog; + +begin + DeActivateFileLog; +end; + +procedure TEventLog.WriteSystemLog(EventType : TEventType; Msg : String); + +begin + WriteFileLog(EventType,Msg); +end; + +Function TEventLog.RegisterMessageFile(AFileName : String) : Boolean; + +begin + Result:=True; +end; + +function TEventLog.MapTypeToCategory(EventType: TEventType): Word; +begin + Result:=0; +end; + +function TEventLog.MapTypeToEventID(EventType: TEventType): DWord; + +begin + Result:=0; +end; + +function TEventLog.MapTypeToEvent(EventType: TEventType): DWord; + +begin + Result:=0; +end; + +{ + $Log$ + Revision 1.1 2003-02-19 20:25:16 michael + + Added event log + +} diff --git a/fcl/os2/eventlog.inc b/fcl/os2/eventlog.inc new file mode 100644 index 0000000000..9af82b21c2 --- /dev/null +++ b/fcl/os2/eventlog.inc @@ -0,0 +1,29 @@ +{ + $Id$ + This file is part of the Free Pascal run time library. + Copyright (c) 2003 by the Free Pascal development team + + DOS event logging facility. + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} + +{ --------------------------------------------------------------------- + Include event log that maps to file event log. + ---------------------------------------------------------------------} + +{$i felog.inc} + +{ + $Log$ + Revision 1.1 2003-02-19 20:25:16 michael + + Added event log + +} + \ No newline at end of file diff --git a/fcl/tests/Makefile b/fcl/tests/Makefile index 41ab411f92..2f765b4c79 100644 --- a/fcl/tests/Makefile +++ b/fcl/tests/Makefile @@ -1,8 +1,8 @@ # -# Don't edit, this file is generated by FPCMake Version 1.1 [2002/05/22] +# Don't edit, this file is generated by FPCMake Version 1.1 [2002/10/05] # default: all -MAKEFILETARGETS=linux go32v2 win32 os2 freebsd beos netbsd amiga atari sunos qnx netware +MAKEFILETARGETS=linux go32v2 win32 os2 freebsd beos netbsd amiga atari sunos qnx netware openbsd wdosx override PATH:=$(subst \,/,$(PATH)) ifeq ($(findstring ;,$(PATH)),) inUnix=1 @@ -42,6 +42,9 @@ endif ifeq ($(OS_TARGET),netbsd) BSDhier=1 endif +ifeq ($(OS_TARGET),openbsd) +BSDhier=1 +endif ifdef inUnix BATCHEXT=.sh else @@ -55,6 +58,9 @@ ifdef inUnix PATHSEP=/ else PATHSEP:=$(subst /,\,/) +ifneq ($(findstring sh.exe,$(SHELL)),) +PATHSEP=/ +endif endif ifdef PWD BASEDIR:=$(subst \,/,$(shell $(PWD))) @@ -137,6 +143,16 @@ ifndef OS_TARGET OS_TARGET:=$(shell $(FPC) -iTO) endif endif +ifndef CPU_TARGET +ifdef CPU_TARGET_DEFAULT +CPU_TARGET=$(CPU_TARGET_DEFAULT) +endif +endif +ifndef OS_TARGET +ifdef OS_TARGET_DEFAULT +OS_TARGET=$(OS_TARGET_DEFAULT) +endif +endif FULL_TARGET=$(CPU_TARGET)-$(OS_TARGET) FULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE) ifneq ($(FULL_TARGET),$(FULL_SOURCE)) @@ -196,7 +212,7 @@ else UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET)) endif PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/extra) -override TARGET_PROGRAMS+=stringl dparser fstream mstream list threads testrtf cfgtest xmldump htdump testcgi tidea b64test b64test2 b64enc b64dec restest testz testz2 istream doecho testol testcont txmlreg testreg +override TARGET_PROGRAMS+=stringl dparser fstream mstream list threads testrtf cfgtest xmldump htdump testcgi tidea b64test b64test2 b64enc b64dec restest testz testz2 istream doecho testol testcont txmlreg testreg tstelcmd ifeq ($(OS_TARGET),linux) override TARGET_PROGRAMS+=sockcli isockcli dsockcli socksvr isocksvr dsocksvr testhres testnres testsres testrhre testrnre testrsre endif @@ -221,6 +237,9 @@ endif ifeq ($(OS_TARGET),netbsd) UNIXINSTALLDIR=1 endif +ifeq ($(OS_TARGET),openbsd) +UNIXINSTALLDIR=1 +endif ifeq ($(OS_TARGET),sunos) UNIXINSTALLDIR=1 endif @@ -237,6 +256,9 @@ endif ifeq ($(OS_SOURCE),netbsd) UNIXINSTALLDIR=1 endif +ifeq ($(OS_SOURCE),openbsd) +UNIXINSTALLDIR=1 +endif ifeq ($(OS_TARGET),sunos) UNIXINSTALLDIR=1 endif @@ -452,6 +474,12 @@ HASSHAREDLIB=1 FPCMADE=fpcmade.netbsd ZIPSUFFIX=netbsd endif +ifeq ($(OS_TARGET),openbsd) +EXEEXT= +HASSHAREDLIB=1 +FPCMADE=fpcmade.openbsd +ZIPSUFFIX=openbsd +endif ifeq ($(OS_TARGET),win32) PPUEXT=.ppw OEXT=.ow @@ -829,6 +857,19 @@ REQUIRE_PACKAGES_RTL=1 REQUIRE_PACKAGES_PASZLIB=1 REQUIRE_PACKAGES_FCL=1 endif +ifeq ($(OS_TARGET),openbsd) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_PASZLIB=1 +REQUIRE_PACKAGES_INET=1 +REQUIRE_PACKAGES_FCL=1 +REQUIRE_PACKAGES_MYSQL=1 +REQUIRE_PACKAGES_IBASE=1 +endif +ifeq ($(OS_TARGET),wdosx) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_PASZLIB=1 +REQUIRE_PACKAGES_FCL=1 +endif ifdef REQUIRE_PACKAGES_RTL PACKAGEDIR_RTL:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/$(OS_TARGET)/Makefile.fpc,$(PACKAGESDIR)))))) ifneq ($(PACKAGEDIR_RTL),) @@ -991,6 +1032,9 @@ endif ifneq ($(OS_TARGET),$(OS_SOURCE)) override FPCOPT+=-T$(OS_TARGET) endif +ifeq ($(OS_SOURCE),openbsd) +override FPCOPT+=-FD$(NEW_BINUTILS_PATH) +endif ifdef UNITDIR override FPCOPT+=$(addprefix -Fu,$(UNITDIR)) endif @@ -1300,6 +1344,7 @@ fpc_baseinfo: @$(ECHO) Rm........ $(RMPROG) @$(ECHO) GInstall.. $(GINSTALL) @$(ECHO) Echo...... $(ECHO) + @$(ECHO) Shell..... $(SHELL) @$(ECHO) Date...... $(DATE) @$(ECHO) FPCMake... $(FPCMAKE) @$(ECHO) PPUMove... $(PPUMOVE) diff --git a/fcl/tests/Makefile.fpc b/fcl/tests/Makefile.fpc index a08250eb30..f79f9021f2 100644 --- a/fcl/tests/Makefile.fpc +++ b/fcl/tests/Makefile.fpc @@ -6,7 +6,7 @@ programs=stringl dparser fstream mstream list threads testrtf \ cfgtest xmldump htdump testcgi tidea \ b64test b64test2 b64enc b64dec restest testz testz2 \ - istream doecho testol testcont txmlreg testreg + istream doecho testol testcont txmlreg testreg tstelcmd programs_win32=showver testproc testhres testnres testsres testrhre \ testrnre testrsre programs_linux=sockcli isockcli dsockcli socksvr isocksvr dsocksvr \ diff --git a/fcl/tests/README b/fcl/tests/README index 15f063e570..670837ed54 100644 --- a/fcl/tests/README +++ b/fcl/tests/README @@ -46,11 +46,13 @@ dsockcli.pp Dual socket server application. Tests ssockets. sstream.pp Tests TStringStream object. testol.pp Tests TObjectList in contnrs. (MVC) testcont.pp Tests TStack/TQueue in contnrs. (MVC) -testhres.pp Test hostresolver in resolve -testnres.pp Test netresolver in resolve -testsres.pp Test serviceresolver in resolve -testrhre.pp Test reverse hostresolver in resolve -testrnre.pp Test reverse netresolver in resolve -testrsre.pp Test reverse serviceresolver in resolve -txmlreg.pp Test of xmlreg unit (xml-like registry) -testreg.pp Test of registry unit. \ No newline at end of file +testhres.pp Test hostresolver in resolve (MVC) +testnres.pp Test netresolver in resolve (MVC) +testsres.pp Test serviceresolver in resolve (MVC) +testrhre.pp Test reverse hostresolver in resolve (MVC) +testrnre.pp Test reverse netresolver in resolve (MVC) +testrsre.pp Test reverse serviceresolver in resolve (MVC) +txmlreg.pp Test of xmlreg unit (xml-like registry) (MVC) +testreg.pp Test of registry unit. (MVC) +tstelcmd.pp Test of eventlog unit, command-line version. +tstelgtk.pp Test of eventlog unit, FPGTK version. Not built by default. (MVC) diff --git a/fcl/tests/tstelcmd.pp b/fcl/tests/tstelcmd.pp new file mode 100644 index 0000000000..f0e1626ecb --- /dev/null +++ b/fcl/tests/tstelcmd.pp @@ -0,0 +1,25 @@ +{$mode objfpc} +{$h+} +{$ifdef win32} +{$r fclel.res} +{$endif} + +program testelcmd; + +uses eventlog; + +Var + E : TEventType; + +begin + With TEventLog.Create(Nil) do + Try + Identification:='Test eventlog class'; + RegisterMessageFile(''); + Active:=True; + For E:=etInfo to etDebug do + Log(E,'An event log message of type '+EventTypeToString(E)); + finally + Free; + end; +end. \ No newline at end of file diff --git a/fcl/tests/tstelgtk.pp b/fcl/tests/tstelgtk.pp new file mode 100644 index 0000000000..bffdc69f96 --- /dev/null +++ b/fcl/tests/tstelgtk.pp @@ -0,0 +1,158 @@ +{$mode objfpc} +{$H+} +{$apptype gui} + +{$ifdef win32} +{$R fclel.res} +{$endif} + +program tstelgtk; + +uses gdk,gtk,fpgtk,fpgtkext,classes,sysutils,eventlog; + +{ --------------------------------------------------------------------- + Main form class + ---------------------------------------------------------------------} + + +Type + TMainForm = Class(TFPGtkWindow) + FEventLog : TEventLog; + RGFrame : TFPgtkFrame; + FHBox : TFPgtkHBox; + RGBox, + FVBox : TFPgtkVBox; + BSend : TFPgtkButton; + RGMsgType : TFPgtkRadioButtonGroup; + FLMsg : TFPGtkLabel; + FMsg : TFPGtkEntry; + Procedure BSendClicked(Sender : TFPgtkObject; Data : Pointer); + Public + Constructor Create; + Destructor Destroy; override; + Procedure CreateWindow; + Procedure SendEvent; + end; + +ResourceString + SCaption = 'Free Pascal Event Log Demo'; + SEventlogDemo = 'TestEventlogClass'; + SMessage = 'Message text:'; + SMsgType = 'Message type:'; + SSend = 'Send message'; + SInformation = 'Information'; + SWarning = 'Warning'; + SError = 'Error'; + SDebug = 'Debug'; + +{ --------------------------------------------------------------------- + Form Creation + ---------------------------------------------------------------------} + +Constructor TMainForm.Create; + +begin + Inherited create (gtk_window_dialog); + Createwindow; +end; + +Procedure TMainForm.CreateWindow; + + Procedure AddRG(C : String); + + Var + RB : TFPgtkRadioButton; + + begin + RB:= TFPgtkRadioButton.CreateWithLabel(RGmsgType,C); + RGBox.Packstart(RB,False,False,2); + rb.TheLabel.Justify:=GTK_JUSTIFY_LEFT; + end; + +Var + S : TStrings; + +begin + BSend:=TFPGtkButton.CreateWithlabel(SSend); + BSend.ConnectCLicked(@BSendClicked,Nil); + RGFrame:=TFpgtkFrame.Create; + RGFrame.Text:=SMsgType; + RGBox:=TFPgtkVBox.Create; + RGFRame.Add(RGBox); + S:=TstringList.Create; + try + With S do + begin + Add(SInformation); + Add(SWarning); + Add(SError); + Add(SDebug); + end; + RGMsgType:=RadioButtonGroupCreateFromStrings(S,Nil); + RGMsgType.PackInBox(RGBox,True,False,False,2); + Finally + S.Free; + end; + FLMsg:=TfpGtkLabel.Create(SMessage); + FMsg:=TfpGtkEntry.Create; + FHBox:=TFPgtkHbox.Create; + FHBox.PackStart(FLMsg,False,False,2); + FHBox.PackStart(FMsg,True,True,2); + Title:=SCaption; + FVBox:=TFPgtkVBox.Create; + FVBox.Homogeneous:=False; + FVBox.PackStart(FHBox,False,False,2); + FVBox.PackStart(RGFrame,False,False,2); + FVBox.PackStart(BSend,true,false,2); + Add(FVBox); + FMsg.GrabFocus; + FEventLog:=TEventlog.Create(Nil); + FEventLog.Identification:=SEventLogDemo; + FEventLog.RegisterMessagefile(''); + FEventLog.Active:=True; +end; + +Destructor TMainForm.Destroy; + +begin + FEventLog.Active:=False; + FEventLog.Free; + Inherited; +end; + +{ --------------------------------------------------------------------- + Callback events + ---------------------------------------------------------------------} + +Procedure TMainForm.BSendClicked(Sender : TFPgtkObject; Data : Pointer); + +begin + SendEvent; +end; + + +Procedure TMainForm.SendEvent; + +Var + E : TEventType; + +begin + Case RGMsgType.ActiveButtonIndex of + 0 : E:=etinfo; + 1 : E:=etWarning; + 2 : E:=etError; + 3 : E:=etDebug; + end; + FEventLog.log(E,FMsg.Text); +end; + +{ --------------------------------------------------------------------- + Program. + ---------------------------------------------------------------------} + +begin + application := TFPgtkApplication.Create; + application.MainWindow := TMainForm.Create; + application.Run; + application.Free; +end. \ No newline at end of file diff --git a/fcl/unix/eventlog.inc b/fcl/unix/eventlog.inc new file mode 100644 index 0000000000..0c97d05daf --- /dev/null +++ b/fcl/unix/eventlog.inc @@ -0,0 +1,125 @@ +{ + $Id$ + This file is part of the Free Pascal run time library. + Copyright (c) 2003 by the Free Pascal development team + + Unix implementation of event mechanism + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} + +{$linklib c} + +const + // OpenLog options + LOG_PID = $01; + LOG_CONS = $02; + LOG_ODELAY = $04; + LOG_NDELAY = $08; + LOG_NOWAIT = $10; + LOG_PERROR = $20; + + // Priority levels + LOG_EMERG = 0; + LOG_ALERT = 1; + LOG_CRIT = 2; + LOG_ERR = 3; + LOG_WARNING = 4; + LOG_NOTICE = 5; + LOG_INFO = 6; + LOG_DEBUG = 7; + LOG_PRIMASK = $07; + + // facility + LOG_KERN = 0 shl 3; + LOG_USER = 1 shl 3; + LOG_MAIL = 2 shl 3; + LOG_DAEMON = 3 shl 3; + LOG_AUTH = 4 shl 3; + LOG_SYSLOG = 5 shl 3; + LOG_LPR = 6 shl 3; + LOG_NEWS = 7 shl 3; + LOG_UUCP = 8 shl 3; + LOG_CRON = 9 shl 3; + LOG_AUTHPRIV = 10 shl 3; + +procedure closelog;cdecl;external; +procedure openlog(__ident:pchar; __option:longint; __facilit:longint);cdecl;external; +function setlogmask(__mask:longint):longint;cdecl;external; +procedure syslog(__pri:longint; __fmt:pchar; args:array of const);cdecl;external; + +Function TEventLog.DefaultFileName : String; + +begin + Result:='/tmp/'+ChangeFileExt(ExtractFileName(Paramstr(0)),'.log'); +end; + +Resourcestring + SErrNoSysLog = 'Could not open system log (error %d)'; + SErrLogFailed = 'Failed to log entry (error %d)'; + +Procedure TEventLog.ActivateSystemLog; + +begin + CheckIdentification; + OpenLog(Pchar(Identification),LOG_NOWAIT,LOG_USER); +end; + +Procedure TEventLog.DeActivateSystemLog; + +begin + CloseLog; +end; + +procedure TEventLog.WriteSystemLog(EventType : TEventType; Msg : String); + +Var + P,PT : PChar; + T : String; + +begin + P:=PChar(Msg); + T:=EventTypeToString(EventType); + PT:=PChar(T); + syslog(MapTypeToEvent(EventType),'[%s] %s',[PT,P]); +end; + +Function TEventLog.RegisterMessageFile(AFileName : String) : Boolean; + +begin + Result:=True; +end; + +function TEventLog.MapTypeToCategory(EventType: TEventType): Word; +begin + Result:=0; +end; + +function TEventLog.MapTypeToEventID(EventType: TEventType): DWord; + +begin + Result:=0; +end; + +function TEventLog.MapTypeToEvent(EventType: TEventType): DWord; + +Const + WinET : Array[TEventType] of word = (LOG_NOTICE, + LOG_INFO,LOG_WARNING,LOG_ERR,LOG_DEBUG); + +begin + If EventType=etCustom Then + begin + If CustomLogType=0 then + CustomLogType:=LOG_NOTICE; + Result:=CustomLogType + end + else + Result:=WinET[EventType]; +end; diff --git a/fcl/win32/eventlog.inc b/fcl/win32/eventlog.inc new file mode 100644 index 0000000000..fcc5a7d9b6 --- /dev/null +++ b/fcl/win32/eventlog.inc @@ -0,0 +1,142 @@ +{ + $Id$ + This file is part of the Free Pascal run time library. + Copyright (c) 2003 by the Free Pascal development team + + Win32 implementation part of event logging facility. + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} + +uses windows,registry; + +Function TEventLog.DefaultFileName : String; + +begin + Result:=ChangeFileExt(Paramstr(0),'.log'); +end; + +Resourcestring + SErrNoSysLog = 'Could not open system log (error %d)'; + SErrLogFailed = 'Failed to log entry (error %d)'; + +Procedure TEventLog.ActivateSystemLog; + +begin + CheckIdentification; + FLogHandle := Pointer(OpenEventLog(Nil,Pchar(Identification))); + If FLogHandle=Nil then + Raise ELogError.CreateFmt(SErrNoSysLog,[GetLastError]); +end; + +Procedure TEventLog.DeActivateSystemLog; + +begin + CloseEventLog(Cardinal(FLogHandle)); +end; + +{ +function ReportEvent(hEventLog: THandle; wType, wCategory: Word; + dwEventID: DWORD; lpUserSid: Pointer; wNumStrings: Word; + dwDataSize: DWORD; lpStrings, lpRawData: Pointer): BOOL; stdcall; +} + +procedure TEventLog.WriteSystemLog(EventType : TEventType; Msg : String); + +Var + P : PChar; + I : Integer; + FCategory : Word; + FEventID : DWord; + FEventType : Word; + +begin + FCategory:=MapTypeToCategory(EventType); + FEventID:=MapTypeToEventID(EventType); + FEventType:=MapTypeToEvent(EventType); + P:=PChar(Msg); + If Not ReportEvent(Cardinal(FLogHandle),FEventType,FCategory,FEventID,Nil,1,0,@P,Nil) then + begin + I:=GetLastError; + Raise ELogError.CreateFmt(SErrLogFailed,[I]); + end; +end; + +Function TEventLog.RegisterMessageFile(AFileName : String) : Boolean; + +Const + SKeyEventLog = '\SYSTEM\CurrentControlSet\Services\EventLog\Application\%s'; + SKeyCategoryCount = 'CategoryCount'; + SKeyEventMessageFile = 'EventMessageFile'; + SKeyCategoryMessageFile = 'CategoryMessageFile'; + SKeyTypesSupported = 'TypesSupported'; + +Var + ELKey : String; + R : TRegistry; + +begin + CheckIdentification; + If AFileName='' then + AFileName:=ParamStr(0); + R:=TRegistry.Create; + Try + R.RootKey:=HKEY_LOCAL_MACHINE; + ELKey:=Format(SKeyEventLog,[IDentification]); + Result:=R.OpenKey(ELKey,True); + If Result then + try + R.WriteInteger(SKeyCategoryCount,4); + R.WriteString(SKeyCategoryMessageFile,AFileName); + R.WriteString(SKeyEventMessageFile,AFileName); + R.WriteInteger(SKeyTypesSupported,7); + except + Result:=False; + end + Finally + R.Free; + end; +end; + +function TEventLog.MapTypeToCategory(EventType: TEventType): Word; +begin + Result:=Ord(EventType); + If Result=0 then + Result:=1; +end; + +function TEventLog.MapTypeToEventID(EventType: TEventType): DWord; + +begin + If (FEventIDOffset=0) then + FEventIDOffset:=1000; + Result:=FEventIDOffset+Ord(EventType); +end; + +function TEventLog.MapTypeToEvent(EventType: TEventType): DWord; + + + +Const + EVENTLOG_SUCCESS=0; + WinET : Array[TEventType] of word = (EVENTLOG_SUCCESS, + EVENTLOG_INFORMATION_TYPE, + EVENTLOG_WARNING_TYPE,EVENTLOG_ERROR_TYPE, + EVENTLOG_AUDIT_SUCCESS); + +begin + If EventType=etCustom Then + begin + If CustomLogType=0 then + CustomLogType:=EVENTLOG_SUCCESS; + Result:=CustomLogType + end + else + Result:=WinET[EventType]; +end; diff --git a/fcl/win32/fclel.mc b/fcl/win32/fclel.mc new file mode 100644 index 0000000000..0f0d23e7a5 --- /dev/null +++ b/fcl/win32/fclel.mc @@ -0,0 +1,79 @@ +; $Id$ +; This file is part of the Free Pascal run time library. +; Copyright (c) 2003 by the Free Pascal development team +; +; Messages for event logging facility +; +; See the file COPYING.FPC, included in this distribution, +; for details about the copyright. +; +; This program is distributed in the hope that it will be useful, +; but WITHOUT ANY WARRANTY; without even the implied warranty of +; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +; +; +;****************************************************** +; Default messages for FPC eventlog class +;****************************************************** +; Categories are mapped from 1 to 4 +; 1 : etInfo +; 2 : etWarning +; 3 : etError +; 4 : etDebug +; +; Categories (1-4) +MessageId=1 +SymbolicName=ECInfo +Language=English +Information +. + +MessageId=2 +SymbolicName=ECWarning +Language=English +Warning +. + +MessageId=3 +SymbolicName=ECError +Language=English +Error +. + +MessageId=4 +SymbolicName=ECDebug +Language=English +Debug +. + +; +; Message Definitions (1000-1004) +; +MessageId=1000 +Language=English +%1. +. + +; Information +MessageId=1001 +Language=English +Information: %1 +. + +; Warnings +MessageId=1002 +Language=English +Warning: %1 +. + +; Error +MessageId=1003 +Language=English +Error: %1 +. + +; Debug +MessageId=1004 +Language=English +Debug: %1 +. diff --git a/fcl/win32/fclel.rc b/fcl/win32/fclel.rc new file mode 100644 index 0000000000..82ac240ae7 --- /dev/null +++ b/fcl/win32/fclel.rc @@ -0,0 +1,2 @@ +LANGUAGE 0x9,0x1 +1 11 "C:\\TEMP\\fclel.msg" diff --git a/fcl/win32/fclel.res b/fcl/win32/fclel.res new file mode 100644 index 0000000000000000000000000000000000000000..9a646e039104ee03f5b13560f6b45f06f20d2cfa GIT binary patch literal 324 zcmY+6yA8rX5Cso#Vm^`s0zxNFk(?4kKn27`0_1?Rb%G8kfdVLi0w{wb2>6BMX7;=w zIBE3e?Vi>cV`8YP8uaf4jnBTr9||urVJ&zFQiKwk%8qO)dooZCH7xpF5*C VN&Q^z>#grh?)!T>k?wD5e*;gEGdKVM literal 0 HcmV?d00001