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