10 SUB WWWHTM() %TITLE "WWWHTM" %IDENT "X0.15" ! http server - output a html page. ! ! (c) 2012 by Johnny Billquist ! ! X0.0 2012-04-12 Johnny Billquist ! Initial coding ! ! X0.1 2012-08-16 Johnny Billquist ! Added redirect ! ! X0.2 2012-08-29 Johnny Billquist ! Added F.CR flag ! ! X0.3 2013-09-28 Johnny Billquist ! Added check for error 14 if file is open. Assume that ! means we failed to write to network. ! ! X0.4 2015-12-02 Johnny Billquist ! Try open both with and withoout recordsize clause, as ! different files might work with one or the other. ! ! X0.5 2016-03-20 Johnny Billquist ! Add handlong of POST requests. ! ! X0.6 2016-03-29 Johnny Billquist ! Improve handling of err 14. We should always bail out ! when it happens. ! Also general cleanup of error handler. ! ! X0.7 2016-12-31 Johnny Billquist ! Add length of BODY to content length. ! ! X0.8 2017-01-18 Johnny Billquist ! Added detection and handling of connection lost. ! ! X0.9 2017-02-01 Johnny Billquist ! Added handling of accept field in requests. ! ! X0.10 2020-08-14 Johnny Billquist ! Cleared F.LOG once we have started generating header. ! This means we can get one new log entry if we get a fail ! while serving the page. ! ! X0.11 2023-02-18 Johnny Billquist ! If ACCEPT field ends up with an empty main value, ! we allow it. ! ! X0.12 2023-02-18 Johnny Billquist ! WWWERR cleared out ACCEPT. Preserve the original value ! of ACCEPT if we get a 406, for logging. ! Also optimize a bit by not having to trim the original ! ACCEPT string multiple times. ! ! X0.13 2023-02-19 Johnny Billquist ! If ACCEPT contains no semicolon, we check for space as ! a separator as well. ! ! X0.14 2023-03-05 Johnny Billquist ! Correct logging of 406. It contained the strings for ! the generated error instead of the original content. ! ! X0.15 2023-03-06 Johnny Billquist ! If content is because of error status, we do ! not check for ACCEPT. %INCLUDE "WWW.INC" %INCLUDE "LB:[1,1]BQTLIB.B2S" DECLARE STRING LN DECLARE WORD F.DONE, F.OPEN, F.FILE, F.CR DECLARE STRING FATT, FCONT DECLARE WORD I DECLARE STRING A0,AL,AR DECLARE STRING CL,CCR DEF WORD CHECK_CONTENT(STRING C, STRING A) C=EDIT$(C,1+2+4+32) A=EDIT$(A,1+4+8+16+32+128) EXIT DEF 0 IF A="" OR C="" I=INSTR(1,C,";") C=LEFT$(C,I-1) IF I>0 I=INSTR(1,C,"/") CL=LEFT$(C,I-1) CCR=RIGHT$(C,I+1) WHILE A<>"" I = INSTR(1,A,",") IF I=0 THEN A0 = A A = "" ELSE A0 = LEFT$(A,I-1) A = RIGHT$(A,I+1) END IF I = INSTR(1,A0,";") I = INSTR(1,A0," ") IF I=0 A0 = LEFT$(A0,I-1) IF I>0 I = INSTR(1,A0,"/") IF I=0 THEN AL = EDIT$(A0,2) AR = "" ELSE AL = EDIT$(LEFT$(A0,I-1),2) AR = EDIT$(RIGHT$(A0,I+1),2) END IF EXIT DEF 0 IF AL="" AL=CL IF AL="*" AR=CCR IF AR="*" EXIT DEF 0 IF AL=CL AND AR=CCR NEXT END DEF 1 ON ERROR GOTO Hell F.DONE=0 F.FILE=0 F.CR=0 F.OPEN=0 IF F.POST THEN CALL WWWERR(405,"Method not allowed", & "Allow: GET,HEAD", "") ELSE FATT = TRM$(ACCEP) FCONT = TRM$(CONTENT) IF STATVAL < 400 AND CHECK_CONTENT(FCONT,FATT) THEN CALL WWWERR(406, "Not acceptable", "", "") CALL WWWLOG(406, "Accept: "+FATT+" Content: "+FCONT) END IF END IF REPLY: GOTO HEADER IF F.NOFILE F.OPEN = 1 DOOPEN: SELECT F.OPEN CASE 1 OPEN TRM$(FNAM) FOR INPUT AS FILE HTMFIL, ACCESS READ, & ALLOW READ, ORGANIZATION SEQUENTIAL VARIABLE, & RECORDTYPE ANY, RECORDSIZE 1024, DEFAULTNAME DIR, & USEROPEN FINFO CASE 2 OPEN TRM$(FNAM) FOR INPUT AS FILE HTMFIL, ACCESS READ, & ALLOW READ, ORGANIZATION SEQUENTIAL VARIABLE, & RECORDTYPE ANY, DEFAULTNAME DIR, USEROPEN FINFO CASE 3 OPEN TRM$(FNAM) FOR INPUT AS FILE HTMFIL, ACCESS READ, & ALLOW READ, ORGANIZATION SEQUENTIAL, & RECORDTYPE ANY, DEFAULTNAME DIR, USEROPEN FINFO CASE 4 IF (STATVAL < 300) THEN CALL WWWERR(404,"Cannot open file", & "", & ERT$(ERR)+': "'+TRM$(FNAM)+'"

URI: '+ & TRM$(URI)) ELSE F.NOFILE=1 END IF GOTO REPLY END SELECT FTS=FTIME FATT = FSP$(HTMFIL) F.FILE=1 F.CR=1 IF (ASCII(MID$(FATT,2,1)) AND 2)=2 IF F.CHUNK = 0 THEN FSIZ=F.SIZE(HTMFIL,F.CR) IF ASCII(FATT) <> 1 FSIZ=FSIZE IF ASCII(FATT) = 1 END IF FSIZ = FSIZ+LEN(TRM$(BODY))+2 IF BODY<>"" HEADER: CALL WWWHDR(F.FILE) PRINT #WWWFIL,"Content-Type: ";TRM$(CONTENT) IF CONTENT <> "" PRINT #WWWFIL,TRM$(EXTRA) IF EXTRA<>"" PRINT #WWWFIL F.LOG = 0 CALL SFLG(WWWFIL, TCPOPT_HITHR) IF F.BODY AND F.FILE AND F.SKIP=0 THEN WHILE 1 GET #HTMFIL MOVE FROM #HTMFIL, LN=RECOUNT LN=LN+CR+LF IF F.CR CALL CHUNK(WWWFIL,LN) NEXT END IF DONE: F.DONE=1 IF F.BODY THEN IF BODY <> "" THEN CALL CHUNK(WWWFIL,TRM$(BODY)+CR+LF) END IF IF F.CHUNK THEN PRINT #WWWFIL,"0" PRINT #WWWFIL END IF END IF ABT: CLOSE HTMFIL IF F.FILE CALL SFLG(WWWFIL, TCPOPT_TXT+TCPOPT_HITHR) EXIT SUB Lost: CLOSE HTMFIL IF F.FILE ON ERROR GO BACK CAUSE ERROR 14 Hell: ECNT = ECNT+1 RESUME LOST IF ECNT>10 SELECT ERR CASE 11 ! End of file RESUME DONE IF F.DONE=0 RESUME ABT IF F.DONE<>0 CASE 148, 157, 160 ! Record size errors F.OPEN = F.OPEN+1 RESUME DOOPEN CASE 2, 5, 133, 175 ! Failed to open file or illegal fnam. IF STATVAL < 300 THEN CALL WWWERR(404,"File not found", & "", & ERT$(ERR)+': "'+TRM$(FNAM)+ & '"

URI: '+ TRM$(URI)) ELSE F.NOFILE=1 END IF RESUME REPLY CASE 14, 253 ! Network I/O error. ! Device hung or write lock (network error) RESUME Lost CASE ELSE ! Catchall for errors... PRINT USING "WWWHTM - Unknown error (###) 'E",ERR, & ERT$(ERR) ON ERROR GO BACK END SELECT END SUB