Merge pull request #41 from divinity76/patch-1

warning about Delphi 10.4 Community being incompatible

README.md

@@ -1,3 +1,9 @@
+# Obsolete
+This is the repository of the old HFS.
+
+I'm working on HFS 3 on another repository. Check it out! 
+https://github.com/rejetto/hfs
+
 ## Introduction
 You can use HFS (HTTP File Server) to send and receive files.
 It's different from classic file sharing because it uses web technology.
@@ -9,6 +15,10 @@ The virtual file system will allow you to easily share even one single file.
 Initially developed in 2002 with Delphi 6, now with Delphi 10.3.3 (Community Edition).
 Icons are generated at http://fontello.com/ . Use fontello.json for further modifications.
 
+For the default template we are targeting compatibility with Chrome 49 as it's the latest version running on Windows XP.
+
+Warning: Delphi Community Edition 10.4 removed support for command-line compilation, and is thus unable to compile JEDI Code Library, and is thus unable to compile HFS2, ref [Community Edition no longer includes the command-line compilers](https://blogs.embarcadero.com/delphi-cbuilder-community-editions-now-available-in-version-10-4-2/#comment-1339) - meaning the last version of Community Edition cabale of compiling HFS2 is Delphi 10.3.x
+
 ## Libs used
 - [ICS v8.64](http://www.overbyte.be) by François PIETTE 
 - [TRegExpr v0.952b](https://github.com/andgineer/TRegExpr/releases) by Andrey V. Sorokin

classesLib.pas

@@ -99,6 +99,7 @@ type
     constructor create;
     destructor Destroy; override;
     function addFile(src:string; dst:string=''; data:Tobject=NIL):boolean; virtual;
+    function contains(src:string):boolean;
     function count():integer;
     procedure reset(); virtual;
     property totalSize:int64 read getTotal;
@@ -524,6 +525,16 @@ if cachedTotal < 0 then calculate();
 result:=cachedTotal;
 end; // getTotal
 
+function TarchiveStream.contains(src:string):boolean;
+var
+  i: integer;
+begin
+for i:=0 to Length(flist)-1 do
+  if flist[i].src = src then
+    exit(TRUE);
+result:=FALSE;
+end;
+
 function TarchiveStream.addFile(src:string; dst:string=''; data:Tobject=NIL):boolean;
 
   function getMtime(fh:Thandle):int64;
@@ -1127,7 +1138,7 @@ var
     ss: TStringDynArray;
     s, si: string;
     till: pchar;
-    append: boolean;
+    append, prepend, add: boolean;
     sect, from: PtplSection;
   begin
   till:=pred(bos);
@@ -1143,8 +1154,10 @@ var
   if not parseFlagsAndAcceptSection(ss) then
     exit;
 
-  append:=ansiStartsStr('+', cur_section);
-  if append then
+  prepend:=startsStr('^', cur_section);
+  append:=startsStr('+', cur_section);
+  add:=prepend or append;
+  if add then
     delete(cur_section,1,1);
 
   // there may be several section names separated by =
@@ -1160,16 +1173,19 @@ var
     from:=NIL;
     if sect = NIL then // not found
       begin
-      if append then
+      if add then
         from:=getSection(s);
       sect:=newSection(s);
       end
     else
-      if append then
+      if add then
         from:=sect;
     if from<>NIL then
       begin // inherit from it
-      sect.txt:=from.txt+base.txt;
+      if append then
+        sect.txt:=from.txt+base.txt
+      else
+        sect.txt:=base.txt+CRLF+from.txt;
       sect.nolog:=from.nolog or base.nolog;
       sect.public:=from.public or base.public;
       sect.noList:=from.noList or base.noList;

hfs.dproj

@@ -206,9 +206,10 @@
             </Platforms>
             <ModelSupport>False</ModelSupport>
             <Deployment Version="3">
-                <DeployFile LocalName="hfs.exe" Configuration="Release" Class="ProjectOutput">
+                <DeployFile LocalName="hfs.dpr" Configuration="Release" Class="ProjectFile">
                     <Platform Name="Win32">
-                        <RemoteName>hfs.exe</RemoteName>
+                        <RemoteDir>.\</RemoteDir>
+                        <Enabled>false</Enabled>
                         <Overwrite>true</Overwrite>
                     </Platform>
                 </DeployFile>
@@ -218,16 +219,15 @@
                         <Overwrite>true</Overwrite>
                     </Platform>
                 </DeployFile>
-                <DeployFile LocalName="hfs.dpr" Configuration="Debug" Class="ProjectFile">
+                <DeployFile LocalName="hfs.exe" Configuration="Release" Class="ProjectOutput">
                     <Platform Name="Win32">
-                        <RemoteDir>.\</RemoteDir>
+                        <RemoteName>hfs.exe</RemoteName>
                         <Overwrite>true</Overwrite>
                     </Platform>
                 </DeployFile>
-                <DeployFile LocalName="hfs.dpr" Configuration="Release" Class="ProjectFile">
+                <DeployFile LocalName="hfs.dpr" Configuration="Debug" Class="ProjectFile">
                     <Platform Name="Win32">
                         <RemoteDir>.\</RemoteDir>
-                        <Enabled>false</Enabled>
                         <Overwrite>true</Overwrite>
                     </Platform>
                 </DeployFile>

hfs.lng

@@ -1,5 +1,5 @@
 ; Kryvich's Delphi Localizer Language File.
-; Generated by K.D.L. Scanner, 28/06/2020 20:30:07
+; Generated by K.D.L. Scanner, 02/08/2020 18:30:32
 
 Humanize=1
 HumanizedCR=\^
@@ -282,7 +282,6 @@ menu.Debug1.dumpTrafficChk.Caption=Dump traffic
 menu.Debug1.Showcustomizedoptions1.Caption=Show customized options...
 menu.Debug1.highSpeedChk.Caption=Experimental high speed handling
 menu.Debug1.macrosLogChk.Caption=Enable macros.log
-menu.Debug1.Appendmacroslog1.Caption=Append macros.log
 menu.Debug1.Runscript1.Caption=Run script...
 menu.Debug1.showMemUsageChk.Caption=Show memory usage
 menu.Debug1.noContentdispositionChk.Caption=No Content-disposition

hslib.pas

@@ -1599,7 +1599,7 @@ end; // initInputStream
 
 function ThttpConn.sendNextChunk(max:integer=MAXINT):integer;
 var
-  n: int64;
+  n, toSend: int64;
   buf: ansistring;
 begin
 result:=0;
@@ -1611,7 +1611,8 @@ if (n = 0) or (bytesSentLastItem = 0) then n:=max;
 if n > MAXIMUM_CHUNK_SIZE then n:=MAXIMUM_CHUNK_SIZE;
 if n < MINIMUM_CHUNK_SIZE then n:=MINIMUM_CHUNK_SIZE;
 if n > max then n:=max;
-if n > bytesToSend then n:=bytesToSend;
+toSend:=bytesToSend;
+if n > toSend then n:=toSend;
 if n = 0 then exit;
 setLength(buf, n);
 n:=stream.read(buf[1], n);

main.dfm

@@ -2963,10 +2963,6 @@ object mainFrm: TmainFrm
         AutoCheck = True
         Caption = 'Enable macros.log'
       end
-      object Appendmacroslog1: TMenuItem
-        AutoCheck = True
-        Caption = 'Append macros.log'
-      end
       object Runscript1: TMenuItem
         Caption = 'Run script...'
         OnClick = Runscript1Click

main.pas

@@ -35,8 +35,8 @@ uses
   HSlib, traylib, monoLib, progFrmLib, classesLib;
 
 const
-  VERSION = '2.4.0 RC6';
-  VERSION_BUILD = '318';
+  VERSION = '2.4.0 RC8';
+  VERSION_BUILD = '320';
   VERSION_STABLE = {$IFDEF STABLE } TRUE {$ELSE} FALSE {$ENDIF};
   CURRENT_VFS_FORMAT :integer = 1;
   CRLF = #13#10;
@@ -671,7 +671,6 @@ type
     Speedlimitforsingleaddress1: TMenuItem;
     macrosLogChk: TMenuItem;
     Debug1: TMenuItem;
-    Appendmacroslog1: TMenuItem;
     preventStandbyChk: TMenuItem;
     titlePnl: TPanel;
     HTMLtemplate1: TMenuItem;
@@ -1383,7 +1382,6 @@ type
 constructor TfileListing.create();
 begin
 dir:=NIL;
-timeout:=Now()+1/MINUTES;
 end; // create
 
 destructor TfileListing.destroy;
@@ -1666,7 +1664,7 @@ this would let us have "=" inside the names, but names cannot be assigned
         repeat
         application.ProcessMessages();
         cd.lastActivityTime:=now();
-        if cd.lastActivityTime > timeout then
+        if (timeout > 0) and (cd.lastActivityTime > timeout) then
           break;
         // we don't list these entries
         if (sr.name = '.') or (sr.name = '..')
@@ -3625,13 +3623,11 @@ begin
 result:='';
 if (folder = NIL) or not folder.isFolder() then exit;
 
-if macrosLogChk.checked and not appendmacroslog1.checked then
-  resetLog();
 diffTpl:=Ttpl.create();
 folder.lock();
 try
   buildTime:=now();
-  cd.conn.addHeader('Cache-Control: no-cache, no-store, must-revalidate, max-age=-1');
+  cd.conn.setHeaderIfNone('Cache-Control: no-cache, no-store, must-revalidate, max-age=-1');
   recur:=shouldRecur(cd);
   baseurl:=protoColon()+getSafeHost(cd)+folder.url(TRUE);
 
@@ -4010,9 +4006,9 @@ if result then
   conn.reply.mode:=HRM_NOT_MODIFIED;
   exit;
   end;
-conn.addHeader('ETag: '+UTF8encode(etag));
+conn.setHeaderIfNone('ETag: '+UTF8encode(etag));
 if ts > '' then
-  conn.addHeader('Last-Modified: '+UTF8encode(ts));
+  conn.setHeaderIfNone('Last-Modified: '+UTF8encode(ts));
 end; // notModified
 
 function notModified(conn:ThttpConn; f:string):boolean; overload;
@@ -4944,7 +4940,7 @@ var
   var s:ansistring;
   begin
   s:=ansistring(HSlib.encodeURL(data.lastFN));
-  conn.addHeader( ansistring('Content-Disposition: '+if_(attach, 'attachment; ')
+  conn.setHeaderIfNone( ansistring('Content-Disposition: '+if_(attach, 'attachment; ')
     +'filename*=UTF-8'''''+s+'; filename='+s));
   end;
 
@@ -5028,6 +5024,12 @@ var
     tar: TtarStream;
     nofolders, selection, itsAsearch: boolean;
 
+    procedure addToTar(src,dst:string);
+    begin
+    if not selection or not tar.contains(src) then
+      tar.addFile(src, dst);
+    end;
+
     procedure addFolder(f:Tfile; ignoreConnFilters:boolean=FALSE);
     var
       i, ofs: integer;
@@ -5040,6 +5042,7 @@ var
     listing:=TfileListing.create();
     try
       listing.ignoreConnFilter:=ignoreConnFilters;
+      listing.timeout:= now()+1/MINUTES;
       listing.fromFolder( f, data, shouldRecur(data));
       fIsTemp:=f.isTemp();
       ofs:=length(f.resource)-length(f.name)+1;
@@ -5061,7 +5064,7 @@ var
         else
           s:=fi.pathTill(f.parent); // we want the path to include also f, so stop at f.parent
 
-        tar.addFile(fi.resource, s);
+        addToTar(fi.resource, s);
         end
     finally listing.free end;
     end; // addFolder
@@ -5096,7 +5099,7 @@ var
             t:=substr(s, lastDelimiter('\/', s)+1)
           else
             t:=s;
-          tar.addFile(ft.resource, t);
+          addToTar(ft.resource, t);
         finally freeIfTemp(ft) end;
         end;
     end; // addSelection
@@ -5342,6 +5345,29 @@ var
     runEventScript('login')
     end; //urlAuth
 
+    function thumb():Boolean;
+    var
+      b: rawbytestring;
+      s, e: integer;
+    begin
+    if mode <> 'thumb' then
+      exit(FALSE);
+    result:=TRUE;
+    b:=loadFile(f.resource, 0, 96*KILO);
+    s:= pos(rawbytestring(#$FF#$D8#$FF), b, 2);
+    if s > 0 then
+      e:=pos(rawbytestring(#$FF#$D9), b, s);
+    if (s=0) or (e=0) then
+      begin
+      data.conn.reply.mode:=HRM_NOT_FOUND;
+      exit;
+      end;
+    conn.reply.contentType:='image/jpeg';
+    conn.reply.mode:=HRM_REPLY;
+    conn.reply.bodyMode:=RBM_STRING;
+    conn.reply.body:=Copy(b, s, e-s+2);
+    end;
+
   var
     b: boolean;
     s: string;
@@ -5701,6 +5727,9 @@ var
 
   if notModified(conn, f) then // calling notModified before limitsExceededOnDownload makes possible for [download] to manipualate headers set here
     exit;
+  if thumb() then
+    Exit;
+
   data.countAsDownload:=f.shouldCountAsDownload();
   if data.countAsDownload and limitsExceededOnDownload() then
     exit;
@@ -5985,7 +6014,7 @@ case event of
 
     refreshConn(data);
     end;
-  HE_POST_VAR: data.postVars.add(conn.post.varname+'='+conn.post.data);
+  HE_POST_VAR: data.postVars.add(conn.post.varname+'='+UTF8toString(conn.post.data));
   HE_POST_VARS:
     if conn.post.mode = PM_URLENCODED then
       urlToStrings(conn.post.data, data.postVars);
@@ -8089,10 +8118,10 @@ var
 
         if userSocketBuffer > 0 then
           data.conn.sndBuf:=userSocketBuffer
-        else
+        else if highSpeedChk.checked then
           begin
           size:=minmax(8192, MEGA, round(data.averageSpeed));
-          if highSpeedChk.checked and (safeDiv(0.0+size, data.conn.sndbuf, 2) > 2) then
+          if safeDiv(0.0+size, data.conn.sndbuf, 2) > 2 then
             data.conn.sndBuf:=size;
           end;
         end;
@@ -11871,7 +11900,6 @@ if menu.items.find(logmenu.items.caption) = NIL then
 SwitchON1.imageIndex:=if_(srv.active, 11, 4);
 SwitchON1.caption:=if_(srv.active, S_OFF, S_ON);
 
-Appendmacroslog1.Enabled:=macrosLogChk.checked;
 stopSpidersChk.Enabled:=not fileExistsByURL('/robots.txt');
 Showbandwidthgraph1.visible:=not graphBox.visible;
 if bakShellMenuText='' then
@@ -12096,7 +12124,7 @@ tray:=TmyTrayicon.create(self);
 DragAcceptFiles(handle, true);
 caption:=format('HFS ~ HTTP File Server %s', [VERSION]);
 application.Title:=format('HFS %s', [VERSION]);
-setSpeedLimit(-1);
+setSpeedLimit(50000);
 setSpeedLimitIP(-1);
 setGraphRate(10);
 setMaxConnections(0);

scriptLib.pas

@@ -161,16 +161,18 @@ var
   procedure deprecatedMacro(what:string=''; instead:string='');
   begin mainfrm.add2log('WARNING, deprecated macro: '+first(what, name)+nonEmptyConcat(' - Use instead: ',instead), NIL, clRed) end;
 
+  procedure unsatisfied(b:boolean=TRUE);
+  begin
+  if b then
+    macroError('cannot be used here')
+  end;
+
   function satisfied(p:pointer):boolean;
   begin
   result:=assigned(p);
-  if not result then
-    macroError('cannot be used here');
+  unsatisfied(not result);
   end;
 
-  procedure unsatisfied(b:boolean=TRUE);
-  begin if b then macroError('cannot be used here') end;
-
   function parEx(idx:integer; name:string=''; doTrim:boolean=TRUE):string; overload;
   var
     i: integer;
@@ -262,9 +264,9 @@ var
     result:=staticVars;
     delete(varname,1,length(G_VAR_PREFIX));
     end
-  else if satisfied(md.cd) then
+  else if assigned(md.cd) then
     result:=md.cd.vars
-  else if satisfied(md.tempVars) then
+  else if assigned(md.tempVars) then
     result:=md.tempVars
   else
     raise Exception.create('no namespace available');
@@ -293,7 +295,7 @@ var
   if not satisfied(space) then exit;
   i:=space.indexOfName(varname);
   if i < 0 then
-    if value = '' then exit // all is good the way it is
+    if value = '' then exit(TRUE) // all is good the way it is
     else i:=space.add(varname+'='+value)
   else
     if value > '' then // in case of empty value, there's no need to assign, because we are going to delete it (after we cleared the bound object)

todo.txt

@@ -29,12 +29,13 @@ document: {.if|var}
 document: {.exec|out|timeout|exitcode.}
 document: [+section]
 document: {.set item|diff template.}
+document: {.add header|overwrite=0.}
 document: {.calc| ][ }
 document: single line diff templates (file path)
 document: {.disconnection reason|if=XXX.}
 document: %url%
 document: commands returning white space: add folder, save, set account, exec, mkdir, chdir, delete, rename, move copy, set
-document: base64, base64decode, dir, disk free, filetime, file changed, load tpl, sha256, for line
+document: pipe, base64, base64decode, dir, disk free, filetime, file changed, load tpl, sha256, for line
 document {.convert|macros|dec|hex.}
 document: new event [login]
 + event to filter logging http://www.rejetto.com/forum/index.php/topic,9784.0.html

utillib.pas

@@ -2220,7 +2220,7 @@ const
 var
   sa            : TSecurityAttributes;
   ReadPipe,WritePipe  : THandle;
-  start               : TStartUpInfoA;
+  start               : TStartUpInfoW;
   ProcessInfo         : TProcessInformation;
   Buffer              : Pansichar;
   TotalBytesRead,
@@ -2251,7 +2251,7 @@ else
   timeout:=now()+timeout/SECONDS;
 // Create a Console Child Process with redirected input and output
 try
-  if CreateProcessA(nil, PansiChar(ansistring(DosApp)), @sa, @sa, true, CREATE_NO_WINDOW or NORMAL_PRIORITY_CLASS, nil, nil, start, ProcessInfo) then
+  if CreateProcess(nil, PChar(dosApp), @sa, @sa, true, CREATE_NO_WINDOW or NORMAL_PRIORITY_CLASS, nil, nil, start, ProcessInfo) then
     repeat
     result:=TRUE;
     // wait for end of child process
@@ -2261,16 +2261,22 @@ try
     // so that the pipe is not blocked by an overflow. New information
     // can be written from the console app to the pipe only if there is
     // enough buffer space.
-    if not PeekNamedPipe(ReadPipe, @Buffer[TotalBytesRead], ReadBuffer,
-      @BytesRead, @TotalBytesAvail, @BytesLeftThisMessage ) then
-      break
-    else if BytesRead > 0 then
-      ReadFile(ReadPipe, Buffer[TotalBytesRead], BytesRead, BytesRead, nil );
+    if not PeekNamedPipe(ReadPipe, @Buffer[TotalBytesRead], ReadBuffer, @BytesRead, @TotalBytesAvail, @BytesLeftThisMessage )
+    or (BytesRead > 0) and not ReadFile(ReadPipe, Buffer[TotalBytesRead], BytesRead, BytesRead, nil ) then
+      break;
     inc(TotalBytesRead, BytesRead);
     until (Apprunning <> WAIT_TIMEOUT) or (now() >= timeout);
+  if IsTextUnicode(Buffer, TotalBytesRead, NIL) then
+    begin
+    Pchar(@Buffer[TotalBytesRead])^:= #0;
+    output:=pchar(Buffer)
+    end
+  else
+    begin
     Buffer[TotalBytesRead]:= #0;
-  OemToCharA(PansiChar(Buffer),Buffer);
+    OemToCharA(Buffer,Buffer);
     output:=string(ansistrings.strPas(Buffer));
+    end;
 finally
   GetExitCodeProcess(ProcessInfo.hProcess, exitcode);
   TerminateProcess(ProcessInfo.hProcess, 0);