TCP server on dynamic threads. windows and linux

General FreeBASIC programming questions.
AWPStar
Posts: 38
Joined: May 03, 2009 21:47

TCP server on dynamic threads. windows and linux

Postby AWPStar » Jan 11, 2019 7:51

This is my attempt to create a server. Not just multithreaded.
You have two main settings. MAX_CLIENTS and MAX_THREADS.
Server accepts new connection and adds it to queue. It can create new thread or use existing.
There is a watchdog that can kick clients and threads by timeout.

This procedure can process data from client. ClientProcess

Is it a right way to do that? All that i did before is just "one client - one thread". Any suggestions?

Hope it's readable.

Code: Select all

#INCLUDE once "crt.bi"
#INCLUDE once "crt/errno.bi"

#ifdef __FB_WIN32__
    #INCLUDE once "win/winsock2.bi"
#Else
    #INCLUDE once "crt/netdb.bi"
    #INCLUDE once "crt/sys/socket.bi"
    #INCLUDE once "crt/netinet/in.bi"
    #INCLUDE once "crt/arpa/inet.bi"
    #INCLUDE once "crt/unistd.bi"
#EndIf

#ifndef TCP_SYNCNT
#define TCP_SYNCNT 7
#endif

#ifdef __FB_LINUX__
   Type TimeVal
     tv_sec  as Integer
     tv_usec as Integer
   End Type
#endif

#IF DEFINED(__FB_LINUX__)
    DECLARE FUNCTION pthread_cancel CDECL LIB "c" ALIAS "pthread_cancel" (BYVAL pthread_t AS INTEGER) AS INTEGER
#ELSEIF DEFINED(__FB_WIN32__)
    #INCLUDE ONCE "windows.bi"
#ENDIF


SUB ThreadCancel(thread AS ANY PTR)
#IF DEFINED(__FB_LINUX__)
    pthread_cancel(CAST(INTEGER PTR, thread)[0])
#ELSEIF DEFINED(__FB_WIN32__)
    TerminateThread(CAST(Handle PTR, thread)[0], 0)
#ENDIF
END SUB

Function resolveHost( ByRef hostname As String ) As long
    Dim ia As in_addr, host As hostent PTR
    ia.S_addr = inet_addr( hostname )
    If ( ia.S_addr = INADDR_NONE ) Then
        host = gethostbyname( hostname )
        If ( host = 0 ) Then return 0
        return *cast(long PTR, *host->h_addr_list )
    Else
        return ia.S_addr
    End If
End Function


type client_t
   c as SOCKET
   ip as long
   port as ushort
   processed as long
   accept_time as double
end type

type thread_t
   id as long
   td as any ptr
   terminate_flag as long
   last_signal as double
   last_client as double
   current_client as long
   running as long
   srv_RECVBUFF as ubyte ptr
end type

Dim Shared As Long MAX_CLIENTS = 999
Dim Shared As Long MAX_THREADS = 8
Dim Shared As double THREAD_TIMEOUT = 4
Dim Shared As double THREAD_FREE_TIMEOUT = 6
Dim Shared As double THREAD_IDLE_TIMEOUT = 8
dim shared as double ACCEPT_TIMEOUT = 3
Dim Shared As double RCV_TIMEOUT = 3
Dim Shared As Long srv_RECVBUFFLEN = 512
Dim Shared As Long srv_SENDBUFFLEN = 512
Dim Shared srv As SOCKET
dim shared client() as client_t
dim shared thread() as thread_t
dim shared as any ptr dMutex
dim shared as long QueueCount
dim shared as long WatchDogExit
dim shared as any ptr WatchDogThread

sub CloseClient(i as long)
   if i < 0 or i > MAX_CLIENTS-1 then exit sub
   if client(i).c = -1 then exit sub
   closesocket client(i).c
   client(i).c = -1
end sub

sub ClientProcess(i as long, buff as ubyte ptr)
   Dim bytes As Long
   Dim s As String
   dim tm as double = timer
   do: bytes = recv(client(i).c, buff, srv_RECVBUFFLEN,  0)
      If bytes=-1 Then
         exit do
      ElseIf bytes=0 Then
         exit do
      Else
         ' Data received
         if bytes < srv_RECVBUFFLEN then buff[bytes] = 0
         s= *cast(zstring PTR, buff)
         
         ? s
         
         exit do
      End If
   Loop
   mutexlock(dMutex)
      CloseClient(i)
   mutexunlock(dMutex)
   ? "read timeout " & timer - tm
end sub

function ClientsInQueue() as long
   dim as long c = 0
   for n as long = 0 to MAX_CLIENTS-1
      if client(n).c <> -1 and client(c).processed = 0 then c += 1
   next
   return c
end function

sub TimeoutKick()
   dim as double tm = timer
   for i As Long = 0 to MAX_CLIENTS - 1
      if client(i).c <> -1 and client(i).processed = 0 then
         if (tm - client(i).accept_time > ACCEPT_TIMEOUT) then
            ' release and kick client
            CloseClient(i)
            exit for
         end if
      end if
   next   
end sub

sub TimeoutKicks()
   dim as double tm = timer
   for i As Long = 0 to MAX_CLIENTS - 1
      if client(i).c <> -1 and client(i).processed = 0 then
         if (tm - client(i).accept_time > ACCEPT_TIMEOUT) then
            ' release and kick client
            CloseClient(i)
         end if
      end if
   next   
end sub

sub KillThread(i as long)
   CloseClient(thread(i).current_client)
   thread(i).id = -1
   thread(i).terminate_flag = 1
   ThreadCancel(thread(i).td)
   ThreadWait(thread(i).td)
   thread(i).running = 0
   thread(i).td = 0
end sub

function DeadThread() as long
   for n as long = 0 to MAX_THREADS - 1
      if thread(n).running = 0 then return n
   next
   return -1
end function

function ThreadsRunning() as long
   dim c as long = 0
   for n as long = 0 to MAX_THREADS - 1
      if thread(n).running = 1 then c += 1
   next
   return c
end function

function FreeThread() as long
   for n as long = 0 to MAX_THREADS - 1
      if thread(n).running = 1 and thread(n).current_client = -1 then return n
   next
   return -1
end function

function ThreadsFree() as long
   dim c as long = 0
   for n as long = 0 to MAX_THREADS - 1
      if thread(n).running = 1 and thread(n).current_client <> -1 then c += 1
   next
   return (MAX_THREADS - c)
end function

Sub ThreadProcess(ByVal userdata As Any PTR)
    Dim ti As Long  = *cast(long ptr,userdata)
   thread(ti).running = 1
   dim i as long
   #ifdef __FB_WIN32__
      dim as integer timeout  = RCV_TIMEOUT * 1000 - 500
      if RCV_TIMEOUT>0 then
         if timeout<1 then timeout=1
      else
         if timeout<0 then timeout=0
      end if
   #else
      dim as timeval timeout
      timeout.tv_sec = RCV_TIMEOUT
      timeout.tv_usec = 0
   #EndIf
   do while (thread(ti).terminate_flag=0)
      thread(ti).last_signal = Timer
      ' Select client in queue
      i = -1
      mutexlock(dMutex)
         for n as long = 0 to MAX_CLIENTS-1
            if client(n).c <> -1 then
               if client(n).processed = 0 then
                  i = n
                  client(n).processed = 1
                  exit for
               end if
            end if
         next
      mutexunlock(dMutex)
      if i<>-1 then
         thread(ti).last_client = timer
         ' Client processing
         ? "accepted" & ti & "  " & i
         thread(ti).current_client = i
         setsockopt(client(i).c, SOL_SOCKET, SO_RCVTIMEO, cast(any ptr, @timeout), sizeof(timeout))
         ClientProcess(i, thread(ti).srv_RECVBUFF)
         thread(ti).current_client = -1
         thread(ti).last_client = timer
      end if
      sleep (20,1)
   loop
   thread(ti).td = 0
   thread(ti).running = 0
End Sub

sub ThreadRun(i as long)
   thread(i).id = i
   thread(i).terminate_flag = 0
   thread(i).current_client = -1
   thread(i).td = ThreadCREATE(@ThreadProcess, @thread(i).id)
end sub

