(*
/*

CLASS {NATIVE_Socket|_Pascal},
UNTESTED, NATIVE, BYTES:

IMPORT: {Socket}, {String_functions} .

NATIVE: @
	"uses NATIVE_Socket, "
	"	  {$IFDEF LINUX} sockets, process "
	"	  {$ELSE} WinSock, Windows {$ENDIF};" .
NATIVE: "///COPY NATIVE_Socket.pas" .
NATIVE: "{$IFDEF LINUX}{$ELSE} type pu_long = ^u_long; {$ENDIF} " .

*/
*)

unit NATIVE_Socket;

interface

uses {$IFDEF LINUX} sockets {$ELSE} WinSock, Windows {$ENDIF} ;

function Create_socket(
		X_Address,
		X_Type,
		X_Protocol: Byte;
		X_Is_server: Boolean): Integer;

implementation

(*
/*

FUN Create_socket(
{Socket}.{address_family} Address|_family,
{Socket}.{socket_type} Type|_of_socket,
{Socket}.{protocol} Protocol,
BOOL Is_server) ==> INT, NATIVE: @
	"RESULT := NATIVE_Socket.Create_socket("
	"	X_Address, X_Type, X_Protocol, X_Is_server);" .
	
*/
*)

{$IFDEF LINUX}
{$ELSE}
	var WinSocks_initialized: Boolean;
	var varTWSAData : TWSAData;
{$ENDIF}

function Create_socket(
		X_Address,
		X_Type,
		X_Protocol: Byte;
		X_Is_server: Boolean): Integer;
var s: TSocket;
	prot: Integer;
const INVALID_SOCKET = TSocket(not(0));
begin
{$IFDEF LINUX}
{$ELSE}
	if not WinSocks_initialized then
	begin
		WSAStartup(MakeWord(2,0), varTWSAData);
		WinSocks_initialized := true;
	end;
{$ENDIF}

	RESULT := 0;
	
	if (X_Address <> 15 {InterNetwork})
	and (X_Address <> 16 {InterNetworkV6}) then Exit;
	
	if (X_Type <> 1 {Dgram}) and (X_Type <> 5 {Stream}) then Exit;

	if (X_Protocol <> 22 {TCP}) and (X_Protocol <> 23 {UDP}) then Exit;
    
    if X_Protocol = 23 then prot := IPPROTO_UDP else prot := IPPROTO_TCP;
    s := {$IFDEF FPC} fpsocket
    	 {$ELSE} socket {$ENDIF}
    	 		 (AF_INET, SOCK_STREAM, prot);
	if s = INVALID_SOCKET then Exit;
	
	Result := Integer(s);
end;

