+ Added event log

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)

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

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
+
+}
+  

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
+
+}

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
+
+}

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
+
+}
+  

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)

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 \

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
+testhres.pp  Test hostresolver in resolve (MVC)
-testnres.pp  Test netresolver in resolve
+testnres.pp  Test netresolver in resolve (MVC) 
-testsres.pp  Test serviceresolver in resolve
+testsres.pp  Test serviceresolver in resolve (MVC)
-testrhre.pp  Test reverse hostresolver in resolve
+testrhre.pp  Test reverse hostresolver in resolve (MVC)
-testrnre.pp  Test reverse netresolver in resolve
+testrnre.pp  Test reverse netresolver in resolve (MVC)
-testrsre.pp  Test reverse serviceresolver in resolve
+testrsre.pp  Test reverse serviceresolver in resolve (MVC)
-txmlreg.pp   Test of xmlreg unit (xml-like registry)
+txmlreg.pp   Test of xmlreg unit (xml-like registry) (MVC)
-testreg.pp   Test of registry unit.
+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)

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.

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.

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;

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;

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
+.

fcl/win32/fclel.rc

@@ -0,0 +1,2 @@
+LANGUAGE 0x9,0x1
+1 11 "C:\\TEMP\\fclel.msg"