Sub ThreadWatchdog(ByVal userdata As Any PTR)
   do while (WatchDogExit = 0)
      mutexlock(dMutex)
         TimeoutKick()
         
         ' Queue Count
         QueueCount = ClientsInQueue()
         
         ' Kill threads
         dim as double ttimeout
         if ThreadsFree() > 0 then
            ttimeout = THREAD_FREE_TIMEOUT
         else
            ttimeout = THREAD_TIMEOUT
         end if
         for n as long = 0 to MAX_THREADS-1
            if thread(n).running then
               if thread(n).id <> -1 then
                  if (timer - thread(n).last_signal) > ttimeout then
                     ' Thread is not working
                     KillThread(n)
                     thread(n).id = n
                     thread(n).current_client = -1
                     thread(n).terminate_flag = 0
                     'thread(n).td = ThreadCREATE(@ThreadProcess, @thread(n).id )
                  else
                     ' Thread is working fine
                     if (timer - thread(n).last_client) > THREAD_IDLE_TIMEOUT then
                        ? "Thread is shutting down. Left " & ThreadsRunning()
                        thread(n).terminate_flag = 1
                     end if
                  end if
               end if
            end if
         next
      mutexunlock(dMutex)
      sleep(100,1)
   loop
end sub

sub TerminateServer()
   WatchDogExit = 1
   ThreadWait(WatchDogThread)
   
    For i As Long =0 To MAX_CLIENTS -1
      CloseClient(i)
    Next
   for i as long =0 to MAX_THREADS-1
      thread(i).terminate_flag = 1
   next
   sleep(50,1)
   for i as long =0 to MAX_THREADS-1
      if thread(i).td then
         ThreadCancel(thread(i).td)
         thread(i).id = -1
      end if   
   next
   for i as long =0 to MAX_THREADS-1
      if thread(i).td then
         ThreadWait(thread(i).td)
         thread(i).td = 0
      end if
      deallocate(thread(i).srv_RECVBUFF)
   next
end sub

Function StartServer(Port As ushort, Host As String = "") As Long
   Dim As sockaddr_in srv_sa
   dim as long srvip = 0
   
    #ifdef __FB_WIN32__
        Dim wsaData As WSAData
        If( WSAStartup(MAKEWORD( 1, 1 ) , @wsaData ) <> 0 ) Then Return 1
    #EndIf
   
    closesocket srv

    ' Get host ip
    If Len(Host)  Then
        srvip = resolveHost(Host)
    End If
   
    srv = opensocket( 2, 1, 6 )
    If ( srv < 0 ) Then Return 1

    ' reuse address, nodelay, set buffer size
    Dim  As Integer optval = 1
    setsockopt(srv, SOL_SOCKET, SO_REUSEADDR, Cast(zstring PTR, @optval), sizeof(optval))
    #ifdef __FB_WIN32__
        setsockopt(srv, IPPROTO_TCP, TCP_NODELAY, Cast(zstring PTR, @optval), sizeof(optval))
    #EndIf
    setsockopt(srv, SOL_SOCKET , SO_RCVBUF , Cast(zstring PTR, @srv_RECVBUFFLEN) , sizeof(Long))
    setsockopt(srv, SOL_SOCKET , SO_SNDBUF , Cast(zstring PTR, @srv_SENDBUFFLEN), sizeof(Long))

    ' Bind Port
    srv_sa.sin_family      = AF_INET
    srv_sa.sin_port        = htons(Port)
    srv_sa.sin_addr.S_addr = srvip'inet_addr(srv_ip)
    If bind( srv, cptr( SOCKADDR PTR, @srv_sa ), Len(srv_sa)) = SOCKET_ERROR Then Return 2
   
    If listen(srv, MAX_CLIENTS) = 0 Then
    Else   
        Return 3
    End If
   
   redim client(MAX_CLIENTS-1)
    For i As Long =0 To MAX_CLIENTS -1
        client(i).c = -1
        client(i).processed = 0
    Next
   
   dMutex = MutexCreate()
   
   redim thread(MAX_THREADS-1)
   for i as long =0 to MAX_THREADS-1
      thread(i).id = i
      thread(i).current_client = -1
      thread(i).terminate_flag = 0
      thread(i).srv_RECVBUFF = allocate(srv_RECVBUFFLEN)
      thread(i).running = 0
      sleep(10,1)
   next
   WatchDogExit = 0
   WatchDogThread = ThreadCREATE(@ThreadWatchdog, 0)
End Function


