mmo-project/fortran/server/app/main.f90

107 lines
3.5 KiB
Fortran
Raw Normal View History

program main
use iso_fortran_env
2023-10-10 23:49:28 -04:00
use iso_c_binding
2023-10-08 11:54:21 -04:00
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-10-10 23:49:28 -04:00
use json_module
use db
implicit none
2023-09-10 20:22:32 -04:00
type(db_type) :: db
character(len=128):: db_path
2023-10-10 23:49:28 -04:00
character(len=:), allocatable :: username
real(real64) :: x_pos
real(real64) :: y_pos
2023-10-08 11:54:21 -04:00
integer :: command
2023-10-10 23:49:28 -04:00
logical :: exist, found
2023-10-08 11:54:21 -04:00
integer(c_int) :: connection, rc, socket
integer(c_size_t) :: message_size, msglen = 256
2023-10-10 23:49:28 -04:00
character(c_char) :: message(255) = ''
2023-10-08 11:54:21 -04:00
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-10-10 23:49:28 -04:00
type(json_value), pointer :: root
type(json_file) :: json
character(len=:), allocatable :: str
character(len=255) :: jsn_string
2023-09-10 20:22:32 -04:00
call getarg(1, db_path)
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-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)
2023-10-13 22:55:14 -04:00
! print *, 'New connection from '//trim(address_string)
2023-10-08 11:54:21 -04:00
connection = suffix_attach(connection, TCP_SUFFIX, 2_c_size_t)
2023-10-13 22:55:14 -04:00
! print *, 'connected'
2023-10-08 11:54:21 -04:00
message_size = mrecv(connection, message, msglen, -1_c_int64_t)
2023-10-13 22:55:14 -04:00
! print *, message_size
2023-10-08 11:54:21 -04:00
2023-10-10 23:49:28 -04:00
call c_f_string(message, jsn_string)
call json%initialize()
call json%deserialize(jsn_string(:Len_Trim(jsn_string)))
2023-10-13 22:55:14 -04:00
! call json%print()
2023-10-10 23:49:28 -04:00
call json%get('user.username', username, found)
if (.not. found) print *, 'cant find username!'
call json%get('user.x_pos', x_pos, found)
if (.not. found) print *, 'cant find x_pos!'
call json%get('user.y_pos', y_pos, found)
if (.not. found) print *, 'cant find y_pos!'
call json%get('user.command', command, found)
if (.not. found) print *, 'cant find command!'
call json%destroy()
2023-10-08 11:54:21 -04:00
if (command .eq. 0) then ! get all logged in users and return their positions to client
else if (command .eq. 1) then
rc = db_login_user(db, username)
else if (command .eq. 3) then ! update new pos to database
rc = db_move_user(db, username, x_pos, y_pos)
else ! (2) if logout update logged_in to database
rc = db_logout_user(db, username)
end if
rc = db_get_logged_in_users(db, connection)
rc = tcp_close(connection, -1_c_int64_t)
2023-10-08 11:54:21 -04:00
end do server_loop
rc = tcp_close(connection, -1_c_int64_t)
2023-10-08 11:54:21 -04:00
rc = db_close(db)
2023-10-10 23:49:28 -04:00
contains
subroutine c_f_string(c_string, f_string)
character(kind=c_char), dimension(:), intent(in) :: c_string
character(len=*), intent(out) :: f_string
integer :: i
i = 1
do while (c_string(i) /= c_null_char .and. i <= len(f_string) - 1)
f_string(i:i) = c_string(i)
i = i + 1
end do
if (i < len(f_string)) f_string(i:) = ' '
end subroutine c_f_string
end program main