Compare commits

..

No commits in common. "master" and "v2.4-rc06" have entirely different histories.

11 changed files with 447 additions and 643 deletions

View File

@ -1,9 +1,3 @@
# 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.
@ -15,10 +9,6 @@ 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

View File

@ -99,7 +99,6 @@ 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;
@ -525,16 +524,6 @@ 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;
@ -1138,7 +1127,7 @@ var
ss: TStringDynArray;
s, si: string;
till: pchar;
append, prepend, add: boolean;
append: boolean;
sect, from: PtplSection;
begin
till:=pred(bos);
@ -1154,10 +1143,8 @@ var
if not parseFlagsAndAcceptSection(ss) then
exit;
prepend:=startsStr('^', cur_section);
append:=startsStr('+', cur_section);
add:=prepend or append;
if add then
append:=ansiStartsStr('+', cur_section);
if append then
delete(cur_section,1,1);
// there may be several section names separated by =
@ -1173,19 +1160,16 @@ var
from:=NIL;
if sect = NIL then // not found
begin
if add then
if append then
from:=getSection(s);
sect:=newSection(s);
end
else
if add then
if append then
from:=sect;
if from<>NIL then
begin // inherit from it
if append then
sect.txt:=from.txt+base.txt
else
sect.txt:=base.txt+CRLF+from.txt;
sect.txt:=from.txt+base.txt;
sect.nolog:=from.nolog or base.nolog;
sect.public:=from.public or base.public;
sect.noList:=from.noList or base.noList;

File diff suppressed because it is too large Load Diff

View File

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

View File

@ -1,5 +1,5 @@
; Kryvich's Delphi Localizer Language File.
; Generated by K.D.L. Scanner, 02/08/2020 18:30:32
; Generated by K.D.L. Scanner, 28/06/2020 20:30:07
Humanize=1
HumanizedCR=\^
@ -282,6 +282,7 @@ 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

View File

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

View File

@ -2963,6 +2963,10 @@ 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

View File