Function ServerAccepting() As Long
    Dim As sockaddr_in sa
    Dim As Long addrlen
    Dim As SOCKET ac

    addrlen = Len(sa)
    ac =  accept (srv, Cptr( PSOCKADDR, @sa ), @addrlen)
    If ac=-1 Then
        Return 1
    ElseIf ac=0 Then
        Return 2
    End If
    '? "Connected: " & *inet_ntoa(sa.sin_addr) & " : " & htons(sa.sin_port)
   
   MutexLock(dMutex)
      TimeoutKick()
      
      dim as long i = -1
      dim as long CIQ = ClientsInQueue
      For n As Long = 0 To MAX_CLIENTS-1
         If client(n).c = -1 Then
            i = n
            exit for
         End If
      Next
   MutexUnLock(dMutex)
   
   if i<>-1 then
      dim ti as long
      ' Add in Queue
      client(i).c = ac
      #ifdef __FB_WIN32__
      client(i).ip = sa.sin_addr.S_un.S_addr_ '*inet_ntoa(sa.sin_addr)
      #elseif defined(__FB_LINUX__)
      client(i).ip = sa.sin_addr.S_addr  '*inet_ntoa(sa.sin_addr)
      #ENDIF
      client(i).port = htons(sa.sin_port)
      client(i).processed = 0
      client(i).accept_time = timer
      
      ' To create a new thread or not
      ti = DeadThread()
      if ti <> -1 then
         if FreeThread() = -1 then
            ' Current threads are busy
            ' Run available thread
            ThreadRun(ti)
         end if
      else
         ' All threads are running
         if FreeThread = -1 then
            ' All threads are busy
            TimeoutKicks()
         end if
      end if
      Return 0
   else
      ' Queue is full
      return 3
   end if
End Function


if StartServer(82, "0.0.0.0") then
   ? "Cannot start server"
   end
end if
do
   ServerAccepting()
   sleep (20,1)
loop
badidea
Posts: 1182
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: TCP server on dynamic threads. windows and linux

Postby badidea » Jan 11, 2019 10:16

I have bookmarked this topic. Interesting code, but a much too much dive into now.
Do you have a client to test it with? A ran the code (via sudo), but without clients, the watchdog is mostly sleeping and nothing happens.
AWPStar
Posts: 38
Joined: May 03, 2009 21:47

Re: TCP server on dynamic threads. windows and linux

Postby AWPStar » Jan 11, 2019 20:00

i just used winsock in vb6 IDE.
You can use this code.

Code: Select all

#ifdef __FB_WIN32__
   #include once "win/winsock2.bi"
#else
   #include once "crt/netdb.bi"
   #include once "crt/sys/socket.bi"
   #include once "crt/netinet/in.bi"
   #include once "crt/arpa/inet.bi"
   #include once "crt/unistd.bi"
#endif

Function resolveHost( ByRef hostname As String ) As long
    Dim ia As in_addr, host As hostent PTR
    ia.S_addr = inet_addr( hostname )
    If ( ia.S_addr = INADDR_NONE ) Then
        host = gethostbyname( hostname )
        If ( host = 0 ) Then return 0
        return *cast(long PTR, *host->h_addr_list )
    Else
        return ia.S_addr
    End If
End Function

function TestSend(Host as string, Port as ushort, sdata as string, delay as long) as long
   #ifdef __FB_WIN32__
      dim wsaData as WSAData
      if( WSAStartup( MAKEWORD( 1, 1 ), @wsaData ) <> 0 ) then return 1
   #endif
   
   dim ip as integer
   dim s as SOCKET

   ip = resolveHost(Host)
   if (ip = 0) then return 2

   '' open socket
   s = opensocket(AF_INET, SOCK_STREAM, IPPROTO_TCP)
   if (s = 0) then return 3

   '' connect to host
   dim sa as sockaddr_in
   sa.sin_port        = htons(Port)
   sa.sin_family      = AF_INET
   sa.sin_addr.S_addr = ip

   if connect(s, cast( PSOCKADDR, @sa), sizeof(sa)) = SOCKET_ERROR then
      closesocket(s)
      return 4
   end if
   
   sleep(delay)
   
   if send(s, sdata, len(sdata), 0) = SOCKET_ERROR then
      closesocket(s)
      return 5
   end if

   dim recvbuffer as zstring * 4096 + 1
   dim bytes as integer
   do
      bytes = recv( s, recvBuffer, 4096, 0)
      if bytes = -1 then
         closesocket(s)
         return 6
      elseif bytes = 0 then
         exit do
      else
         recvbuffer[bytes] = 0
         ? recvbuffer
      end if
   loop

   closesocket( s )

   #ifdef __FB_WIN32__
      WSACleanup()
   #endif
   
   return 0
