program main use iso_fortran_env use iso_c_binding 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 use json_module use db implicit none type(db_type) :: db character(len=128):: db_path character(len=:), allocatable :: username real(real64) :: x_pos real(real64) :: y_pos integer :: command logical :: exist, found integer(c_int) :: connection, rc, socket integer(c_size_t) :: message_size, msglen = 256 character(c_char) :: message(255) = '' 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 type(json_value), pointer :: root type(json_file) :: json character(len=:), allocatable :: str character(len=255) :: jsn_string call getarg(1, db_path) inquire (file=db_path(:Len_Trim(db_path)), exist=exist) if (.not. exist) then stop 1 end if 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) print *, 'connected' message_size = mrecv(connection, message, msglen, -1_c_int64_t) print *, message_size call c_f_string(message, jsn_string) call json%initialize() call json%deserialize(jsn_string(:Len_Trim(jsn_string))) call json%print() 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() 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) exit server_loop end if rc = db_get_logged_in_users(db, connection) rc = tcp_close(connection, -1_c_int64_t) end do server_loop rc = tcp_close(connection, -1_c_int64_t) rc = db_close(db) 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