@ -35,8 +35,8 @@ uses
HSlib, traylib, monoLib, progFrmLib, classesLib;
const
VERSION = '2.4.0 RC8';
VERSION_BUILD = '320';
VERSION = '2.4.0 RC6';
VERSION_BUILD = '318';
VERSION_STABLE = {$IFDEF STABLE } TRUE {$ELSE} FALSE {$ENDIF};
CURRENT_VFS_FORMAT :integer = 1;
CRLF = #13#10;
@ -671,6 +671,7 @@ type
Speedlimitforsingleaddress1: TMenuItem;
macrosLogChk: TMenuItem;
Debug1: TMenuItem;
Appendmacroslog1: TMenuItem;
preventStandbyChk: TMenuItem;
titlePnl: TPanel;
HTMLtemplate1: TMenuItem;
@ -1382,6 +1383,7 @@ type
constructor TfileListing.create();
begin
dir:=NIL;
timeout:=Now()+1/MINUTES;
end; // create
destructor TfileListing.destroy;
@ -1664,7 +1666,7 @@ this would let us have "=" inside the names, but names cannot be assigned
repeat
application.ProcessMessages();
cd.lastActivityTime:=now();
if (timeout > 0) and (cd.lastActivityTime > timeout) then
if cd.lastActivityTime > timeout then
break;
// we don't list these entries
if (sr.name = '.') or (sr.name = '..')
@ -3623,11 +3625,13 @@ 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.setHeaderIfNone('Cache-Control: no-cache, no-store, must-revalidate, max-age=-1');
cd.conn.addHeader('Cache-Control: no-cache, no-store, must-revalidate, max-age=-1');
recur:=shouldRecur(cd);
baseurl:=protoColon()+getSafeHost(cd)+folder.url(TRUE);
@ -4006,9 +4010,9 @@ if result then
conn.reply.mode:=HRM_NOT_MODIFIED;
exit;
end;
conn.setHeaderIfNone('ETag: '+UTF8encode(etag));
conn.addHeader('ETag: '+UTF8encode(etag));
if ts > '' then
conn.setHeaderIfNone('Last-Modified: '+UTF8encode(ts));
conn.addHeader('Last-Modified: '+UTF8encode(ts));
end; // notModified
function notModified(conn:ThttpConn; f:string):boolean; overload;
@ -4940,7 +4944,7 @@ var
var s:ansistring;
begin
s:=ansistring(HSlib.encodeURL(data.lastFN));
conn.setHeaderIfNone( ansistring('Content-Disposition: '+if_(attach, 'attachment; ')
conn.addHeader( ansistring('Content-Disposition: '+if_(attach, 'attachment; ')
+'filename*=UTF-8'''''+s+'; filename='+s));
end;
@ -5024,12 +5028,6 @@ 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;
@ -5042,7 +5040,6 @@ 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;
@ -5064,7 +5061,7 @@ var
else
s:=fi.pathTill(f.parent); // we want the path to include also f, so stop at f.parent
addToTar(fi.resource, s);
tar.addFile(fi.resource, s);
end
finally listing.free end;
end; // addFolder
@ -5099,7 +5096,7 @@ var
t:=substr(s, lastDelimiter('\/', s)+1)
else
t:=s;
addToTar(ft.resource, t);
tar.addFile(ft.resource, t);
finally freeIfTemp(ft) end;
end;
end; // addSelection
@ -5345,29 +5342,6 @@ 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;
@ -5727,9 +5701,6 @@ 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;
@ -6014,7 +5985,7 @@ case event of
refreshConn(data);
end;
HE_POST_VAR: data.postVars.add(conn.post.varname+'='+UTF8toString(conn.post.data));
HE_POST_VAR: data.postVars.add(conn.post.varname+'='+conn.post.data);
HE_POST_VARS:
if conn.post.mode = PM_URLENCODED then
urlToStrings(conn.post.data, data.postVars);
@ -8118,10 +8089,10 @@ var
if userSocketBuffer > 0 then
data.conn.sndBuf:=userSocketBuffer
else if highSpeedChk.checked then
else
begin
size:=minmax(8192, MEGA, round(data.averageSpeed));
if safeDiv(0.0+size, data.conn.sndbuf, 2) > 2 then
if highSpeedChk.checked and (safeDiv(0.0+size, data.conn.sndbuf, 2) > 2) then
data.conn.sndBuf:=size;
end;
end;
@ -11900,6 +11871,7 @@ 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
@ -12124,7 +12096,7 @@ tray:=TmyTrayicon.create(self);
DragAcceptFiles(handle, true);
caption:=format('HFS ~ HTTP File Server %s', [VERSION]);
application.Title:=format('HFS %s', [VERSION]);
setSpeedLimit(50000);
setSpeedLimit(-1);
setSpeedLimitIP(-1);
setGraphRate(10);
setMaxConnections(0);

View File

@ -161,18 +161,16 @@ 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);
unsatisfied(not result);
if not result then
macroError('cannot be used here');
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;
@ -264,9 +262,9 @@ var
result:=staticVars;
delete(varname,1,length(G_VAR_PREFIX));
end
else if assigned(md.cd) then
else if satisfied(md.cd) then
result:=md.cd.vars
else if assigned(md.tempVars) then
else if satisfied(md.tempVars) then
result:=md.tempVars
else
raise Exception.create('no namespace available');
@ -295,7 +293,7 @@ var
if not satisfied(space) then exit;
i:=space.indexOfName(varname);
if i < 0 then
if value = '' then exit(TRUE) // all is good the way it is
if value = '' then exit // 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)

View File

@ -29,13 +29,12 @@ 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: pipe, base64, base64decode, dir, disk free, filetime, file changed, load tpl, sha256, for line
document: 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

View File

@ -2220,7 +2220,7 @@ const
var
sa : TSecurityAttributes;
ReadPipe,WritePipe : THandle;
start : TStartUpInfoW;
start : TStartUpInfoA;
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 CreateProcess(nil, PChar(dosApp), @sa, @sa, true, CREATE_NO_WINDOW or NORMAL_PRIORITY_CLASS, nil, nil, start, ProcessInfo) then
if CreateProcessA(nil, PansiChar(ansistring(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,22 +2261,16 @@ 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 )
or (BytesRead > 0) and not ReadFile(ReadPipe, Buffer[TotalBytesRead], BytesRead, BytesRead, nil ) then
break;
if not PeekNamedPipe(ReadPipe, @Buffer[TotalBytesRead], ReadBuffer,
@BytesRead, @TotalBytesAvail, @BytesLeftThisMessage ) then
break
else if BytesRead > 0 then
ReadFile(ReadPipe, Buffer[TotalBytesRead], BytesRead, BytesRead, nil );
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(Buffer,Buffer);
output:=string(ansistrings.strPas(Buffer));
end;
Buffer[TotalBytesRead]:= #0;
OemToCharA(PansiChar(Buffer),Buffer);
output:=string(ansistrings.strPas(Buffer));
finally
GetExitCodeProcess(ProcessInfo.hProcess, exitcode);
TerminateProcess(ProcessInfo.hProcess, 0);