Browse Source

--- Merging r17470 into '.':
U rtl/objpas/sysutils/sysutils.inc
--- Merging r17516 into '.':
U rtl/unix/video.pp
--- Merging r17530 into '.':
U packages/fcl-extra/src/daemonapp.pp
U packages/fcl-web/src/base/custweb.pp
U packages/fcl-base/src/custapp.pp
--- Merging r17531 into '.':
U rtl/objpas/sysutils/osutilsh.inc
--- Merging r17613 into '.':
U packages/fcl-image/src/fpimage.inc
--- Merging r17634 into '.':
U packages/openssl/src/openssl.pas

# revisions: 17470,17516,17530,17531,17613,17634
------------------------------------------------------------------------
r17470 | florian | 2011-05-15 17:13:22 +0200 (Sun, 15 May 2011) | 1 line
Changed paths:
M /trunk/rtl/objpas/sysutils/sysutils.inc

* fix Sysutils.AssertErrorHandler as proposed by Martin Friebe in #19130, resolves #19310
------------------------------------------------------------------------
------------------------------------------------------------------------
r17516 | florian | 2011-05-20 22:39:43 +0200 (Fri, 20 May 2011) | 3 lines
Changed paths:
M /trunk/rtl/unix/video.pp

* patch by Nikolay Nikolov to use a hardware block cursor on the
linux console, resolves #19259

------------------------------------------------------------------------
------------------------------------------------------------------------
r17530 | michael | 2011-05-23 14:01:22 +0200 (Mon, 23 May 2011) | 2 lines
Changed paths:
M /trunk/packages/fcl-base/src/custapp.pp
M /trunk/packages/fcl-extra/src/daemonapp.pp
M /trunk/packages/fcl-web/src/base/custweb.pp

* Log event no longer virtual, descendents must override DoLog
Filtering is applied in Log in CustApp.
------------------------------------------------------------------------
------------------------------------------------------------------------
r17531 | michael | 2011-05-23 14:33:28 +0200 (Mon, 23 May 2011) | 1 line
Changed paths:
M /trunk/rtl/objpas/sysutils/osutilsh.inc