(*
/*

---------------------------------- 'SERVER'

FUN Listen_socket(
{Socket} SO|bject_socket,
STR Host|_address,
INT Port|_number_or_0,
INT Max_queue) ==> BOOL, NATIVE:
	CASE SO.Handle == 0 || !SO.Is_server || SO.Type != 'STREAM' ? ==> ;
	INT handle|_of_socket = SO.Handle
	NATIVE @
"var s: TSocket;"
"var a: sockaddr_in;"
"	s := TSocket(X_handle);"
"	a.sin_family := AF_INET;"
"	a.sin_port := htons(X_Port);"
"	a.sin_addr.S_addr := INADDR_ANY;"
"	//a.sin_addr.S_addr := inet_addr(PChar(X_Host));"
"	if X_Max_queue <= 0 then X_Max_queue := SOMAXCONN;"
"	{$IFDEF LINUX}"
"		if fpbind(s, @a, Sizeof(a)) <> 0 then Exit;"
"		if fplisten(s, X_Max_queue) <> 0 then Exit;"
"	{$ELSE}"
"		if bind(s, a, Sizeof(a)) = SOCKET_ERROR then Exit;"
"	    if listen(s, X_Max_queue) = SOCKET_ERROR then  Exit;"
"	{$ENDIF}"
"	RESULT := TRUE;" .

FUN Socket_accept({Socket} SO|bject_socket) ==> INT, NATIVE:
	INT handle|_of_server_socket = SO.Handle
	NATIVE @
"var s, c: TSocket;"
"var a_len: Integer;"
"var a: sockaddr_in;"
"	s := TSocket(X_handle);"
"	a_len := Sizeof(sockaddr_in);"
"	try"
"	  {$IFDEF LINUX}"
"	  	c := fpaccept(s, @a, @a_len);"
"	  {$ELSE}"
"	  	c := accept(s, @a, {$IFnDEF FPC}@{$ENDIF}a_len);"
"	  {$ENDIF}"
"	except"
"	  c := 0; //INVALID_SOCKET;"
"	end;"
"   RESULT := Integer(c);" .

FUN Socket_shutdown(
{Socket} SO|bject_socket|DUMMY, 
INT H|andler_connection_to_close), NATIVE : @
"var c: TSocket;"
"	c := TSocket(X_H);"
"	{$IFDEF LINUX}"
"	  fpshutdown(c, 2);"
"	{$ELSE}" 
"	  shutdown(c, {$IFDEF FPC} 2 {SHUT_RDWR} {$ELSE} SD_BOTH {$ENDIF});"
"	{$ENDIF}" 
"	closesocket(c);" .

------------------------- 'CLIENT'

FUN Socket_connect(
{Socket} SO|bject_socket,
STR Host|_address,
INT Port|_number) ==> BOOL, NATIVE:
	INT handle|_of_client_socket = SO.Handle
	STR digits|_ip_addr[]
	Split(digits[], Host, ".")
	INT ip|_address_to_connect_to = 0
	FOR d IN digits[] : ip = ip * 256 + d.Int ; 
	NATIVE @
"var c: TSocket;"
"var a: {$IFDEF LINUX} sockaddr {$ELSE} sockaddr_in {$ENDIF} ;"
"var r: Integer;"
"	c := TSocket(X_handle);"
"	a.sin_family := AF_INET;"
"	a.sin_port := htons(X_Port);"
"	a.sin_addr.S_addr := {$IFDEF LINUX} HostToNet(X_ip)"
"						 {$ELSE} inet_addr(PChar(X_Host)) {$ENDIF} ;"
"  	try"
"		r := {$IFDEF LINUX}Integer(fpconnect"
"			 {$ELSE}(connect"
"			 {$ENDIF}"
"							(c, {$IFDEF LINUX}@{$ENDIF} a, Sizeof(a)));"
" 		{$IFDEF LINUX}"
"			RESULT := r = 0;"
"		{$ELSE}"
//" 			if r = SOCKET_ERROR then"
//"				WriteLn('error: ' + {$IFDEF KOL} Int2Str"
//"							  		{$ELSE} IntToStr"
//"									{$ENDIF} (WSAGetLastError));"
"			RESULT := r <> SOCKET_ERROR;"
"		{$ENDIF}"
"  	except"
"	end;" .

------------------------- 'SEND / RECEIVE'

FUN Socket_receive(
{Socket} SO|bject_socket|DUMMY,
INT Handler|_socket_used_to_receive,
BYTE Data|_array_to_fill[]), NATIVE : @
"var s: TSocket;"
"var buf: array[0..255] of byte;"
"var len, i: Integer;"
"	s := TSocket(X_Handler);"
"	repeat"
"		{$IFDEF LINUX}"
"			len := fprecv(s, @buf[0], Sizeof(buf), 0);"
"		{$ELSE}"
"			len := recv(s, buf[0], Sizeof(buf), 0);"
"		{$ENDIF}"
"		if len = 0 then break;"
"		for i := 0 to len-1 do"
"			X_Data.Add(MAXINT, buf[i]);"
"	until len < Sizeof(buf);" .

FUN Socket_send(
{Socket} SO|bject_socket|DUMMY,
INT Handler|_socket_used_to_send,
BYTE Data|_array_to_send[*]), NATIVE : @
"var s: TSocket;"
"var buf: array of Byte;"
"var i: Integer;"
"	s := TSocket(X_Handler);"
"	SetLength(buf, X_Data.Count());"
"	for i := 0 to X_Data.Count()-1 do"
"		buf[i] := X_Data.GetBytes(i);"
"	{$IFDEF LINUX}"
"	    fpsend(s, @buf[0], Length(buf), 0);"
"	{$ELSE}" 
"	    send(s, buf[0], Length(buf), 0);"
"	{$ENDIF}" 
"	SetLength(buf, 0);" .

-------------------------- 'CLOSE'

FUN Socket_close({Socket} SO|bject_socket), NATIVE:
	INT handle|_to_close = SO.Handle
	NATIVE @
"var s: TSocket;"
"	s := TSocket(X_handle);"
"	{$IFDEF LINUX}"
"	     fpshutdown(s, 2);"
"	{$ELSE}"
"	     shutdown(s, {$IFDEF FPC} 2 {SHUT_RDWR} {$ELSE} SD_BOTH {$ENDIF} );"
"	{$ENDIF}"
"	closesocket(s);" .

------------------------------ 'Utility'

//FUN Get_host_name ==> STR, NATIVE : @
//"var buf: array[0..255] of Char;"
//"	buf[0] := #0;"
//"	if gethostname(buf, Sizeof(buf)) > 0 then"
//"		RESULT := buf;" .

FUN Get_host_ip ==> STR, NATIVE : @
"var {$IFDEF LINUX} i: Integer; {$ELSE} He : PHostEnt; Ia : TInAddr;{$ENDIF}"
"var {$IFDEF LINUX} s: String; {$ELSE} namebuf : Array[0..255] of char;{$ENDIF}"
"	{$IFDEF LINUX}"
"		RunCommand('/sbin/ip', ['a'], s);"
"		RESULT := M_find_valid_inet_addr(s);"
"	{$ELSE}"
"       gethostname(namebuf,sizeof(namebuf));"
"       He := gethostbyname(namebuf);"
"       Ia.S_addr := u_long(pu_long(He^.h_addr_list^)^);"
"       RESULT := inet_ntoa(Ia);"
"	{$ENDIF}"
.

FUN find_valid_inet_addr|_in_linux(
STR S|tring_responded_to_ip_a) ==> STR, CALLBACK
	:
	STR lines|_splitted[]
	Split(lines[], S, #LF)
	FOR s IN lines[] :
	    CASE s.[0] IN " "#TAB ? CONTINUE s ;
	    s = s.[s.Find(":")+1 TO *].Trim
	    CASE s.Starting("lo:") ? CONTINUE s ;
	    FOR ss IN lines[s.Index+1 TO *] :
	        CASE ss.[0] !IN " "#TAB ? BREAK ss, CONTINUE s ;
	        ss = ss.TrimL
	        CASE !ss.Starting("inet ") ? CONTINUE ss ;
	        DONE     
		         ss = ss.["inet ".Len TO *]
		         CASE "/" IN ss ?
		        	  ss = ss.[0 TO ss.Find("/")-1]
		         ELSE ss = ss.[0 TO ss.Find(" ")-1] ;
		         RESULT = ss ==> ;
	; .

END
*/
*)
end.
