10	PROGRAM WWW
	%TITLE "WWW"
	%IDENT "Y0.45"

	! http server
	! (c) 2012 by Johnny Billquist
	!
	! X0.0	2012-04-02	Johnny Billquist
	!	Initial coding
	!
	! X0.1	2012-04-09	Johnny Billquist
	!	Added HEAD function
	!
	! X0.2	2012-04-12	Johnny Billquist
	!	Split code into different functions.
	!
	! X0.3	2012-04-15	Johnny Billquist
	!	Change type detection and reply generation
	!
	! X0.4	2012-04-27	Johnny Billquist
	!	Changed parsing of request to use last whitespace to split
	!	off http version.
	!	Also added catch for log file locked error.
	!
	! X0.5	2012-11-26	Johnny Billquist
	!	Changed QT library.
	!
	! X0.6	2013-06-07	Johnny Billquist
	!	Bugfix. Check protocol type.
	!
	! X0.7	2013-06-09	Johnny Billquist
	!	Added log function
	!
	! X0.8	2013-06-15	Johnny Billquist
	!	Added getting actual OS type and version dynamically
	!
	! X0.9	2013-06-18	Johnny Billquist
	!	Changed WWWERR semantics
	!
	! X0.10	2014-03-14	Johnny Billquist
	!	Changed API
	!
	! X0.11	2014-03-23	Johnny Billquist
	!	Changed timeouts
	!
	! X0.12	2014-05-26	Johnny Billquist
	!	Changed parsing of URL to filename to handle wildcards.
	!
	! X0.13	2014-06-17	Johnny Billquist
	!	Cleaned up GETFNA.
	!
	! X0.15	2016-03-16	Johnny Billquist
	!	Bugfix in WWWLOG. Logging needs to be done with privs on.
	!
	! X0.16	2016-03-17	Johnny Billquist
	!	Added If-Modified-Since and If-Unmodified-Since
	!
	! X0.17	2016-03-22	Johnny Billquist
	!	Changed how CGI works.
	!
	! X0.18	2016-03-29	Johnny Billquist
	!	Added handling of err 14, which means network error.
	!
	! X0.19	2016-05-12	Johnny Billquist
	!	Fixed non-chunked CGI output path.
	!
	! X0.20	2016-07-17	Johnny Billquist
	!	Changed error handling at initial timeout
	!	to not produce an HTTP response.
	!
	! X0.21	26-Sep-2016	Johnny Billquist
	!	Added handling of errors when running subprocess
	!
	! X0.22	2-Dec-2016	Johnny Billquist
	!	Changed reading to use RECV instead of LINPUT
	!
	! X0.23	31-Dec-2016	Johnny Billquist
	!	Corrected content length info for possible
	!	added data in addition to file size.
	!
	! Y0.24 31-Dec-2016	Johnny Billquist
	!	Clear RQ at the end of a request.
	!
	! Y0.25	1-Feb-2017	Johnny Billquist
	!	Added Accpt: processing.
	!
	! Y0.26	2-Feb-2017	Johnny Billquist
	!	Allow multiple lines for options.
	!
	! Y0.27	10-Mar-2017	Johnny Billquist
	!	Fix pattern matching in url wildcard
	!	matching to not match wildcards against
	!	url sections containing slashes.
	!
	! Y0.28	10-Mar-2017	Johnny Billquist
	!	Revert Y0.27.
	!	Add URI scrubber to sanitize URI
	!
	! Y0.29	4-Aug-2017	Johnny Billquist
	!	Changed ACNT routines to use BQTLIB.
	!	Added checking that user was actually found.
	!
	! Y0.30	8-Oct-2017	Johnny Billquist
	!	Added call to NOTIFY when timeouts.
	!
	! Y0.31	13-Oct-2017	Johnny Billquist
	!	Improve keepalive logic. Allow it on HTTP/1.0, but
	!	default to disable for HTTP/1.0. Default to true
	!	for HTTP/1.1
	!
	! Y0.32	18-Dec-2017	Johnny Billquist
	!	Include BQTLIB definitions.
	!
	! Y0.33	24-Jan-2018	Johnny Billquist
	!	Adapted to new SUBP
	!
	! Y0.34	25-Feb-2018	Johnny Billquist
	!	Added global error counter
	!
	! Y0.35 9-Sep-2018	Johnny Billquist
	!	Added virtual host support
	!
	! Y0.36	8-Oct-2018	Johnny Billquist
	!	Added capability for CGI programs to return other than
	!	200 status.
	!
	! Y0.37	13-Oct-2019	Johnny Billquist
	!	Changed logging to first build string, and only
	!	then log it, instead of creating it on the fly
	!	when writing to the log file.
	!
	! Y0.38	5-Mar-2020	Johnny Billquist
	!	Bugfix in WWWCGI.
	!
	! Y0.39	5-Aug-2020	Johnny Billquist
	!	Added flag to indicate if request have been logged,
	!	so that entries don't get multiple logs.
	!
	! Y0.40	18-May-2021	Johnny Billquist
	!	Added sent length counter.
	!
	! Y0.41	24-May-2021	Johnny Billquist
	!	Add more information at the 995 error.
	!
	! Y0.42	28-Apr-2022	Johnny Billquist
	!	Added 400 error if HTTP/1.1 and no host option.
	!
	! Y0.43	5-Sep-2022	Johnny Billquist
	!	Added URL matching with terminating $ after wildcard
	!	to mean that the wildcarded part is not allowed to contain
	!	slashes.
	!
	! Y0.44	29-Aug-2023	Johnny Billquist
	!	Changed ACCEPT library function.
	!	Changed to not flag running state before anything has
	!	been received.
	!
	! Y0.45	8-Sep-2023	Johnny Billquist
	!	When started as a daemon, pull out remote IP before
	!	we even do ACCEPT, so we can know who is messing with
	!	us in case they don't complete the connection.

	%INCLUDE "WWW.INC"
	%INCLUDE "LB:[1,1]BQTLIB.B2S"

	DECLARE STRING LN,RQ
	DECLARE STRING TGT
	DECLARE STRING OKEY,OVAL
	DECLARE STRING START, TMP
	DECLARE WORD I,J,X,ATMO
	DECLARE WORD F.OK, F.RUN, F.UERR, MYPORT, F.HOST
	DECLARE LONG STIME
	DECLARE STRING PFX(10)

	DATA "B","KB","MB",""

	ON ERROR GOTO Hell

	CALL GINFMK(FM1,17)	! We just happen to know that the area starting
				! at FM1 is 17 words long.

	SRV="BQTWWW/0.11.6 ("+TRM$(OSTYP)+" V"+TRM$(OSVER)+")"

	RANDOMIZE

	Dloop:
	FOR I=0 TO 10
		READ PFX(I)
		EXIT Dloop IF PFX(I) = ""
	NEXT I

	DEF STRING appe(STRING S, STRING V)
		IF S="" THEN
			EXIT DEF V
		END IF
	END DEF TRM$(S)+" "+V

	DEF STRING Xbyte(LONG X)
		I = 0
		WHILE X > 1024
			EXIT DEF NUM1$(X)+PFX(I) IF PFX(I+1) = ""
			X = X/1024
			I = I + 1
		NEXT
	END DEF NUM1$(X)+PFX(I)

	REMOTE = "Unknown"
	FUN = "---"
	URI = "-"
	UAG = "?"
	REFER = ""

	F.RUN = 0			! Initially we are not in running state.
	ECNT = 0

	%if (%variant = 0)
	%then

	MYPORT = TCP(WWWFIL,800)
	IF MYPORT = 0 THEN
		PRINT "Failed to create port."
		EXIT PROGRAM
	END IF
	ATMO = 15
	%else

	MYPORT = SOCKET(WWWFIL,0)
	IF MYPORT = 0 THEN
		PRINT "Not requested from a listener."
		EXIT PROGRAM
	END IF

	ATMO = 0

	EP = GEP(WWWFIL)
	REMOTE = IP2HOS(EP,RES_ADR+RES_PORT)

	%end %if

	EP = ACCEPT(WWWFIL,TCPOPT_TXT+TCPOPT_HITHR,ATMO)
	
	REMOTE = IP2HOS(EP,RES_ADR+RES_PORT) IF ATMO > 0

	Main_Loop:
	RQ = ""
	TGT = ""
	BODY = ""
	EXTRA = ""
	STATVAL = 100
	STATTXT = "Unknown"
	CONTENT = ""
	UAG = ""
	HOST = ""
	CTYP = ""
	REFER = ""
	COOKIE = ""
	ACCEP = ""
	CLEN = 0
	F.HOST = 0
	F.V11 = 0
	F.KAF = 0
	F.NOFILE = 0
	F.BODY = 0
	F.OK = 0
	F.CGI = 0
	F.POST = 0
	F.UERR = 0
	F.CHUNK = 0
	F.SKIP = 0
	F.LOG = 0
	UIC = DEFUIC
	COMPARE = 0
	C.DATE = ""
	SNDLEN = 0
	FSIZ = 0

	KAF = " "

	! Start...

	CALL BEPRIV(DEFUIC)

	CALL STMO(WWWFIL,TMO)		! standard timeout
	RQ = EDIT$(RECV(WWWFIL,512),4+1) WHILE RQ=""	! Get request line.

	F.RUN = 1			! At this point we are running.

	! Extract and parse the request line

	I = INSTR(1,RQ," ")
	J = I

	WHILE J > 0
		X = J
		J = INSTR(X+1,RQ," ")
	NEXT

	FUN = EDIT$(LEFT$(RQ,I-1),32+1)
	URI = WWWDEC(SEG$(RQ,I+1,X-1))
	RVER = EDIT$(RIGHT$(RQ,X+1),32+1)
	CAUSE ERROR 52 IF LEFT$(RVER,5) <> "HTTP/"
	I = INSTR(1,RVER,".")
	CAUSE ERROR 52 IF I=0
	HMAJ = VAL(SEG$(RVER,6,I-1))
	HMIN = VAL(RIGHT$(RVER,I+1))

	IF (HMAJ<>1) OR (HMIN>1) THEN
		CALL WWWERR(505, "HTTP version not supported", &
			"", "This server only understand HTTP version 1")
		RVER = "HTTP/1.1"
		CALL WWWHTM
		EXIT PROGRAM
	END IF

	F.V11 = (HMAJ=1 AND HMIN=1)

	! Read all options.

	CALL STMO(WWWFIL,15)	! 15s timeout here...
	OKEY = ""
	Opt_Loop:
	WHILE 1
		LN = EDIT$(RECV(WWWFIL,512),4)
		EXIT Opt_Loop IF LN=""
		I=INSTR(1,LN,":")
		IF I>0 THEN
			OKEY = EDIT$(LEFT$(LN,I-1),32+1)
			OVAL = EDIT$(RIGHT$(LN,I+1),8+128)
		ELSE
			OVAL = EDIT$(LN,8+128)
		END IF
		SELECT OKEY
			CASE "HOST"
				HOST=OVAL
				F.HOST=1
			CASE "USER-AGENT"
				UAG=EDIT$(OVAL,16)
			CASE "CONNECTION"
				KAF=OVAL
			CASE "CONTENT-TYPE"
				CTYP=OVAL
			CASE "CONTENT-LENGTH"
				CLEN=VAL(OVAL)
			CASE "REFERER"
				REFER=OVAL
			CASE "COOKIE"
				COOKIE=appe(COOKIE,OVAL)
			CASE "IF-MODIFIED-SINCE"
				C.DATE=OVAL
				COMPARE=1
			CASE "IF-UNMODIFIED-SINCE"
				C.DATE=OVAL
				COMPARE=2
			CASE "ACCEPT"
				ACCEP=appe(ACCEP,OVAL)
			CASE ELSE
		END SELECT
	NEXT

	IF KAF="" THEN
	  KAF = "Close" IF F.V11 = 0
	  KAF = "Keep-Alive" IF F.V11 <> 0
	END IF

	F.KAF = 1 IF EDIT$(KAF,32)="KEEP-ALIVE"
	F.OK = 1

	CALL STMO(WWWFIL,3600)	! Really long timeout here.(1h)

	START = QTIME

	IF F.V11 AND F.HOST=0 THEN
		CALL WWWERR(400,"No host", "", "") 
		CALL WWWHTM
	ELSE
	    SELECT FUN
		CASE "GET","HEAD","POST"
			CALL GETFNA	! Get filename from URI
			F.BODY = 1 UNLESS FUN = "HEAD"
			F.POST = 1 IF FUN = "POST"
			CALL WWWCGI IF F.CGI
			CALL WWWHTM IF F.CGI=0
		CASE "OPTIONS"
			IF INSTR(1,URI,":") THEN
				CALL WWWERR(400,"Bad request","","")
				CALL WWWHTM
			ELSE
				CALL WWWERR(200,"OK", &
				"Allow: GET,HEAD,OPTIONS,POST"+CR+LF+ &
				"Content-Length: 0", "")
				F.NOFILE = 1
				CALL WWWHTM
			END IF
		CASE ELSE
			CALL WWWERR(405,"Method not allowed", &
				"Allow: GET,HEAD,OPTIONS,POST","")
			CALL WWWHTM
	    END SELECT
	END IF

	CALL PUSH(WWWFIL)

	STIME = QTDIFF(START,QTIME)
	STIME = 1 IF STIME=0
	CALL WWWLOG(299,"Complete. "+NUM1$(SNDLEN)+" bytes sent in "+ &
		NUM1$(QTDIFF(START, QTIME))+"s ("+Xbyte(SNDLEN/STIME)+"/s)") IF STATVAL < 300

	F.RUN = 0			! Done running.
	GOTO Main_Loop IF F.KAF
	DONE:
	EXIT PROGRAM

	UNK_ERR:
	CALL NOTIFY(WWWFIL, 5)
	CALL WWWERR(500,"Unknown error","", &
		FORMAT$(ERR,"Unknown error (###) _'")+ERT$(ERR)+"'")
	CALL WWWHTM

	EXIT PROGRAM

	Timeout:
	IF TRM$(RQ) <> "" THEN
		!CALL NOTIFY(WWWFIL, 5) IF F.RUN
		CALL WWWERR(408,"Request Timeout", &
		"","")	! Error if running.
		CALL WWWHTM
	ELSE
		CALL WWWLOG(997,"Timeout") IF F.RUN
	END IF
	GOTO DONE

	Accept:
	CALL NOTIFY(WWWFIL, 5)
	CALL WWWLOG(999,"Accept error")
	EXIT PROGRAM

	EOF:
	!CALL NOTIFY(WWWFIL, 1) IF F.RUN
	CALL WWWLOG(998,"EOF") IF F.RUN
	EXIT PROGRAM

	HUNG:
	!CALL NOTIFY(WWWFIL, 2)
	STIME = QTDIFF(START,QTIME)
	STIME = 1 IF STIME=0
	TMP = " bytes"
	TMP = " of "+NUM1$(FSIZ)+" bytes ("+NUM1$(INT(REAL(SNDLEN)/REAL(FSIZ)*100.0))+"%)" &
		IF FSIZ > 0
	CALL WWWLOG(995, "Connection lost. "+NUM1$(SNDLEN)+TMP+ &
		" sent in "+NUM1$(STIME)+"s ("+Xbyte(SNDLEN/STIME)+"/s)")
	EXIT PROGRAM

	LOOP:
	CALL NOTIFY(WWWFIL, 5)
	CALL WWWLOG(994, "Too many errors")
	EXIT PROGRAM

	Hell:
	ECNT = ECNT + 1
	RESUME LOOP IF ECNT>10
	SELECT ERR
		CASE 182	! Accept error
			RESUME Accept

		CASE 253	! Read timeout
			RESUME Timeout

		CASE 47		! Line too long
			RESUME Opt_Loop

		CASE 11		! End of file. Remote closed us down...
			RESUME EOF

		CASE 14		! Device hung. Network error...
			RESUME HUNG

		CASE ELSE	! Catchall for errors...
	! Any errors that come here will cause a 500, unless we were
	! already generating reply, at which point we instead finish.

			RESUME DONE IF F.UERR
			F.UERR = 1
			CALL WWWLOG(996,"Bad request - "+RQ) IF ERR=52
			RESUME DONE UNLESS F.OK
			PRINT "WWW - Error ";ERT$(ERR);" (";ERR;")"
			RESUME UNK_ERR
	END SELECT

	END