* Added TEventTypes set
------------------------------------------------------------------------
------------------------------------------------------------------------
r17613 | michael | 2011-05-30 23:23:44 +0200 (Mon, 30 May 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-image/src/fpimage.inc

* Default no longer uses palette
------------------------------------------------------------------------
------------------------------------------------------------------------
r17634 | marco | 2011-06-02 18:19:52 +0200 (Thu, 02 Jun 2011) | 2 lines
Changed paths:
M /trunk/packages/openssl/src/openssl.pas

* patch from mantis #19039 which adds dessetkey

------------------------------------------------------------------------

git-svn-id: branches/fixes_2_4@17708 -

marco 14 years ago
parent
commit
e6ae810bdd

+ 10 - 2
packages/fcl-base/src/custapp.pp

@@ -46,6 +46,7 @@ Type
     Procedure DoRun; Virtual;
     Procedure DoRun; Virtual;
     Function GetParams(Index : Integer) : String;virtual;
     Function GetParams(Index : Integer) : String;virtual;
     function GetParamCount: Integer;Virtual;
     function GetParamCount: Integer;Virtual;
+    Procedure DoLog(EventType : TEventType; const Msg : String);  virtual;
   Public
   Public
     constructor Create(AOwner: TComponent); override;
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     destructor Destroy; override;
@@ -67,7 +68,7 @@ Type
     Function CheckOptions(Const ShortOptions : String; Const LongOpts : String) : String;
     Function CheckOptions(Const ShortOptions : String; Const LongOpts : String) : String;
     Procedure GetEnvironmentList(List : TStrings;NamesOnly : Boolean);
     Procedure GetEnvironmentList(List : TStrings;NamesOnly : Boolean);
     Procedure GetEnvironmentList(List : TStrings);
     Procedure GetEnvironmentList(List : TStrings);
-    Procedure Log(EventType : TEventType; const Msg : String); virtual;
+    Procedure Log(EventType : TEventType; const Msg : String);
     // Delphi properties
     // Delphi properties
     property ExeName: string read GetExeName;
     property ExeName: string read GetExeName;
     property HelpFile: string read FHelpFile write FHelpFile;
     property HelpFile: string read FHelpFile write FHelpFile;
@@ -228,10 +229,17 @@ begin
   // Do nothing. Override in descendent classes.
   // Do nothing. Override in descendent classes.
 end;
 end;
 
 
+Procedure TCustomApplication.DoLog(EventType : TEventType; const Msg : String);
+
+begin
+  // Do nothing, override in descendants
+end;
+
 Procedure TCustomApplication.Log(EventType : TEventType; const Msg : String);
 Procedure TCustomApplication.Log(EventType : TEventType; const Msg : String);
 
 
 begin
 begin
-  // Do nothing. Override in descendent classes.
+  If (FEventLogFilter=[]) or (EventType in FEventLogFilter) then
+    DoLog(EventType,Msg);
 end;
 end;
 
 
 constructor TCustomApplication.Create(AOwner: TComponent);
 constructor TCustomApplication.Create(AOwner: TComponent);

+ 41 - 8
packages/fcl-extra/src/daemonapp.pp

@@ -359,6 +359,7 @@ Type
     Procedure RemoveController(AController : TDaemonController); virtual;
     Procedure RemoveController(AController : TDaemonController); virtual;
     Function GetEventLog: TEventLog; virtual;
     Function GetEventLog: TEventLog; virtual;
     Procedure DoRun; override;
     Procedure DoRun; override;
+    procedure DoLog(EventType: TEventType; const Msg: String); override;
     Property SysData : TObject Read FSysData Write FSysData;
     Property SysData : TObject Read FSysData Write FSysData;
   Public
   Public
     destructor Destroy; override;
     destructor Destroy; override;
@@ -370,7 +371,6 @@ Type
     procedure UnInstallDaemons;
     procedure UnInstallDaemons;
     procedure ShowHelp;
     procedure ShowHelp;
     procedure CreateForm(InstanceClass: TComponentClass; var Reference); virtual;
     procedure CreateForm(InstanceClass: TComponentClass; var Reference); virtual;
-    procedure Log(EventType: TEventType; const Msg: String); override;
     Property  OnRun : TNotifyEvent Read FOnRun Write FOnRun;
     Property  OnRun : TNotifyEvent Read FOnRun Write FOnRun;
     Property EventLog : TEventLog Read GetEventLog;
     Property EventLog : TEventLog Read GetEventLog;
     Property GUIMainLoop : TGuiLoopEvent Read FGUIMainLoop Write FGuiMainLoop;
     Property GUIMainLoop : TGuiLoopEvent Read FGUIMainLoop Write FGuiMainLoop;
@@ -412,7 +412,7 @@ Resourcestring
   SHelpUnInstall                = 'To uninstall the service';
   SHelpUnInstall                = 'To uninstall the service';
   SHelpRun                      = 'To run the service';
   SHelpRun                      = 'To run the service';
 
 
-{ $define svcdebug}
+{$define svcdebug}
 
 
 {$ifdef svcdebug}
 {$ifdef svcdebug}
 Procedure DebugLog(Msg : String);
 Procedure DebugLog(Msg : String);
@@ -520,8 +520,12 @@ end;
 
 
 function Application: TCustomDaemonApplication;
 function Application: TCustomDaemonApplication;
 begin
 begin
+ {$ifdef svcdebug}Debuglog('Application');{$endif}
   If (AppInstance=Nil) then
   If (AppInstance=Nil) then
+    begin
+    {$ifdef svcdebug}Debuglog('Application creating instance');{$endif}
     CreateDaemonApplication;
     CreateDaemonApplication;
+    end;
   Result:=AppInstance;
   Result:=AppInstance;
 end;
 end;
 
 
@@ -722,12 +726,39 @@ Var
   DD : TDaemonDef;
   DD : TDaemonDef;
   
   
 begin
 begin
-  If (Args=Nil) then
-    Exit;
-  SN:=StrPas(Args^);
-  DD:=FMapper.DaemonDefs.FindDaemonDef(SN);
+ {$ifdef svcdebug}DebugLog('Application.Main');{$endif svcdebug}
+  If (Argc=0) then
+    begin
+    {$ifdef svcdebug}DebugLog('Using Default daemon');{$endif svcdebug}
+    if FMapper.DaemonDefs.Count=1 then
+      DD:=FMapper.DaemonDefs[0]
+    else
+      DD:=Nil
+    end
+  else
+    begin
+    {$ifdef svcdebug}DebugLog('Application.Main 2 : '+IntToStr(Argc));{$endif svcdebug}
+    DD:=Nil;
+    SN:='';
+    If (Args<>Nil) then
+      begin
+      If (Args^<>Nil) then
+        SN:=StrPas(Args^)
+      else
+        SN:='';
+      end;
+    {$ifdef svcdebug}DebugLog('Looking for daemon '+SN);{$endif svcdebug}
+    DD:=FMapper.DaemonDefs.FindDaemonDef(SN);
+    end;
   If (DD<>Nil) then
   If (DD<>Nil) then
+    begin
+    {$ifdef svcdebug}DebugLog('Found daemon '+SN);{$endif svcdebug}
     DD.Instance.Controller.Main(Argc,Args);
     DD.Instance.Controller.Main(Argc,Args);
+    end
+  else
+    begin
+  {$ifdef svcdebug}DebugLog('Did not fin daemon '+SN);{$endif svcdebug}
+    end;
 end;
 end;
 
 
 
 
@@ -851,7 +882,7 @@ begin
   end;
   end;
 end;
 end;
 
 
-procedure TCustomDaemonApplication.Log(EventType: TEventType; const Msg: String);
+procedure TCustomDaemonApplication.DoLog(EventType: TEventType; const Msg: String);
 begin
 begin
   EventLog.Log(EventType,Msg);
   EventLog.Log(EventType,Msg);
 end;
 end;
@@ -887,8 +918,9 @@ begin
   if not assigned(FEventLog) then
   if not assigned(FEventLog) then
     begin
     begin
     FEventLog:=TEventlog.Create(Self);
     FEventLog:=TEventlog.Create(Self);
-    FEventLog.RaiseExceptionOnError:=true;
+    FEventLog.RaiseExceptionOnError:=False;
     FEventLog.RegisterMessageFile('');
     FEventLog.RegisterMessageFile('');
+    FEventLog.Active:=True;
     end;
     end;
   result := FEventLog;
   result := FEventLog;
 end;
 end;
@@ -1193,6 +1225,7 @@ Var
   S : String;
   S : String;
 
 
 begin
 begin
+ {$ifdef svcdebug}DebugLog('Handling control code '+IntToStr(ACode));{$endif svcdebug}
   CS:=FDaemon.Status;
   CS:=FDaemon.Status;
   Try
   Try
     OK:=True;
     OK:=True;

+ 1 - 2
packages/fcl-image/src/fpimage.inc

@@ -430,8 +430,7 @@ constructor TFPMemoryImage.Create (AWidth,AHeight:integer);
 begin
 begin
   Fdata := nil;
   Fdata := nil;
   inherited create (AWidth,AHeight);
   inherited create (AWidth,AHeight);
-{Default behavior is to use palette as suggested by Michael}
-  SetUsePalette(True);
+  SetUsePalette(False);
 end;
 end;
 
 
 destructor TFPMemoryImage.Destroy;
 destructor TFPMemoryImage.Destroy;

+ 2 - 2
packages/fcl-web/src/base/custweb.pp

@@ -162,6 +162,7 @@ Type
   protected
   protected
     Procedure DoRun; override;
     Procedure DoRun; override;
     function InitializeWebHandler: TWebHandler; virtual; abstract;
     function InitializeWebHandler: TWebHandler; virtual; abstract;
+    Procedure DoLog(EventType: TEventType; const Msg: String); override;
     procedure SetTitle(const AValue: string); override;
     procedure SetTitle(const AValue: string); override;
     property WebHandler: TWebHandler read FWebHandler write FWebHandler;
     property WebHandler: TWebHandler read FWebHandler write FWebHandler;
   Public
   Public
@@ -169,7 +170,6 @@ Type
     destructor Destroy; override;
     destructor Destroy; override;
     Procedure CreateForm(AClass : TComponentClass; out Reference);
     Procedure CreateForm(AClass : TComponentClass; out Reference);
     Procedure Initialize; override;
     Procedure Initialize; override;
-    Procedure Log(EventType: TEventType; const Msg: String); override;
     procedure Terminate; override;
     procedure Terminate; override;
     Property HandleGetOnPost : Boolean Read GetHandleGetOnPost Write SetHandleGetOnPost;
     Property HandleGetOnPost : Boolean Read GetHandleGetOnPost Write SetHandleGetOnPost;
     Property RedirectOnError : boolean Read GetRedirectOnError Write SetRedirectOnError;
     Property RedirectOnError : boolean Read GetRedirectOnError Write SetRedirectOnError;
@@ -609,7 +609,7 @@ begin
   Inherited;
   Inherited;
 end;
 end;
 
 
-procedure TCustomWebApplication.Log(EventType: TEventType; const Msg: String);
+procedure TCustomWebApplication.DoLog(EventType: TEventType; const Msg: String);
 begin
 begin
   EventLog.log(EventType,Msg);
   EventLog.log(EventType,Msg);
 end;
 end;

+ 16 - 0
packages/openssl/src/openssl.pas

@@ -604,6 +604,10 @@ const
   BIO_C_SET_EX_ARG		= 153;
   BIO_C_SET_EX_ARG		= 153;
   BIO_C_GET_EX_ARG		= 154;
   BIO_C_GET_EX_ARG		= 154;
 
 
+//DES modes
+  DES_ENCRYPT = 1;
+  DES_DECRYPT = 0;
+  
 var
 var
   SSLLibHandle: TLibHandle = 0;
   SSLLibHandle: TLibHandle = 0;
   SSLUtilHandle: TLibHandle = 0;
   SSLUtilHandle: TLibHandle = 0;
@@ -706,6 +710,7 @@ var
 
 
   // 3DES functions
   // 3DES functions
   procedure DESsetoddparity(Key: des_cblock);
   procedure DESsetoddparity(Key: des_cblock);
+  function DESsetkey(key: des_cblock; schedule: des_key_schedule): cInt;
   function DESsetkeychecked(key: des_cblock; schedule: des_key_schedule): cInt;
   function DESsetkeychecked(key: des_cblock; schedule: des_key_schedule): cInt;
   procedure DESecbencrypt(Input: des_cblock; output: des_cblock; ks: des_key_schedule; enc: cInt);
   procedure DESecbencrypt(Input: des_cblock; output: des_cblock; ks: des_key_schedule; enc: cInt);
 
 
@@ -942,6 +947,7 @@ type
   // 3DES functions
   // 3DES functions
   TDESsetoddparity = procedure(Key: des_cblock); cdecl;
   TDESsetoddparity = procedure(Key: des_cblock); cdecl;
   TDESsetkeychecked = function(key: des_cblock; schedule: des_key_schedule): cInt; cdecl;
   TDESsetkeychecked = function(key: des_cblock; schedule: des_key_schedule): cInt; cdecl;
+  TDESsetkey = TDESsetkeychecked;
   TDESecbencrypt = procedure(Input: des_cblock; output: des_cblock; ks: des_key_schedule; enc: cInt); cdecl;
   TDESecbencrypt = procedure(Input: des_cblock; output: des_cblock; ks: des_key_schedule; enc: cInt); cdecl;
   //thread lock functions
   //thread lock functions
   TCRYPTOnumlocks = function: cInt; cdecl;
   TCRYPTOnumlocks = function: cInt; cdecl;
@@ -1146,6 +1152,7 @@ var
 
 
   // 3DES functions
   // 3DES functions
   _DESsetoddparity: TDESsetoddparity = nil;
   _DESsetoddparity: TDESsetoddparity = nil;
+  _DESsetkey	   : TDESsetkey = nil;
   _DESsetkeychecked: TDESsetkeychecked = nil;
   _DESsetkeychecked: TDESsetkeychecked = nil;
   _DESecbencrypt: TDESecbencrypt = nil;
   _DESecbencrypt: TDESecbencrypt = nil;
   //thread lock functions
   //thread lock functions
@@ -1921,6 +1928,14 @@ begin
     _DESsetoddparity(Key);
     _DESsetoddparity(Key);
 end;
 end;
 
 
+function DESsetkey(key: des_cblock; schedule: des_key_schedule): cInt;
+begin
+  if InitSSLInterface and Assigned(_DESsetkey) then
+    Result := _DESsetkey(key, schedule)
+  else
+    Result := -1;
+end;
+
 function DESsetkeychecked(key: des_cblock; schedule: des_key_schedule): cInt;
 function DESsetkeychecked(key: des_cblock; schedule: des_key_schedule): cInt;
 begin
 begin
   if InitlibeaInterface and Assigned(_DESsetkeychecked) then
   if InitlibeaInterface and Assigned(_DESsetkeychecked) then
@@ -2690,6 +2705,7 @@ begin
         // 3DES functions
         // 3DES functions
         _DESsetoddparity := GetProcAddr(SSLUtilHandle, 'des_set_odd_parity', AVerboseLoading);
         _DESsetoddparity := GetProcAddr(SSLUtilHandle, 'des_set_odd_parity', AVerboseLoading);
         _DESsetkeychecked := GetProcAddr(SSLUtilHandle, 'des_set_key_checked', AVerboseLoading);
         _DESsetkeychecked := GetProcAddr(SSLUtilHandle, 'des_set_key_checked', AVerboseLoading);
+        _DESsetkey := GetProcAddr(SSLUtilHandle, 'des_set_key', AVerboseLoading);
         _DESecbencrypt := GetProcAddr(SSLUtilHandle, 'des_ecb_encrypt', AVerboseLoading);
         _DESecbencrypt := GetProcAddr(SSLUtilHandle, 'des_ecb_encrypt', AVerboseLoading);
         //
         //
         _CRYPTOnumlocks := GetProcAddr(SSLUtilHandle, 'CRYPTO_num_locks', AVerboseLoading);
         _CRYPTOnumlocks := GetProcAddr(SSLUtilHandle, 'CRYPTO_num_locks', AVerboseLoading);

+ 1 - 0
rtl/objpas/sysutils/osutilsh.inc

@@ -54,6 +54,7 @@ Type
 
 
 Type
 Type
   TEventType = (etCustom,etInfo,etWarning,etError,etDebug);
   TEventType = (etCustom,etInfo,etWarning,etError,etDebug);
+  TEventTypes = Set of TEventType;
 
 
 Var
 Var
   OnGetVendorName      : TGetVendorNameEvent;
   OnGetVendorName      : TGetVendorNameEvent;

+ 1 - 1
rtl/objpas/sysutils/sysutils.inc

@@ -379,7 +379,7 @@ begin
     S:=SAssertionFailed
     S:=SAssertionFailed
   else
   else
     S:=Msg;
     S:=Msg;
-  Raise EAssertionFailed.Createfmt(SAssertError,[S,Fn,LineNo]) at Pointer(theAddr);
+  Raise EAssertionFailed.Createfmt(SAssertError,[S,Fn,LineNo]) at get_caller_addr(theAddr), get_caller_frame(theAddr);
 end;
 end;
 
 
 {$ifdef STACKCHECK_WAS_ON}
 {$ifdef STACKCHECK_WAS_ON}

+ 1 - 1
rtl/unix/video.pp

@@ -127,7 +127,7 @@ const term_codes_ansi:Ttermcodes=
          #$1B#$5B#$48,                                      {cursor_home}
          #$1B#$5B#$48,                                      {cursor_home}
          #$1B'[?25h'#$1B'[?0c',                             {cursor_normal}
          #$1B'[?25h'#$1B'[?0c',                             {cursor_normal}
          #$1B'[?0c',                                        {cursor visible, underline}
          #$1B'[?0c',                                        {cursor visible, underline}
-         #$1B'[?17;0;127c',                                 {cursor visible, block}
+         #$1B'[?6c',                                        {cursor visible, block}
          #$1B'[?1c',                                        {cursor_invisible}
          #$1B'[?1c',                                        {cursor_invisible}
          nil,                                               {enter_ca_mode}
          nil,                                               {enter_ca_mode}
          nil,                                               {exit_ca_mode}
          nil,                                               {exit_ca_mode}