;-*- Mode: MIDAS -*- TITLE WEBSER ; Simple Web Server -- install as DEVICE;TCP SYN120 PORT==80. ; Official TCP port for WWW Server A=1 B=2 C=3 D=4 OC=7 U1=10 U2=11 U3=12 U4=13 T=14 TT=15 P=17 NETI==1 NETO==2 FILI==3 LOC 42 JSR TSINT LOC 100 ; Here we go PAT: BLOCK 40 ; Patch area PDL: BLOCK 40 ; Push down stack DEBUG: 0 ; Non-zero when debugging FILDEV: SIXBIT /DSK/ FILFN1: SIXBIT /MAIN/ FILFN2: SIXBIT />/ FILDIR: SIXBIT /.WWW./ FILTYP: ASCIZ /plain/ ; MIME text type BLOCK 5 ; For Justin TSINT: 0 ; Interrupt handler - for fatal conditions 0 JSR AUTPSY ; Any interrupt is cause for death. AUTPSY: 0 SKIPE DEBUG .VALUE .LOGOUT LOSE: 0 ; Tell loser what went wrong JRST ERR500 LOC 1000 ; Pure code only from here on .INSRT KSC;MACROS .INSRT KSC;OUT GO: MOVEI P,PDL ; Set up stack NETOPN: SYSCAL TCPOPN,[ MOVEI NETI MOVEI NETO MOVEI PORT [-1] [-1]] JSR AUTPSY ; Failed (should timeout!) MOVEI B,3*30. ; Try for 30 sec NETLOP: MOVEI A,10. .SLEEP A, SYSCAL WHYINT,[ MOVEI NETO MOVEM A MOVEM A] .LOSE %LSSYS CAIE A,%NSOPN CAIN A,%NSRFN CAIA SOJG B,NETLOP CAIG B, JSR AUTPSY ; Timed out... NETOK: OUT(,CH(NETO),OPEN(UC$IOT)) GETCMD: PUSHJ P,GETWRD ; Read command CAME A,[SIXBIT /GET/] ; command GET JSR LOSE ; else fail CAIE C,40 ; Whitespace JSR LOSE ; else fail PUSHJ P,GETCHR ; Read first character of name CAIE C,"/ ; Should be a leading slash JSR LOSE ; else fail MOVEI B,FILFN1 ; first fn first GETFN: PUSHJ P,GETWRD ; Get one word JUMPE A,FILOPN ; Done GETFN2: CAIN C,"; ; If it's terminated by a semicolon MOVEM A,FILDIR ; then it's a directory CAIN C,": ; If it's terminated by a colon MOVEM A,FILDEV ; then it's a device CAIE C,40 ; If it's not terminated by whitespace JRST GETFN ; then continue MOVEM A,@B ; Save FNn AOS B ; Next FNn CAMLE B,FILDIR ; If past the directory CAIA ; Then fail %%% cut off for debugging JRST GETFN ; Next word FILOPN: SYSCAL OPEN,[ ; Open target file [.UAI,,FILI] ; Unit Ascii Input FILDEV FILFN1 FILFN2 FILDIR] JRST ERR404 ; or fail GETTYP: .IOT FILI,C ; get first char CAIE C,"< ; look for JRST SNDHDR ; no, text MOVE T,[ASCIZ /html/] ; yes, html MOVEM T,FILTYP SNDHDR: OUT(,("HTTP/1.0 200"),CRLF) OUT(,("Content-Type: text/"),TZ(FILTYP),CRLF,CRLF) SNDFIL: CAIE C,^C ; Skip spurious .IOT NETO,C ; We already have the first char .IOT FILI,C ; Get another char JUMPGE C,SNDFIL ; -1,,^C is EOF DONE: .CLOSE FILI, ; Clean up. .NETS NETO, ; Force the output. .CLOSE NETO, ; Disconnect. .CLOSE NETI, ; Disconnect. .LOGOUT ERR404: OUT(,("HTTP/1.1 404 No such file or directory."),CRLF) OUT(,("Content-Type: text/html"),CRLF,CRLF) OUT(,(""),CRLF) OUT(,("404 - Page not found"),CRLF) OUT(,(""),CRLF) OUT(,("

Unable to retrieve ")) OUT(,6F(FILDEV),(": "),6F(FILDIR),("; "),6F(FILFN1),SP) MOVE T,FILFN2 CAMN T,[SIXBIT //] ; CROCK - should quote by char JRST [ OUT(,(">")) JRST ERR2] OUT(,6F(FILFN2)) ERR2: OUT(,("

"),CRLF,CRLF) OUT(,("The web site you seek
"),CRLF) OUT(,("cannot be located but
"),CRLF) OUT(,("endless others exist"),CRLF) OUT(,(""),CRLF) JRST DONE ERR500: OUT(,("HTTP/1.0 500 ERROR at "),RH(LOSE)) OUT(,(" A/"),HV(A),(" B/"),HV(B),(" C/"),HV(C),(" D/"),HV(D)) OUT(,CRLF,CRLF) SKIPE DEBUG .VALUE JRST DONE GETC: ; Get one character from NETI into C, converting %XX escapes ; We're relying on junk characters (e.g. EOF) going thru unchanged ; Clobbers TT .IOT NETI,C CAIE C,"% ; If not a % POPJ P, ; then we're done SETZ C, ; result goes here PUSHJ P,GETC1 ; get first digit LSH C,4 ; * 16. GETC1: .IOT NETI,TT ; and then the other CAIL TT,"0 ; If it's less than 0 CAILE TT,"9 ; or greater than 9 CAIA ; then don't SUBI TT,"0 ; convert to binary ANDCMI TT,40 ; convert to uppercase CAIL TT,"A ; If it's less than A CAILE TT,"F ; or greater than F CAIA ; then don't SUBI TT,"A-10. ; convert to binary IOR C,TT ; Add bits to result POPJ P, GETCHR: ; Skip spaces, then read one character from NETI into C ; Clobbers TT PUSHJ P,GETC CAIE C,40 ; If space CAIN C,^I ; or tab JRST GETCHR ; then try again POPJ P, GETWRD: ; Skip spaces, then read word from NETI, until SP, CRLF, : or ; ; Returns word in sixbit in A (0 at end), terminator in C ; Jumps to LOSE if NETI disappears prematurely ; Clobbers T and TT SETZ A, ; result MOVE T,[440600,,A] ; sixbit byte pointer PUSHJ P,GETCHR ; skip spaces and get first char CAIA ; but only once GETWR2: PUSHJ P,GETC CAIL C,0 ; If EOF CAIN C,^I ; or tab MOVEI C,40 ; then consider it space CAIE C,^M ; If CR CAIN C,^J ; or LF MOVEI C,40 ; then consider it space CAIN C,40 ; If whitespace POPJ P, ; then done CAIE C,": ; If colon CAIN C,"; ; or semicolon POPJ P, ; tnen done CAMN A,[SIXBIT /HTTP/] ; If HTTP %% CROCK CAIE C,"/ ; followed by slash JRST GETWR3 ; then SETZ A, ; consider it END POPJ P, ; and return it GETWR3: CAMN T,[360600,,A+1] ; If six chars already POPJ P, ; then fail %% cut off for debugging CAIL C,"a ; If after a CAILE C,"z ; and before z CAIA ; then ANDCMI C,40 ; convert to uppercase SUBI C,40 ; convert to sixbit IDPB C,T ; add to result JRST GETWR2 ; next LITS: ; literals go here END GO