;-*- Mode: MIDAS -*- TITLE WEBSER ; Simple Web Server -- install as DEVICE;TCP SYN120 PORT==80. ; Official TCP port for WWW Server $$TEST==1 ; Provide some test code U.INS=1 ; UUO instruction bits U.AC=2 ; UUO string length U.E=3 ; UUO byte pointer U.CHR=4 ; UUO scratch U.TMP=5 ; UUO scratch RP=6 ; Command parser read pointer WP=7 ; Command parser write pointer A=10 ; Scratch, clobbered by PUSHJ B=11 ; Scratch, clobbered by PUSHJ C=12 ; Scratch, clobbered by PUSHJ D=13 ; Scratch, clobbered by PUSHJ E=14 ; Scratch, clobbered by PUSHJ F=15 ; Scratch, clobbered by PUSHJ P=17 ; Stack pointer NETI==1 ; Network read socket NETO==2 ; Network write socket FILI==3 ; File to send LOGO==4 ; Log file LOC 100 ; Here we go PATCH: BLOCK 20 ; Patch area PDL: -20,,PDL ; Push down stack BLOCK 20 DEBUG: 0 ; Non-zero when debugging, <0 when testing FILDEV: SIXBIT /DSK/ FILFN1: SIXBIT /MAIN/ FILFN2: SIXBIT />/ FILDIR: SIXBIT /.WWW./ FILTYP: [ASCIZ "text/html"] FILMOD: .UAI,,FILI ; File open mode, depending on type FILDEF: 0 ; set if FN1 specified by user SIXBP==440600 ; SIXBIT Byte Pointer ASCBP==440700 ; ASCII Byte Pointer SPACE==40 ; ASCII Space Character %HERE=. UUOINS==40 ; UUO instruction pickup UUOOFF==50 ; UUO table offset LOC 40 0 ; UUO instruction LOC 41 JSR U.DISP ; UUO dispatch vector LOC 42 JSR I.DISP ; Interrupt dispatch vector LOC %HERE I.DISP: 0 ; Interrupt handler - fatal 0 JSR DEATH ; Any interrupt is cause for death. DEATH: 0 SKIPE DEBUG .VALUE .LOGOUT JRST DEATH ; For Justin LOSE: 0 ; Tell loser what went wrong JRST ERR500 POPJS: AOS 0(P) ; Success return here POPJF: POPJ P, ; Error return here ; Non-SS UUOS JRST from here U.TAB: REPEAT 100-UUOOFF,JSR DEATH %UUO==UUOOFF ; Leave room for system UUOs DEFINE DEFUUO %NAME %NAME=<%UUO_33> %HERE==. LOC U.TAB-UUOOFF+%UUO ; Just the right spot JRST %HERE LOC %HERE %UUO==%UUO+1 TERMIN XXX==-1 ; Patch point indicator ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; UUOS 0-37 for sending to NETO -- decoded bitwise ;; ;; BIT 0 1 ;; --- ----------- ------------ ;; 01 AC is LEN LEN in (AC) 0 -> NUL terminated ;; 02 E is DATA DATA in (E) ;; 04 Direct Text Byte Pointer ;; 10 - Quote w/ &; ;; 20 - Quote w/ % ;; ;; Bits 04,02 are decoded as follows: ;; ;; 0,0 E is character(s) directly AC ignored ;; 0,1 [Len,,Adr] in (E) AC ignored ;; 1,0 E is Adr ;; 1,1 Byte pointer or Adr in (E) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; U.CC: 0 ; Immediate string goes here U.DISP: 0 HRRZ U.E,UUOINS ; Effective Address LDB U.INS,[.BP <77_33>,UUOINS] ; OP field CAIL U.INS,UUOINS ; If it's not an SS uuo JRST U.TAB-UUOOFF(U.INS) ; dispatch from table TRNN U.INS,06 ; If E is data (0,0) JRST [ TRNE U.E,774000 ; If there's data to the left JRST [ SETZ U.AC, ; Ignore the AC HRLZM U.E,U.CC ; Pack it up MOVEI U.E,U.CC ; with a pointer JRST U.DSP2] ; and go. MOVE U.CHR,U.E ; Otherwise, JSR U.OUT ; just send the one JRST 2,@U.DISP] ; and we're done TRNE U.INS,02 ; If [Len, Adr] in (E) (0,1) JRST [ HLRZ U.AC,@U.E ; fetch len HRRZ U.E,@U.E ; and address JRST U.DSP2] ; and ignore the AC LDB U.AC,[.BP <17_27>,,UUOINS] ; AC field (1,x) JUMPE U.AC,U.DSP3 ; If AC is set TRNE U.INS,01 ; and len in (AC) MOVE U.AC,@U.AC ; then get it U.DSP3: TRNE U.INS,02 ; If byte pointer in (E) (1,1) MOVE U.E,@U.E ; then fetch it TLNN U.E,-1 ; If data is an address U.DSP2: HRLI U.E,ASCBP ; then use a 7 bit bp for ASCII ;; Fall tru to U.TEXT ; Do the actual work for the SS UUOs ; UUO bits 01-04 have already been decoded ; U.E is a byte pointer and and U.AC holds the length U.TEXT: TRNN U.INS,30 ; If quoting requested CAIN U.AC, ; or no length is given JRST U.MTXT ; then we need to do them one by one .CALL [ SETZ ; Otherwise, just blast it out SIXBIT /SIOT/ MOVEI NETO MOVE U.E MOVE U.AC ((SETZ))] JSR DEATH ; or die JRST 2,@U.DISP ; and we're done U.MTXT: ILDB U.CHR,U.E ; Get next character CAIGE U.AC, ; If no length specified JUMPE U.CHR,U.DONE ; terminate on NUL JSR U.OUT ; Send it out SOJN U.AC,U.MTXT ; Next U.DONE: JRST 2,@U.DISP ; Return to caller ; Send U.CHR to NETO with appropriate quoting U.OUT: 0 TRNN U.INS,30 ; If it's a simple case JRST [ .IOT NETO,U.CHR ; then it's easy to do JRST @U.OUT] ; all done SETZ U.TMP, ; Nothing found yet TRNE U.INS,20 ; If we need to quote w/ % JRST [ CAIN U.CHR,"% MOVE U.TMP,[ASCIZ "%25"] CAIN U.CHR,SPACE MOVE U.TMP,[ASCIZ "%20"] CAIN U.CHR,.ASCVL /" MOVE U.TMP,[ASCIZ "%22"] JRST .+1] TRNE U.INS,10 ; If we need to quote w/ & JRST [ CAIN U.CHR,"& MOVE U.TMP,[ASCIZ "&"] CAIN U.CHR,"< MOVE U.TMP,[ASCIZ "<"] CAIN U.CHR,"> MOVE U.TMP,[ASCIZ ">"] JRST .+1] JUMPE U.TMP,[ ; If it wasn't quoted .IOT NETO,U.CHR ; then it's easy to do JRST @U.OUT] ; all done U.QUOT: SETZ U.CHR, ; Clear to recieve LSHC U.CHR,7 ; one character .IOT NETO,U.CHR ; Send it out JUMPN U.TMP,U.QUOT ; Next JRST @U.OUT ; Done ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; UUOs 0-37 N ac is leNgth immediate ;; Send String Q Quote as &item; ;; H quote as %Hex ;; |N|-|I B quote as Both ;; SS| |Q|D I Immediate char(s) ;; |-|H|- D [len,,adr] descriptor ;; | |B|P P byte Pointer ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; IRP $N,,[N,[]] $$N==.IRPCNT_0 IRP $Q,,[[],Q,H,B] $$Q==.IRPCNT_3 IRP $I,,[I,D,[],P] $$I==.IRPCNT_1 SS!$N!!$Q!!$I=<<$$N\$$Q\$$I>_33> TERMIN TERMIN TERMIN DEFINE $ASC $PRE=[],*$STR*,$POST=[] ; Build string, like ASCII .BYTE 7 $PRE IRPC $C,,$STR .ASCVL /$C TERMIN $POST .BYTE TERMIN DEFINE $$ASC *$STR* ; Two chars in RH, left adjusted IRPC $C,,$STR <<.ASCVL /$C>_<13-<7*.IRPCNT>>>\!TERMIN !0 !TERMIN DEFINE $CRLF ; Line terminator ^M ^J TERMIN DEFINE $$CRLF ; Doublespaced line $CRLF $CRLF TERMIN ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; Arbitrary length Send String macros -- SxxxX "foo" ;; ;; SSqX Send String ;; SLqX Send Strinmg,CRLF ;; SLSqX Send CRLF,String ;; SLLqX Send String,CRLF,CRLF ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; IRP %Q,,[,Q,B,H] DEFINE SS!%Q!X &%TXT& ; Send String %%LEN==<.LENGTH %TXT> IFE %%LEN, JFCL ?.STOP IFE %%LEN-1, SS!%Q!I _-35 ?.STOP IFLE %%LEN-2, SS!%Q!I (ASCII %TXT) ?.STOP IFLE %%LEN-17, SSN!%Q %%LEN,[ASCII %TXT] ?.STOP .ELSE, SS!%Q!D [%%LEN,,[ASCII %TXT]] ?.STOP TERMIN DEFINE SL!%Q!X &%TXT& ; Send Line %%LEN==<<.LENGTH %TXT>+2> IFE %%LEN, SS!%Q!I <^M_13>\<^J_4> ?.STOP IFLE %%LEN-17, SSN!%Q %%LEN,[$ASC ,%TXT,$CRLF] ?.STOP .ELSE, SS!%Q!D [<%%LEN>,,[$ASC ,%TXT,$CRLF]] ?.STOP TERMIN DEFINE SLS!%Q!X &%TXT& ; Send Linefeed and String %%LEN==<<.LENGTH %TXT>+2> IFE %%LEN, SS!%Q!I <^M_13>\<^J_4> ?.STOP IFLE %%LEN-17, SSN!%Q %%LEN,[$ASC $CRLF,%TXT,] ?.STOP .ELSE, SS!%Q!D [<%%LEN>,,[$ASC $CRLF,%TXT,]] ?.STOP TERMIN DEFINE SLL!%Q!X &%TXT& ; Send Line Doublespaced %%LEN==<<.LENGTH %TXT>+4> IFLE %%LEN-17, SSN!%Q %%LEN,[$ASC ,%TXT,$$CRLF] ?.STOP .ELSE, SS!%Q!D [%%LEN,,[$ASC ,%TXT,$$CRLF]] ?.STOP TERMIN TERMIN ; GET FileName from string ; BP in (E) -> sixbit in (AC), terminator in (AC+1) ; Skips leading spaces; terminates on :, ;, space, or non-sixbit ; Skips if gubbage in string DEFUUO GETFN U.GETF: HRRZ U.E,UUOINS ; Effective address LDB U.AC,[.BP <17_27>,,UUOINS] ; AC field SETZM @U.AC ; Clear result HRLI U.AC,SIXBP ; Point to output U.GETS: ILDB U.CHR,@U.E ; Get next character CAIN U.CHR,SPACE ; If it's space JRST U.GETS ; then keep skipping U.GET1: MOVE U.TMP,@U.E ; Remember where we were JUMPE U.CHR,U.GETL ; Bail on NUL CAIN U.CHR,^Q ; If it's quoted JRST [ ILDB U.CHR,@U.E ; then get next char JUMPE U.CHR,U.GETL ; bail on NUL JRST U.GETC] ; otherwise don't look at it CAIL U.CHR,"a ; If it's between a CAILE U.CHR,"z ; and z CAIA ; then SUBI U.CHR,40 ; convert to uppercase CAILE U.CHR,SPACE ; If it's space, or below CAILE U.CHR,"_ ; or higher than underscore JRST U.GETZ ; then it's a terminator CAIE U.CHR,": ; If it's a colon CAIN U.CHR,"; ; or a semicolon JRST U.GETZ ; then it's a terminator U.GETC: TLNN U.AC,770000 ; If we have six chars already JRST U.GETL ; then the word is too long SUBI U.CHR,40 ; Convert to sixbit IDPB U.CHR,U.AC ; Put it away ILDB U.CHR,@U.E ; Get next char JRST U.GET1 ; And do it again U.GETL: MOVEM U.TMP,@U.E ; Too far; back up U.GETZ: CAIE U.CHR, ; If we saw NUL CAIL U.AC, ; or some data AOS U.DISP ; then win MOVEM U.CHR,1(U.AC) ; Return terminator JRST 2,@U.DISP ; All done ; PUT FileName to string ; BP in (AC), sixbit in (E) ; Writes FN to string, w/o trailing spaces, ; followed by single ascii char in (AC+1) ; Never skips DEFUUO PUTFN U.PUTF: HRRZ U.E,UUOINS ; Effective address LDB U.AC,[.BP <17_27>,,UUOINS] ; AC field MOVE U.TMP,@U.E ; Fetch sixbit U.PUT1: JUMPE U.TMP,[ ; If empty, then we're done MOVE U.CHR,1(U.AC) ; Get terminator IDPB U.CHR,@U.AC ; write it to string JRST 2,@U.DISP] ; Return to caller SETZ U.CHR, ; Clear to recieve LSHC U.CHR,6 ; one sixbit char ADDI U.CHR,40 ; Convert to ASCII IDPB U.CHR,@U.AC ; Write to string JRST U.PUT1 ; Next ; READ Line from channel AC into ADR in (E) ; Cuts off CRLF, NUL-terminates ; Saves number of characters read into (ADR-1) ; Skips if EOF w/ no data DEFUUO READLN U.READ: HRR U.E,UUOINS ; Effective address SETZM -1(U.E) ; Clear char count HRRM U.E,U.AOS ; Patch AOS for char count SOS U.AOS ; Length goes before buffer LDB U.AC,[.BP <17_27>,,UUOINS] ; AC field DPB U.AC,[.BP <17_27>,,U.RD2] ; Patch .IOT HRLI U.E,ASCBP ; Make it a pointer U.RD1: SETZ U.TMP, ; No CR seen yet U.RD2: .IOT XXX,U.CHR ; Get from patched channel JUMPL U.CHR,U.RDZ ; Bail on EOF CAIN U.CHR,^M ; If it's CR JRST [ MOVE U.TMP,U.CHR ; Hold it JRST U.RD2] ; keep looking CAIN U.CHR,^J ; If it's LF JUMPN U.TMP,U.RDZ ; after CR, then we're done JUMPE U.TMP,U.RD3 ; If we have a CR IDPB U.TMP,U.E ; then write it to the string XCT U.AOS ; and count it U.RD3: IDPB U.CHR,U.E ; Write it to the string U.AOS: AOS XXX ; Increment patched char count JRST U.RD1 ; and continue U.RDZ: CAIL U.E, ; If we read anything AOS U.DISP ; then win SETZ U.CHR, ; NUL- IDPB U.CHR,U.E ; terminate JRST 2,@U.DISP ; return to caller U.CONS: ; UUO literals go here CONSTANTS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;LOC 2000 ; Pure code only from here on (except buffer) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; GO: MOVE P,PDL ; Set up stack PUSHJ P,NETOPN ; Open network sockets JSR DEATH ; or die AGAIN: READLN NETI,BUFFER ; Get command line JSR LOSE ; or bitch PUSHJ P,LOG ; Memories are made of this MOVE A,BUFFER CAME A,[ASCII "GET /"] ; The only command we know JSR LOSE PUSHJ P,PARSE ; Get DEV: DIR; FN1 FN1 JSR LOSE PUSHJ P,GETTYP ; Set FILMOD and FILTYP JRST LIST ; if no file, list the directory .CALL [ SETZ ; Open target file SIXBIT /OPEN/ MOVE FILMOD MOVE FILDEV MOVE FILFN1 MOVE FILFN2 MOVE FILDIR ((SETZ))] JRST LIST ; Oops, someone removed it MOVEI A,[ASCIZ "200 Ok"] ; Looking good PUSHJ P,SNDHDR ; Send HTTP header PUSHJ P,SNDFIL ; Copy all data DONE: .CLOSE FILI, ; Clean up. .NETS NETO, ; Force the output. .CLOSE NETO, ; Disconnect. .CLOSE NETI, ; Disconnect. SKIPGE DEBUG ; If we're testing JRST WWWTST ; then keep testing .LOGOUT ; Buh-bye now JSR DEATH ; Give up already LIST: SKIPN FILDEF ; If the loser requested a file PUSHJ P,LISTF ; or we can't list the directory PUSHJ P,ERR404 ; then bitch JRST DONE ; Open network sockets NETI and NETO ; Skips if successful NETOPN: .CALL [ SETZ ; Open network sockets SIXBIT /TCPOPN/ MOVEI NETI MOVEI NETO MOVEI PORT MOVE [-1] MOVE [-1] ((SETZ))] JSR DEATH ; or die. MOVEI B,3*30. ; Try for 30 sec NET1: MOVEI A,10. .SLEEP A, .CALL [ SETZ SIXBIT /WHYINT/ MOVEI NETO MOVEM A MOVEM A ((SETZ))] .LOSE %LSSYS ; Shouldn't happen CAIE A,%NSOPN CAIN A,%NSRFN CAIA SOJG B,NET1 JUMPG B,POPJS ; If time left, win POPJ P, ; Timed out, lose ; Figure out what type of file we're dealing with ; Sets FILMOD and FILTYP ; Skips unless file could not be opened ; NYI: recognize binary files GETTYP: MOVE A,FILFN1 CAMN A,[SIXBIT /..NEW./] ; Sorry Dave, can't do that POPJ P, ; close the pod bay door .CALL [ SETZ ; Open target file SIXBIT /OPEN/ MOVE [.UAI,,FILI] MOVE FILDEV MOVE FILFN1 MOVE FILFN2 MOVE FILDIR ((SETZ))] POPJ P, ; or lose .IOT FILI,C ; get first char CAIN C,"< ; look for JRST POPJS ; Default, no change MOVEI C,[ASCIZ "text/plain"] MOVEM C,FILTYP JRST POPJS ; Win ; Get DEV: DIR; FN1 FN2 ; Sets FNDEF if FN1 specified ; Skips if something sensible could be parsed PARSE: ; First, skip the command and slash MOVE RP,[ASCBP,,BUFFER] ; Read Pointer MOVE WP,RP ; Write pointer PAR1: ILDB C,RP ; Look at next char JUMPE C,POPJF ; Bail at end of string CAIE C,"/ ; If it's not a slash JRST PAR1 ; then keep looking ; Done skipped ; Then, take out %xx and trailing http gubbage PARX: ILDB C,RP ; Get next char CAIN C,"% ; If it's a hex escape JRST [ SETZ C, ; clear to recieve PUSHJ P,PARHEX ; first hex digit PUSHJ P,PARHEX ; second hex digit JRST PAR2] ; skip looking for HTTP/ CAIN C,SPACE ; If it's a space PUSHJ P,PARCLN ; remove trailing HTTP/x.y PAR2: IDPB C,WP ; Write char back JUMPN C,PARX ; continue until NUL ; Now we have a clean buffer with filenames only ; Finally, pick out the file name parts MOVE RP,[ASCBP,,BUFFER] ; Read pointer HRLZI B,-4 ; Count FN1 FN2 DIR PARN: GETFN C,RP ; Get next name POPJ P, ; or bail JUMPE C,POPJS ; If no more, then win CAIN D,"; ; If it's a semicolon JRST [ MOVEM C,FILDIR ; then it's a directory JRST PARN] ; Next CAIN D,": ; If it's a colon JRST [ MOVEM C,FILDEV ; then it's a device JRST PARN] ; Next AOBJP B,POPJF ; next FNn or fail if too many MOVEM C,FILDEV(B) ; Save it SETOM FILDEF ; Remember that we saw FNn JUMPE D,POPJS ; Win terminated by NUL JRST PARN ; Next ; Look for HTTP/x.y using BP in WP ; Clears C if found ; Never skips PARCLN: MOVE B,WP ; Don't touch WP MOVE A,[ASCBP,,[ASCIZ "HTTP/0.0"]] CLN1: ILDB D,A ; get next pattern char JUMPE D,CLNZ ; If it all matched, we're done ILDB E,B ; get next string char CAIGE E,"0 ; If it's between 0 CAIG E,"9 ; and 9 MOVEI E,"0 ; treat it as a 0 CAMN D,E ; If the chars match JRST CLN1 ; then keep looking CAIA ; No match CLNZ: SETZ C, POPJ P, ; Read one hex digit from BP in WP, and shift it into C ; Never skips -- garbage in, garbage out PARHEX: LSH C,4 ; * 16. ILDB A,WP ; get a digit CAIL A,"0 ; If it's less than 0 CAILE A,"9 ; or greater than 9 CAIA ; then don't SUBI A,"0 ; convert to binary ANDCMI A,40 ; convert to uppercase CAIL D,"A ; If it's less than A CAILE A,"F ; or greater than F CAIA ; then don't SUBI A,"A-10. ; convert to binary IOR C,A ; Add bits to result POPJ P, ; List a directory on user request ; Skips unless directory could not be opened LISTF: .CALL [ SETZ ; Open directory list SIXBIT /OPEN/ MOVE [.UAI,,FILI] ; Unit Ascii Input MOVE FILDEV MOVE [SIXBIT /.FILE./] MOVE [SIXBIT /(DIR)/] MOVE FILDIR ((SETZ))] POPJ P, ; or lose, don't skip MOVEI A,[ASCIZ "200 directory follows"] PUSHJ P,SNDHDR ; Send HTTP header SSX "" PUSHJ P,SNDNAM SLX "" PUSHJ P,SNDDIR SLX "" JRST POPJS ; Win ; Tell the loser it's not there ; Include directory listing, if availble ; Never skips ERR404: MOVEI A,[ASCIZ "404 no such file or directory"] PUSHJ P,SNDHDR ; HTTP header SLX "" SLX "404 - Page not found" SLX "" SSX "

Unable to retrieve " PUSHJ P,SNDNAM SLX "

" SLX "The web site you seek
" SLX "cannot be located but
" SLX "endless others exist

" SKIPE FILDEF ; If loser really wanted the dir JRST ERRZ ; then there's nothing more we can do XCT LISTF ; but, if we can open the directory CAIA ; then PUSHJ P,SNDDIR ; show what's available ERRZ: SLX "" POPJ P, ; Sorry bub, you're screwed ; Never returns ERR500: MOVEI A,[ASCIZ "500 Sorry ERRROR"] PUSHJ P,SNDHDR ; HTTP reply SKIPE DEBUG .VALUE ; Stop and have a look at it JRST DONE ; Can't trust the stack, just bail ; Send DEV: DIR; FN1 FN2 to NETO ; If FILDEF is not set, send just DEV: DIR; ; Never skips SNDNAM: MOVE A,[ASCBP,,BUFFER+20] ; Don't clobber the dir list MOVEI B,": PUTFN A,FILDEV ; write DEV: MOVEI B,"; PUTFN A,FILDIR ; write DIR; SKIPN C,FILDEF ; If we got FN1 from the user JRST NAM2 ; then MOVEI B,SPACE PUTFN A,FILFN1 ; write FN1, space SETZ B, PUTFN A,FILFN2 ; and FN2, NUL NAM2: IDPB C,A ; Always NUL-terminate SSQ BUFFER+20 ; and send, quoted POPJ P, ; Send appropriate HTTP header, using ; response message ASCIZ ptr in A ; Never skips SNDHDR: SSX "HTTP/1.0 " SS @A SLSX "Content-Type: " SS @FILTYP SLLX "" ; Double CRLF POPJ P, ; Copy file from FILI to NETO ; Never skips ; NYI: block mode transfer ; NYI: binary files SNDFIL: .IOT FILI,C ; Get a character JUMPL C,POPJF ; -1,,^C is EOF CAIE C,^C ; Unless it's a spurious ^C .IOT NETO,C ; Send it over JRST SNDFIL ; Next ; Copy directory listing from FILI to NETO ; Never skips ; NYI: Add HTML tags SNDDIR: SLX "
"
DIR2:	.IOT FILI,C
	JUMPL C,[			; EOF is -1,,^C
		SLX "
" POPJ P,] ; All done CAIE C,^M ; If it's CR CAIN C,^J ; or LF JRST DIR1 ; then it's ok CAIGE C,40 ; If it's any other control char JRST DIR2 ; then drop it DIR1: LSH C,35 ; Convert to ASCIZ SSQ C ; Quote and send JRST DIR2 ; Append command string to log file ; Never skip ; NYI: log client ip# LOG: MOVEI B,6*15. ; Try for 15 seconds LOG1: .CALL [ SETZ ; Open the log file SIXBIT /OPEN/ %CLBIT,,100000\.UAO ; Locked MOVEI LOGO MOVE [SIXBIT /DSK/] MOVE [SIXBIT /ACCESS/] MOVE [SIXBIT /LOG/] MOVE [SIXBIT /.WWW./] %CLERR,A ((SETZ))] JRST [ CAIE A,%ENAFL ; or, if it's not locked POPJ P, ; just ignore the error MOVEI A,5 .SLEEP A, ; wait a little SOJGE B,LOG1 ; then try again POPJ P,] ; Timeout -- sorry, no log .CALL [ SETZ ; Get file length SIXBIT /FILLEN/ MOVEI LOGO MOVEM A ((SETZ))] .LOSE %LSFIL ; Shouldn't happen .ACCESS LOGO,A ; Seek to EOF .IOT LOGO,["2] ; Hardcode the century .IOT LOGO,["0] ; this will have to change eventually .RDATIM A, ; get date and time EXCH A,B ; We want the date first MOVE D,[SIXBP,,A] ; point to the date MOVE E,[ASCBP,,[ASCIZ "-- :: "]]; point to the separators LOGT: ILDB F,E ; Get a separator JUMPE F,LOG2 ; If it's NUL, the timestamp is done ILDB C,D ; Get first digit ADDI C,40 ; Convert to sixbit .IOT LOGO,C ; Write it out ILDB C,D ; Get next digit ADDI C,40 ; Convert to sixbit .IOT LOGO,C ; Write it out .IOT LOGO,F ; Write the separator JRST LOGT ; Next date part LOG2: MOVE A,[ASCBP,,BUFFER] ; Point at command string .CALL [ SETZ SIXBIT /SIOT/ MOVEI LOGO MOVE A MOVE BUFLEN ((SETZ))] .IOT LOGO,["?] ; Oh, blah LOGZ: .IOT LOGO,[^M] ; CR .IOT LOGO,[^J] ; LF .CLOSE LOGO, POPJ P, ; All done CONST: ; literals go here CONSTANTS BUFLEN: 0 ; Number of characters read by READLN BUFFER: ; I/O scratch until end of page BUFSIZ=<2000-.>*5 ; Size in bytes DEFINE PRINT% (#X#) PRINTX "X" TERMIN IF2,{ PRINT% BUFSIZ PRINTX " bytes I/O Buffer available "} IFN $$TEST,{ ; Just Testing LOC 2000 ; Next page ; Excersize some SS UUOs UUOTST: SETOM DEBUG .OPEN NETO,[.UAO,,'TTY] .LOSE %LSFIL IRP SSS,,[SSX,SSQX,SSHX,SSBX,SLX,SLSX,SLLX] SLX "Testing SSS" SSS "" SSS "A" SSS "BC" SSS "DEFGHI" SSS "*XXXXXXXXXX<&> %:/XXXXXXXXXX*" SLX "" TERMIN SLLX "Done" .VALUE ; Get command from TTY instead of net WWWTST: MOVE P,PDL SETOM DEBUG .OPEN NETI,[.UAI,,'TTY] .LOSE %LSFIL .OPEN NETO,[.UAO,,'TTY] .LOSE %LSFIL SSX "HTTP>" JRST AGAIN } END GO