407 lines
10 KiB
QBasic
407 lines
10 KiB
QBasic
' Applesoft BASIC Webserver
|
|
' by Vince Weaver <vince@deater.net>
|
|
'
|
|
1 REM *** Setup UTHERNET II - W5100
|
|
' SLOT0=$C080 49280 SLOT4=$C0C0 49344
|
|
' SLOT1=$C090 49296 SLOT5=$C0D0 49360
|
|
' SLOT2=$C0A0 49312 SLOT6=$C0E0 49376
|
|
' SLOT3=$C0B0 49328 SLOT7=$C0F0 49392
|
|
'
|
|
' Set up the memory addresses to use
|
|
'
|
|
2 REM *** OURS IS IN SLOT3 ($C0B0)
|
|
3 SLOT=49328: REM *** $C0B0
|
|
4 MR=SLOT+4: REM *** MODE REGISTER C0B4
|
|
5 HA=SLOT+5:LA=SLOT+6: REM *** HIGH/LOW ADDR $C0B5,$C0B6
|
|
7 DP=SLOT+7: REM *** DATA PORT $C0B7
|
|
'
|
|
' Init the W5100
|
|
'
|
|
10 REM *** Init W5100
|
|
12 POKE MR,128 : REM RESET W5100
|
|
14 POKE MR,3 : REM AUTOINCREMENT
|
|
20 REM *** Setup MAC Address 41:50:50:4c:45:32
|
|
22 POKE HA,0:POKE LA,9
|
|
23 POKE DP,65:POKE DP,80:POKE DP,80:POKE DP,76:POKE DP,69:POKE DP,50
|
|
30 REM *** Setup IP Address 192.168.8.15
|
|
32 POKE LA,15
|
|
33 POKE DP,192:POKE DP,168:POKE DP,8:POKE DP,15
|
|
40 PRINT "UTHERNET II READY: 192.168.8.15"
|
|
'
|
|
' Setup Machine Language Memcpy routine
|
|
' NOTE! This code assumes the Uthernet is in slot 3
|
|
' FIXME: patch on the fly once it works
|
|
' See Appendix 1 at the end of this for more details
|
|
'
|
|
50 FOR I=0 TO 72: READ X: POKE 768+I,X:NEXT I
|
|
51 DATA 169,0,133,6,169,64,133,7,162,11,240,36,160,0,177,6
|
|
52 DATA 141,183,192,213,9,208,15,217,8,0,208,10,169,64,141,181
|
|
53 DATA 192,169,0,141,182,192,200,208,229,230,7,202,208,224,162,10
|
|
54 DATA 177,6,141,183,192,217,8,0,208,10,169,64,141,181,192,169
|
|
55 DATA 0,141,182,192,200,202,208,232,96
|
|
'
|
|
' Setup Socket 0
|
|
'
|
|
100 REM *** Setup Socket 0
|
|
102 PRINT "** Setting up Socket 0"
|
|
105 POKE HA,0:POKE LA,26: REM RX MEMSIZE
|
|
110 POKE DP,3: REM 8kB RX buffer
|
|
115 POKE DP,3: REM 8kB TX buffer
|
|
200 REM *** Setup TCP MODE on SOCKET 0
|
|
205 POKE HA,4: POKE LA,0: REM *** 0x400 mode
|
|
210 POKE DP,65 : REM *** 0x41 MAC FILTER (non-promisc) TCP
|
|
300 REM ** Setup Source PORT
|
|
303 PRINT "** Setting up to use TCP port 80"
|
|
305 POKE HA,4: POKE LA,4: REM *** 0x404 port
|
|
310 POKE DP,0:POKE DP, 80: REM *** http port 80
|
|
'
|
|
' OPEN the socket
|
|
'
|
|
400 REM *** OPEN socket
|
|
404 PRINT "** OPENing socket"
|
|
405 POKE HA,4: POKE LA,1: REM *** 0x401 command register
|
|
410 POKE DP, 1: REM *** OPEN
|
|
'
|
|
' Check return value
|
|
'
|
|
500 REM *** Check if opened
|
|
505 POKE HA,4: POKE LA,3: REM *** 0x403 status register
|
|
510 RE=PEEK(DP)
|
|
515 PRINT "** STATUS IS ";RE;
|
|
520 IF RE=19 THEN PRINT " OPENED":GOTO 600
|
|
530 IF RE=0 THEN PRINT " CLOSED, ERROR": GOTO 5000
|
|
540 PRINT "UNKNOWN ERROR ";RE
|
|
550 GOTO 5000
|
|
'
|
|
' LISTEN on the socket
|
|
'
|
|
600 REM *** Connection opened, Listen
|
|
605 POKE HA,4: POKE LA,1: REM *** 0x401 command register
|
|
610 POKE DP, 2: REM *** LISTEN
|
|
'
|
|
' Check return value
|
|
'
|
|
620 REM *** Check if successful
|
|
625 POKE HA,4: POKE LA,3: REM *** 0x403 status register
|
|
630 RE=PEEK(DP)
|
|
635 PRINT "** STATUS IS ";RE;
|
|
640 IF RE=20 THEN PRINT " LISTENING":GOTO 700
|
|
650 IF RE=0 THEN PRINT " CLOSED, ERROR":GOTO 5000
|
|
655 PRINT "UNKNOWN ERROR ";RE
|
|
675 GOTO 5000
|
|
'
|
|
' Wait for incoming connection
|
|
'
|
|
700 REM *** Wait for incoming connection
|
|
705 POKE HA,4: POKE LA,1: REM *** 0x401 command register
|
|
710 POKE DP, 2: REM *** LISTEN
|
|
'
|
|
' Check for result
|
|
'
|
|
720 REM *** Check if successful
|
|
725 POKE HA,4: POKE LA,3: REM *** 0x403 status register
|
|
730 RE=PEEK(DP)
|
|
740 IF RE=23 THEN GOTO 800: REM ESTABLISHED
|
|
745 IF RE<>20 THEN PRINT "WAITING: UNEXPECTED STATUS=";RE
|
|
750 GOTO 700: REM *** Repeat until connected
|
|
'
|
|
' Established, repeat waiting for incoming data
|
|
'
|
|
800 PRINT "ESTABLISHED"
|
|
802 POKE HA,4: POKE LA,38: REM *** 0x426 Received Size
|
|
805 SH=PEEK(DP):SL=PEEK(DP)
|
|
810 SI=(SH*256)+SL
|
|
820 IF SI<>0 THEN GOTO 900
|
|
'
|
|
' Should we delay? busy polling seems wasteful
|
|
'
|
|
830 REM DELAY?
|
|
840 GOTO 802
|
|
'
|
|
' We have some data, let's read it
|
|
'
|
|
900 POKE HA,4: POKE LA,40: REM *** 0x428 Received ptr
|
|
905 OH=PEEK(DP):OL=PEEK(DP)
|
|
910 RF=(OH*256)+OL
|
|
920 REM *** MASK WITH 0x1ff
|
|
925 R%=RF/8192:RM=RF-(8192*R%)
|
|
930 RA=RM+24576:REM $6000
|
|
940 PRINT "READ OFFSET=";RM;" READ ADDRESS=";RA;" READ SIZE=";SI
|
|
'
|
|
' Check for buffer wraparound
|
|
'
|
|
942 BW=0
|
|
945 IF (SI+TA>=32768) THEN BW=1:BO=32768-TA:PRINT "RX BUFFER WRAPAROUND IN ";BO
|
|
'
|
|
' Print received packet
|
|
'
|
|
1000 REM *** PRINT PACKET
|
|
1001 FL=1:FL$=""
|
|
1003 R%=RA/256
|
|
1005 POKE HA,R%: POKE LA,RA-(R%*256)
|
|
1010 FOR I=1 TO SI
|
|
1020 C=PEEK(DP):C$=CHR$(C)
|
|
1025 IF FL=1 THEN FL$=FL$+C$
|
|
1027 IF C=10 THEN FL=0
|
|
1030 IF C<>10 THEN PRINT C$;
|
|
1032 IF BW=0 THEN GOTO 1040
|
|
1033 BO=BO-1: IF BO=0 THEN POKE HA,96:POKE LA,0:BW=0
|
|
1040 NEXT I
|
|
'
|
|
' Deal with first line
|
|
'
|
|
1050 PRINT "FIRST LINE=";FL$
|
|
1060 IF LEFT$(FL$,3)<>"GET" GOTO 7000
|
|
1065 N$=""
|
|
1070 FOR I=6 TO LEN(FL$)
|
|
1075 M$=MID$(FL$,I,1)
|
|
1080 IF M$=" " GOTO 1090
|
|
1085 N$=N$+M$
|
|
1087 NEXT I
|
|
1090 IF N$="" THEN N$="index.html"
|
|
1095 PRINT "SENDING FILE: ";N$
|
|
'
|
|
' TODO: handle wraparound of 8kb buffer
|
|
'
|
|
'
|
|
' Update read pointer
|
|
'
|
|
1100 REM *** Update read pointer
|
|
1110 POKE HA,4: POKE LA,40: REM *** 0x428 Received ptr
|
|
1120 RA=RF+SI
|
|
1130 R%=RA/256
|
|
1140 POKE DP,R%: POKE DP,RA-(R%*256)
|
|
1150 REM *** RECEIVE
|
|
1160 POKE HA,4: POKE LA,1: REM *** 0x401 command register
|
|
1170 POKE DP, 64: REM *** RECV
|
|
'
|
|
' Load file from disk
|
|
'
|
|
1200 REM *** LOAD FILE
|
|
1202 X$=RIGHT$(N$,3):M$="text/html"
|
|
1203 IF X$="txt" THEN M$="text/plain"
|
|
1204 IF X$="png" THEN M$="image/png"
|
|
1205 IF X$="jpg" THEN M$="image/jpg"
|
|
1206 IF X$="ico" THEN M$="image/x-icon"
|
|
1207 IF N$="teapot.html" GOTO 9000
|
|
1208 ONERR GOTO 8000
|
|
1209 PRINT "LOADING ";N$
|
|
1210 PRINT CHR$(4)+"BLOAD ";N$
|
|
1215 POKE 216,0: REM CANCEL ONERR
|
|
1220 FS=PEEK(43616)+256*PEEK(43617): REM FILESIZE
|
|
1225 PRINT "DONE LOADING"
|
|
' assume loaded at 0x4000, text page 2
|
|
' and that max size is 8kb
|
|
1240 A$="HTTP/1.1 200 OK"+CHR$(13)+CHR$(10)
|
|
1250 A$=A$+"Server: VMW-web"+CHR$(13)+CHR$(10)
|
|
1260 A$=A$+"Content-Length: "+STR$(FS)+CHR$(13)+CHR$(10)
|
|
1280 A$=A$+"Content-Type: "+M$+CHR$(13)+CHR$(10)+CHR$(13)+CHR$(10)
|
|
'
|
|
1380 PRINT "SENDING:":PRINT A$
|
|
1385 C=0
|
|
'
|
|
' read TX free size reg (0x420)
|
|
'
|
|
1700 SI=LEN(A$)+FS
|
|
1710 IF (SI>8192) THEN PRINT "FILE TOO BIG!": REM GOTO 403?
|
|
1800 POKE HA,4: POKE LA,32: REM *** 0x420 FREESIZE
|
|
1810 OH=PEEK(DP):OL=PEEK(DP)
|
|
1815 FR=(OH*256)+OL
|
|
1820 PRINT "FREE: ";FR
|
|
1830 IF SI>FR GOTO 1800: REM REPEAT UNTIL FREE
|
|
'
|
|
' Read tx offset
|
|
'
|
|
1900 POKE HA,4: POKE LA,36: REM *** 0x424 TX write ptr
|
|
1905 OH=PEEK(DP):OL=PEEK(DP)
|
|
1910 TF=(OH*256)+OL
|
|
1920 REM *** MASK WITH 0x1ff
|
|
1925 T%=TF/8192:TM=TF-(8192*T%)
|
|
1930 TA=TM+16384:REM $4000
|
|
1940 PRINT "OH/OL=";OH;"/";OL;" TX OFFSET=";TM;" TX ADDRESS=";TA;" TX SIZE=";SI
|
|
'
|
|
' Check for buffer wraparound
|
|
'
|
|
1942 BW=0:BO=0
|
|
1945 IF (SI+TA>=24576) THEN BW=1:BO=24576-TA:PRINT "TX BUFFER WRAPAROUND IN ";BO
|
|
'
|
|
' Write data to TX buffer
|
|
' First write header
|
|
'
|
|
2000 T%=TA/256
|
|
2005 POKE HA,T%: POKE LA,TA-(T%*256)
|
|
2010 FOR I=1 TO LEN(A$)
|
|
2015 POKE DP,ASC(MID$(A$,I,1))
|
|
2017 IF BW=0 THEN GOTO 2020
|
|
2018 BO=BO-1: IF BO=0 THEN POKE HA,64:POKE LA,0:BW=0
|
|
2020 NEXT I
|
|
'
|
|
' Write disk part
|
|
'
|
|
2025 FOR I=1 TO FS
|
|
2026 C=C+1: IF C=50 THEN PRINT ".";:C=0
|
|
2030 POKE DP,PEEK(16383+I)
|
|
2032 IF BW=0 THEN GOTO 2035
|
|
2033 BO=BO-1: IF BO=0 THEN POKE HA,64:POKE LA,0:BW=0
|
|
2035 NEXT I
|
|
2040 PRINT
|
|
'
|
|
' The above is slow
|
|
' Intead use our machine language routine
|
|
'
|
|
'2025 B%=BO/256:POKE 9,B%:POKE 8,BO-(B%*256)
|
|
'2027 B%=FS/256:POKE 11,B%:POKE 10,FS-(B%*256)
|
|
'2030 CALL 768
|
|
'
|
|
' Update TX write ptr
|
|
'
|
|
2050 REM ** UPDATE TX WRITE PTR
|
|
2060 POKE HA,4: POKE LA,36: REM *** 0x424 TX write ptr
|
|
2075 TA=TF+SI
|
|
2080 T%=TA/256
|
|
2085 POKE DP,T%: POKE DP,TA-(T%*256)
|
|
2090 PRINT "UPDATE TX TO ";T%;"/";TA-(T%*256)
|
|
'
|
|
' SEND packet
|
|
'
|
|
2100 REM *** SEND
|
|
2102 PRINT "SENDING"
|
|
2105 POKE HA,4: POKE LA,1: REM *** 0x401 command register
|
|
2110 POKE DP, 32: REM *** SEND
|
|
'
|
|
' Return to reading
|
|
'
|
|
4000 REM *** Check if successful
|
|
4010 POKE HA,4: POKE LA,3: REM *** 0x403 status register
|
|
4020 RE=PEEK(DP)
|
|
4030 PRINT "STATUS AFTER SEND ";RE
|
|
4035 IF RE=28 THEN GOTO 6000: REM CLOSE_WAIT
|
|
4040 IF RE=0 THEN GOTO 400: REM CLOSED
|
|
4060 REM *** RECEIVE
|
|
4075 POKE HA,4: POKE LA,1: REM *** 0x401 command register
|
|
4080 POKE DP, 64: REM *** RECV
|
|
4090 GOTO 800
|
|
'
|
|
' Close the socket
|
|
'
|
|
5000 REM *** CLOSE AND EXIT
|
|
5010 POKE HA,4: POKE LA,1: REM *** 0x401 command register
|
|
5020 POKE DP, 16: REM *** CLOSE
|
|
5030 END
|
|
6000 REM *** CLOSE AND RELISTEN
|
|
6010 POKE HA,4: POKE LA,1: REM *** 0x401 command register
|
|
6020 POKE DP, 16: REM *** CLOSE
|
|
' Check status?
|
|
6030 GOTO 400
|
|
'
|
|
'
|
|
' ERROR MESSAGES
|
|
'
|
|
'
|
|
7000 REM 400 BAD REQUEST
|
|
7005 S$="400 Bad Request"
|
|
7010 M$="<html><head><title>400 Bad Request</title></head><body><h1>Bad Request</h1><p>Your browser sent a request that this server could not understand.<br /></p></body></html>"+CHR$(13)+CHR$(10)
|
|
7020 GOTO 9100
|
|
8000 REM 404 NOT FOUND
|
|
8003 POKE 216,0: REM CANCEL ONERR
|
|
8004 PRINT "DISK ERROR: ";PEEK(222)
|
|
8005 S$="404 Not Found"
|
|
8010 M$="<html><head><title>404 Not Found</title></head><body><h1>Not Found</h1><p>File not found.<br /></p></body></html>"+CHR$(13)+CHR$(10)
|
|
8020 GOTO 9100
|
|
9000 REM 418 TEAPOT
|
|
9005 S$="418 I'm a Teapot"
|
|
9010 M$="<html><head><title>418 I'm a Teapot</title></head><body><h1>I'm a Teapot</h1><p>Short *and* stout.<br /></p></body></html>"+CHR$(13)+CHR$(10)
|
|
'
|
|
' Make header
|
|
'
|
|
9100 A$="HTTP/1.1 "+S$+CHR$(13)+CHR$(10)+"Server: VMW-web"+CHR$(13)+CHR$(10)
|
|
9105 A$=A$+"Content-Length: "+STR$(LEN(M$))+CHR$(13)+CHR$(10)
|
|
9110 A$=A$+"Connection: close"+CHR$(13)+CHR$(10)+"Content-Type: text/html; charset=iso-8859-1"+CHR$(13)+CHR$(10)+CHR$(13)+CHR$(10)
|
|
' Poke as if we had loaded from disk
|
|
9200 FS=LEN(M$)
|
|
9210 FOR I=1 TO FS
|
|
9220 POKE 16383+I,ASC(MID$(M$,I,1))
|
|
9300 NEXT I
|
|
9310 GOTO 1380
|
|
'
|
|
' STATUSES
|
|
' p28 of W5100 manual
|
|
' 0x0 0 SOCK_CLOSED
|
|
' 0x13 SOCK_INIT
|
|
' 0x14 SOCK_LISTEN
|
|
' 0x17 23 SOCK_ESTABLISHED
|
|
' 0x1C 28 SOCK_CLOSE_WAIT
|
|
' 0x22 SOCK_UDP
|
|
' 0x32 SOCK_IPRAW
|
|
' 0x42 SOCK_MACRAW
|
|
' 0x5f SOCK_PPOE
|
|
|
|
'
|
|
' Appendix 1: The memcpy machine code
|
|
'
|
|
'
|
|
'PTR EQU $06
|
|
'PTRH EQU $07
|
|
'
|
|
'WRAPL EQU $08
|
|
'WRAPH EQU $09
|
|
'
|
|
'SIZEL EQU $0A
|
|
'SIZEH EQU $0B
|
|
'
|
|
'tx_copy:
|
|
'
|
|
' lda #0 ; always copying from 0x4000
|
|
' sta PTR
|
|
' lda #$40
|
|
' sta PTR+1
|
|
'
|
|
' ldx #SIZEH ; number of 256-byte blocks
|
|
' beq copy_remainder ; if none, skip ahead
|
|
'
|
|
' ldy #0
|
|
'copy256:
|
|
' lda (PTR),y
|
|
' sta $C0B7 ; change based on uthernet slot
|
|
'
|
|
' cmp WRAPH,x
|
|
' bne nowrap256
|
|
'
|
|
' cmp WRAPL,y
|
|
' bne nowrap256
|
|
'
|
|
' lda #$40
|
|
' sta $C0B5
|
|
' lda #$00
|
|
' sta $C0B6 ; wrap tx buffer address to 0x4000
|
|
'
|
|
'nowrap256:
|
|
' iny
|
|
' bne copy256
|
|
'
|
|
' inc PTR+1 ; update 16-bit pointer
|
|
' dex ; finish a 256 byte block
|
|
' bne copy256
|
|
'
|
|
' ldx #SIZEL
|
|
'copy_remainder:
|
|
' lda (PTR),y
|
|
' sta $C0B7 ; change based on uthernet slot
|
|
'
|
|
' cmp WRAPL,y
|
|
' bne nowrap_r
|
|
'
|
|
' lda #$40
|
|
' sta $C0B5
|
|
' lda #$00
|
|
' sta $C0B6 ; wrap tx buffer address to 0x4000
|
|
'
|
|
'nowrap_r:
|
|
' iny
|
|
' dex
|
|
' bne copy_remainder
|
|
'
|
|
' rts
|
|
|
|
|