2023-09-10 18:51:11 -04:00
|
|
|
program main
|
|
|
|
use iso_fortran_env
|
2023-10-08 11:54:21 -04:00
|
|
|
use iso_c_binding, only: c_char, c_double, c_int, c_int64_t, c_null_char, &
|
|
|
|
c_size_t, c_carriage_return, c_new_line
|
|
|
|
use mod_dill, only: ipaddr, ipaddr_local, ipaddr_port, ipaddr_str, &
|
|
|
|
IPADDR_MAXSTRLEN, IPADDR_IPV4, tcp_accept, tcp_close, &
|
|
|
|
tcp_listen, mrecv, msend, suffix_attach, suffix_detach
|
2023-09-10 18:51:11 -04:00
|
|
|
use db
|
|
|
|
implicit none
|
|
|
|
|
2023-09-10 20:22:32 -04:00
|
|
|
type(db_type) :: db
|
2023-09-10 18:51:11 -04:00
|
|
|
character(len=128):: db_path
|
2023-09-10 20:22:32 -04:00
|
|
|
character(len=24):: username
|
|
|
|
real(kind=c_double) :: x_pos
|
|
|
|
real(kind=c_double) :: y_pos
|
2023-10-08 11:54:21 -04:00
|
|
|
integer :: command
|
2023-09-10 18:51:11 -04:00
|
|
|
logical :: exist
|
|
|
|
|
2023-10-08 11:54:21 -04:00
|
|
|
integer(c_int) :: connection, rc, socket
|
|
|
|
integer(c_size_t) :: message_size, msglen = 256
|
|
|
|
character(c_char) :: message(256) = ''
|
|
|
|
type(ipaddr) :: addr, addr_remote
|
|
|
|
character(kind=c_char, len=IPADDR_MAXSTRLEN) :: address_string = ''
|
|
|
|
character(len=*), parameter :: TCP_SUFFIX = c_carriage_return//c_new_line//c_null_char
|
2023-09-10 18:51:11 -04:00
|
|
|
|
2023-09-10 20:22:32 -04:00
|
|
|
call getarg(1, db_path)
|
2023-09-10 18:51:11 -04:00
|
|
|
|
2023-09-10 20:22:32 -04:00
|
|
|
inquire (file=db_path(:Len_Trim(db_path)), exist=exist)
|
|
|
|
if (.not. exist) then
|
|
|
|
stop 1
|
|
|
|
end if
|
2023-09-10 18:51:11 -04:00
|
|
|
|
2023-10-08 11:54:21 -04:00
|
|
|
rc = db_open(db, db_path(:Len_Trim(db_path)))
|
|
|
|
|
|
|
|
rc = ipaddr_local(addr, '127.0.0.1'//c_null_char, 5555_c_int, IPADDR_IPV4)
|
|
|
|
call ipaddr_str(addr, address_string)
|
|
|
|
|
|
|
|
print *, 'Listening on socket:'
|
|
|
|
print *, ' IP address: ', address_string
|
|
|
|
print *, ' Port: ', ipaddr_port(addr)
|
|
|
|
print *, ' Opened DB : ', db_path(:Len_Trim(db_path))
|
|
|
|
|
|
|
|
socket = tcp_listen(addr, 0_c_int)
|
|
|
|
|
|
|
|
! do while not logged out
|
|
|
|
server_loop: do
|
|
|
|
|
|
|
|
connection = tcp_accept(socket, addr_remote, -1_c_int64_t)
|
|
|
|
call ipaddr_str(addr, address_string)
|
|
|
|
print *, 'New connection from '//trim(address_string)
|
|
|
|
connection = suffix_attach(connection, TCP_SUFFIX, 2_c_size_t)
|
|
|
|
message_size = mrecv(connection, message, msglen, -1_c_int64_t)
|
|
|
|
print *, message_size, message
|
|
|
|
|
|
|
|
read (message, "(f8.2, f8.2, i3, a24)") x_pos, y_pos, command, username
|
|
|
|
print *, 'username=', username, ' x_pos=', x_pos, ' y_pos=', y_pos, ' command=', command
|
|
|
|
|
|
|
|
if (command .eq. 0) then ! get all logged in users and return their positions to client
|
|
|
|
rc = db_count_logged_in_users(db, connection)
|
|
|
|
rc = db_get_logged_in_users(db, connection)
|
|
|
|
else if (command .eq. 1) then
|
|
|
|
rc = db_login_user(db, username)
|
|
|
|
rc = db_count_logged_in_users(db, connection)
|
|
|
|
rc = db_get_logged_in_users(db, connection)
|
|
|
|
else if (command .eq. 3) then ! update new pos to database
|
|
|
|
rc = db_move_user(db, username, x_pos, y_pos)
|
|
|
|
rc = db_count_logged_in_users(db, connection)
|
|
|
|
rc = db_get_logged_in_users(db, connection)
|
|
|
|
else ! (2) if logout update logged_in to database
|
|
|
|
rc = db_logout_user(db, username)
|
|
|
|
rc = db_count_logged_in_users(db, connection)
|
|
|
|
rc = db_get_logged_in_users(db, connection)
|
|
|
|
exit server_loop
|
|
|
|
end if
|
|
|
|
end do server_loop
|
|
|
|
|
|
|
|
rc = db_close(db)
|
2023-09-10 18:51:11 -04:00
|
|
|
|
|
|
|
end program main
|