https client support

.gitignore

@@ -8,6 +8,7 @@ win32/
 *.exe
 *.map
 *.tmp
+*.dll
 *.bak
 *.*-
 *.corrupted

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
+  exit(TRUE);
-  result:=TRUE;
-  exit;
-  end;
 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 
-if isOver() then exit; // finished
+  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
+  exit(FALSE);
-  result:=false;
-  exit;
-  end;
 // 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
+  exit(FALSE);
-  result:=false;
-  exit;
-  end;
 dec(stackTop);
 bound:=stack[stackTop];
 dec(stackTop);

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

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
+  exit(account);
-  result:=account;
-  exit;
-  end;
 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
+    exit(account);
-    result:=account;
-    exit;
-    end;
   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
+  exit(f.accessFor(cd));
-  result:=f.accessFor(cd);
-  exit;
-  end;
 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
+        exit(s);
-        result:=s;
-        exit;
-        end;
       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
+  exit(ICON_FILE);
-  result:=ICON_FILE;
-  exit;
-  end;
 // 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
+    exit(address2name[i*2]);
-    result:=address2name[i*2];
-    exit;
-    end;
 result:='';
 end; // localDNSget
 
@@ -2196,10 +2179,7 @@ procedure updateDynDNS();
   begin
   s:=trim(s);
   if s = '' then
-    begin
+    exit('no reply');
-    result:='no reply';
-    exit;
-    end;
   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
+  exit(NIL);
-  result:=NIL;
-  exit;
-  end;
 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
+  exit(DLcount);
-  result:=DLcount;
-  exit;
-  end;
 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
-if self = root then exit;
+  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(f);
-    exit;
     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
+      exit(iconMasks[i].int);
-      result:=iconMasks[i].int;
-      exit;
-      end;
 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 
-if (n = NIL) or (n.data = NIL) then exit;
+  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
+    exit(mimeTypes[i*2+1]);
-    result:=mimeTypes[i*2+1];
-    exit;
-    end;
 for i:=0 to length(DEFAULT_MIME_TYPES) div 2-1 do
   if fileMatch(DEFAULT_MIME_TYPES[i*2], fn) then
-    begin
+    exit(DEFAULT_MIME_TYPES[i*2+1]);
-    result:=DEFAULT_MIME_TYPES[i*2+1];
-    exit;
-    end;
 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:=[];

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
+  exit('');
-  result:='';
-  exit;
-  end;
 reply:=TStringStream.Create('');
+with ThttpClient.createURL(url) do
   try
-  http:=Thttpcli.create(NIL);
+    rcvdStream:=reply;
-  try
-    http.URL:=url;
-    http.followRelocation:=TRUE;
-    http.rcvdStream:=reply;
-    http.agent:=HFS_HTTP_AGENT;
     if (from <> 0) or (size > 0) then
-      http.contentRangeBegin:=intToStr(from);
+      contentRangeBegin:=intToStr(from);
     if size > 0 then
-      http.contentRangeEnd:=intToStr(from+size-1);
+      contentRangeEnd:=intToStr(from+size-1);
-    http.get();
+    get();
     result:=reply.dataString;
-  finally http.free end
+  finally
-finally reply.free end
+    reply.free;
+    Free;
+    end
 end; // httpGet
 
 function httpFileSize(url:string):int64;
-var
-  http: THttpCli;
 begin
-http:=Thttpcli.create(NIL);
+with ThttpClient.createURL(url) do
   try
-  http.URL:=url;
-  http.Agent:=HFS_HTTP_AGENT;
     try
-    http.head();
+      head();
-    result:=http.contentLength
+      result:=contentLength
-  except result:=-1 end;
+     except result:=-1
-finally http.free end
+      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);
+with ThttpClient.createURL(url) do
   try
-  http:=Thttpcli.create(NIL);
+    rcvdStream:=reply;
-  try
+    onDocData:=notify;
-    http.URL:=url;
-    http.RcvdStream:=reply;
-    http.Agent:=HFS_HTTP_AGENT;
-    http.OnDocData:=notify;
     result:=TRUE;
-    try http.get()
+    try get()
-    except result:=FALSE end;
+    except result:=FALSE
-    supposed:=http.ContentLength;
+      end;
-  finally http.free end
+    supposed:=ContentLength;
-finally reply.free end;
+  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);