Const VERSION
= "v22.03.30.4" ' Start with root path of webserver as parameter and optional port e.g. mdserver2 d:\mysite 8088
' Place 'favicon.ico' file (+R+H) in root directory
' Place '.auth' file (+R+H) with authorized hashes in all protected directories
Const MAXFILESIZE
= 2 ^ 39 Const SEP0
= "/", SEP
= "\" Const SEP0
= "\", SEP
= "/"
cBoundary
As String ' Content multi-part boundary string cFileNameIn
As String ' Post filename 'file.ext' cFileNameOut
As String ' '<SEP>...<SEP>file.ext'
main
APPLNAME = appName$: SITEPATH = ".": PORT = "8088"
If SITEPATH
= SEP
Or Right$(SITEPATH
, 2) = ":\" Then SITEPATH
= SITEPATH
+ "."
printLog "SERVER: '" + APPLNAME + "'"
printLog "VERSION: " + VERSION
printLog "PORT: " + PORT
printLog
"SITEPATH: '" + Left$(SITEPATH
, Len(SITEPATH
) - 2) + SEP
+ "'" printLog "SITEPATH: '" + SITEPATH + SEP + "'"
init% = (HOST < 0)
Sub processRequest
(thread%
) Dim req
As reqType: req.thread
= thread%: req.client
= client%
Get req.client
, , reqBytes$
If parseRequest
(req
, reqBytes$
) Then log$
= LTrim$(Str$(-req.client
)) + ":" + req.Typ
+ " " + req.Path
log$
= log$
+ " Authenticate: " res$
= httpHeader$
(req
, 401, ""):
Put req.client
, , res$
received~&& = handlePost(req, reqBytes$)
'redirect
res$
= httpHeader$
(req
, 301, ""):
Put req.client
, , res$
If req.File
<> "" Then 'download file sent~&& = handleGetFile(req)
If sent~&&
= 0 Then ' redirect log$
= log$
+ " ERROR: File not found" req.Path
= "/": res$
= httpHeader$
(req
, 404, ""):
Put req.client
, , res$
html$ = renderDirectory$(req)
res$ = httpHeader$(req, 200, html$)
log$
= log$
+ " ERROR: Path not found" res$ = httpHeader$(req, 404, "")
log$
= "ERROR: NOT ALLOWED !!!" 'redirect
res$
= httpHeader$
(req
, 404, ""):
Put req.client
, , res$
fspec$ = replace$(SITEPATH + req.Path, SEP0, SEP)
px12$ = "style='font-family:" + quoted$("Courier New") + "; font-size:12px;'"
px14$ = "style='font-family:" + quoted$("Arial") + "; font-size:14px;'"
px20$ = "style='font-family:" + quoted$("Courier New") + "; font-size:20px;'"
html$ = "<html><body><form enctype='multipart/form-data' action='.' method='POST'>" + _
"<input type='file' name='filename' " + px14$ + ">" + _
"<input type='submit' " + px14$ + "></form><hr>" + _
"<p " + px20$ + ">"
html$ = html$ + "/"
Dim p$
(1000): parts%
= split
(req.Path
, "/", p$
()) href$ = ""
href$ = href$ + p$(i%) + "/"
html$ = html$ + "<a href='" + href$ + "'>" + p$(i%) + "/</a> "
html$ = html$ + p$(i%)
html$ = html$ + "</p><table " + px12$ + ">"
tmp$
= APPLNAME
+ LTrim$(Str$(req.thread
)) + ".tmp" Shell _Hide "ls -l --group-directories-first " + fspec$
+ " >" + tmp$
tdp$ = "<td style='padding-right: 20px;"
tda$ = tdp$ + " text-align:right;'>"
dat$
= Left$(l$
, 16): sz~&&
= Val(replace$
(Mid$(l$
, 18), ",", "")): f$
= Mid$(l$
, 36) html$ = html$ + "<tr>" + tdp$ + "'><a href='" + req.Path + f$ + "/'>" + f$ + "</a></td>" + _
"<td/><td>" + dat$ + "</td></tr>"
html$ = html$ + "<tr>" + tdp$ + "'><a href='" + req.Path + f$ + "'>" + f$ + "</a></td>" + _
tda$
+ Str$(sz~&&
) + "</td><td>" + dat$
+ "</td></tr>" sp%
= 0:
For i%
= 1 To 4: sp%
= InStr(sp%
+ 1, l$
, " "):
Next i%: sp%
= sp%
+ 1 dp%
= InStr(sp%
+ 1, l$
, " ") sz~&&
= Val(Mid$(l$
, sp%
, dp%
- sp%
)) html$ = html$ + "<tr>" + tdp$ + "'><a href='" + req.Path + f$ + "/'>" + f$ + "</a></td>" + _
"<td/><td>" + dat$ + "</td></tr>"
html$ = html$ + "<tr>" + tdp$ + "'><a href='" + req.Path + f$ + "'>" + f$ + "</a></td>" + _
tda$
+ Str$(sz~&&
) + "</td><td>" + dat$
+ "</td></tr>" html$ = html$ + "</table></body></html>"
renderDirectory$ = html$
fspec$ = replace$(SITEPATH + req.Path + req.File, SEP0, SEP)
res$ = httpHeader$(req, 200, "")
If req.cFileSize
<= BLOCKSIZE
Then _Delay .001 'for other threads blocks&
= _Ceil((req.cFileSize
/ BLOCKSIZE
)) req.cBytes = 0
For b&
= 1 To blocks&
- 1 req.cBytes
= req.cBytes
+ Len(dat$
) _Delay .001 'for other threads req.cBytes
= req.cBytes
+ Len(dat$
) handleGetFile~&& = req.cBytes
Function handlePost~&&
(req
As reqType
, reqBytes$
) content$
= Mid$(reqBytes$
, req.cStart
) req.cBytes
= req.cBytes
+ Len(content$
) content$
= Mid$(reqBytes$
, req.cStart
, req.cEnd
- req.cStart
- 4) req.cBytes
= req.cBytes
+ Len(content$
) + Len(req.cBoundary
) + 8 req.cFileSize
= Len(content$
) _Delay .001 'for other threads Get req.client
, , reqBytes$
req.cEnd
= InStr(reqBytes$
, req.cBoundary
) content$ = reqBytes$
req.cBytes
= req.cBytes
+ Len(content$
) content$
= Left$(reqBytes$
, req.cEnd
- 5) req.cBytes
= req.cBytes
+ Len(content$
) + Len(req.cBoundary
) + 8 req.cFileSize
= req.cFileSize
+ Len(content$
) _Delay .001 'for other threads Get req.client
, , reqBytes$
handlePost~&& = req.cBytes
Function parseRequest%
(req
As reqType
, reqBytes$
) 'printLog reqBytes$ '@@
parseRequest = FALSE
req.Typ = "": req.Path = "": req.Param = "": req.File = "": req.Auth = ""
req.cLen = 0: req.cStart = 0: req.cEnd = 0: req.cMime = "": req.cBoundary = ""
req.cFileNameIn = "": req.cFileNameOut = ""
req.cBytes = 0: req.cFileSize = 0
req.Typ = "GET": s% = 5
req.Typ = "POST": s% = 6
url$
= Mid$(reqBytes$
, s%
, h%
- s%
) If uc$
= "?" Then param%
= TRUE
If InStr("./_-~ 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz", uc$
) > 0 Then req.Path
= req.Path
+ uc$
If InStr("=_-~ 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz", uc$
) > 0 Then req.Param
= req.Param
+ uc$
req.File
= Mid$(req.Path
, bs%
+ 1) req.Path
= Left$(req.Path
, bs%
) auth%
= InStr(reqBytes$
, "Authorization: ") If auth%
> 0 Then req.Auth
= Mid$(reqBytes$
, auth%
+ 15, InStr(auth%
, reqBytes$
, CRLF
) - auth%
- 15) req.cBoundary
= Mid$(reqBytes$
, s%
+ 11, h%
- s%
- 11) req.cFileNameIn
= unquoted$
(Mid$(reqBytes$
, h%
+ 11, s%
- h%
- 11)) req.cFileNameOut = replace$(SITEPATH + req.Path + req.cFileNameIn, SEP0, SEP)
req.cMime
= Mid$(reqBytes$
, h%
+ 14, s%
- h%
- 14) req.cStart = s% + 4
req.cBytes = req.cStart - req.cBytes
req.cEnd
= InStr(req.cStart
, reqBytes$
, req.cBoundary
) parseRequest = TRUE
fspec$ = replace$(SITEPATH + req.Path, SEP0, SEP) + ".auth"
authorized% = TRUE
Function httpHeader$
(req
As reqType
, code%
, html$
) Case 200 ' render page & favicon.ico & get file res$ ="HTTP/1.1 200 OK" + CRLF + _
"Server: md" + CRLF + "Connection: close" + CRLF
If html$
<> "" Then ' render page res$
= res$
+ "Content-Type: text/html" + CRLF
+ "Content-Length:" + Str$(Len(html$
)) + CRLF
+ CRLF
+ html$
ElseIf req.File
= "favicon.ico" Then 'get favicon.ico res$ = res$ + "Content-Type: image/png" + CRLF + _
"Content-Length:" + CRLF
+ Ltrim$(Str$(req.cFileSize
)) + CRLF
+ CRLF
res$ = res$ + "Content-Type: application/force-download" + CRLF + _
"Content-Length:" + CRLF
+ Ltrim$(Str$(req.cFileSize
)) + CRLF
+ _
"Content-Transfer-Encoding: binary" + _
"Content-Disposition: attachment; filename=" + quoted$(req.File) + CRLF + CRLF
Case 301 'after post & not allowed res$ ="HTTP/1.1 301 Moved Permanently" + CRLF + _
"Location: " + req.Path + CRLF + _
"Server: md" + CRLF + "Connection: close" + CRLF + "Content-Type: text/html" + CRLF + CRLF
res$ ="HTTP/1.1 401 Unauthorized" + CRLF + _
"WWW-Authenticate: Basic" + CRLF + _
"Server: md" + CRLF + "Connection: close" + CRLF + CRLF
res$ ="HTTP/1.1 404 Not Found" + CRLF + _
"Server: md" + CRLF + "Connection: close" + CRLF + CRLF
httpHeader$ = res$
unquoted$ = uq$
curpos
= 1: arrpos
= LBound(outArray
): LD
= Len(delim
) dpos
= InStr(curpos
, inString
, delim
) outArray
(arrpos
) = Mid$(inString
, curpos
, dpos
- curpos
) arrpos = arrpos + 1
curpos = dpos + LD
dpos
= InStr(curpos
, inString
, delim
) outArray
(arrpos
) = Mid$(inString
, curpos
) split& = arrpos
FileName$
= Space$(512): res
= GetModuleFileNameA
(0, FileName$
, Len(FileName$
)) appName$ = appNam$