diff --git a/.gitignore b/.gitignore index 8bc2254..088b798 100644 --- a/.gitignore +++ b/.gitignore @@ -8,6 +8,7 @@ win32/ *.exe *.map *.tmp +*.dll *.bak *.*- *.corrupted diff --git a/classesLib.pas b/classesLib.pas index 159e29a..3b5e3ed 100644 --- a/classesLib.pas +++ b/classesLib.pas @@ -23,7 +23,8 @@ unit classesLib; interface uses - iniFiles, types, hslib, strUtils, sysUtils, classes, math, system.Generics.Collections; + iniFiles, types, hslib, strUtils, sysUtils, classes, math, system.Generics.Collections, + OverbyteIcsWSocket, OverbyteIcshttpProt; type TfastStringAppend = class @@ -189,6 +190,12 @@ type destructor Destroy; override; end; + ThttpClient = class(TSslHttpCli) + constructor Create(AOwner: TComponent); override; + destructor destroy; + class function createURL(url:string):ThttpClient; + end; + Ttlv = class protected cur, bound: integer; @@ -214,6 +221,30 @@ implementation uses utilLib, main, windows, dateUtils, forms; +class function ThttpClient.createURL(url:string):ThttpClient; +begin +if startsText('https://', url) +and not httpsCanWork() then + exit(NIL); +result:=ThttpClient.Create(NIL); +result.URL:=url; +end; + +constructor ThttpClient.create(AOwner: TComponent); +begin +inherited; +followRelocation:=TRUE; +agent:=HFS_HTTP_AGENT; +SslContext := TSslContext.Create(NIL); +end; // create + +destructor ThttpClient.destroy; +begin +SslContext.free; +SslContext:=NIl; +inherited; +end; + constructor TperIp.create(); begin limiter:=TspeedLimiter.create(); @@ -504,10 +535,7 @@ end; // reset function TtarStream.fsInit():boolean; begin if assigned(fs) and (fs.FileName = flist[cur].src) then - begin - result:=TRUE; - exit; - end; + exit(TRUE); result:=FALSE; try freeAndNIL(fs); @@ -1089,8 +1117,8 @@ function Ttlv.pop(var value:string; var raw:ansistring):integer; var n: integer; begin -result:=-1; -if isOver() then exit; // finished +if isOver() then + exit(-1); // finished result:=integer((@whole[cur])^); n:=Pinteger(@whole[cur+4])^; raw:=copy(whole, cur+8, n); @@ -1109,10 +1137,7 @@ function Ttlv.down():boolean; begin // do we have anything to recur on? if (cur = 1) then - begin - result:=false; - exit; - end; + exit(FALSE); // push into the stack if (stackTop = length(stack)) then // space over setLength(stack, stackTop+10); // make space @@ -1129,10 +1154,7 @@ end; // down function Ttlv.up():boolean; begin if stackTop = 0 then - begin - result:=false; - exit; - end; + exit(FALSE); dec(stackTop); bound:=stack[stackTop]; dec(stackTop); diff --git a/main.dfm b/main.dfm index 063f7ba..07101e8 100644 --- a/main.dfm +++ b/main.dfm @@ -2,7 +2,7 @@ object mainFrm: TmainFrm Left = 293 Top = 219 Caption = 'HFS ~ HTTP File Server' - ClientHeight = 483 + ClientHeight = 436 ClientWidth = 879 Color = clBtnFace Constraints.MinHeight = 260 @@ -218,7 +218,7 @@ object mainFrm: TmainFrm Left = 0 Top = 83 Width = 879 - Height = 400 + Height = 353 Align = alClient BevelOuter = bvNone Font.Charset = DEFAULT_CHARSET @@ -228,10 +228,11 @@ object mainFrm: TmainFrm Font.Style = [] ParentFont = False TabOrder = 0 + ExplicitHeight = 400 object splitV: TSplitter Left = 313 Top = 0 - Height = 289 + Height = 242 Beveled = True Constraints.MaxWidth = 3 Constraints.MinWidth = 3 @@ -241,7 +242,7 @@ object mainFrm: TmainFrm end object splitH: TSplitter Left = 0 - Top = 289 + Top = 242 Width = 879 Height = 5 Cursor = crVSplit @@ -257,15 +258,16 @@ object mainFrm: TmainFrm Left = 316 Top = 0 Width = 563 - Height = 289 + Height = 242 Align = alClient BevelOuter = bvNone TabOrder = 1 + ExplicitHeight = 289 object logBox: TRichEdit Left = 0 Top = 23 Width = 563 - Height = 266 + Height = 219 Align = alClient Font.Charset = ANSI_CHARSET Font.Color = clWindowText @@ -282,6 +284,7 @@ object mainFrm: TmainFrm Zoom = 100 OnChange = logBoxChange OnMouseDown = logBoxMouseDown + ExplicitHeight = 266 end object logTitle: TPanel Left = 0 @@ -557,16 +560,17 @@ object mainFrm: TmainFrm Left = 0 Top = 0 Width = 313 - Height = 289 + Height = 242 Align = alLeft BevelOuter = bvNone Caption = 'filesPnl' TabOrder = 0 + ExplicitHeight = 289 object filesBox: TTreeView Left = 0 Top = 23 Width = 313 - Height = 266 + Height = 219 Align = alClient BevelInner = bvLowered BevelOuter = bvSpace @@ -602,6 +606,7 @@ object mainFrm: TmainFrm OnMouseEnter = filesBoxMouseEnter OnMouseLeave = filesBoxMouseLeave OnMouseUp = filesBoxMouseUp + ExplicitHeight = 266 end object filesTitle: TPanel Left = 0 @@ -616,12 +621,13 @@ object mainFrm: TmainFrm end object connPnl: TPanel Left = 0 - Top = 294 + Top = 247 Width = 879 Height = 106 Align = alBottom BevelOuter = bvNone TabOrder = 2 + ExplicitTop = 294 object sbar: TStatusBar Left = 0 Top = 87 diff --git a/main.pas b/main.pas index 042d8d3..b501b89 100644 --- a/main.pas +++ b/main.pas @@ -983,6 +983,7 @@ type procedure progFrmHttpGetUpdate(sender:TObject; buffer:pointer; Len:integer); procedure recalculateGraph(); public + procedure statusBarHttpGetUpdate(sender:TObject; buffer:pointer; Len:integer); procedure remove(node:Ttreenode=NIL); function setCfg(cfg:string; alreadyStarted:boolean=TRUE):boolean; function getCfg(exclude:string=''):string; @@ -1268,10 +1269,7 @@ begin result:=NIL; if (account = NIL) or not account.enabled then exit; if shouldStop() then - begin - result:=account; - exit; - end; + exit(account); i:=0; toCheck:=account.link; while i < length(toCheck) do @@ -1280,10 +1278,7 @@ while i < length(toCheck) do inc(i); if (account = NIL) or not account.enabled then continue; if shouldStop() then - begin - result:=account; - exit; - end; + exit(account); addUniqueArray(toCheck, account.link); end; end; // accountRecursion @@ -1304,10 +1299,7 @@ begin result:=FALSE; if f = NIL then exit; if action = FA_ACCESS then - begin - result:=f.accessFor(cd); - exit; - end; + exit(f.accessFor(cd)); if f.isTemp() then f:=f.parent; if (action = FA_UPLOAD) and not f.isRealFolder() then exit; @@ -1600,10 +1592,7 @@ var s:=commentMasks[i]; mask:=chop('=', s); if fileMatch(mask, fn) then - begin - result:=s; - exit; - end; + exit(s); end; result:=''; end; // getCommentByMaskFor @@ -2026,10 +2015,7 @@ fillChar(shfi, SizeOf(TShFileInfo), 0); // but it does not actually work without the expandFileName() shGetFileInfo( pchar(expandFileName(fn)), 0, shfi, SizeOf(shfi), SHGFI_SYSICONINDEX); if shfi.iIcon = 0 then - begin - result:=ICON_FILE; - exit; - end; + exit(ICON_FILE); // as reported by official docs destroyIcon(shfi.hIcon); @@ -2136,10 +2122,7 @@ var begin for i:=0 to length(address2name) div 2-1 do if addressmatch(address2name[i*2+1], ip) then - begin - result:=address2name[i*2]; - exit; - end; + exit(address2name[i*2]); result:=''; end; // localDNSget @@ -2196,10 +2179,7 @@ procedure updateDynDNS(); begin s:=trim(s); if s = '' then - begin - result:='no reply'; - exit; - end; + exit('no reply'); code:=''; result:='successful'; code:=trim(lowercase(getTill(' ',s))); @@ -2207,9 +2187,8 @@ procedure updateDynDNS(); for i:=1 to length(ERRORS) do if code = ERRORS[i].code then begin - result:='error: '+ERRORS[i].msg; dyndns.active:=FALSE; - exit; + exit('error: '+ERRORS[i].msg); end; result:='unknown reply: '+s; end; // interpretResponse @@ -2602,10 +2581,7 @@ end; // fixTreeStructure function Tfile.getParent():Tfile; begin if node = NIL then - begin - result:=NIL; - exit; - end; + exit(NIL); if node.data <> self then // the tree structure is unreliable, at least on DISPLAYCHANGE event. This will workaround it fixTreeStructure(mainFrm.filesBox.Items[0]); if isTemp() then result:=nodeToFile(node) @@ -2633,10 +2609,7 @@ var f: Tfile; begin if not isFolder() then - begin - result:=DLcount; - exit; - end; + exit(DLcount); result:=0; if node = NIL then exit; n:=node.getFirstChild(); @@ -2714,8 +2687,8 @@ function Tfile.pathTill(root:Tfile=NIL; delim:char='\'):string; var f: Tfile; begin -result:=''; -if self = root then exit; +if self = root then + exit(''); result:=name; f:=parent; if isTemp() then @@ -2914,8 +2887,7 @@ if not isTemp() then n:=n.getNextSibling(); if (FA_LINK in f.flags) or f.isFolder() or not fileMatch(mask, f.name) or not fileExists(f.resource) then continue; - result:=f; - exit; + exit(f); end; if not isRealFolder() or not sysutils.directoryExists(resource) then exit; @@ -2982,10 +2954,7 @@ if result >= 0 then exit; if isFile() then for i:=0 to length(iconMasks)-1 do if fileMatch(iconMasks[i].str, name) then - begin - result:=iconMasks[i].int; - exit; - end; + exit(iconMasks[i].int); ic:=iconsCache.get(resource); if ic = NIL then begin @@ -3089,7 +3058,6 @@ var begin result:=FALSE; if isFile() and isDLforbidden() then exit; -result:=FALSE; f:=self; while assigned(f) do begin @@ -3214,8 +3182,8 @@ end; // getSafeHost function nodeIsLocked(n:Ttreenode):boolean; begin -result:=FALSE; -if (n = NIL) or (n.data = NIL) then exit; +if (n = NIL) or (n.data = NIL) then + exit(FALSE); result:=nodeToFile(n).isLocked(); end; // nodeIsLocked @@ -3774,16 +3742,10 @@ begin result:=default; for i:=0 to length(mimeTypes) div 2-1 do if fileMatch(mimeTypes[i*2], fn) then - begin - result:=mimeTypes[i*2+1]; - exit; - end; + exit(mimeTypes[i*2+1]); for i:=0 to length(DEFAULT_MIME_TYPES) div 2-1 do if fileMatch(DEFAULT_MIME_TYPES[i*2], fn) then - begin - result:=DEFAULT_MIME_TYPES[i*2+1]; - exit; - end; + exit(DEFAULT_MIME_TYPES[i*2+1]); end; // name2mimetype procedure Tmainfrm.getPage(sectionName:string; data:TconnData; f:Tfile=NIL; tpl2use:Ttpl=NIL); @@ -12080,6 +12042,12 @@ with sender as ThttpCli do end; end; // progFrmHttpGetUpdate +procedure TmainFrm.statusBarHttpGetUpdate(sender:Tobject; buffer:pointer; len:integer); +begin +with sender as ThttpCli do + setStatusBarText( 'Downloading '+intToStr(safeDiv(RcvdCount*100, contentLength))+'%' ); +end; // statusBarHttpGetUpdate + function purgeFilesCB(f:Tfile; childrenDone:boolean; par, par2:integer):TfileCallbackReturn; begin result:=[]; diff --git a/utillib.pas b/utillib.pas index d9c9a4a..55c1832 100644 --- a/utillib.pas +++ b/utillib.pas @@ -44,6 +44,7 @@ type TnameExistsFun = function(user:string):boolean; procedure doNothing(); inline; // useful for readability +function httpsCanWork():boolean; function accountExists(user:string; evenGroups:boolean=FALSE):boolean; function getAccount(user:string; evenGroups:boolean=FALSE):Paccount; function nodeToFile(n:TtreeNode):Tfile; @@ -1651,71 +1652,101 @@ result:=inputQueryLongdlg.ShowModal() = mrOk; if result then value:=inputQueryLongdlg.inputBox.Text; end; // inputQueryLong +function dllIsPresent(name:string):boolean; +var h: HMODULE; +begin +h:=LoadLibrary(@name); +result:= h<>0; +FreeLibrary(h); +end; + +function httpsCanWork():boolean; +const + files: array of string = ['libcrypto-1_1.dll','libssl-1_1.dll']; + baseUrl = 'http://rejetto.com/hfs/'; + // these should be made resourcestring but then a runtime error is raised + MSG = 'An HTTPS action is required but some files are missing. Download them?'; + MSG_OK = 'Download completed'; + MSG_KO = 'Download failed'; +var + s: string; + missing: TStringDynArray; +begin +missing:=NIL; +for s in files do + if not FileExists(s) and not dllIsPresent(s) then + addString(s, missing); +if missing=NIL then + exit(TRUE); +if msgDlg(MSG, MB_OKCANCEL+MB_ICONQUESTION) <> MROK then + exit(FALSE); +for s in missing do + if not httpGetFile(baseUrl+s, s, 2, mainfrm.statusBarHttpGetUpdate) then + begin + msgDlg(MSG_KO, MB_ICONERROR); + exit(FALSE); + end; +mainfrm.setStatusBarText(MSG_OK); +result:=TRUE; +end; // httpsCanWork + function httpGet(url:string; from:int64=0; size:int64=-1):string; var - http: THttpCli; reply: Tstringstream; begin if size = 0 then - begin - result:=''; - exit; - end; + exit(''); reply:=TStringStream.Create(''); -try - http:=Thttpcli.create(NIL); +with ThttpClient.createURL(url) do try - http.URL:=url; - http.followRelocation:=TRUE; - http.rcvdStream:=reply; - http.agent:=HFS_HTTP_AGENT; + rcvdStream:=reply; if (from <> 0) or (size > 0) then - http.contentRangeBegin:=intToStr(from); + contentRangeBegin:=intToStr(from); if size > 0 then - http.contentRangeEnd:=intToStr(from+size-1); - http.get(); + contentRangeEnd:=intToStr(from+size-1); + get(); result:=reply.dataString; - finally http.free end -finally reply.free end + finally + reply.free; + Free; + end end; // httpGet function httpFileSize(url:string):int64; -var - http: THttpCli; begin -http:=Thttpcli.create(NIL); -try - http.URL:=url; - http.Agent:=HFS_HTTP_AGENT; +with ThttpClient.createURL(url) do try - http.head(); - result:=http.contentLength - except result:=-1 end; -finally http.free end + try + head(); + result:=contentLength + except result:=-1 + end; + finally free + end; end; // httpFileSize function httpGetFile(url, filename:string; tryTimes:integer=1; notify:TdocDataEvent=NIL):boolean; var - http: THttpCli; - reply: Tfilestream; supposed: integer; + reply: Tfilestream; begin reply:=TfileStream.Create(filename, fmCreate); -try - http:=Thttpcli.create(NIL); +with ThttpClient.createURL(url) do try - http.URL:=url; - http.RcvdStream:=reply; - http.Agent:=HFS_HTTP_AGENT; - http.OnDocData:=notify; + rcvdStream:=reply; + onDocData:=notify; result:=TRUE; - try http.get() - except result:=FALSE end; - supposed:=http.ContentLength; - finally http.free end -finally reply.free end; + try get() + except result:=FALSE + end; + supposed:=ContentLength; + finally + reply.free; + free; + end; result:= result and (sizeOfFile(filename)=supposed); -if not result then deleteFile(filename); +if not result then + deleteFile(filename); if not result and (tryTimes > 1) then result:=httpGetFile(url, filename, tryTimes-1, notify);