HTTPServer

10 REM > HTTPServer

20 REM Deliver a webpage using the HTTP

40 REM Modified by JGH to use BBC Sockets Library

50 :

60 REM **********************************************************************

70 REM * *

80 REM * No check is made of the name of the page requested, any GET *

90 REM * request will be sent a web page on port 80. Other methods such *

100 REM * as POST are left as an exercise for the reader *

110 REM * *

120 REM **********************************************************************

130 :

140 httpsize%=128:REM Buffer for request

150 httpport%=80 :REM Port number allocated for HTTP

160 httpsock%=-1 :REM The listening socket

170 httpreq% =-1 :REM The request socket

180 DIM httpsendblk httpsize%

190 DIM httprecvblk httpsize%

200 :

210 REM Blocks for addresses, conversions, and OSWord calls

220 DIM ipaddrblk 16,ipaddrlen 4

230 DIM tempblk 5

240 DIM name% 80, wordblk 32:X%=wordblk:Y%=X%DIV256

250 ON ERROR REPORT:PRINTERL:PROCskt_close(httpsock%):END

260 :

270 REM Create a socket in protocol family 'internet' for streams

280 socketstream%=1

290 socketinet%=2

300 httpsock%=FNskt_open(socketinet%,socketstream%,0)

310 IFhttpsock%<0 THEN PRINT'"Couldn't get a socket":END

320 :

330 REM Bind to the HTTP port

340 ipaddrblk?0=16

350 ipaddrblk?1=socketinet%

360 ipaddrblk!2=FNswap_16(httpport%)

370 ipaddrblk!4=0

380 ipaddrblk!8=0

390 ipaddrblk!12=0

400 IFFNskt_bind(httpsock%,ipaddrblk,16)<0 THEN PRINT"Can't bind socket":PROCskt_close(httpsock%):END

410 :

420 REM Make the socket listen for incoming connections

430 IFFNskt_listen(httpsock%,1)<0 THEN PRINT"Socket not listening":PROCskt_close(httpsock%):END

440 :

450 PRINT"Listening on port ";httpport%;" for requests"

460 REPEAT

470 REM Sit waiting for requests

480 !ipaddrlen=16

490 httpreq%=FNskt_accept(httpsock%,ipaddrblk,ipaddrlen)

500 IFhttpreq%>0 THEN PROCdorequest(httpreq%,ipaddrblk!4):PROCskt_close(httpreq%):httpreq%=-1

510 UNTIL0

520 :

530 DEFPROCdorequest(socket%,remote%)

540 LOCALsize%

550 size%=FNskt_recv(socket%,httprecvblk,httpsize%,0)

560 IFsize%<=0 THEN ENDPROC:REM Stream closed unexpectedly

570 httprecvblk?size%=13:REM Ensure a terminator

580 IFLEFT$($httprecvblk,5)<>"GET /" THEN ENDPROC

590 PRINTFNIP_Stn(remote%);" sent '"LEFT$($httprecvblk,16);"...'"

600 REM There are no sub pages, any 'GET' will return this HTML

610 $httpsendblk="HTTP/1.1 200 OK"+CHR$13+CHR$10+"Content-type: text/html"+CHR$13+CHR$10+CHR$13+CHR$10

620 IFFNskt_send(socket%,httpsendblk,44,0)<=0 THEN PRINT"Failed to deliver header"

630 $httpsendblk="<HTML><HEAD><TITLE>Test Page</TITLE></HEAD><BODY>Time is "+STR$TIME+"</BODY></HTML>"

640 IFFNskt_send(socket%,httpsendblk,LEN$httpsendblk,0)<=0 THEN PRINT"Failed to deliver page"

650 ENDPROC

660 :

670 :

680 REM > BLib.IP 1.00 12Feb2009

690 :

700 REM IP_Stn - Returns dotted net&station number

710 REM ------------------------------------------

720 DEFFNIP_Stn(A%):LOCAL B%:DIM B%-1:!B%=A%:B%!4=0

730 =STR$B%?3+"."+STR$B%?2+"."+STR$B%?1+"."+STR$?B%

740 :

750 REM IP_StnFixed - Returns fixed-length dotted net&station number

760 REM ----------------------------------------------------------------

770 DEFFNIP_StnFixed(A%):LOCAL B%:DIM B%-1:!B%=A%

