Ping test

SuperStrict

Framework Pub.StdC

Extern "OS"
	Const INVALID_SOCKET_ : Int = -1
	Const SOCK_RAW_       : Int = 3
	Const IPPROTO_ICMP    : Int = 1

	?Win32
		Const SOL_SOCKET_ : Int = $FFFF

		Function inet_addr_:Int(Address$z) = "inet_addr@4"
		Function GetCurrentProcessId:Int() = "GetCurrentProcessId@0"

	?MacOS
		Const SOL_SOCKET_ : Int = $FFFF

		Function inet_addr_:Int(Address$z) = "inet_addr"
		Function GetCurrentProcessId:Int() = "getpid"

	?Linux
		Const SOL_SOCKET_ : Int = 1

		Function inet_addr_:Int(Address$z) = "inet_addr"
		Function GetCurrentProcessId:Int() = "getpid"
	?
End Extern

Type TICMP
	Field _Type     : Byte
	Field Code      : Byte
	Field Checksum  : Short
	Field ID        : Short
	Field Sequence  : Short

	Function BuildChecksum:Short(Buffer:Short Ptr, Size:Int)
		Local Checksum:Long

		While Size > 1
			Checksum :+ Buffer[0]
			Buffer :+ 1
			Size :- 2
		Wend
		If Size Then Checksum :+ (Byte Ptr(Buffer))[0]

		Checksum = (Checksum Shr 16) + (Checksum & $FFFF)
		Checksum :+ Checksum Shr 16
		Return htons_(~Checksum)
	End Function
End Type

Const ICMP_ECHOREPLY   : Byte = 0
Const ICMP_UNREACHABLE : Byte = 3
Const ICMP_ECHO        : Byte = 8

Const ICMP_CODE_NETWORK_UNREACHABLE : Byte = 0
Const ICMP_CODE_HOST_UNREACHABLE    : Byte = 1

Function Ping:Int(RemoteIP:Int, Data:Byte Ptr, Size:Int, Sequence:Int = 0, ..
                  Timeout:Int = 5000)
	Local Socket:Int, ProcessID:Int, ICMP:TICMP, Buffer:Byte Ptr, ..
	      Start:Int, Stop:Int, Result:Int, SenderIP:Int, SenderPort:Int, ..
	      IPSize:Int

	Socket = socket_(AF_INET_, SOCK_RAW_, IPPROTO_ICMP)
	If Socket = INVALID_SOCKET_ Then Return -1

	If setsockopt_(Socket, SOL_SOCKET_, SO_RCVTIMEO, Varptr(Timeout), 4) = ..
	   SOCKET_ERROR_ Then
		closesocket_(Socket)
		Return -1
	EndIf

	ProcessID = GetCurrentProcessID()

	ICMP = New TICMP
	ICMP._Type     = ICMP_ECHO
	ICMP.Code      = 0
	ICMP.Checksum  = 0
	ICMP.ID        = ProcessID
	ICMP.Sequence  = 0

	Buffer = MemAlloc(65536)
	MemCopy(Buffer, ICMP, 8)
	MemCopy(Buffer + 8, Data, Size)
	Short Ptr(Buffer)[1] = htons_(TICMP.BuildChecksum(Short Ptr(Buffer), 8 + Size))

	If sendto_(Socket, Buffer, 8 + Size, 0, RemoteIP, 0) = SOCKET_ERROR_ Then
		MemFree(Buffer)
		closesocket_(Socket)
		Return -1
	EndIf

	Start = MilliSecs()
	Repeat
		Result = recvfrom_(Socket, Buffer, 65536, 0, SenderIP, SenderPort)
		Stop = MilliSecs()
		If Result = SOCKET_ERROR_ Then
			MemFree(Buffer)
			closesocket_(Socket)
			Return -1
		EndIf

		?X86
			IPSize = (Buffer[0] & $0F)*4
		?PPC
			IPSize = (Buffer[0] & $F0)*4
		?
		MemCopy(ICMP, Buffer + IPSize, 8)

		If ICMP.ID <> ProcessID Then
			Continue
		ElseIf ICMP._Type = ICMP_UNREACHABLE Then
			If ICMP.Code = ICMP_CODE_HOST_UNREACHABLE Or ..
			   ICMP.Code = ICMP_CODE_NETWORK_UNREACHABLE Then
				MemFree(Buffer)
				closesocket_(Socket)
				Return -1
			EndIf
		ElseIf ICMP.Code = ICMP_ECHOREPLY Then
			Exit
		EndIf
	Forever

	MemFree(Buffer)
	closesocket_(Socket)
	Return Stop - Start
End Function

Function IntIP:Int(IP:String)
	Return htonl_(inet_addr_(IP))
End Function

Function GetHostIP:Int(HostName:String)
	Local Addresses:Byte Ptr Ptr, AddressType:Int, AddressLength:Int
	Local PAddress:Byte Ptr, Address:Int

	Addresses = gethostbyname_(HostName, AddressType, AddressLength)
	If (Not Addresses) Or AddressType <> AF_INET_ Or AddressLength <> 4 Then Return 0

	If Addresses[0] Then
		PAddress = Addresses[0]
		Address = (PAddress[0] Shl 24) | (PAddress[1] Shl 16) | ..
		          (PAddress[2] Shl 8) | PAddress[3]
		Return Address
	Else
		Return 0
	EndIf
End Function

Global RemoteIP : Int, ..
       Message  : String, ..
       Data     : Byte Ptr, ..
       Result   : Int

RemoteIP = GetHostIP("google.com")
If Not RemoteIP Then
	WriteStdout("Host not found~n")
	End
EndIf

Message = "Hello, world!"
Data = Message.ToCString()
Result = Ping(RemoteIP, Data, Message.Length)
If Result = -1 Then
	WriteStdout("Ping failed~n")
	MemFree(Data)
	End
EndIf

WriteStdout("Ping tooks " + Result + "ms~n")
MemFree(Data)
End