* Merging revisions r42247,r42248,r42249,r42250,r42262,r42263,r42264,r42265,r42266,r42267,r42269 from trunk:

    ------------------------------------------------------------------------
    r42247 | michael | 2019-06-19 08:12:15 +0200 (Wed, 19 Jun 2019) | 1 line
    
    * Fix bug ID #35731 (ReadSectionRaw needs to read comments)
    ------------------------------------------------------------------------
    r42248 | michael | 2019-06-19 08:25:02 +0200 (Wed, 19 Jun 2019) | 1 line
    
    * Patch from Pascal Riekenberg to make component loading thread safe (bug ID 35638)
    ------------------------------------------------------------------------
    r42249 | michael | 2019-06-19 10:10:26 +0200 (Wed, 19 Jun 2019) | 1 line
    
    * Fix non-threading platforms
    ------------------------------------------------------------------------
    r42250 | michael | 2019-06-19 14:24:59 +0200 (Wed, 19 Jun 2019) | 1 line
    
    * Patch from Ondrej Pokorny to support streaming to position 0 (bug ID 35724)
    ------------------------------------------------------------------------
    r42262 | michael | 2019-06-22 09:16:19 +0200 (Sat, 22 Jun 2019) | 1 line
    
    * Make sure error content is sent
    ------------------------------------------------------------------------
    r42263 | michael | 2019-06-22 09:29:34 +0200 (Sat, 22 Jun 2019) | 1 line
    
    * Correct registration of metadata resource in case rdoConnectionInURL is specified
    ------------------------------------------------------------------------
    r42264 | michael | 2019-06-22 09:33:49 +0200 (Sat, 22 Jun 2019) | 1 line
    
    * Add RoutesRegistered property to TSQLDBRestBridge
    ------------------------------------------------------------------------
    r42265 | michael | 2019-06-22 09:44:18 +0200 (Sat, 22 Jun 2019) | 1 line
    
    * Unregister routes
    ------------------------------------------------------------------------
    r42266 | michael | 2019-06-22 10:19:16 +0200 (Sat, 22 Jun 2019) | 1 line
    
    * Make sure output contains something in case of empty dataset
    ------------------------------------------------------------------------
    r42267 | michael | 2019-06-22 10:22:30 +0200 (Sat, 22 Jun 2019) | 1 line
    
    * Correct autoincrement handling
    ------------------------------------------------------------------------
    r42269 | michael | 2019-06-22 15:37:47 +0200 (Sat, 22 Jun 2019) | 1 line
    
    * Add SplitCommandLine
    ------------------------------------------------------------------------

git-svn-id: branches/fixes_3_2@42431 -

packages/fcl-base/examples/testini.pp

@@ -33,8 +33,13 @@ begin
       for i:=0 to lines.Count-1 do 
         WriteLn('  ', lines[i]);
       lines.Clear();
-      ini.ReadSectionValues('main', lines,[svoIncludeComments]);
-      WriteLn('ReadSectionValues (with comments, no invalid):');
+      ini.ReadSectionValues('main', lines,[]);
+      WriteLn('ReadSectionValues (no options):');
+      for i:=0 to lines.Count-1 do
+        WriteLn('  ', lines[i]);
+      lines.Clear();
+      ini.ReadSectionRaw('main', lines);
+      WriteLn('ReadSectionRaw (with comments, no invalid):');
       for i:=0 to lines.Count-1 do
         WriteLn('  ', lines[i]);
       lines.Clear();

packages/fcl-base/src/blowfish.pp

@@ -59,8 +59,8 @@ Type
     function GetPosition: Int64; override;
     procedure InvalidSeek; override;
   Public
-    Constructor Create(AKey : TBlowFishKey; AKeySize : Byte; Dest: TStream);
-    Constructor Create(Const KeyPhrase : String; Dest: TStream);
+    Constructor Create(AKey : TBlowFishKey; AKeySize : Byte; Dest: TStream); overload; virtual;
+    Constructor Create(Const KeyPhrase : String; Dest: TStream); overload;
     Destructor Destroy; override;
     Property BlowFish : TBlowFish Read FBF;
   end;
