' Read a remote clock using the NTP  (C)2009 SPROW 0 Modified by JGH to use BBC Sockets Library (: 2L ********************************************************************** 0 h Just take the first alias r*server%=readword(readword(host%!16)) |#"Resolved to "IP_Stn(server%) : A Create a socket in protocol family 'internet' for datagrams socketdgram%=2 socketinet%=2 3ntpsock%=skt_creat(socketinet%,socketdgram%,0) -ntpsock%<0 '"Couldn't get a socket": : < Prepare a version 3 client message to request the time count%=0(ntpsize%-1)4 ntpsendblk!count%=0  3!ntpsendblk=(ntpvers%*(2^27))(ntpmode%*(2^24)) count%=0(ntpsize%-1)4 1ntpsendblk!count%=swap_32(ntpsendblk!count%)  : & Send it 0ipaddrblk?0=16 :ipaddrblk?1=socketinet% D"ipaddrblk!2=swap_16(ntpport%) Nipaddrblk!4=server% Xipaddrblk!8=0 bipaddrblk!12=0 laskt_connect(ntpsock%,ipaddrblk,16)<0 "Couldn't connect to socket":skt_close(ntpsock%): vfskt_send(ntpsock%,ntpsendblk,ntpsize%,0)<=0 '"Couldn't send to socket":skt_close(ntpsock%): : " Wait for a whole quanta back "Waiting for time";  ".";:key%=(50) 8skt_recv(ntpsock%,ntprecvblk,ntpsize%,0)>=ntpsize% :  Tidy up $skt_close(ntpsock%):ntpsock%=-1 :  Interpret result count%=0(ntpsize%-1)4 1ntprecvblk!count%=swap_32(ntprecvblk!count%)   C(ntprecvblk!40=0)(ntprecvblk!44=0) '"Duff time received": )'"UTC = ";decodetime(ntprecvblk!40)   *: 4L ********************************************************************** >L * * HL * Common utilities * RL * * \L ********************************************************************** fݤtakefive(offset%,block%) pT Takes 5 bytes held in 'block%' from 'offset%' putting result back in 'offset%' z0lo3r%=(!offset% &FFFFFF)-(!block% &FFFFFF) ,(lo3r% &FF000000)<>0 hi2r%=1 hi2r%=0 4hi2r%=(offset%!3 &FFFF)-(block%!3 &FFFF)-hi2r% (hi2r% &FF0000)<>0 = 9!offset%=lo3r%:offset%!3=(offset%!3 &FFFF0000)hi2r% = : ݤaddday(day%) - Adds one to the day and clips to a week "day%=day%+1:day%=8 =1 =day% : ݤadddays(day%,count%)  Add many days at once %count%=count% 7:count%=0 =day% 2:day%=addday(day%):count%=count%-1:count%=0  =day% : $ݤdecodetime(seconds%) .(year%,month%,date%,day%,hour%,mins% 8more%,leap%,loop%,date$ B) Epoch is 'Mon,01 Jan 1900.00:00:00' Lyear%=1900:day%=2:leap%= V"!yearblk=365*86400:yearblk?4=0 `$!lyearblk=366*86400:lyearblk?4=0 j t%!remainblk=seconds%:remainblk?4=0 ~Sleap% more%=takefive(remainblk,lyearblk) more%=takefive(remainblk,yearblk) [more% year%=year%+1:seconds%=!remainblk:day%=addday(day%):leap% day%=addday(day%) Hyear% 4=0 year%<>1900 year%<>2100 year%<>2200 leap%= leap%=  more% + Remainder is always less than 31 bits  month%=1 $leap% month(2)=29 month(2)=28 loop%=112 more%=month(loop%)*86400 hseconds%>=more% seconds%=seconds%-more%:day%=adddays(day%,month(loop%)):month%=month%+1 loop%=13  sdate%=seconds% 86400:seconds%=seconds%-(date%*86400):day%=adddays(day%,date%):date%=date%+1: Natural numbers 7hour%=seconds% 3600:seconds%=seconds%-(hour%*3600) 3mins%=seconds% 60:seconds%=seconds%-(mins%*60)   Collect up date$="SunMonTueWedThuFriSat",1+(3*(day%-1)),3)+","+d0(date%,2)+" "+"JanFebMarAprMayJunJulAugSepOctNovDec",1+(3*(month%-1)),3)+" "+year% @=date$+"."+d0(hour%,2)+":"+d0(mins%,2)+":"+d0(seconds%,2) (: 2*0,31,28,31,30,31,30,31,31,30,31,30,31 <: F&ݤreadword(addr%):addr%<0:=!addr% PC B%:A%=5: B%=0 3:!X%=addr%+B%:&FFF1:X%?(B%+5)=X%?4::=X%!5 Z: d: n > BLib.IP 1.00 12Feb2009 x: 0 IP_Stn - Returns dotted net&station number 0 ------------------------------------------ *ݤIP_Stn(A%): B%: B%-1:!B%=A%:B%!4=0 '=B%?3+"."+B%?2+"."+B%?1+"."+?B% : B IP_StnFixed - Returns fixed-length dotted net&station number F ---------------------------------------------------------------- (ݤIP_StnFixed(A%): B%: B%-1:!B%=A% ?=d0(B%?3,3)+"."+d0(B%?2,3)+"."+d0(B%?1,3)+"."+d0(?B%,3) : > IP_StnNum - Convert dotted IP address string into number > -------------------------------------------------------- 2ݤIP_StnNum(A$): B%: B%-1:!B%=0:!B%=!B%+A$ /A%=A$,"."):A%:A$=A$,A%+1):B%!1=!B%:?B%=0 A%=0:=!B% : "/ swap_16 - Swap b0-b7 and b8-b15 of number ,1 ------------------------------------------- 6ݤswap_16(A%) @, B%: B%-1:!B%=A%:B%!2=A%:=(B%!1)&FFFF J: T0 swap_32 - word from &AABBCCDD to &DDCCBBAA ^2 -------------------------------------------- hݤswap_32(A%) r9 B%: B%-1:!B%=A%:B%?4=B%?2:B%?5=B%?1:B%?6=?B%:=B%!3 |: #ݤd0(A%,N%)="00000000"+A%,N%) : : $ > BLib.Socket 1.00 12-Dec-2010  Sockets Library 5 Requires X%->32-byte control block, Y%=X%DIV256 - FNIP_gethost() requires name%->80 bytes :  FNIP_gethost(name$)  ------------------- TݤIP_gethost(A$):!X%=&411808:X%!4=name%:$name%=A$:A%=192:&FFF1:X%?3:=0 =X%+4 : " FNskt_creat(pf%,type%,prot%) " ---------------------------- Iݤskt_creat(X%!4,X%!8,X%!12):!X%=&810:A%=192:&FFF1:X%?3:=-1 =X%!4 : &( FNskt_bind(handle%,addr%,addrlen%) 0( ---------------------------------- :Jݤskt_bind(X%!4,X%!8,X%!12):!X%=&10810:A%=192:&FFF1:X%?3:=-1 =X%!4 D: N" FNskt_listen(handle%,count%) X" ---------------------------- bFݤskt_listen(X%!4,X%!8):!X%=&2080C:A%=192:&FFF1:X%?3:=-1 =X%!4 l: v* FNskt_accept(handle%,addr%,addrlen%) * ------------------------------------ Lݤskt_accept(X%!4,X%!8,X%!12):!X%=&30816:A%=192:&FFF1:X%?3:=-1 =X%!4 : + FNskt_connect(handle%,addr%,addrlen%) + ------------------------------------- Mݤskt_connect(X%!4,X%!8,X%!12):!X%=&40816:A%=192:&FFF1:X%?3:=-1 =X%!4 : * FNskt_recv(handle%,data%,len%,opts%) * ------------------------------------ Pݤskt_recv(X%!4,X%!8,X%!12,X%!16):!X%=&50814:A%=192:&FFF1:X%?3:=-1 =X%!4 : * FNskt_send(handle%,data%,len%,opts%) * ------------------------------------ Pݤskt_send(X%!4,X%!8,X%!12,X%!16):!X%=&80814:A%=192:&FFF1:X%?3:=-1 =X%!4  : % PROCskt_shutdown(handle%,type%)  % ------------------------------- *8skt_shutdown(X%!4,X%!8):!X%=&B040C:A%=192:&FFF1: 4: > PROCskt_close(handle%) H ---------------------- R1skt_close(X%!4):!X%=&100408:A%=192:&FFF1: \: