diff --git a/default.tpl b/default.tpl index 4bf8bf1..eee8432 100644 --- a/default.tpl +++ b/default.tpl @@ -39,7 +39,7 @@ COMMENT with the ones above you can disable some features of the template. They
-

WARNING: this template is only to be used with HFS 2.3 (and macros enabled)

+

WARNING: this template is only to be used with HFS 2.4 (and macros enabled)

{.$menu panel.} {.$folder panel.} {.$list panel.} diff --git a/hslib.pas b/hslib.pas index 8fc08d8..8a52521 100644 --- a/hslib.pas +++ b/hslib.pas @@ -19,6 +19,7 @@ Copyright (C) 2002-2014 Massimo Melina (www.rejetto.com) HTTP Server Lib ==== TO DO +* https * upload bandwidth control (can it be done without multi-threading?) } @@ -292,7 +293,7 @@ const 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 @@ const '', '405 - Method not allowed', '302 - Redirection to %url%', - '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 %url%', '' // RFC2616: The 304 response MUST NOT contain a message-body @@ -875,7 +876,6 @@ end; // timerEvent 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 index 06d0e19..4183009 100644 --- a/main.pas +++ b/main.pas @@ -36,7 +36,7 @@ uses 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 @@ end; // shouldRecur 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,6 +3605,39 @@ var fast.append(s); end; // handleItem +const ip2availability: Tdictionary = NIL; +const folderConcurrents: integer = 0; + + procedure updateAvailability(); + var + pair: Tpair; + 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.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; @@ -3613,6 +3645,12 @@ 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 @@ try result:=replaceText(result, '%build-time%', floatToStrF((now()-buildTime)*SECONDS, ffFixed, 7,3) ); finally + updateAvailability(); folder.unlock(); diffTpl.free; end; @@ -5184,7 +5223,8 @@ var 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 @@ var 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 @@ var 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 @@ var 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 index 23030bc..adf0e03 100644 --- 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 @@ begin 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 @@ while idx+l < length(a) do 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);