@@ -74,7 +74,11 @@ Type
   end;
 
   TBlowFishDeCryptStream = Class(TBlowFishStream)
+  private
+    FSourcePos0: Int64;
   public
+    Constructor Create(AKey : TBlowFishKey; AKeySize : Byte; Dest: TStream); override;
+
     function Read(var Buffer; Count: Longint): Longint; override;
     function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
   end;
@@ -652,6 +656,13 @@ end;
     TBlowFishDecryptStream
   ---------------------------------------------------------------------}
 
+constructor TBlowFishDeCryptStream.Create(AKey: TBlowFishKey; AKeySize: Byte;
+  Dest: TStream);
+begin
+  inherited Create(AKey, AKeySize, Dest);
+
+  FSourcePos0 := Source.Position;
+end;
 
 function TBlowFishDeCryptStream.Read(var Buffer; Count: Longint): Longint;
 
@@ -697,7 +708,13 @@ end;
 function TBlowFishDeCryptStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
 
 begin
-  FakeSeekForward(Offset,TSeekOrigin(Origin),FPos);
+  if (Offset=0) and (Origin=soBeginning) then
+  begin // support seek to beginning
+    FBufPos:=0;
+    FPos:=0;
+    Source.Position := FSourcePos0;
+  end else
+    FakeSeekForward(Offset,TSeekOrigin(Origin),FPos);
   Result:=FPos;
 end;
 

packages/fcl-base/src/inifiles.pp

@@ -1190,7 +1190,6 @@ begin
     oSection := FSectionList.SectionByName(Section,CaseSensitive);
     if oSection <> nil then with oSection.KeyList do
       for i := 0 to Count-1 do
-        if not IsComment(Items[i].Ident) then
          begin
            if Items[i].Ident<>'' then
             Strings.Add(Items[i].Ident + Separator +Items[i].Value)

packages/fcl-web/examples/restbridge/expenses-sqlite.sql