780 =FNd0(B%?3,3)+"."+FNd0(B%?2,3)+"."+FNd0(B%?1,3)+"."+FNd0(?B%,3)

790 :

800 REM IP_StnNum - Convert dotted IP address string into number

810 REM --------------------------------------------------------

820 DEFFNIP_StnNum(A$):LOCAL B%:DIM B%-1:!B%=0:REPEAT!B%=!B%+VALA$

830 A%=INSTR(A$,"."):IFA%:A$=MID$(A$,A%+1):B%!1=!B%:?B%=0

840 UNTILA%=0:=!B%

850 :

860 REM swap_16 - Swap b0-b7 and b8-b15 of number

870 REM -------------------------------------------

880 DEFFNswap_16(A%)

890 LOCAL B%:DIM B%-1:!B%=A%:B%!2=A%:=(B%!1)AND&FFFF

900 :

910 REM swap_32 - word from &AABBCCDD to &DDCCBBAA

920 REM --------------------------------------------

930 DEFFNswap_32(A%)

940 LOCAL B%:DIM B%-1:!B%=A%:B%?4=B%?2:B%?5=B%?1:B%?6=?B%:=B%!3

950 :

960 DEFFNd0(A%,N%)=RIGHT$("00000000"+STR$A%,N%)

970 :

980 :

990 REM > BLib.Socket 1.00 12-Dec-2010

1000 REM Sockets Library

1010 REM Requires X%->32-byte control block, Y%=X%DIV256

1020 REM FNIP_gethost requires name%->80 bytes

1030 :

1040 REM FNIP_gethost(name$)

1050 REM -------------------

1060 DEFFNIP_gethost(A$):!X%=&411808:X%!4=name%:$name%=A$:A%=192:CALL&FFF1:IFX%?3:=0 ELSE =X%+4

1070 :

1080 REM FNskt_open(pf%,type%,prot%)

1090 REM ----------------------------

1100 DEFFNskt_open(X%!4,X%!8,X%!12):!X%=&810:A%=192:CALL&FFF1:IFX%?3:=-1 ELSE =X%!4

1110 :

1120 REM FNskt_bind(handle%,addr%,addrlen%)

1130 REM ----------------------------------

1140 DEFFNskt_bind(X%!4,X%!8,X%!12):!X%=&10810:A%=192:CALL&FFF1:IFX%?3:=-1 ELSE =X%!4

1150 :

1160 REM FNskt_listen(handle%,count%)

1170 REM ----------------------------

1180 DEFFNskt_listen(X%!4,X%!8):!X%=&2080C:A%=192:CALL&FFF1:IFX%?3:=-1 ELSE =X%!4

1190 :

1200 REM FNskt_accept(handle%,addr%,addrlen%)

1210 REM ------------------------------------

1220 DEFFNskt_accept(X%!4,X%!8,X%!12):!X%=&30816:A%=192:CALL&FFF1:IFX%?3:=-1 ELSE =X%!4

1230 :

1240 REM FNskt_connect(handle%,addr%,addrlen%)

1250 REM -------------------------------------

1260 DEFFNskt_connect(X%!4,X%!8,X%!12):!X%=&40816:A%=192:CALL&FFF1:IFX%?3:=-1 ELSE =X%!4

1270 :

1280 REM FNskt_recv(handle%,data%,len%,opts%)

1290 REM ------------------------------------

1300 DEFFNskt_recv(X%!4,X%!8,X%!12,X%!16):!X%=&50814:A%=192:CALL&FFF1:IFX%?3:=-1 ELSE =X%!4

1310 :

1320 REM FNskt_send(handle%,data%,len%,opts%)

1330 REM ------------------------------------

1340 DEFFNskt_send(X%!4,X%!8,X%!12,X%!16):!X%=&80814:A%=192:CALL&FFF1:IFX%?3:=-1 ELSE =X%!4

1350 :

1360 REM PROCskt_shutdown(handle%,type%)

1370 REM -------------------------------

1380 DEFPROCskt_shutdown(X%!4,X%!8):!X%=&B040C:A%=192:CALL&FFF1:ENDPROC

1390 :

1400 REM PROCskt_close(handle%)

1410 REM ----------------------

1420 DEFPROCskt_close(X%!4):!X%=&100408:A%=192:CALL&FFF1:ENDPROC

1430 :