fix: possible DoS, as reported by John Page (aka hyp3rlinx) Apparitio…

…nSec (CVE-2020-13432)
rejetto · Jun 7, 2020 · a3056cc · a3056cc
1 parent 16744d7
commit a3056cc
Show file tree

Hide file tree

Showing 4 changed files with 85 additions and 21 deletions.
diff --git a/default.tpl b/default.tpl
@@ -39,7 +39,7 @@ COMMENT with the ones above you can disable some features of the template. They
 </head>
 <body>
  <div id="wrapper">
- <!--{.comment|--><h1 style='margin-bottom:100em'>WARNING: this template is only to be used with HFS 2.3 (and macros enabled)</h1> <!--.} -->
+ <!--{.comment|--><h1 style='margin-bottom:100em'>WARNING: this template is only to be used with HFS 2.4 (and macros enabled)</h1> <!--.} -->
  {.$menu panel.}
  {.$folder panel.}
  {.$list panel.}

diff --git a/hslib.pas b/hslib.pas
@@ -19,6 +19,7 @@
 HTTP Server Lib
 
 ==== TO DO
+* https
 * upload bandwidth control (can it be done without multi-threading?)
 
 }
@@ -292,7 +293,7 @@ ThttpSrv = class
  MINIMUM_CHUNK_SIZE = 2*1024;
  MAXIMUM_CHUNK_SIZE = 1024*1024;
  HRM2CODE: array [ThttpReplyMode] of integer = (200, 200, 403, 401, 404, 400,
- 500, 0, 0, 405, 302, 503, 413, 301, 304 );
+ 500, 0, 0, 405, 302, 429, 413, 301, 304 );
  METHOD2STR: array [ThttpMethod] of ansistring = ('UNK','GET','POST','HEAD');
  HRM2STR: array [ThttpReplyMode] of ansistring = ('Head+Body', 'Head only', 'Deny',
  'Unauthorized', 'Not found', 'Bad request', 'Internal error', 'Close',
@@ -352,7 +353,7 @@ implementation
  '',
  '405 - Method not allowed',
  '<html><head><meta http-equiv="refresh" content="url=%url%" /></head><body onload=''window.location="%url%"''>302 - <a href="%url%">Redirection to %url%</a></body></html>',
- '503 - Server is overloaded, retry later',
+ '429 - Server is overloaded, retry later',
  '413 - The request has exceeded the max length allowed',
  '301 - Moved permanently to <a href="%url%">%url%</a>',
  '' // RFC2616: The 304 response MUST NOT contain a message-body
@@ -875,7 +876,6 @@ procedure ThttpSrv.timerEvent(sender:Tobject);
 procedure ThttpSrv.notify(ev:ThttpEvent; conn:ThttpConn);
 begin
 if not assigned(onEvent) then exit;
-//if assigned(sock) then sock.pause();
 if assigned(conn) then
  begin
  inc(conn.lockCount);

diff --git a/main.pas b/main.pas
@@ -36,7 +36,7 @@ interface
  HSlib, traylib, monoLib, progFrmLib, classesLib;
 
 const
- VERSION = '2.4.0 beta10';
+ VERSION = '2.4.0 RC1';
  VERSION_BUILD = '312';
  VERSION_STABLE = {$IFDEF STABLE } TRUE {$ELSE} FALSE {$ENDIF};
  CURRENT_VFS_FORMAT :integer = 1;
@@ -3458,7 +3458,6 @@ function shouldRecur(data:TconnData):boolean;
 
 function Tmainfrm.getFolderPage(folder:Tfile; cd:TconnData; otpl:Tobject):string;
 // we pass the Tpl parameter as Tobject because symbol Ttpl is not defined yet
-
 var
  baseurl, list, fileTpl, folderTpl, linkTpl: string;
  table: TStringDynArray;
@@ -3606,13 +3605,52 @@ function Tmainfrm.getFolderPage(folder:Tfile; cd:TconnData; otpl:Tobject):string
  fast.append(s);
  end; // handleItem
 
+const ip2availability: Tdictionary<string,Tdatetime> = NIL;
+const folderConcurrents: integer = 0;
+
+ procedure updateAvailability();
+ var
+ pair: Tpair<string,Tdatetime>;
+ t: Tdatetime;
+ begin
+ dec(folderConcurrents);
+ t:=now();
+ ip2availability[cd.address]:=t+1/SECONDS;
+ // purge leftovers
+ for pair in ip2availability do 
+ if pair.Value < t then
+ ip2availability.Remove(pair.Key);
+ end;
+
+ function available():boolean;
+ begin
+ if ip2availability = NIL then
+ ip2availability:=Tdictionary<string,Tdatetime>.create();
+ try 
+ if ip2availability[cd.address] > now() then // this specific address has to wait?
+ exit(FALSE);
+ except
+ end;
+ if folderConcurrents >= 3 then // max number of concurrent folder loading, others are postponed
+ exit(FALSE);
+ inc(folderConcurrents);
+ ip2availability.AddOrSetValue(cd.address, now()+1);
+ result:=TRUE;
+ end; // available
+
 var
  i, n: integer;
  f: Tfile;
 begin
 result:='';
 if (folder = NIL) or not folder.isFolder() then exit;
 
+if not available() then
+ begin
+ cd.conn.reply.mode:=HRM_OVERLOAD;
+ cd.conn.addHeader('Refresh: '+intToStr(1+random(2))); // random for less collisions
+ exit('Please wait, server busy');
+ end; 
 if macrosLogChk.checked and not appendmacroslog1.checked then
  resetLog();
 diffTpl:=Ttpl.create();
@@ -3735,6 +3773,7 @@ function Tmainfrm.getFolderPage(folder:Tfile; cd:TconnData; otpl:Tobject):string
  result:=replaceText(result, '%build-time%',
  floatToStrF((now()-buildTime)*SECONDS, ffFixed, 7,3) );
 finally
+ updateAvailability(); 
  folder.unlock();
  diffTpl.free;
  end;
@@ -5184,7 +5223,8 @@ procedure Tmainfrm.httpEvent(event:ThttpEvent; conn:ThttpConn);
 
  if conn.reply.contentType = '' then
  conn.reply.contentType:=ansistring(if_(trim(getTill('<', s))='', 'text/html', 'text/plain'))+'; charset=utf-8';
- conn.reply.mode:=HRM_REPLY;
+ if conn.reply.mode = HRM_IGNORE then 
+ conn.reply.mode:=HRM_REPLY;
  conn.reply.bodyMode:=RBM_STRING;
  conn.reply.body:=UTF8encode(s);
  compressReply(data);
@@ -5427,6 +5467,12 @@ procedure Tmainfrm.httpEvent(event:ThttpEvent; conn:ThttpConn);
  if conn.reply.mode = HRM_REDIRECT then
  exit;
 
+ lastActivityTime:=now();
+ if conn.request.method = HM_HEAD then
+ conn.reply.mode:=HRM_REPLY_HEADER
+ else
+ conn.reply.mode:=HRM_REPLY;
+
  if ansiStartsStr('/~img', url) then
  begin
  if not sendPic(data) then
@@ -5579,6 +5625,8 @@ procedure Tmainfrm.httpEvent(event:ThttpEvent; conn:ThttpConn);
  if ansiStartsStr('~files.lst', urlCmd)
  or f.isFolder() and (data.urlvars.values['tpl'] = 'list') then
  begin
+ if conn.reply.mode=HRM_REPLY_HEADER then
+ exit;
  // load from external file
  s:=cfgPath+FILELIST_TPL_FILE;
  if newMtime(s, lastFilelistTpl) then
@@ -5605,19 +5653,12 @@ procedure Tmainfrm.httpEvent(event:ThttpEvent; conn:ThttpConn);
  exit;
  end;
 
- case conn.request.method of
- HM_GET, HM_POST:
- begin
- conn.reply.mode:=HRM_REPLY;
- lastActivityTime:=now();
- end;
- HM_HEAD: conn.reply.mode:=HRM_REPLY_HEADER;
- end;
-
  data.lastFile:=f; // auto-freeing
 
  if f.isFolder() then
  begin
+ if conn.reply.mode=HRM_REPLY_HEADER then
+ exit;
  deletion();
  if sessionRedirect() then
  exit;

diff --git a/utillib.pas b/utillib.pas
@@ -166,7 +166,7 @@ function replaceString(var ss:TStringDynArray; old, new:string):integer;
 function popString(var ss:TstringDynArray):string;
 procedure insertString(s:string; idx:integer; var ss:TStringDynArray);
 function removeString(var a:TStringDynArray; idx:integer; l:integer=1):boolean; overload;
-function removeString(find:string; var a:TStringDynArray):boolean; overload;
+function removeString(s:string; var a:TStringDynArray; onlyOnce:boolean=TRUE; ci:boolean=TRUE; keepOrder:boolean=TRUE):boolean; overload;
 procedure removeStrings(find:string; var a:TStringDynArray);
 procedure toggleString(s:string; var ss:TStringDynArray);
 function onlyString(s:string; ss:TStringDynArray):boolean;
@@ -669,10 +669,6 @@ procedure removeStrings(find:string; var a:TStringDynArray);
  until false;
 end; // removeStrings
 
-// remove first instance of the specified string
-function removeString(find:string; var a:TStringDynArray):boolean;
-begin result:=removeString(a, idxOf(find,a)) end;
-
 function removeArray(var src:TstringDynArray; toRemove:array of string):integer;
 var
  i, l, ofs: integer;
@@ -746,6 +742,33 @@ function removestring(var a:TStringDynArray; idx:integer; l:integer=1):boolean;
 setLength(a, idx);
 end; // removestring
 
+function removeString(s:string; var a:TStringDynArray; onlyOnce:boolean=TRUE; ci:boolean=TRUE; keepOrder:boolean=TRUE):boolean; overload;
+var i, lessen:integer;
+begin
+result:=FALSE;
+lessen:=0;
+try
+ for i:=length(a)-1 to 0 do
+ if ci and sameText(a[i], s)
+ or not ci and (a[i]=s) then
+ begin
+ result:=TRUE;
+ if keepOrder then
+ removeString(a, i)
+ else
+ begin
+ inc(lessen);
+ a[i]:=a[length(a)-lessen];
+ end;
+ if onlyOnce then
+ exit;
+ end;
+finally
+ if lessen > 0 then
+ setLength(a, length(a)-lessen);
+ end;
+end;
+
 function dotted(i:int64):string;
 begin
 result:=intToStr(i);