try to fix TPdfEncryptionRC4MD5

- #32
synopse · Feb 4, 2021 · b1d4264 · b1d4264
1 parent 8b6e9d2
commit b1d4264
Show file tree

Hide file tree

Showing 10 changed files with 111 additions and 81 deletions.
diff --git a/SynCommons.pas b/SynCommons.pas
@@ -6,7 +6,7 @@
 (*
     This file is part of Synopse framework.
 
-    Synopse framework. Copyright (C) 2020 Arnaud Bouchez
+    Synopse framework. Copyright (C) 2021 Arnaud Bouchez
       Synopse Informatique - https://synopse.info
 
   *** BEGIN LICENSE BLOCK *****
@@ -25,7 +25,7 @@
 
   The Initial Developer of the Original Code is Arnaud Bouchez.
 
-  Portions created by the Initial Developer are Copyright (C) 2020
+  Portions created by the Initial Developer are Copyright (C) 2021
   the Initial Developer. All Rights Reserved.
 
   Contributor(s):
@@ -3929,8 +3929,9 @@ procedure RaiseLastOSError;
 procedure VarCastError;
 {$endif}
 
-/// extract file name, without its extension
-// - may optionally return the associated extension, as '.ext'
+/// compute the file name, including its path if supplied, but without its extension
+// - e.g. GetFileNameWithoutExt('/var/toto.ext') = '/var/toto'
+// - may optionally return the extracted extension, as '.ext'
 function GetFileNameWithoutExt(const FileName: TFileName;
   Extension: PFileName=nil): TFileName;
 
@@ -9823,7 +9824,7 @@   TRawUTF8List = class
 
   /// abstract low-level parent class for generic compression/decompression algorithms
   // - will encapsulate the compression algorithm with crc32c hashing
-  // - all Algo* abtract methods should be overriden by inherited classes
+  // - all Algo* abstract methods should be overriden by inherited classes
   TAlgoCompress = class(TSynPersistent)
   public
     /// should return a genuine byte identifier
@@ -12444,8 +12445,8 @@   {$ifdef USERECORDWITHMETHODS}TSynDate = record{$else}
   // - FPC's TSystemTime in datih.inc does NOT match Windows TSystemTime fields!
   // - also used to store a Date/Time in TSynTimeZone internal structures, or
   // for fast conversion from TDateTime to its ready-to-display members
-  // - DayOfWeek field is not handled by most methods by default, but could be
-  // filled on demand via ComputeDayOfWeek
+  // - DayOfWeek field is not handled by most methods by default (left as 0),
+  // but could be filled on demand via ComputeDayOfWeek into its 1..7 value
   // - some Delphi revisions have trouble with "object" as own method parameters
   // (e.g. IsEqual) so we force to use "record" type if possible
   {$ifdef USERECORDWITHMETHODS}TSynSystemTime = record{$else}
@@ -16333,6 +16334,9 @@   TSynFPUException = class(TSynInterfacedObject)
   end;
 
   /// simple reference-counted storage for local objects
+  // - WARNING: both FPC and Delphi 10.4+ don't keep the IAutoFree instance
+  // up to the end-of-method -> you should not use TAutoFree for new projects
+  // :( - see https://quality.embarcadero.com/browse/RSP-30050
   // - be aware that it won't implement a full ARC memory model, but may be
   // just used to avoid writing some try ... finally blocks on local variables
   // - use with caution, only on well defined local scope
@@ -16366,6 +16370,8 @@   TAutoFree = class(TInterfacedObject,IAutoFree)
     // !end; // here myVar will be released
     // - warning: under FPC, you should assign the result of this method to a local
     // IAutoFree variable - see bug http://bugs.freepascal.org/view.php?id=26602
+    // - Delphi 10.4 also did change it and release the IAutoFree before the
+    // end of the current method, so you should better use a local variable
     class function One(var localVariable; obj: TObject): IAutoFree;
     /// protect several local TObject variable instances life time
     // - specified as localVariable/objectInstance pairs
@@ -16379,6 +16385,8 @@   TAutoFree = class(TInterfacedObject,IAutoFree)
     // !end; // here var1 and var2 will be released
     // - warning: under FPC, you should assign the result of this method to a local
     // IAutoFree variable - see bug http://bugs.freepascal.org/view.php?id=26602
+    // - Delphi 10.4 also did change it and release the IAutoFree before the
+    // end of the current method, so you should better use a local variable
      class function Several(const varObjPairs: array of pointer): IAutoFree;
     /// protect another TObject variable to an existing IAutoFree instance life time
     // - you may write:
@@ -16603,6 +16611,8 @@   TAutoLocker = class(TInterfacedObjectWithCustomCreate,IAutoLocker)
     procedure Clear;
     /// save the stored values as UTF-8 encoded JSON Object
     function ToJSON(HumanReadable: boolean=false): RawUTF8;
+    /// low-level access to the associated thread-safe mutex
+    function Lock: TAutoLocker;
     /// the document fields would be safely accessed via this property
     // - this is the main entry point of this storage
     // - will raise an EDocVariant exception if Name does not exist at reading
@@ -16667,6 +16677,8 @@   TLockedDocVariant = class(TInterfacedObjectWithCustomCreate,ILockedDocVariant)
     /// save the stored value as UTF-8 encoded JSON Object
     // - implemented as just a wrapper around VariantSaveJSON()
     function ToJSON(HumanReadable: boolean=false): RawUTF8;
+    /// low-level access to the associated thread-safe mutex
+    function Lock: TAutoLocker;
     /// the document fields would be safely accessed via this property
     // - will raise an EDocVariant exception if Name does not exist
     // - result variant is returned as a copy, not as varByRef, since a copy
@@ -23535,7 +23547,7 @@ function isSelect(P: PUTF8Char; SelectClause: PRawUTF8): boolean;
 begin
   if P<>nil then begin
     P := SQLBegin(P);
-    case IdemPCharArray(P, ['SELECT','EXPLAIN ','VACUUM','PRAGMA','WITH']) of
+    case IdemPCharArray(P, ['SELECT','EXPLAIN ','VACUUM','PRAGMA','WITH','EXECUTE']) of
     0: if P[6]<=' ' then begin
          if SelectClause<>nil then begin
            inc(P,7);
@@ -23551,6 +23563,10 @@ function isSelect(P: PUTF8Char; SelectClause: PRawUTF8): boolean;
     2,3: result := P[6] in [#0..' ',';'];
     4:   result := (P[4]<=' ') and not (StrPosI('INSERT',P+5)<>nil) or
            (StrPosI('UPDATE',P+5)<>nil) or (StrPosI('DELETE',P+5)<>nil);
+    5: begin // FireBird specific
+        P := GotoNextNotSpace(P+7);
+        result := IdemPChar(P,'BLOCK') and IdemPChar(GotoNextNotSpace(P+5),'RETURNS');
+      end
     else result := false;
     end;
   end else
@@ -57842,6 +57858,34 @@ function JSONObjectAsJSONArrays(JSON: PUTF8Char; out keys,values: RawUTF8): bool
   end;
 end;
 
+function TryRemoveComment(P: PUTF8Char): PUTF8Char; {$ifdef HASINLINE}inline;{$endif}
+begin
+  result := P + 1;
+  case result^ of
+   '/': begin // this is // comment - replace by ' '
+     dec(result);
+     repeat
+       result^ := ' ';
+       inc(result)
+     until result^ in [#0, #10, #13];
+     if result^<>#0 then inc(result);
+   end;
+   '*': begin // this is /* comment - replace by ' ' but keep CRLF
+     result[-1] := ' ';
+     repeat
+       if not(result^ in [#10, #13]) then
+         result^ := ' '; // keep CRLF for correct line numbering (e.g. for error)
+       inc(result);
+       if PWord(result)^=ord('*')+ord('/')shl 8 then begin
+         PWord(result)^ := $2020;
+         inc(result,2);
+         break;
+       end;
+     until result^=#0;
+   end;
+  end;
+end;
+
 procedure RemoveCommentsFromJSON(P: PUTF8Char);
 var PComma: PUTF8Char;
 begin // replace comments by ' ' characters which will be ignored by parser
@@ -57851,40 +57895,18 @@ procedure RemoveCommentsFromJSON(P: PUTF8Char);
       '"': begin
         P := GotoEndOfJSONString(P);
         if P^<>'"' then
-          exit;
-        inc(P);
-      end;
-      '/': begin
-         inc(P);
-         case P^ of
-           '/': begin // this is // comment - replace by ' '
-             dec(P);
-             repeat
-               P^ := ' ';
-               inc(P)
-             until P^ in [#0,#10,#13];
-             if P^<>#0 then Inc(P);
-           end;
-           '*': begin // this is /* comment - replace by ' ' but keep CRLF
-             P[-1] := ' ';
-             repeat
-               if not(P^ in [#10, #13]) then
-                 P^ := ' '; // keep CRLF for correct line numbering (e.g. for error)
-               inc(P);
-               if PWord(P)^=ord('*')+ord('/')shl 8 then begin
-                 PWord(P)^ := $2020;
-                 inc(P,2);
-                 break;
-               end;
-             until P^=#0;
-           end;
-         end;
+          exit else
+          Inc(P);
       end;
+      '/': P := TryRemoveComment(P);
       ',': begin // replace trailing comma by space for strict JSON parsers
         PComma := P;
         repeat inc(P) until (P^>' ') or (P^=#0);
-        if P^ in ['}',']'] then
-          PComma^ := ' ';
+        if P^='/' then
+          P := TryRemoveComment(P);
+        while (P^<=' ') and (P^<>#0) do inc(P);
+        if P^ in ['}', ']'] then
+          PComma^ := ' '; // see https://github.com/synopse/mORMot/pull/349
       end;
     else
       inc(P);
@@ -59032,6 +59054,11 @@ destructor TLockedDocVariant.Destroy;
   fLock.Free;
 end;
 
+function TLockedDocVariant.Lock: TAutoLocker;
+begin
+  result := fLock;
+end;
+
 function TLockedDocVariant.Exists(const Name: RawUTF8; out Value: Variant): boolean;
 var i: integer;
 begin

diff --git a/SynCrypto.pas b/SynCrypto.pas
@@ -8,7 +8,7 @@
 (*
     This file is part of Synopse framework.
 
-    Synopse framework. Copyright (C) 2020 Arnaud Bouchez
+    Synopse framework. Copyright (C) 2021 Arnaud Bouchez
       Synopse Informatique - https://synopse.info
 
   *** BEGIN LICENSE BLOCK *****
@@ -27,7 +27,7 @@
 
   The Initial Developer of the Original Code is Arnaud Bouchez.
 
-  Portions created by the Initial Developer are Copyright (C) 2020
+  Portions created by the Initial Developer are Copyright (C) 2021
   the Initial Developer. All Rights Reserved.
 
   Contributor(s):

diff --git a/SynFPCTypInfo.pas b/SynFPCTypInfo.pas
@@ -6,7 +6,7 @@
 {
     This file is part of Synopse mORMot framework.
 
-    Synopse mORMot framework. Copyright (C) 2020 Arnaud Bouchez
+    Synopse mORMot framework. Copyright (C) 2021 Arnaud Bouchez
       Synopse Informatique - https://synopse.info
 
   *** BEGIN LICENSE BLOCK *****
@@ -25,7 +25,7 @@
 
   The Initial Developer of the Original Code is Alfred Glaenzer.
 
-  Portions created by the Initial Developer are Copyright (C) 2020
+  Portions created by the Initial Developer are Copyright (C) 2021
   the Initial Developer. All Rights Reserved.
 
   Contributor(s):

diff --git a/SynGdiPlus.pas b/SynGdiPlus.pas
@@ -9,7 +9,7 @@
 {
     This file is part of Synopse framework.
 
-    Synopse framework. Copyright (C) 2020 Arnaud Bouchez
+    Synopse framework. Copyright (C) 2021 Arnaud Bouchez
       Synopse Informatique - https://synopse.info
 
   *** BEGIN LICENSE BLOCK *****
@@ -28,7 +28,7 @@
 
   The Initial Developer of the Original Code is Arnaud Bouchez.
 
-  Portions created by the Initial Developer are Copyright (C) 2020
+  Portions created by the Initial Developer are Copyright (C) 2021
   the Initial Developer. All Rights Reserved.
 
   Contributor(s):

diff --git a/SynLZ.pas b/SynLZ.pas
@@ -5,7 +5,7 @@
 {
     This file is part of Synopse SynLZ Compression.
 
-    Synopse SynLZ Compression. Copyright (C) 2020 Arnaud Bouchez
+    Synopse SynLZ Compression. Copyright (C) 2021 Arnaud Bouchez
       Synopse Informatique - https://synopse.info
 
   *** BEGIN LICENSE BLOCK *****
@@ -24,7 +24,7 @@
 
   The Initial Developer of the Original Code is Arnaud Bouchez.
 
-  Portions created by the Initial Developer are Copyright (C) 2020
+  Portions created by the Initial Developer are Copyright (C) 2021
   the Initial Developer. All Rights Reserved.
 
   Contributor(s):

diff --git a/SynPdf.pas b/SynPdf.pas
@@ -6,7 +6,7 @@
 {
     This file is part of Synopse framework.
 
-    Synopse framework. Copyright (C) 2020 Arnaud Bouchez
+    Synopse framework. Copyright (C) 2021 Arnaud Bouchez
       Synopse Informatique - https://synopse.info
 
   *** BEGIN LICENSE BLOCK *****
@@ -25,7 +25,7 @@
 
   The Initial Developer of the Original Code is Arnaud Bouchez.
 
-  Portions created by the Initial Developer are Copyright (C) 2020
+  Portions created by the Initial Developer are Copyright (C) 2021
   the Initial Developer. All Rights Reserved.
 
   Contributor(s):
@@ -2946,11 +2946,11 @@ implementation
 
 const
   // those constants are not defined in earlier Delphi revisions
-  cPI: Single = 3.141592654;
-  cPIdiv180: Single = 0.017453292;
-  c180divPI: Single = 57.29577951;
-  c2PI: Single = 6.283185307;
-  cPIdiv2: Single = 1.570796326;
+  cPI: single = 3.141592654;
+  cPIdiv180: single = 0.017453292;
+  c180divPI: single = 57.29577951;
+  c2PI: double = 6.283185307;
+  cPIdiv2: double = 1.570796326;
 
 function RGBA(r, g, b, a: cardinal): COLORREF; {$ifdef HASINLINE}inline;{$endif}
 begin
@@ -10986,12 +10986,14 @@ procedure TPdfEncryptionRC4MD5.EncodeBuffer(const BufIn; var BufOut; Count: card
     fLastObjectNumber := fDoc.fCurrentObjectNumber;
     fLastGenerationNumber := fDoc.fCurrentGenerationNumber;
   end;
+var work: TRC4; // Encrypt() changes the RC4 state -> local copy for reuse
 begin
   if (fDoc.fCurrentObjectNumber<>fLastObjectNumber) or
      (fDoc.fCurrentGenerationNumber<>fLastGenerationNumber) then
     // a lot of string encodings have the same context
     ComputeNewRC4Key;
-  fLastRC4Key.Encrypt(BufIn,BufOut,Count); // RC4 allows in-place encryption :)
+  work := fLastRC4Key;
+  work.Encrypt(BufIn,BufOut,Count); // RC4 allows in-place encryption :)
 end;
 
 {$endif USE_PDFSECURITY}

diff --git a/SynTable.pas b/SynTable.pas
@@ -6,7 +6,7 @@
 (*
     This file is part of Synopse framework.
 
-    Synopse framework. Copyright (C) 2020 Arnaud Bouchez
+    Synopse framework. Copyright (C) 2021 Arnaud Bouchez
       Synopse Informatique - https://synopse.info
 
   *** BEGIN LICENSE BLOCK *****
@@ -25,7 +25,7 @@
 
   The Initial Developer of the Original Code is Arnaud Bouchez.
 
-  Portions created by the Initial Developer are Copyright (C) 2020
+  Portions created by the Initial Developer are Copyright (C) 2021
   the Initial Developer. All Rights Reserved.
 
   Contributor(s):
@@ -7708,7 +7708,7 @@ function GetWhereExpression(FieldIndex: integer; var Where: TSynTableStatementWh
         end else
         exit; // incorrect SQL statement
       end else
-      if Prop<>'' then
+      if (Prop<>'') or not(GotoNextNotSpace(P)^ in [#0, ';']) then
         exit else // incorrect SQL statement
         break; // reached the end of the statement
     end;