end function

TestSend("127.0.0.1", 82, "Hello", 0)
AWPStar
Posts: 38
Joined: May 03, 2009 21:47

Re: TCP server on dynamic threads. windows and linux

Postby AWPStar » Jan 25, 2019 8:17

Small improvements:
Now it is using conditions.
better performance and faster access to the queue.

Callback functions
Just for usability

MIN_THREADS.
You can set MIN_THREADS and that count of threads will alway be running.
For immediate acceptance of clients

added send functions

Thanks for your attention.

server.bas

Code: Select all

#INCLUDE once "crt.bi"
#INCLUDE once "crt/errno.bi"

#ifdef __FB_WIN32__
    #INCLUDE once "win/winsock2.bi"
#Else
    #INCLUDE once "crt/netdb.bi"
    #INCLUDE once "crt/sys/socket.bi"
    #INCLUDE once "crt/netinet/in.bi"
    #INCLUDE once "crt/arpa/inet.bi"
    #INCLUDE once "crt/unistd.bi"
#EndIf

#ifndef TCP_SYNCNT
#define TCP_SYNCNT 7
#endif

#ifdef __FB_LINUX__
   Type TimeVal
     tv_sec  as Integer
     tv_usec as Integer
   End Type
#endif

#IF DEFINED(__FB_LINUX__)
    DECLARE FUNCTION pthread_cancel CDECL LIB "c" ALIAS "pthread_cancel" (BYVAL pthread_t AS INTEGER) AS INTEGER
#ELSEIF DEFINED(__FB_WIN32__)
    #INCLUDE ONCE "windows.bi"
#ENDIF


SUB ThreadCancel(thread AS ANY PTR)
#IF DEFINED(__FB_LINUX__)
    pthread_cancel(CAST(INTEGER PTR, thread)[0])
#ELSEIF DEFINED(__FB_WIN32__)
    TerminateThread(CAST(Handle PTR, thread)[0], 0)
#ENDIF
END SUB

Function resolveHost( ByRef hostname As String ) As long
    Dim ia As in_addr, host As hostent PTR
    ia.S_addr = inet_addr( hostname )
    If ( ia.S_addr = INADDR_NONE ) Then
        host = gethostbyname( hostname )
        If ( host = 0 ) Then return 0
        return *cast(long PTR, *host->h_addr_list )
    Else
        return ia.S_addr
    End If
End Function


type client_t
   c as SOCKET
   ip as long
   port as ushort
   processed as long
   accept_time as double
end type

type thread_t
   id as long
   td as any ptr
   terminate_flag as long
   last_signal as double
   last_client as double
   current_client as long
   running as long
   srv_RECVBUFF as ubyte ptr
end type

Dim Shared As Long MAX_CLIENTS = 999
Dim Shared As Long MAX_THREADS = 8
Dim Shared As Long MIN_THREADS = 1
Dim Shared As double THREAD_TIMEOUT = 5
Dim Shared As double THREAD_FREE_TIMEOUT = 8
Dim Shared As double THREAD_IDLE_TIMEOUT = 10
dim shared as double ACCEPT_TIMEOUT = 4
Dim Shared As double RCV_TIMEOUT = 4
Dim Shared As Long srv_RECVBUFFLEN = 16384
Dim Shared As Long srv_SENDBUFFLEN = 16384
Dim Shared srv As SOCKET
dim shared client() as client_t
dim shared thread() as thread_t
dim shared as any ptr dMutex
dim shared as long QueueCount
dim shared as long WatchDogExit
dim shared as any ptr WatchDogThread
Dim Shared as Any Ptr hcondstart
Dim Shared as Any Ptr hmutexstart

dim shared ClientProcessPrc as sub (i as long, buff as ubyte ptr)
dim shared ClientClosePrc as sub (i as long)

function send_data(i as long, dt as ubyte ptr, dtl as long) as long
   return send(client(i).c, dt, dtl,0)
end function

function send_string(i as long, txt as string) as long
   if len(txt)<=0 then return 0
   return send(client(i).c, strptr(txt), len(txt),0)
end function

sub CloseClient(i as long)
   if i < 0 or i > MAX_CLIENTS-1 then exit sub
   if client(i).c = -1 then exit sub
   ClientClosePrc(i)
   closesocket client(i).c
   client(i).c = -1
