NTPClock

10 REM Read a remote clock using the NTP

30 REM Modified by JGH to use BBC Sockets Library

40 :

50 REM **********************************************************************

60 REM * *

70 REM * We use one of 3 of the NTP pool servers as detailed at *

80 REM * http://www.pool.ntp.org/use.html *

90 REM * and send it a simple NTP request as defined in RFC2030 and RFC958 *

100 REM * *

110 REM **********************************************************************

120 :

130 ntpsize%=48 :REM Because it is

140 ntpmode%=3 :REM Client request

150 ntpvers%=3 :REM Format version 3

160 ntpport%=123:REM Port number allocated for NTP

170 ntpsock%=-1 :REM The opened socket

180 DIM ntpsendblk ntpsize%

190 DIM ntprecvblk ntpsize%

200 :

210 REM How many days are in each month

220 DIMmonth(12):FORmonth%=0TO12:READmonth(month%):NEXT

230 :

240 REM Blocks for addresses, conversions, and OSWord calls

250 DIM ipaddrblk 16

260 DIM tempblk 5,yearblk 5,lyearblk 5,remainblk 5

270 DIM name% 80,wordblk 32,nameblk 256:X%=wordblk:Y%=X%DIV256

280 ONERRORREPORT:PRINTERL:PROCskt_close(ntpsock%):END

290 :

300 REM Resolve the server name to an address

310 server$=STR$(RND(3)-1)+".pool.ntp.org"

320 PRINT"Contacting "server$

330 REPEAT

340 host%=FNIP_gethost(server$+CHR$0)

350 UNTILhost%<>0

360 REM Just take the first alias

370 server%=FNreadword(FNreadword(host%!16))

380 PRINT"Resolved to "FNIP_Stn(server%)

390 :

400 REM Create a socket in protocol family 'internet' for datagrams

410 socketdgram%=2

420 socketinet%=2

430 ntpsock%=FNskt_creat(socketinet%,socketdgram%,0)

440 IFntpsock%<0 THEN PRINT'"Couldn't get a socket":END

450 :

460 REM Prepare a version 3 client message to request the time

470 FORcount%=0TO(ntpsize%-1)STEP4

480 ntpsendblk!count%=0

490 NEXT

500 !ntpsendblk=(ntpvers%*(2^27))OR(ntpmode%*(2^24))

510 FORcount%=0TO(ntpsize%-1)STEP4

520 ntpsendblk!count%=FNswap_32(ntpsendblk!count%)

530 NEXT

540 :

550 REM Send it

560 ipaddrblk?0=16

570 ipaddrblk?1=socketinet%

580 ipaddrblk!2=FNswap_16(ntpport%)

590 ipaddrblk!4=server%

600 ipaddrblk!8=0

610 ipaddrblk!12=0

620 IFFNskt_connect(ntpsock%,ipaddrblk,16)<0 THEN PRINT"Couldn't connect to socket":PROCskt_close(ntpsock%):END

630 IFFNskt_send(ntpsock%,ntpsendblk,ntpsize%,0)<=0 THEN PRINT'"Couldn't send to socket":PROCskt_close(ntpsock%):END

640 :

650 REM Wait for a whole quanta back

660 PRINT"Waiting for time";

670 REPEAT

680 PRINT".";:key%=INKEY(50)

690 UNTILFNskt_recv(ntpsock%,ntprecvblk,ntpsize%,0)>=ntpsize%

700 :

710 REM Tidy up

720 PROCskt_close(ntpsock%):ntpsock%=-1

730 :

740 REM Interpret result

750 FORcount%=0TO(ntpsize%-1)STEP4

760 ntprecvblk!count%=FNswap_32(ntprecvblk!count%)

770 NEXT

780 IF(ntprecvblk!40=0)OR(ntprecvblk!44=0) THEN PRINT'"Duff time received":END

790 PRINT'"UTC = ";FNdecodetime(ntprecvblk!40)

800 END

810 :

820 REM **********************************************************************

830 REM * *

840 REM * Common utilities *

850 REM * *

860 REM **********************************************************************

870 DEFFNtakefive(offset%,block%)

880 REM Takes 5 bytes held in 'block%' from 'offset%' putting result back in 'offset%'

890 lo3r%=(!offset% AND&FFFFFF)-(!block% AND&FFFFFF)

900 IF(lo3r% AND&FF000000)<>0 THENhi2r%=1 ELSEhi2r%=0

910 hi2r%=(offset%!3 AND&FFFF)-(block%!3 AND&FFFF)-hi2r%

920 IF(hi2r% AND&FF0000)<>0 THEN=FALSE

930 !offset%=lo3r%:offset%!3=(offset%!3 AND&FFFF0000)ORhi2r%

