Yet another NTP client

Share your advanced PureBasic knowledge/code with the community.
User avatar
Lunasole
Addict
Addict
Posts: 1091
Joined: Mon Oct 26, 2015 2:55 am
Location: UA
Contact:

Yet another NTP client

Post by Lunasole »

"Relatively simple" stuff which allows you to get truly exactly verified checked and approved time from some NTP server ^^

PS. It uses WinAPI to get UTC date, for linux that needs to be adapted
Here is alternative
viewtopic.php?t=81257

Code: Select all

EnableExplicit

;{ Simple NTP Client } 
	
	; 2017-2023			Luna Sole
	; v 1.0.0.5
	
	Structure ntp_packet Align #PB_Structure_AlignC
		livnmode.a				; li - 2 bits, vn = 3 bits, mode = 3 bits
		
		stratum.a				; Stratum level of the local clock
		poll.a					; Maximum interval between successive messages
		precision.a				; Precision of the local clock
		
		rootDelay.l				; Total round trip delay time
		rootDispersion.l		; Max error aloud from primary clock source
		refId.l					; Reference clock identifier
		
		refTm_s.l				; Reference time-stamp seconds
		refTm_f.l				; Reference time-stamp fraction of a second
		
		origTm_s.l				; Originate time-stamp seconds
		origTm_f.l				; Originate time-stamp fraction of a second
		
		rxTm_s.l				; Received time-stamp seconds
		rxTm_f.l				; Received time-stamp fraction of a second
		
		txTm_s.l				; Transmit time-stamp seconds
		txTm_f.l				; Transmit time-stamp fraction of a second
	EndStructure				; = 48 bytes
	
	; Difference between UNIX time (used by PB, starts at 1970) and NTP time (starts at 1900) = 70 years 
	#NTP_TIMESTAMP_DELTA = 2208988800
	
	; ------------------------------------------------ ;
	
	; Inverts byte order (BE <> LE)
	; RETURN:		inverted long
	Procedure.l BSwap32(L.l)
		ProcedureReturn 255&L>>24|(255&L)<<24|(255&L>>16)<<8|(255&L>>8)<<16
	EndProcedure
	
	; Returns system time in UTC format
	Procedure GetUTCTime()
		Protected TINFO.SYSTEMTIME
		GetSystemTime_(TINFO)
		ProcedureReturn Date(TINFO\wYear, TINFO\wMonth, TINFO\wDay, TINFO\wHour, TINFO\wMinute, TINFO\wSecond)
	EndProcedure
	
	; Updates system time/date (UTC)
	; The calling process must have the SE_SYSTEMTIME_NAME privilege. This privilege is disabled by default. 
	Procedure SetUTCTime(Date)
		Protected TINFO.SYSTEMTIME
		TINFO\wDay = Day(Date)
		TINFO\wHour = Hour(Date)
		TINFO\wMinute = Minute(Date)
		TINFO\wMonth = Month(Date)
		TINFO\wSecond = Second(Date)
		TINFO\wYear = Year(Date)
		
		SetSystemTime_(TINFO)
	EndProcedure
	
	; Here "NIST Internet Time Servers" may be used to get actual time
	; ! Do not query them more often than once per 4 seconds
	; See (http://tf.nist.gov/tf-cgi/servers.cgi) for details
	;
	; Performs request to specified NTP server and returns date
	; Server$		an IP or hostname of time server
	; UTC			If True, the return will be UTC time, else localized time
	; TimeOut		value in seconds to wait for reply
	; RETURN:		date in UNIX format received from NTP server
	; RETURN:		negative value on error:
	; 				-3:	Connection failed
	; 				-2:	Timeout expired
	; 				-1:	Invalid response received
	Procedure NTPDate(Server$, UTC, TimeOut = 30)
		; Result
		Protected NTPTime
		Protected hServ = OpenNetworkConnection(Server$, 123, #PB_Network_UDP, TimeOut * 1000)
		Protected nWait = Date() + TimeOut
		
		; Perform request
		If hServ
			; Send NTP query
			Protected nBuffer.ntp_packet
			nBuffer\livnmode = %00011011 ; which means li = 0, vn = 3, and mode = 3
			nBuffer\txTm_s = BSwap32(#NTP_TIMESTAMP_DELTA + GetUTCTime())
			SendNetworkData(hServ, nBuffer, SizeOf(ntp_packet))
			
			; Wait for response and process it
			Repeat
				If NetworkClientEvent(hServ) = #PB_NetworkEvent_Data
					ClearStructure(nBuffer, ntp_packet)
					If ReceiveNetworkData(hServ, @nBuffer, SizeOf(nBuffer)) = SizeOf(nBuffer)
						; Convert required values from "big endian" to little
						; Don't forget to convert anything else you need from response
						nBuffer\txTm_s 		= BSwap32(nBuffer\txTm_s)
						nBuffer\origTm_s 	= BSwap32(nBuffer\origTm_s)
						nBuffer\rxTm_s 		= BSwap32(nBuffer\rxTm_s)
						
						; Calculate resulting difference taking all that stuff into quads, cause unsigned ints needed
						Protected.q a, b, c, d
						CopyMemory(@nBuffer\rxTm_s, @a, 4)
						CopyMemory(@nBuffer\origTm_s, @b, 4)
						CopyMemory(@nBuffer\txTm_s, @c, 4)
						d = #NTP_TIMESTAMP_DELTA + GetUTCTime()
						; Calculate resulting time
						If UTC
							; Calculate result to UTC
							NTPTime = GetUTCTime() + ((a - b) + (c - d)) / 2
						Else
							; Calculate comparing to local time
							NTPTime = Date() + ((a - b) + (c - d)) / 2
						EndIf
					Else
						; FAIL: Invalid response received
						NTPTime = -1
					EndIf
					
					Break
				Else
					If Date() >= nWait
						; FAIL: Timeout expired
						NTPTime = -2
						Break
					EndIf
					Delay(8)
				EndIf
			ForEver
			
			CloseNetworkConnection(hServ)
		Else
			; FAIL: Connect failed
			NTPTime = -3
		EndIf
		
		ProcedureReturn NTPTime
	EndProcedure
	
;}


;------------------------------------------------------------------------
; Example

InitNetwork()
OpenConsole("Simple NTP client")

; Do all the stuff
Define NTPDate = NTPDate("time.nist.gov", #False, 30)
If NTPDate < 0
	PrintN("Failed NTP query: " + Str(NTPDate))
Else
	PrintN("System date:       " + FormatDate("%yyyy.%mm.%dd", Date()))
	PrintN("NTP server date:   " + FormatDate("%yyyy.%mm.%dd", NTPDate))
	PrintN("")
	PrintN("System time:       " + FormatDate("%hh:%ii:%ss", Date()))
	PrintN("NTP server time:   " + FormatDate("%hh:%ii:%ss", NTPDate))
EndIf

Input()

Last edited by Lunasole on Thu Apr 13, 2023 11:03 am, edited 7 times in total.
"W̷i̷s̷h̷i̷n̷g o̷n a s̷t̷a̷r"
User avatar
Lunasole
Addict
Addict
Posts: 1091
Joined: Mon Oct 26, 2015 2:55 am
Location: UA
Contact:

Re: Yet another NTP client

Post by Lunasole »

Updated it a bit: added timeout, wrapped all into simple function.. and few other such things, should be usable ^_^
"W̷i̷s̷h̷i̷n̷g o̷n a s̷t̷a̷r"
TassyJim
Enthusiast
Enthusiast
Posts: 151
Joined: Sun Jun 16, 2013 6:27 am
Location: Tasmania (Australia)

Re: Yet another NTP client

Post by TassyJim »

Works well but it assumes that I am in Daylight Saving time.
It is mid winter here!

GetTimeZoneInformation_(TZi) correctly returns 1 indicating normal time but you are adding both normal and daylight bias.

I am not sure how to handle a return of zero - DST not set

Code: Select all

    Protected TZi.TIME_ZONE_INFORMATION, re.l, TZoffset.l
    re = GetTimeZoneInformation_(TZi)
    If re = 2 
      TZoffset = TZi\Bias + TZi\DaylightBias
    Else
      TZoffset = TZi\Bias + TZi\StandardBias
    EndIf
Jim
User avatar
Lunasole
Addict
Addict
Posts: 1091
Joined: Mon Oct 26, 2015 2:55 am
Location: UA
Contact:

Re: Yet another NTP client

Post by Lunasole »

TassyJim wrote:Works well but it assumes that I am in Daylight Saving time.
It is mid winter here!

GetTimeZoneInformation_(TZi) correctly returns 1 indicating normal time but you are adding both normal and daylight bias.

I am not sure how to handle a return of zero - DST not set
Thanks for reply. I've removed GetTimeZoneInformation at all, just though of simpler&clearer variant ^^
Check updated code, should work fine
"W̷i̷s̷h̷i̷n̷g o̷n a s̷t̷a̷r"
TassyJim
Enthusiast
Enthusiast
Posts: 151
Joined: Sun Jun 16, 2013 6:27 am
Location: Tasmania (Australia)

Re: Yet another NTP client

Post by TassyJim »

That looks better now.
There's always more than one way to skin a cat.
User avatar
Lunasole
Addict
Addict
Posts: 1091
Joined: Mon Oct 26, 2015 2:55 am
Location: UA
Contact:

Re: Yet another NTP client

Post by Lunasole »

TassyJim wrote: There's always more than one way to skin a cat.
:D
"W̷i̷s̷h̷i̷n̷g o̷n a s̷t̷a̷r"
chris319
Enthusiast
Enthusiast
Posts: 782
Joined: Mon Oct 24, 2005 1:05 pm

Re: Yet another NTP client

Post by chris319 »

Improved text display:

Code: Select all

EnableExplicit

;{ Simple NTP Client }

   ;   2017         (c) Luna Sole
   
   Structure ntp_packet Align #PB_Structure_AlignC
      livnmode.a            ; li - 2 bits, vn = 3 bits, mode = 3 bits
      
      stratum.a            ; Stratum level of the local clock
      poll.a               ; Maximum interval between successive messages
      precision.a            ; Precision of the local clock
      
      rootDelay.l            ; Total round trip delay time
      rootDispersion.l      ; Max error aloud from primary clock source
      refId.l               ; Reference clock identifier
      
      refTm_s.l            ; Reference time-stamp seconds
      refTm_f.l            ; Reference time-stamp fraction of a second
      
      origTm_s.l            ; Originate time-stamp seconds
      origTm_f.l            ; Originate time-stamp fraction of a second
      
      rxTm_s.l            ; Received time-stamp seconds
      rxTm_f.l            ; Received time-stamp fraction of a second
      
      txTm_s.l            ; Transmit time-stamp seconds
      txTm_f.l            ; Transmit time-stamp fraction of a second
   EndStructure            ; = 48 bytes
   
   ; Difference between UNIX time (used by PB, starts at 1970) and NTP time (starts at 1900) = 70 years
   #NTP_TIMESTAMP_DELTA = 2208988800
   
   ; ------------------------------------------------ ;
   
   ; Inverts variable byte order (BigEndian <> LittleEndian). Author: @Rescator
   ; RETURN:      inverted val
   Procedure SwapEndian(val)
      !MOV eax, dword[p.v_val]
      !BSWAP eax
      ProcedureReturn
   EndProcedure

   ; Returns system time in UTC format
   Procedure GetUTCTime()
      Protected TINFO.SYSTEMTIME
      GetSystemTime_(TINFO)
      ProcedureReturn Date(TINFO\wYear, TINFO\wMonth, TINFO\wDay, TINFO\wHour, TINFO\wMinute, TINFO\wSecond)
   EndProcedure

   ; Performs request to nist.gov server and returns date
   ; TimeOut      value in seconds to wait for reply
   ; RETURN:      date in UNIX format received from NTP server (yes, it's like return of PB Date() function)
   ; RETURN:      negative value on error:
   ;             -4:   InitNetwork() failed
   ;             -3:   Connection failed
   ;             -2:   Timeout expired
   ;             -1:   Invalid responce received
   Procedure NTPDate(TimeOut = 30)
      ; Result
      Protected NTPTime
      
      If InitNetwork()
         ; Here "NIST Internet Time Servers" are used to get time
         ; ! Do not query them often than once per 4 seconds
         ; See (http://tf.nist.gov/tf-cgi/servers.cgi) for details
         Protected hServ = OpenNetworkConnection("time.nist.gov", 123, #PB_Network_UDP, TimeOut * 1000)
         
         ; Perform request
         Protected nWait = Date() + TimeOut
         If hServ
            ; Send NTP query
            Protected nBuffer.ntp_packet
            nBuffer\livnmode = $1B ; = 00011011, which means li = 0, vn = 3, and mode = 3
            nBuffer\txTm_s = SwapEndian(#NTP_TIMESTAMP_DELTA + GetUTCTime())
            SendNetworkData(hServ, nBuffer, SizeOf(ntp_packet))
            
            ; Wait for responce and process it
            Repeat
               If NetworkClientEvent(hServ) = #PB_NetworkEvent_Data
                  ClearStructure(nBuffer, ntp_packet)
                  If ReceiveNetworkData(hServ, @nBuffer, SizeOf(nBuffer)) = SizeOf(nBuffer)
                     ; Convert required values from "big endian" to little
                     ; Don't forget to convert anything else you need from responce
                     nBuffer\txTm_s       = SwapEndian(nBuffer\txTm_s)
                     nBuffer\origTm_s    = SwapEndian(nBuffer\origTm_s)
                     nBuffer\rxTm_s       = SwapEndian(nBuffer\rxTm_s)
                     
                     ; Calculate resulting difference taking all that stuff into quads, cause unsigned ints needed
                     Protected.q a, b, c, d
                     CopyMemory(@nBuffer\rxTm_s, @a, 4)
                     CopyMemory(@nBuffer\origTm_s, @b, 4)
                     CopyMemory(@nBuffer\txTm_s, @c, 4)
                     d = #NTP_TIMESTAMP_DELTA + GetUTCTime()
                     ; Calculate resulting time
                     NTPTime = Date() + ((a - b) + (c - d)) / 2
                     ; Finally NTPTime should contain nice data :)
                  Else
                     ; FAIL: Invalid responce received
                     NTPTime = -1
                  EndIf
                  
                  Break
               Else
                  If Date() >= nWait
                     ; FAIL: Timeout expired
                     NTPTime = -2
                     Break
                  EndIf
                  Delay(8)
               EndIf
            ForEver
            
            CloseNetworkConnection(hServ)
         Else
            ; FAIL: Connect failed
            NTPTime = -3
         EndIf
      Else
         ; FAIL: InitNetwork() failed
         NTPTime = -4
      EndIf
   
      ProcedureReturn NTPTime
   EndProcedure
   
;}



;------------------------------------------------------------------------
; Example

OpenConsole("Simple NTP client")

; Do all the stuff
Define NTPDate = NTPDate()
If NTPDate < 0
   PrintN("Failed NTP query")
Else
   PrintN("System date:       " + FormatDate("%yyyy.%mm.%dd", Date()))
   PrintN("NTP server date:   " + FormatDate("%yyyy.%mm.%dd", NTPDate))
   PrintN("")
   PrintN("System time:       " + FormatDate("%hh:%ii:%ss", Date()))
   PrintN("NTP server time:   " + FormatDate("%hh:%ii:%ss", NTPDate))
   
 EndIf

Input()
User avatar
Lunasole
Addict
Addict
Posts: 1091
Joined: Mon Oct 26, 2015 2:55 am
Location: UA
Contact:

Re: Yet another NTP client

Post by Lunasole »

Updated a bit, moving deprecated InitNetwork() outside, and some other small changes.
"W̷i̷s̷h̷i̷n̷g o̷n a s̷t̷a̷r"
User avatar
RichAlgeni
Addict
Addict
Posts: 914
Joined: Wed Sep 22, 2010 1:50 am
Location: Bradenton, FL

Re: Yet another NTP client

Post by RichAlgeni »

Nice! Thanks Luna!

The first time sync I ever wrote was a serial interface to a rack mounted radio with, if I remember correctly, an ultra-low frequency radio antennae tuned into Boulder Colorado. That was in 1992!
User avatar
Lunasole
Addict
Addict
Posts: 1091
Joined: Mon Oct 26, 2015 2:55 am
Location: UA
Contact:

Re: Yet another NTP client

Post by Lunasole »

Updated it once more, rewritten BSwap function without ASM (in a half-fart way :mrgreen: )
"W̷i̷s̷h̷i̷n̷g o̷n a s̷t̷a̷r"
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: Yet another NTP client

Post by Kwai chang caine »

Works nice here and very usefull code
Thanks for sharing 8)
ImageThe happiness is a road...
Not a destination
Post Reply