end sub

function ClientsInQueue() as long
   dim as long c = 0
   for n as long = 0 to MAX_CLIENTS-1
      if client(n).c <> -1 and client(c).processed = 0 then c += 1
   next
   return c
end function

sub TimeoutKick()
   dim as double tm = timer
   for i As Long = 0 to MAX_CLIENTS - 1
      if client(i).c <> -1 and client(i).processed = 0 then
         if (tm - client(i).accept_time > ACCEPT_TIMEOUT) then
            ' release and kick client
            CloseClient(i)
            exit for
         end if
      end if
   next   
end sub

sub TimeoutKicks()
   dim as double tm = timer
   for i As Long = 0 to MAX_CLIENTS - 1
      if client(i).c <> -1 and client(i).processed = 0 then
         if (tm - client(i).accept_time > ACCEPT_TIMEOUT) then
            ' release and kick client
            CloseClient(i)
         end if
      end if
   next   
end sub

sub KillThread(i as long)
   CloseClient(thread(i).current_client)
   thread(i).id = -1
   thread(i).terminate_flag = 1
   ThreadCancel(thread(i).td)
   ThreadWait(thread(i).td)
   thread(i).running = 0
   thread(i).td = 0
end sub

function DeadThread() as long
   for n as long = 0 to MAX_THREADS - 1
      if thread(n).running = 0 then return n
   next
   return -1
end function

function ThreadsRunning() as long
   dim c as long = 0
   for n as long = 0 to MAX_THREADS - 1
      if thread(n).running = 1 then c += 1
   next
   return c
end function

function FreeThread() as long
   for n as long = 0 to MAX_THREADS - 1
      if thread(n).running = 1 and thread(n).current_client = -1 then return n
   next
   return -1
end function

function ThreadsFree() as long
   dim c as long = 0
   for n as long = 0 to MAX_THREADS - 1
      if thread(n).running = 1 and thread(n).current_client <> -1 then c += 1
   next
   return (MAX_THREADS - c)
end function

Sub ThreadProcess(ByVal userdata As Any PTR)
    Dim ti As Long  = *cast(long ptr,userdata)
   thread(ti).running = 1
   dim i as long
   #ifdef __FB_WIN32__
      dim as integer timeout  = RCV_TIMEOUT * 1000 - 500
      if RCV_TIMEOUT>0 then
         if timeout<1 then timeout=1
      else
         if timeout<0 then timeout=0
      end if
   #else
      dim as timeval timeout
      timeout.tv_sec = RCV_TIMEOUT
      timeout.tv_usec = 0
   #EndIf
   do while (thread(ti).terminate_flag=0)
      MutexLock hmutexstart
         CondWait hcondstart, hmutexstart
      MutexUnlock hmutexstart

      thread(ti).last_signal = Timer
      ' Select client in queue
      i = -1
      mutexlock(dMutex)
         for n as long = 0 to MAX_CLIENTS-1
            if client(n).c <> -1 then
               if client(n).processed = 0 then
                  i = n
                  client(n).processed = 1
                  exit for
               end if
            end if
         next
      mutexunlock(dMutex)
      if i<>-1 then
         thread(ti).last_client = timer
         ' Client processing
         ? "accepted in thread " & ti & "  " & i
         thread(ti).current_client = i
         setsockopt(client(i).c, SOL_SOCKET, SO_RCVTIMEO, cast(any ptr, @timeout), sizeof(timeout))
         ClientProcessPrc(i, thread(ti).srv_RECVBUFF)
         thread(ti).current_client = -1
         thread(ti).last_client = timer
      end if
      sleep (1,1)
   loop
   thread(ti).td = 0
   thread(ti).running = 0
End Sub

sub ThreadRun(i as long)
   thread(i).id = i
   thread(i).terminate_flag = 0
   thread(i).current_client = -1
   thread(i).last_signal = Timer
   thread(i).last_client = timer
   thread(i).td = ThreadCREATE(@ThreadProcess, @thread(i).id)
end sub

