;-*- 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
GETCHR: ; Skip spaces, then read one character from NETI into C
.IOT NETI,C
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
SETZ A, ; result
MOVE T,[440600,,A] ; sixbit byte pointer
PUSHJ P,GETCHR ; skip spaces and get first char
CAIA ; but only once
GETWR2: .IOT NETI,C ; get next char
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
SUBI 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