940 =TRUE

950 :

960 DEFFNaddday(day%)

970 REM Adds one to the day and clips to a week

980 day%=day%+1:IFday%=8 THEN=1 ELSE=day%

990 :

1000 DEFFNadddays(day%,count%)

1010 REM Add many days at once

1020 count%=count% MOD7:IFcount%=0 THEN=day%

1030 REPEAT:day%=FNaddday(day%):count%=count%-1:UNTILcount%=0

1040 =day%

1050 :

1060 DEFFNdecodetime(seconds%)

1070 LOCALyear%,month%,date%,day%,hour%,mins%

1080 LOCALmore%,leap%,loop%,date$

1090 REM Epoch is 'Mon,01 Jan 1900.00:00:00'

1100 year%=1900:day%=2:leap%=FALSE

1110 !yearblk=365*86400:yearblk?4=0

1120 !lyearblk=366*86400:lyearblk?4=0

1130 REPEAT

1140 !remainblk=seconds%:remainblk?4=0

1150 IFleap% THENmore%=FNtakefive(remainblk,lyearblk) ELSEmore%=FNtakefive(remainblk,yearblk)

1160 IFmore% THENyear%=year%+1:seconds%=!remainblk:day%=FNaddday(day%):IFleap% THENday%=FNaddday(day%)

1170 IFyear% MOD4=0 ANDyear%<>1900 ANDyear%<>2100 ANDyear%<>2200 THENleap%=TRUE ELSEleap%=FALSE

1180 UNTILNOTmore%

1190 REM Remainder is always less than 31 bits

1200 month%=1

1210 IFleap% THENmonth(2)=29 ELSEmonth(2)=28

1220 FORloop%=1TO12

1230 more%=month(loop%)*86400

1240 IFseconds%>=more% THENseconds%=seconds%-more%:day%=FNadddays(day%,month(loop%)):month%=month%+1 ELSEloop%=13

1250 NEXT

1260 date%=seconds% DIV86400:seconds%=seconds%-(date%*86400):day%=FNadddays(day%,date%):date%=date%+1:REM Natural numbers

1270 hour%=seconds% DIV3600:seconds%=seconds%-(hour%*3600)

1280 mins%=seconds% DIV60:seconds%=seconds%-(mins%*60)

1290 REM Collect up

1300 date$=MID$("SunMonTueWedThuFriSat",1+(3*(day%-1)),3)+","+FNd0(date%,2)+" "+MID$("JanFebMarAprMayJunJulAugSepOctNovDec",1+(3*(month%-1)),3)+" "+STR$year%

1310 =date$+"."+FNd0(hour%,2)+":"+FNd0(mins%,2)+":"+FNd0(seconds%,2)

1320 :

1330 DATA0,31,28,31,30,31,30,31,31,30,31,30,31

1340 :

1350 DEFFNreadword(addr%):IFaddr%<0:=!addr%

1360 LOCAL B%:A%=5:FOR B%=0 TO 3:!X%=addr%+B%:CALL&FFF1:X%?(B%+5)=X%?4:NEXT:=X%!5

1370 :

1380 :

1390 REM > BLib.IP 1.00 12Feb2009

1400 :

1410 REM IP_Stn - Returns dotted net&station number

1420 REM ------------------------------------------

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

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

1450 :

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

1470 REM ----------------------------------------------------------------

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

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

1500 :

1510 REM IP_StnNum - Convert dotted IP address string into number

1520 REM --------------------------------------------------------

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

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

1550 UNTILA%=0:=!B%

1560 :

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

1580 REM -------------------------------------------

1590 DEFFNswap_16(A%)

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

1610 :

1620 REM swap_32 - word from &AABBCCDD to &DDCCBBAA

1630 REM --------------------------------------------

1640 DEFFNswap_32(A%)

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

1660 :

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

1680 :

1690 :

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

1710 REM Sockets Library

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

1730 REM FNIP_gethost() requires name%->80 bytes

1740 :

1750 REM FNIP_gethost(name$)

1760 REM -------------------

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

1780 :

1790 REM FNskt_creat(pf%,type%,prot%)

1800 REM ----------------------------

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

1820 :

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

1840 REM ----------------------------------

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

1860 :

1870 REM FNskt_listen(handle%,count%)

1880 REM ----------------------------

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

1900 :

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

1920 REM ------------------------------------

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

1940 :

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

1960 REM -------------------------------------

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

1980 :

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

2000 REM ------------------------------------

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

2020 :

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

2040 REM ------------------------------------

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

2060 :

2070 REM PROCskt_shutdown(handle%,type%)

2080 REM -------------------------------

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

2100 :

2110 REM PROCskt_close(handle%)

2120 REM ----------------------

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

2140 :