Sub ThreadWatchdog(ByVal userdata As Any PTR)
   dim cond_tm as double = timer
   do while (WatchDogExit = 0)
      if timer - cond_tm>0.5 then
         cond_tm = timer
         MutexLock hmutexstart
            CondBroadcast hcondstart
         MutexUnlock hmutexstart
      end if
      mutexlock(dMutex)
         TimeoutKick()
         
         ' Queue Count
         QueueCount = ClientsInQueue()
         
         ' Kill threads
         dim as double ttimeout
         if ThreadsFree() > 0 then
            ttimeout = THREAD_FREE_TIMEOUT
         else
            ttimeout = THREAD_TIMEOUT
         end if
         for n as long = 0 to MAX_THREADS-1
            if thread(n).running then
               if thread(n).id <> -1 then
                  if (timer - thread(n).last_signal) > ttimeout then
                     ' Thread is not working
                     KillThread(n)
                     thread(n).id = n
                     thread(n).current_client = -1
                     thread(n).terminate_flag = 0
                     ? "Thread Killed"
                     if n < MIN_THREADS then
                        ThreadRun(n)                        
                     end if
                  else
                     ' Thread is working fine
                     if n>=MIN_THREADS then
                        if (timer - thread(n).last_client) > THREAD_IDLE_TIMEOUT then
                           ? "Thread is shutting down. Left " & ThreadsRunning()
                           thread(n).terminate_flag = 1
                        end if
                     end if
                  end if
               end if
            end if
         next
      mutexunlock(dMutex)
      sleep(100,1)
   loop
end sub

sub TerminateServer()
   WatchDogExit = 1
   ThreadWait(WatchDogThread)
   
    For i As Long =0 To MAX_CLIENTS -1
      CloseClient(i)
    Next
   for i as long =0 to MAX_THREADS-1
      thread(i).terminate_flag = 1
   next
   sleep(50,1)
   for i as long =0 to MAX_THREADS-1
      if thread(i).td then
         ThreadCancel(thread(i).td)
         thread(i).id = -1
      end if   
   next
   for i as long =0 to MAX_THREADS-1
      if thread(i).td then
         ThreadWait(thread(i).td)
         thread(i).td = 0
      end if
      deallocate(thread(i).srv_RECVBUFF)
   next
   MutexDestroy hmutexstart
   CondDestroy hcondstart
end sub

Function StartServer(Port As ushort, Host As String = "", ProcessAddr as integer, ClientCloseAddr as integer) As Long
   Dim As sockaddr_in srv_sa
   dim as long srvip = 0
   
   ClientProcessPrc = CPTR(Any PTR, ProcessAddr)
   ClientClosePrc = CPTR(Any PTR, ClientCloseAddr)
   
    #ifdef __FB_WIN32__
        Dim wsaData As WSAData
        If( WSAStartup(MAKEWORD( 1, 1 ) , @wsaData ) <> 0 ) Then Return 1
    #EndIf
   
    closesocket srv

    ' Get host ip
    If Len(Host)  Then
        srvip = resolveHost(Host)
    End If
   
    srv = opensocket( 2, 1, 6 )
    If ( srv < 0 ) Then Return 1

    ' reuse address, nodelay, set buffer size
    Dim  As Integer optval = 1
    setsockopt(srv, SOL_SOCKET, SO_REUSEADDR, Cast(zstring PTR, @optval), sizeof(optval))
    #ifdef __FB_WIN32__
        setsockopt(srv, IPPROTO_TCP, TCP_NODELAY, Cast(zstring PTR, @optval), sizeof(optval))
    #EndIf
    setsockopt(srv, SOL_SOCKET , SO_RCVBUF , Cast(zstring PTR, @srv_RECVBUFFLEN) , sizeof(Long))
    setsockopt(srv, SOL_SOCKET , SO_SNDBUF , Cast(zstring PTR, @srv_SENDBUFFLEN), sizeof(Long))

    ' Bind Port
    srv_sa.sin_family      = AF_INET
    srv_sa.sin_port        = htons(Port)
    srv_sa.sin_addr.S_addr = srvip'inet_addr(srv_ip)
    If bind( srv, cptr( SOCKADDR PTR, @srv_sa ), Len(srv_sa)) = SOCKET_ERROR Then Return 2
   
    setsockopt(srv, SOL_SOCKET , SO_RCVBUF , Cast(any PTR, @srv_RECVBUFFLEN) , sizeof(Long))
    setsockopt(srv, SOL_SOCKET , SO_SNDBUF , Cast(any PTR, @srv_SENDBUFFLEN), sizeof(Long))
   
    If listen(srv, MAX_CLIENTS) = 0 Then
    Else   
        Return 3
    End If
   
   redim client(MAX_CLIENTS-1)
    For i As Long =0 To MAX_CLIENTS -1
        client(i).c = -1
        client(i).processed = 0
    Next
   
   dMutex = MutexCreate()
   hcondstart = CondCreate()
   hmutexstart = MutexCreate()
   
   redim thread(MAX_THREADS-1)
   for i as long =0 to MAX_THREADS-1
      thread(i).id = i
      thread(i).current_client = -1
      thread(i).terminate_flag = 0
      thread(i).srv_RECVBUFF = allocate(srv_RECVBUFFLEN)
      thread(i).running = 0
      
      if i < MIN_THREADS then
         thread(i).last_signal = Timer
         thread(i).last_client = Timer
         thread(i).td = ThreadCREATE(@ThreadProcess, @thread(i).id)
      end if
      
      sleep(10,1)
   next
   WatchDogExit = 0
   WatchDogThread = ThreadCREATE(@ThreadWatchdog, 0)

