Skip to content

Commit a3056cc

Browse files
rejettorejetto
committed
fix: possible DoS, as reported by John Page (aka hyp3rlinx) ApparitionSec (CVE-2020-13432)
1 parent 16744d7 commit a3056cc

File tree

4 files changed

+85
-21
lines changed

4 files changed

+85
-21
lines changed

‎default.tpl

+1-1
Original file line numberDiff line numberDiff line change
@@ -39,7 +39,7 @@ COMMENT with the ones above you can disable some features of the template. They
3939
</head>
4040
<body>
4141
<div id="wrapper">
42-
<!--{.comment|--><h1 style='margin-bottom:100em'>WARNING: this template is only to be used with HFS 2.3 (and macros enabled)</h1> <!--.} -->
42+
<!--{.comment|--><h1 style='margin-bottom:100em'>WARNING: this template is only to be used with HFS 2.4 (and macros enabled)</h1> <!--.} -->
4343
{.$menu panel.}
4444
{.$folder panel.}
4545
{.$list panel.}

‎hslib.pas

+3-3
Original file line numberDiff line numberDiff line change
@@ -19,6 +19,7 @@
1919
HTTP Server Lib
2020
2121
==== TO DO
22+
* https
2223
* upload bandwidth control (can it be done without multi-threading?)
2324
2425
}
@@ -292,7 +293,7 @@ ThttpSrv = class
292293
MINIMUM_CHUNK_SIZE = 2*1024;
293294
MAXIMUM_CHUNK_SIZE = 1024*1024;
294295
HRM2CODE: array [ThttpReplyMode] of integer = (200, 200, 403, 401, 404, 400,
295-
500, 0, 0, 405, 302, 503, 413, 301, 304 );
296+
500, 0, 0, 405, 302, 429, 413, 301, 304 );
296297
METHOD2STR: array [ThttpMethod] of ansistring = ('UNK','GET','POST','HEAD');
297298
HRM2STR: array [ThttpReplyMode] of ansistring = ('Head+Body', 'Head only', 'Deny',
298299
'Unauthorized', 'Not found', 'Bad request', 'Internal error', 'Close',
@@ -352,7 +353,7 @@ implementation
352353
'',
353354
'405 - Method not allowed',
354355
'<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>',
355-
'503 - Server is overloaded, retry later',
356+
'429 - Server is overloaded, retry later',
356357
'413 - The request has exceeded the max length allowed',
357358
'301 - Moved permanently to <a href="%url%">%url%</a>',
358359
'' // RFC2616: The 304 response MUST NOT contain a message-body
@@ -875,7 +876,6 @@ procedure ThttpSrv.timerEvent(sender:Tobject);
875876
procedure ThttpSrv.notify(ev:ThttpEvent; conn:ThttpConn);
876877
begin
877878
if not assigned(onEvent) then exit;
878-
//if assigned(sock) then sock.pause();
879879
if assigned(conn) then
880880
begin
881881
inc(conn.lockCount);

‎main.pas

+53-12
Original file line numberDiff line numberDiff line change
@@ -36,7 +36,7 @@ interface
3636
HSlib, traylib, monoLib, progFrmLib, classesLib;
3737

3838
const
39-
VERSION = '2.4.0 beta10';
39+
VERSION = '2.4.0 RC1';
4040
VERSION_BUILD = '312';
4141
VERSION_STABLE = {$IFDEF STABLE } TRUE {$ELSE} FALSE {$ENDIF};
4242
CURRENT_VFS_FORMAT :integer = 1;
@@ -3458,7 +3458,6 @@ function shouldRecur(data:TconnData):boolean;
34583458

34593459
function Tmainfrm.getFolderPage(folder:Tfile; cd:TconnData; otpl:Tobject):string;
34603460
// we pass the Tpl parameter as Tobject because symbol Ttpl is not defined yet
3461-
34623461
var
34633462
baseurl, list, fileTpl, folderTpl, linkTpl: string;
34643463
table: TStringDynArray;
@@ -3606,13 +3605,52 @@ function Tmainfrm.getFolderPage(folder:Tfile; cd:TconnData; otpl:Tobject):string
36063605
fast.append(s);
36073606
end; // handleItem
36083607

3608+
const ip2availability: Tdictionary<string,Tdatetime> = NIL;
3609+
const folderConcurrents: integer = 0;
3610+
3611+
procedure updateAvailability();
3612+
var
3613+
pair: Tpair<string,Tdatetime>;
3614+
t: Tdatetime;
3615+
begin
3616+
dec(folderConcurrents);
3617+
t:=now();
3618+
ip2availability[cd.address]:=t+1/SECONDS;
3619+
// purge leftovers
3620+
for pair in ip2availability do
3621+
if pair.Value < t then
3622+
ip2availability.Remove(pair.Key);
3623+
end;
3624+
3625+
function available():boolean;
3626+
begin
3627+
if ip2availability = NIL then
3628+
ip2availability:=Tdictionary<string,Tdatetime>.create();
3629+
try
3630+
if ip2availability[cd.address] > now() then // this specific address has to wait?
3631+
exit(FALSE);
3632+
except
3633+
end;
3634+
if folderConcurrents >= 3 then // max number of concurrent folder loading, others are postponed
3635+
exit(FALSE);
3636+
inc(folderConcurrents);
3637+
ip2availability.AddOrSetValue(cd.address, now()+1);
3638+
result:=TRUE;
3639+
end; // available
3640+
36093641
var
36103642
i, n: integer;
36113643
f: Tfile;
36123644
begin
36133645
result:='';
36143646
if (folder = NIL) or not folder.isFolder() then exit;
36153647

3648+
if not available() then
3649+
begin
3650+
cd.conn.reply.mode:=HRM_OVERLOAD;
3651+
cd.conn.addHeader('Refresh: '+intToStr(1+random(2))); // random for less collisions
3652+
exit('Please wait, server busy');
3653+
end;
36163654
if macrosLogChk.checked and not appendmacroslog1.checked then
36173655
resetLog();
36183656
diffTpl:=Ttpl.create();
@@ -3735,6 +3773,7 @@ function Tmainfrm.getFolderPage(folder:Tfile; cd:TconnData; otpl:Tobject):string
37353773
result:=replaceText(result, '%build-time%',
37363774
floatToStrF((now()-buildTime)*SECONDS, ffFixed, 7,3) );
37373775
finally
3776+
updateAvailability();
37383777
folder.unlock();
37393778
diffTpl.free;
37403779
end;
@@ -5184,7 +5223,8 @@ procedure Tmainfrm.httpEvent(event:ThttpEvent; conn:ThttpConn);
51845223

51855224
if conn.reply.contentType = '' then
51865225
conn.reply.contentType:=ansistring(if_(trim(getTill('<', s))='', 'text/html', 'text/plain'))+'; charset=utf-8';
5187-
conn.reply.mode:=HRM_REPLY;
5226+
if conn.reply.mode = HRM_IGNORE then
5227+
conn.reply.mode:=HRM_REPLY;
51885228
conn.reply.bodyMode:=RBM_STRING;
51895229
conn.reply.body:=UTF8encode(s);
51905230
compressReply(data);
@@ -5427,6 +5467,12 @@ procedure Tmainfrm.httpEvent(event:ThttpEvent; conn:ThttpConn);
54275467
if conn.reply.mode = HRM_REDIRECT then
54285468
exit;
54295469

5470+
lastActivityTime:=now();
5471+
if conn.request.method = HM_HEAD then
5472+
conn.reply.mode:=HRM_REPLY_HEADER
5473+
else
5474+
conn.reply.mode:=HRM_REPLY;
5475+
54305476
if ansiStartsStr('/~img', url) then
54315477
begin
54325478
if not sendPic(data) then
@@ -5579,6 +5625,8 @@ procedure Tmainfrm.httpEvent(event:ThttpEvent; conn:ThttpConn);
55795625
if ansiStartsStr('~files.lst', urlCmd)
55805626
or f.isFolder() and (data.urlvars.values['tpl'] = 'list') then
55815627
begin
5628+
if conn.reply.mode=HRM_REPLY_HEADER then
5629+
exit;
55825630
// load from external file
55835631
s:=cfgPath+FILELIST_TPL_FILE;
55845632
if newMtime(s, lastFilelistTpl) then
@@ -5605,19 +5653,12 @@ procedure Tmainfrm.httpEvent(event:ThttpEvent; conn:ThttpConn);
56055653
exit;
56065654
end;
56075655

5608-
case conn.request.method of
5609-
HM_GET, HM_POST:
5610-
begin
5611-
conn.reply.mode:=HRM_REPLY;
5612-
lastActivityTime:=now();
5613-
end;
5614-
HM_HEAD: conn.reply.mode:=HRM_REPLY_HEADER;
5615-
end;
5616-
56175656
data.lastFile:=f; // auto-freeing
56185657

56195658
if f.isFolder() then
56205659
begin
5660+
if conn.reply.mode=HRM_REPLY_HEADER then
5661+
exit;
56215662
deletion();
56225663
if sessionRedirect() then
56235664
exit;

‎utillib.pas

+28-5
Original file line numberDiff line numberDiff line change
@@ -166,7 +166,7 @@ function replaceString(var ss:TStringDynArray; old, new:string):integer;
166166
function popString(var ss:TstringDynArray):string;
167167
procedure insertString(s:string; idx:integer; var ss:TStringDynArray);
168168
function removeString(var a:TStringDynArray; idx:integer; l:integer=1):boolean; overload;
169-
function removeString(find:string; var a:TStringDynArray):boolean; overload;
169+
function removeString(s:string; var a:TStringDynArray; onlyOnce:boolean=TRUE; ci:boolean=TRUE; keepOrder:boolean=TRUE):boolean; overload;
170170
procedure removeStrings(find:string; var a:TStringDynArray);
171171
procedure toggleString(s:string; var ss:TStringDynArray);
172172
function onlyString(s:string; ss:TStringDynArray):boolean;
@@ -669,10 +669,6 @@ procedure removeStrings(find:string; var a:TStringDynArray);
669669
until false;
670670
end; // removeStrings
671671

672-
// remove first instance of the specified string
673-
function removeString(find:string; var a:TStringDynArray):boolean;
674-
begin result:=removeString(a, idxOf(find,a)) end;
675-
676672
function removeArray(var src:TstringDynArray; toRemove:array of string):integer;
677673
var
678674
i, l, ofs: integer;
@@ -746,6 +742,33 @@ function removestring(var a:TStringDynArray; idx:integer; l:integer=1):boolean;
746742
setLength(a, idx);
747743
end; // removestring
748744

745+
function removeString(s:string; var a:TStringDynArray; onlyOnce:boolean=TRUE; ci:boolean=TRUE; keepOrder:boolean=TRUE):boolean; overload;
746+
var i, lessen:integer;
747+
begin
748+
result:=FALSE;
749+
lessen:=0;
750+
try
751+
for i:=length(a)-1 to 0 do
752+
if ci and sameText(a[i], s)
753+
or not ci and (a[i]=s) then
754+
begin
755+
result:=TRUE;
756+
if keepOrder then
757+
removeString(a, i)
758+
else
759+
begin
760+
inc(lessen);
761+
a[i]:=a[length(a)-lessen];
762+
end;
763+
if onlyOnce then
764+
exit;
765+
end;
766+
finally
767+
if lessen > 0 then
768+
setLength(a, length(a)-lessen);
769+
end;
770+
end;
771+
749772
function dotted(i:int64):string;
750773
begin
751774
result:=intToStr(i);

0 commit comments

Comments
 (0)