per context project entry cache

Delphi/apache/xxmAhttpdContext.pas

@@ -18,6 +18,7 @@   TxxmAhttpdContext=class(TXxmGeneralContext
     FCookieParsed: boolean;
     FCookie: AnsiString;
     FCookieIdx: TParamIndexes;
+    FProjectCache: TXxmProjectCacheLocal;
   protected
     function GetSessionID:WideString; override;
     procedure DispositionAttach(const FileName: WideString); override;
@@ -58,12 +59,14 @@ implementation
 procedure TxxmAhttpdContext.AfterConstruction;
 begin
   SendDirect:=SendData;
+  FProjectCache:=TXxmProjectCacheLocal.Create;
   inherited;
 end;
 
 destructor TxxmAhttpdContext.Destroy;
 begin
   rq:=nil;
+  FProjectCache.Free;
   inherited;
 end;
 
@@ -142,7 +145,7 @@ procedure TxxmAhttpdContext.HandleRequest;
 
 function TxxmAhttpdContext.GetProjectEntry: TXxmProjectEntry;
 begin
-  Result:=XxmProjectCache.GetProject(FProjectName);
+  Result:=FProjectCache.GetProject(FProjectName);
 end;
 
 function TxxmAhttpdContext.Connected: boolean;

Delphi/cgi/xxmHostMain.pas

@@ -30,6 +30,7 @@   TXxmHostedContext=class(TXxmQueueContext,
     FCGIValuesSize,FCGIValuesCount:integer;
     FReqHeaders:TRequestHeaders;
     FResHeaders:TResponseHeaders;
+    FProjectCache:TXxmProjectCacheLocal;
     FConnected:boolean;
     FURI,FRedirectPrefix,FSessionID:WideString;
     FCookieParsed: boolean;
@@ -128,6 +129,7 @@ procedure TXxmHostedContext.AfterConstruction;
   SendDirect:=SendData;
   FReqHeaders:=TRequestHeaders.Create;
   FResHeaders:=TResponseHeaders.Create;
+  FProjectCache:=TXxmProjectCacheLocal.Create;
   FCGIValuesSize:=0;
   inherited;
 end;
@@ -136,6 +138,7 @@ destructor TXxmHostedContext.Destroy;
 begin
   FReqHeaders.Free;
   FResHeaders.Free;
+  FProjectCache.Free;
   SetLength(FCGIValues,0);
   inherited;
 end;
@@ -283,7 +286,7 @@ procedure TXxmHostedContext.HandleRequest;
 
 function TXxmHostedContext.GetProjectEntry: TXxmProjectEntry;
 begin
-  Result:=XxmProjectCache.GetProject(FProjectName);
+  Result:=FProjectCache.GetProject(FProjectName);
 end;
 
 function TXxmHostedContext.Connected: boolean;

Delphi/changelog.txt

@@ -2,6 +2,7 @@ v1.2.7.?
 - Negotiate: like NTLM but less in danger of getting removed in Windows 11...
 - NTLM/Negotiate: cache by SessionID to avoid 401's on every request
 - parse ?x&y=1 as 'x'='','y'='1' in query string and form data (was 'x&y'='1' previously)
+- per context project entry cache (avoids project registry lock on each request)
 
 v1.2.6.466
 - issue converting IPv6 address to string

Delphi/common/xxmPRegJson.pas

@@ -4,6 +4,9 @@ interface
 
 uses Windows, SysUtils, xxm, xxmPReg, jsonDoc;
 
+const
+  XxmProjectCacheLocalSize=4;
+
 type
   TXxmProjectCacheEntry=class(TXxmProjectEntry)
   private
@@ -29,7 +32,7 @@   TXxmProjectCacheJson=class(TXxmProjectCache)
       SortIndex:integer;
     end;
     FRegFilePath,FRegSignature,FDefaultProject,FSingleProject:string;
-    FRegLastCheckTC:cardinal;
+    FRegLastCheckTC,FCacheIndex:cardinal;
     FFavIcon:OleVariant;
     FAuthCache:array of record
       SessionID:string;
@@ -54,6 +57,22 @@   TXxmProjectCacheJson=class(TXxmProjectCache)
 
     function GetAuthCache(const SessionID:string):AnsiString;
     procedure SetAuthCache(const SessionID:string;const AuthName:AnsiString);
+
+    property CacheIndex:cardinal read FCacheIndex;
+  end;
+
+  TXxmProjectCacheLocal=class(TObject)
+  private
+    FLocalCache:array[0..XxmProjectCacheLocalSize-1] of record
+      CacheIndex:cardinal;
+      Name:WideString;
+      Entry:TXxmProjectCacheEntry;
+    end;
+    FLocalCacheIndex1,FLocalCacheIndex2:integer;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    function GetProject(const Name:WideString):TXxmProjectCacheEntry;
   end;
 
   EXxmProjectRegistryError=class(Exception);
@@ -150,6 +169,7 @@ constructor TXxmProjectCacheJson.Create;
   FRegLastCheckTC:=GetTickCount-XxmRegCheckIntervalMS-1;
   FAuthCacheIndex:=0;
   FAuthCacheSize:=0;
+  FCacheIndex:=FRegLastCheckTC;//random?
 
   SetLength(FRegFilePath,MAX_PATH);
   SetLength(FRegFilePath,GetModuleFileName(HInstance,
@@ -452,7 +472,10 @@ procedure TXxmProjectCacheJson.CheckRegistry;
               FProjects[i].Entry.FNegotiate:=VarToBool(d1['negotiate']);
              end
             else
+             begin
               FreeAndNil(FProjects[i].Entry);
+              inc(FCacheIndex);
+             end;
            end;
           //clean-up items removed from XML
           for i:=0 to FProjectsCount-1 do
@@ -461,6 +484,7 @@ procedure TXxmProjectCacheJson.CheckRegistry;
               FProjects[i].Name:='';
               FProjects[i].Alias:='';
               FreeAndNil(FProjects[i].Entry);
+              inc(FCacheIndex);
              end;
           if FSingleProject<>'' then
             LoadFavIcon(FSingleProject+'.ico');
@@ -681,6 +705,64 @@ procedure TXxmProjectCacheJson.SetAuthCache(const SessionID: string;
    end;
 end;
 
+{ TXxmProjectCacheLocal }
+
+constructor TXxmProjectCacheLocal.Create;
+var
+  i:integer;
+begin
+  inherited Create;
+  FLocalCacheIndex1:=0;
+  FLocalCacheIndex2:=0;
+  for i:=0 to XxmProjectCacheLocalSize-1 do
+   begin
+    FLocalCache[i].CacheIndex:=0;//random?
+    FLocalCache[i].Name:='';
+    FLocalCache[i].Entry:=nil;
+   end;
+end;
+
+destructor TXxmProjectCacheLocal.Destroy;
+var
+  i:integer;
+begin
+  for i:=0 to XxmProjectCacheLocalSize-1 do
+   begin
+    FLocalCache[i].CacheIndex:=0;
+    FLocalCache[i].Name:='';
+    FLocalCache[i].Entry:=nil;//not FreeAndNil, see TXxmProjectCacheJson
+   end;
+  inherited;
+end;
+
+function TXxmProjectCacheLocal.GetProject(
+  const Name: WideString): TXxmProjectCacheEntry;
+var
+  i:integer;
+begin
+  //assert Name<>''
+  i:=0;
+  while (i<FLocalCacheIndex1) and not(
+    (FLocalCache[i].CacheIndex=XxmProjectCache.CacheIndex) and
+    (FLocalCache[i].Name=Name)) do inc(i);
+  if i=FLocalCacheIndex1 then
+   begin
+    Result:=XxmProjectCache.GetProject(Name);
+    if Result<>nil then
+     begin
+      i:=FLocalCacheIndex2;
+      FLocalCache[i].CacheIndex:=XxmProjectCache.CacheIndex;
+      FLocalCache[i].Name:=Name;
+      FLocalCache[i].Entry:=Result;
+      inc(FLocalCacheIndex2);
+      if FLocalCacheIndex2=XxmProjectCacheLocalSize then FLocalCacheIndex2:=0;
+      if FLocalCacheIndex1<>XxmProjectCacheLocalSize then inc(FLocalCacheIndex1);
+     end;
+   end
+  else
+    Result:=FLocalCache[i].Entry;
+end;
+
 initialization
   //XxmProjectCache:=TXxmProjectCacheXml.Create;//moved to project source
 finalization

Delphi/hsys/xxmHSysMain.pas

@@ -44,6 +44,7 @@   TXxmHSysContext=class(TXxmQueueContext,
     FCookieIdx: TParamIndexes;
     FQueryStringIndex:integer;
     FReqHeaders:TRequestHeaders;
+    FProjectCache:TXxmProjectCacheLocal;
     procedure SetResponseHeader(id:THTTP_HEADER_ID;const Value:AnsiString);
     procedure CacheString(const x: AnsiString; var xLen: USHORT; var xPtr: PCSTR);
     function GetResponseHeaderCount:integer;
@@ -165,11 +166,13 @@ procedure TXxmHSysContext.AfterConstruction;
   inherited;
   SendDirect:=SendData;
   FReqHeaders:=nil;//TRequestHeaders.Create;//see GetRequestHeaders
+  FProjectCache:=TXxmProjectCacheLocal.Create;
 end;
 
 destructor TXxmHSysContext.Destroy;
 begin
   FreeAndNil(FReqHeaders);
+  FreeAndNil(FProjectCache);
   inherited;
 end;
 
@@ -358,7 +361,7 @@ function TXxmHSysContext.GetProjectPage(const FragmentName: WideString):IXxmFrag
 
 function TXxmHSysContext.GetProjectEntry: TXxmProjectEntry;
 begin
-  Result:=XxmProjectCache.GetProject(FProjectName);
+  Result:=FProjectCache.GetProject(FProjectName);
 end;
 
 function TXxmHSysContext.Connected: boolean;

Delphi/http/xxmHttpCtx.pas

@@ -17,6 +17,7 @@   TXxmHttpContext=class(TXxmQueueContext,
     FResHeaders: TResponseHeaders;
     FHTTPVersion,FVerb,FURI: AnsiString;
     FRedirectPrefix,FSessionID: WideString;
+    FProjectCache: TXxmProjectCacheLocal;
     FCookieParsed, FAuthStoreCache: boolean;
     FCookie: AnsiString;
     FCookieIdx: TParamIndexes;
@@ -107,6 +108,7 @@ procedure TXxmHttpContext.AfterConstruction;
   SendDirect:=nil;
   FReqHeaders:=TRequestHeaders.Create;
   FResHeaders:=TResponseHeaders.Create;
+  FProjectCache:=TXxmProjectCacheLocal.Create;
   inherited;
 end;
 
@@ -116,6 +118,7 @@ destructor TXxmHttpContext.Destroy;
   FreeAndNil(FSocket);
   FReqHeaders.Free;
   FResHeaders.Free;
+  FProjectCache.Free;
   inherited;
 end;
 
@@ -385,7 +388,7 @@ procedure TXxmHttpContext.HandleRequest;
 
 function TXxmHttpContext.GetProjectEntry:TXxmProjectEntry;
 begin
-  Result:=XxmProjectCache.GetProject(FProjectName);
+  Result:=FProjectCache.GetProject(FProjectName);
 end;
 
 procedure TXxmHttpContext.AuthSChannel(const Package:AnsiString);

Delphi/isapi/xxmIsapiMain.pas

@@ -20,6 +20,7 @@   TXxmIsapiContext=class(TXxmQueueContext,
     FURI, FRedirectPrefix, FSessionID: WideString;
     FReqHeaders: TRequestHeaders;
     FResHeaders: TResponseHeaders;
+    FProjectCache: TXxmProjectCacheLocal;
     FCookieParsed: boolean;
     FCookie: AnsiString;
     FCookieIdx: TParamIndexes;
@@ -208,13 +209,15 @@ procedure TXxmIsapiContext.AfterConstruction;
 begin
   FReqHeaders:=TRequestHeaders.Create;
   FResHeaders:=TResponseHeaders.Create;
+  FProjectCache:=TXxmProjectCacheLocal.Create;
   inherited;
 end;
 
 destructor TXxmIsapiContext.Destroy;
 begin
   FReqHeaders.Free;
   FResHeaders.Free;
+  FProjectCache.Free;
   inherited;
 end;
 
@@ -328,7 +331,7 @@ procedure TXxmIsapiContext.Recycle;
 
 function TXxmIsapiContext.GetProjectEntry:TXxmProjectEntry;
 begin
-  Result:=XxmProjectCache.GetProject(FProjectName);
+  Result:=FProjectCache.GetProject(FProjectName);
 end;
 
 function TXxmIsapiContext.GetProjectPage(const FragmentName: WideString):IXxmFragment;

Delphi/scgi/xxmSCGIMain.pas

@@ -26,6 +26,7 @@   TXxmSCGIContext=class(TXxmQueueContext,
     FSocket:TTcpSocket;
     FReqHeaders:TRequestHeaders;
     FResHeaders:TResponseHeaders;
+    FProjectCache:TXxmProjectCacheLocal;
     FCGIValues:array of record
       Name,Value:AnsiString;
     end;
@@ -225,6 +226,7 @@ procedure TXxmSCGIContext.AfterConstruction;
   FCGIValuesCount:=0;
   FReqHeaders:=TRequestHeaders.Create;
   FResHeaders:=TResponseHeaders.Create;
+  FProjectCache:=TXxmProjectCacheLocal.Create;
   FSocket:=nil;
 end;
 
@@ -235,6 +237,7 @@ destructor TXxmSCGIContext.Destroy;
   SetLength(FCGIValues,0);
   FReqHeaders.Free;
   FResHeaders.Free;
+  FProjectCache.Free;
   inherited;
 end;
 
@@ -515,7 +518,7 @@ procedure TXxmSCGIContext.HandleRequest;
 
 function TXxmSCGIContext.GetProjectEntry:TXxmProjectEntry;
 begin
-  Result:=XxmProjectCache.GetProject(FProjectName);
+  Result:=FProjectCache.GetProject(FProjectName);
 end;
 
 function TXxmSCGIContext.GetProjectPage(const FragmentName: WideString):IXxmFragment;

Delphi/synapse/xxmSynaMain.pas

@@ -31,6 +31,7 @@   TXxmSynaContext=class(TXxmQueueContext,
     FResHeaders:TResponseHeaders;
     FHTTPVersion,FVerb:AnsiString;
     FURI,FRedirectPrefix,FSessionID:WideString;
+    FProjectCache:TXxmProjectCacheLocal;
     FCookieParsed: boolean;
     FCookie: AnsiString;
     FCookieIdx: TParamIndexes;
@@ -268,6 +269,7 @@ procedure TXxmSynaContext.AfterConstruction;
   SendDirect:=SendData;
   FReqHeaders:=TRequestHeaders.Create;
   FResHeaders:=TResponseHeaders.Create;
+  FProjectCache:=TXxmProjectCacheLocal.Create;
   inherited;
 end;
 
@@ -278,6 +280,7 @@ destructor TXxmSynaContext.Destroy;
   FSocket.Free;
   FReqHeaders.Free;
   FResHeaders.Free;
+  FProjectCache.Free;
   inherited;
 end;
 
@@ -510,7 +513,7 @@ procedure TXxmSynaContext.HandleRequest;
 
 function TXxmSynaContext.GetProjectEntry:TXxmProjectEntry;
 begin
-  Result:=XxmProjectCache.GetProject(FProjectName);
+  Result:=FProjectCache.GetProject(FProjectName);
 end;
 
 function TXxmSynaContext.GetProjectPage(const FragmentName: WideString):IXxmFragment;