End Function


Function ServerAccepting() As Long
    Dim As sockaddr_in sa
    Dim As Long addrlen
    Dim As SOCKET ac

    addrlen = Len(sa)
    ac =  accept (srv, Cptr( PSOCKADDR, @sa ), @addrlen)
    If ac=-1 Then
        Return 1
    ElseIf ac=0 Then
        Return 2
    End If
    '? "Connected: " & *inet_ntoa(sa.sin_addr) & " : " & htons(sa.sin_port)
    setsockopt(ac, SOL_SOCKET , SO_RCVBUF , Cast(zstring PTR, @srv_RECVBUFFLEN) , sizeof(Long))
    setsockopt(ac, SOL_SOCKET , SO_SNDBUF , Cast(zstring PTR, @srv_SENDBUFFLEN), sizeof(Long))
   
   MutexLock(dMutex)
      TimeoutKick()
      
      dim as long i = -1
      dim as long CIQ = ClientsInQueue
      For n As Long = 0 To MAX_CLIENTS-1
         If client(n).c = -1 Then
            i = n
            exit for
         End If
      Next
   MutexUnLock(dMutex)
   
   if i<>-1 then
      dim ti as long
      ' Add in Queue
      client(i).c = ac
      #ifdef __FB_WIN32__
      client(i).ip = sa.sin_addr.S_un.S_addr_ '*inet_ntoa(sa.sin_addr)
      #elseif defined(__FB_LINUX__)
      client(i).ip = sa.sin_addr.S_addr  '*inet_ntoa(sa.sin_addr)
      #ENDIF
      client(i).port = htons(sa.sin_port)
      client(i).processed = 0
      client(i).accept_time = timer
      
      ' To create a new thread or not
      ti = DeadThread()
      if ti <> -1 then
         if FreeThread() = -1 then
            ' Current threads are busy
            ' Run available thread
            ThreadRun(ti)
         end if
      else
         ' All threads are running
         if FreeThread = -1 then
            ' All threads are busy
            TimeoutKicks()
         end if
      end if

      MutexLock hmutexstart
         CondBroadcast hcondstart
      MutexUnlock hmutexstart
      Return 0
   else
      ' Queue is full
      return 3
   end if
End Function


main.bas

Code: Select all

#include once "server.bas"

type file_client_t
   some_custom_info as long
end type

dim shared cli() as file_client_t

sub ClientDead (i as long)
   ' Client is closed
end sub

sub ClientProcess(i as long, buff as ubyte ptr)
   Dim bytes As Long
   Dim s As String
   
   do: bytes = recv(client(i).c, buff, srv_RECVBUFFLEN,  0)
      If bytes=-1 Then
         exit do
      ElseIf bytes=0 Then
         exit do
      Else
         ' Data received
         if bytes < srv_RECVBUFFLEN then buff[bytes] = 0
         s = *cast(zstring PTR, buff)
         ? s
         ' SOMETHING
         '
         '
         '

      End If
      sleep(1,1)
      exit do
   Loop

   mutexlock(dMutex)
      CloseClient(i)
   mutexunlock(dMutex)
end sub

if StartServer(82, "0.0.0.0", cint(@ClientProcess), cint(@ClientDead)) then
   ? "Cannot start server"
   end
else
   ? "Server started"
end if
do
   ServerAccepting()
   sleep (20,1)
loop

Return to “General”

Who is online

Users browsing this forum: No registered users and 4 guests