@@ -6,7 +6,7 @@ insert into  sqlite_sequence (name,seq) values ('seqProjectsID',1);
 drop table t2;
  
 create table ExpenseTypes (
-  etID bigint primary key,
+  etID integer primary key,
   etName varchar(50) not null,
   etDescription varchar(100) not null,
   etMaxAmount decimal(10,2),
@@ -15,7 +15,7 @@ create table ExpenseTypes (
 );
 
 create table Users (
-  uID bigint primary key,
+  uID integer primary key,
   uLogin varchar(50) not null,
   uFullName varchar(100) not null,
   uPassword varchar(100) not null,
@@ -23,17 +23,17 @@ create table Users (
 );
 
 create table Projects (
-  pID bigint primary key,
+  pID integer primary key,
   pName varchar(50) not null,
   pDescription varchar(100) not null,
   pActive boolean not null default true
 );
 
 create table Expenses (
-  eID bigint primary key,
-  eUserFK bigint not null,
-  eProjectFK bigint not null,
-  eTypeFK bigint not null,
+  eID integer primary key,
+  eUserFK integer not null,
+  eProjectFK integer not null,
+  eTypeFK integer not null,
   eAmount decimal(10,2) not null,
   eDate date not null default CURRENT_DATE,
   eComment varchar(1024)

packages/fcl-web/src/restbridge/sqldbrestbridge.pp

@@ -231,6 +231,7 @@ Type
     FMetadataItemRoute: THTTPRoute;
     FStatus: TRestStatusConfig;
     FStrings: TRestStringsConfig;
+    function GetRoutesRegistered: Boolean;
     procedure SetActive(AValue: Boolean);
     procedure SetAdminUserIDS(AValue: TStrings);
     procedure SetAuthenticator(AValue: TRestAuthenticator);
@@ -325,6 +326,7 @@ Type
     Function ExposeDatabase(Const aType,aHostName,aDatabaseName,aUserName,aPassword : String; aTables : TStrings = nil; aMinFieldOpts : TRestFieldOptions = []) : TSQLDBRestConnection;
     Function ExposeConnection(aOwner : TComponent; Const aConnection : TSQLDBRestConnection; aTables : TStrings = nil; aMinFieldOpts : TRestFieldOptions = []) : TSQLDBRestSchema;
     Function ExposeConnection(Const aConnection : TSQLDBRestConnection; aTables : TStrings = nil; aMinFieldOpts : TRestFieldOptions = []) : TSQLDBRestSchema;
+    Property RoutesRegistered : Boolean Read GetRoutesRegistered;
   Published
     // Register or unregister HTTP routes
     Property Active : Boolean Read FActive Write SetActive;
@@ -518,6 +520,11 @@ begin
   FActive:=AValue;
 end;
 
+function TSQLDBRestDispatcher.GetRoutesRegistered: Boolean;
+begin
+  Result:=FItemRoute<>Nil;
+end;
+
 procedure TSQLDBRestDispatcher.SetAdminUserIDS(AValue: TStrings);
 begin
   if FAdminUserIDs=AValue then Exit;
@@ -670,15 +677,20 @@ begin
     end;
   if (rdoConnectionInURL in DispatchOptions) then
     begin
-    C:=Strings.GetRestString(rpMetadataResourceName);
-    FMetadataRoute:=HTTPRouter.RegisterRoute(res+C,@HandleMetaDataRequest);
-    FMetadataItemRoute:=HTTPRouter.RegisterRoute(res+C+'/:id',@HandleMetaDataRequest);
+    // Both connection/metadata and /metadata must work.
+    // connection/metadata is handled by HandleRequest (FindSpecialResource)
+    // /metadata must be handled here.
+    if (rdoExposeMetadata in DispatchOptions) then
+      begin
+      C:=Strings.GetRestString(rpMetadataResourceName);
+      FMetadataRoute:=HTTPRouter.RegisterRoute(res+C,@HandleMetaDataRequest);
+      FMetadataItemRoute:=HTTPRouter.RegisterRoute(res+C+'/:id',@HandleMetaDataRequest);
+      end;
     Res:=Res+':connection/';
     end;
   Res:=Res+':resource';
   FListRoute:=HTTPRouter.RegisterRoute(res,@HandleRequest);
   FItemRoute:=HTTPRouter.RegisterRoute(Res+'/:id',@HandleRequest);
-
 end;
 
 function TSQLDBRestDispatcher.GetInputFormat(IO : TRestIO) : String;
@@ -817,6 +829,9 @@ begin
   IO.Response.Code:=aCode;
   IO.Response.CodeText:=aExtraMessage;
   IO.RestOutput.CreateErrorContent(aCode,aExtraMessage);
+  IO.RESTOutput.FinalizeOutput;
+  IO.Response.ContentStream.Position:=0;
+  IO.Response.ContentLength:=IO.Response.ContentStream.Size;
   IO.Response.SendResponse;
 end;
 
@@ -854,6 +869,8 @@ end;
 
 destructor TSQLDBRestDispatcher.Destroy;
 begin
+  if RoutesRegistered then
+    UnregisterRoutes;
   Authenticator:=Nil;
   FreeAndNil(FAdminUserIDs);
   FreeAndNil(FCustomViewResource);
@@ -1971,7 +1988,7 @@ begin
     // Make sure there is a document in case of error
     if (aResponse.ContentStream.Size=0) and Not ((aResponse.Code div 100)=2) then
       IO.RESTOutput.CreateErrorContent(aResponse.Code,aResponse.CodeText);
-    if Not (IO.Operation in [roOptions,roHEAD]) then
+    if Not ((IO.Operation in [roOptions,roHEAD]) or aResponse.ContentSent) then
       IO.RestOutput.FinalizeOutput;
     aResponse.ContentStream.Position:=0;
     aResponse.ContentLength:=aResponse.ContentStream.Size;

packages/fcl-web/src/restbridge/sqldbrestdata.pp

@@ -699,8 +699,13 @@ begin
       end;
     if not (D.EOF and D.BOF) then
       StreamDataset(IO.RESTOutput,D,FieldList)
-    else if Single then
-      DoNotFound;
+    else
+      begin
+      if Single then
+        DoNotFound
+      else
+        StreamDataset(IO.RESTOutput,D,FieldList)
+      end;
   finally
     D.Free;
   end;

packages/rtl-objpas/src/inc/strutils.pp

@@ -266,6 +266,15 @@ Function StringReplace(const S, OldPattern, NewPattern: string; Flags: TReplaceF
 Function StringReplace(const S, OldPattern, NewPattern: unicodestring; Flags: TReplaceFlags): unicodestring; overload;
 Function StringReplace(const S, OldPattern, NewPattern: widestring; Flags: TReplaceFlags): widestring; overload;
 
+
+Type
+  TRawByteStringArray = Array of RawByteString;
+  TUnicodeStringArray = Array of UnicodeString;
+
+Function SplitCommandLine(S : RawByteString) : TRawByteStringArray;
+Function SplitCommandLine(S : UnicodeString) : TUnicodeStringArray;
+
+
 implementation
 
 (*
@@ -3271,4 +3280,148 @@ begin
 end;
 
 
+Function SplitCommandLine(S : RawByteString) : TRawByteStringArray;
+
+  Function GetNextWord : RawByteString;
+
+  Const
+    WhiteSpace = [' ',#9,#10,#13];
+    Literals = ['"',''''];
+
+  Var
+    Wstart,wend : Integer;
+    InLiteral : Boolean;
+    LastLiteral : AnsiChar;
+
+    Procedure AppendToResult;
+
+    begin
+      Result:=Result+Copy(S,WStart,WEnd-WStart);
+      WStart:=Wend+1;
+    end;
+
+  begin
+    Result:='';
+    WStart:=1;
+    While (WStart<=Length(S)) and charinset(S[WStart],WhiteSpace) do
+      Inc(WStart);
+    WEnd:=WStart;
+    InLiteral:=False;
+    LastLiteral:=#0;
+    While (Wend<=Length(S)) and (Not charinset(S[Wend],WhiteSpace) or InLiteral) do
+      begin
+      if charinset(S[Wend],Literals) then
+        If InLiteral then
+          begin
+          InLiteral:=Not (S[Wend]=LastLiteral);
+          if not InLiteral then
+            AppendToResult;
+          end
+        else
+          begin
+          InLiteral:=True;
+          LastLiteral:=S[Wend];
+          AppendToResult;
+          end;
+       inc(wend);
+       end;
+     AppendToResult;
+     While (WEnd<=Length(S)) and (S[Wend] in WhiteSpace) do
+       inc(Wend);
+     Delete(S,1,WEnd-1);
+  end;
+
+Var
+  W : RawByteString;
+  len : Integer;
+
+begin
+  Len:=0;
+  Result:=Default(TRawByteStringArray);
+  SetLength(Result,(Length(S) div 2)+1);
+  While Length(S)>0 do
+    begin
+    W:=GetNextWord;
+    If (W<>'') then
+      begin
+      Result[Len]:=W;
+      Inc(Len);
+      end;
+    end;
+  SetLength(Result,Len);
+end;
+
+
+Function SplitCommandLine(S : UnicodeString) : TUnicodeStringArray;
+
+  Function GetNextWord : UnicodeString;
+
+  Const
+    WhiteSpace = [' ',#9,#10,#13];
+    Literals = ['"',''''];
+
+  Var
+    Wstart,wend : Integer;
+    InLiteral : Boolean;
+    LastLiteral : AnsiChar;
+
+    Procedure AppendToResult;
+
+    begin
+      Result:=Result+Copy(S,WStart,WEnd-WStart);
+      WStart:=Wend+1;
+    end;
+
+  begin
+    Result:='';
+    WStart:=1;
+    While (WStart<=Length(S)) and charinset(S[WStart],WhiteSpace) do
+      Inc(WStart);
+    WEnd:=WStart;
+    InLiteral:=False;
+    LastLiteral:=#0;
+    While (Wend<=Length(S)) and (Not charinset(S[Wend],WhiteSpace) or InLiteral) do
+      begin
+      if charinset(S[Wend],Literals) then
+        If InLiteral then
+          begin
+          InLiteral:=Not (S[Wend]=LastLiteral);
+          if not InLiteral then
+            AppendToResult;
+          end
+        else
+          begin
+          InLiteral:=True;
+          LastLiteral:=S[Wend];
+          AppendToResult;
+          end;
+       inc(wend);
+       end;
+     AppendToResult;
+     While (WEnd<=Length(S)) and (S[Wend] in WhiteSpace) do
+       inc(Wend);
+     Delete(S,1,WEnd-1);
+  end;
+
+Var
+  W : UnicodeString;
+  len : Integer;
+
+begin
+  Len:=0;
+  Result:=Default(TUnicodeStringArray);
+  SetLength(Result,(Length(S) div 2)+1);
+  While Length(S)>0 do
+    begin
+    W:=GetNextWord;
+    If (W<>'') then
+      begin
+      Result[Len]:=W;
+      Inc(Len);
+      end;
+    end;
+  SetLength(Result,Len);
+end;
+
+
 end.

rtl/objpas/classes/classesh.inc

@@ -1435,6 +1435,7 @@ type
     FParent: TComponent;
     FFixups: TObject;
     FLoaded: TFpList;
+    FLock: TRTLCriticalSection;
     FOnFindMethod: TFindMethodEvent;
     FOnSetMethodProperty: TSetMethodPropertyEvent;
     FOnSetName: TSetNameEvent;
@@ -1449,6 +1450,8 @@ type
     FOnReadStringProperty:TReadWriteStringPropertyEvent;
     procedure DoFixupReferences;
     function FindComponentClass(const AClassName: string): TComponentClass;
+    procedure Lock;
+    procedure Unlock;
   protected
     function Error(const Message: string): Boolean; virtual;
     function FindMethod(ARoot: TComponent; const AMethodName: string): CodePointer; virtual;

rtl/objpas/classes/reader.inc

@@ -609,14 +609,34 @@ begin
   If (Stream=Nil) then
     Raise EReadError.Create(SEmptyStreamIllegalReader);
   FDriver := CreateDriver(Stream, BufSize);
+{$ifdef FPC_HAS_FEATURE_THREADING}
+  InitCriticalSection(FLock);
+{$ENDIF}  
 end;
 
 destructor TReader.Destroy;
 begin
+{$ifdef FPC_HAS_FEATURE_THREADING}
+  DoneCriticalSection(FLock);
+{$ENDIF}  
   FDriver.Free;
   inherited Destroy;
 end;
 
+procedure TReader.Lock;
+begin
+{$ifdef FPC_HAS_FEATURE_THREADING}
+  EnterCriticalSection(FLock);
+{$ENDIF}  
+end;
+
+procedure TReader.Unlock;
+begin
+{$ifdef FPC_HAS_FEATURE_THREADING}
+  LeaveCriticalSection(FLock);
+{$ENDIF}  
+end;
+
 procedure TReader.FlushBuffer;
 begin
   Driver.FlushBuffer;
@@ -1476,12 +1496,17 @@ begin
           { Don't use Result.Name directly, as this would influence
             FindGlobalComponent in successive loop runs }
           ResultName := CompName;
-          while Assigned(FindGlobalComponent(ResultName)) do
-          begin
-            Inc(i);
-            ResultName := CompName + '_' + IntToStr(i);
+          Lock;
+          try
+            while Assigned(FindGlobalComponent(ResultName)) do
+            begin
+              Inc(i);
+              ResultName := CompName + '_' + IntToStr(i);
+            end;
+            Result.Name := ResultName;
+          finally
+            Unlock;
           end;
-          Result.Name := ResultName;
         end;
       end;