add tcp client/server

This commit is contained in:
zongor 2023-10-08 11:54:21 -04:00
parent dad620f74e
commit b0c551bd07
9 changed files with 443 additions and 354 deletions

2
.gitignore vendored
View File

@ -3,6 +3,8 @@ a.out
*.mod
*.log
*.~undo-tree~
*.*~
build/
fortran/client/client

Binary file not shown.

View File

@ -27,7 +27,7 @@ program main
call getarg(2, password)
me = player(username, vector3( 0.0_c_float, 1.0_c_float, 2.0_c_float ), PURPLE)
!players = me%login(password)
players = me%login(password)
camera%position = vector3(0.0_c_float, 10.0_c_float, 10.0_c_float) !Camera position
camera%target = vector3(0.0_c_float, 0.0_c_float, 0.0_c_float) !Camera looking at point
@ -58,9 +58,9 @@ program main
call me%sync_camera(camera)
if (player_updated) then
!players = me%move()
players = me%move()
else
!players = me%ping()
players = me%ping()
end if
call begin_drawing()
@ -71,15 +71,15 @@ program main
call draw_grid(30_c_int, 1.0_c_float)
call draw_cube(me%position, 0.5_c_float, 0.5_c_float, 0.5_c_float, me%apperance)
!do i=1,size(players)
! call draw_cube(players(i)%position, 0.5_c_float, 0.5_c_float, 0.5_c_float, players(i)%apperance)
!end do
do i=1,size(players)
call draw_cube(players(i)%position, 0.5_c_float, 0.5_c_float, 0.5_c_float, players(i)%apperance)
end do
call end_mode_3d()
call end_drawing()
end do
!players = me%logout()
players = me%logout()
if (allocated(players)) then
deallocate(players)
end if

View File

@ -16,3 +16,4 @@ library = false
implicit-typing = false
implicit-external = false
source-form = "free"
[dependencies]

View File

@ -37,6 +37,8 @@ contains
character(24) :: password
type(player), dimension(:), allocatable :: players
print *, password
players = send_packet(this, 1)
end function login
@ -85,33 +87,63 @@ contains
integer(c_size_t) :: message_size, msglen = 256
type(ipaddr) :: addr
character(c_char) :: message(256) = ''
character(len=*), parameter :: TCP_SUFFIX = c_carriage_return // c_new_line // c_null_char
character(len=256) :: f_message
character(len=*), parameter :: TCP_SUFFIX = c_carriage_return//c_new_line//c_null_char
rc = ipaddr_remote(addr, '127.0.0.1' // c_null_char, 35565_c_int, IPADDR_IPV4, -1_c_int64_t)
rc = ipaddr_remote(addr, '127.0.0.1'//c_null_char, 5555_c_int, IPADDR_IPV4, -1_c_int64_t)
connection = tcp_connect(addr, -1_c_int64_t)
connection = suffix_attach(connection, TCP_SUFFIX, 2_c_size_t)
write(message, "(i3, 1x, a24, 1x, f8.2, 1x, f8.2)") request_type, &
this%username, this%position%x, this%position%y
write (f_message, "(f8.2, f8.2, i3, a24)") &
this%position%x, this%position%y, request_type, this%username
rc = msend(connection, message(Len_Trim(message)), transfer(Len_Trim(message), 0_c_size_t), -1_c_int64_t)
print *, f_c_string(f_message, .true.)
rc = msend(connection, f_c_string(f_message, .true.), &
transfer(Len_Trim(f_c_string(f_message, .true.)), 0_c_size_t), -1_c_int64_t)
message_size = mrecv(connection, message, msglen, -1_c_int64_t)
print *, 'recv message: ', message(:message_size)
read (message(:message_size), '(i3)') count
do i=0, count, 1
print *, count
do i = 0, count, 1
message_size = mrecv(connection, message, msglen, -1_c_int64_t)
read(message, "(a, i3, i3, i3, f8.2, f8.2)") username, &
apperance_r, apperance_g, apperance_b, x_pos, y_pos
read (message(:message_size), "(i3, i3, i3, f8.2, f8.2, a24)") &
apperance_r, apperance_g, apperance_b, x_pos, y_pos, username
if (allocated(players)) then
players = [players, player(username, vector3( x_pos, 1.0_c_float, y_pos ), &
players = [players, player(username, vector3(x_pos, 1.0_c_float, y_pos), &
color(apperance_r, apperance_g, apperance_b, 255))]
else
players = [player(username, vector3( x_pos, 1.0_c_float, y_pos ), &
players = [player(username, vector3(x_pos, 1.0_c_float, y_pos), &
color(apperance_r, apperance_g, apperance_b, 255))]
end if
end do
end function send_packet
! from ivanpribec `https://fortran-lang.discourse.group/t/best-practices-for-passing-c-strings/104/12`
function f_c_string(string, trim)
use, intrinsic :: iso_c_binding, only: c_char, c_null_char
implicit none
character(len=*), intent(in) :: string
logical, intent(in), optional :: trim
character(kind=c_char, len=:), allocatable :: f_c_string
logical :: trim_
trim_ = .true.
if (present(trim)) trim_ = trim
block
intrinsic trim
if (trim_) then
f_c_string = trim(string)//c_null_char
else
f_c_string = string//c_null_char
end if
end block
end function
end module player_mod

BIN
fortran/server/.test.sh.swp Normal file

Binary file not shown.

View File

@ -1,6 +1,10 @@
program main
use iso_fortran_env
use, intrinsic :: iso_c_binding
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
use db
implicit none
@ -9,15 +13,15 @@ program main
character(len=24):: username
real(kind=c_double) :: x_pos
real(kind=c_double) :: y_pos
integer :: command, rc
integer :: command
logical :: exist
inquire (file="debug.log", exist=exist)
if (exist) then
open (12, file="debug.log", status="old", position="append", action="write")
else
open (12, file="debug.log", status="new", action="write")
end if
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
call getarg(1, db_path)
@ -27,34 +31,49 @@ program main
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
! read message from stdin
read(input_unit, "(i3, 1x, a24, 1x, f8.2, 1x, f8.2)") command, username, x_pos, y_pos
write(12, "(i3, 1x, a24, 1x, f8.2, 1x, f8.2)") command, username, x_pos, y_pos
call flush(12)
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)
rc = db_get_logged_in_users(db)
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)
rc = db_get_logged_in_users(db)
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)
rc = db_get_logged_in_users(db)
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)
rc = db_get_logged_in_users(db)
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)
close(12)
end program main

View File

@ -1,7 +1,9 @@
! db.f90
module db
use iso_fortran_env
use, intrinsic :: iso_c_binding
use iso_c_binding
use mod_dill, only: ipaddr, ipaddr_remote, IPADDR_IPV4, mrecv, msend, tcp_connect, &
suffix_attach
use :: sqlite3
implicit none
private
@ -27,7 +29,6 @@ module db
private :: db_exec
contains
integer function db_open(db, path) result(rc)
!! Opens database.
type(db_type), intent(inout) :: db
@ -61,11 +62,11 @@ contains
! Create table "users".
rc = db_exec(db, "CREATE TABLE users " &
// "(id INTEGER PRIMARY KEY ASC, " &
// "username TEXT, password TEXT, " &
// "apperance_r INTEGER, apperance_g INTEGER, apperance_b INTEGER, " &
// "x_pos REAL, y_pos REAL, logged_in INTEGER, " &
// "created INTEGER);")
//"(id INTEGER PRIMARY KEY ASC, " &
//"username TEXT, password TEXT, " &
//"apperance_r INTEGER, apperance_g INTEGER, apperance_b INTEGER, " &
//"x_pos REAL, y_pos REAL, logged_in INTEGER, " &
//"created INTEGER);")
if (rc /= SQLITE_OK) return
end function db_create_users
@ -118,7 +119,6 @@ contains
call db_error(rc, 'sqlite3_finalize()')
end function db_add_user
integer function db_delete_user(db, username) result(rc)
!! Adds student to database.
type(db_type), intent(inout) :: db
@ -141,10 +141,12 @@ contains
call db_error(rc, 'sqlite3_finalize()')
end function db_delete_user
integer function db_count_logged_in_users(db) result(rc)
integer function db_count_logged_in_users(db, connection) result(rc)
!! Prints number of courses per student to standard output.
type(db_type), intent(inout) :: db
integer(c_int), intent(inout) :: connection
character(len=256) :: message
type(c_ptr) :: stmt
integer :: count
@ -157,7 +159,11 @@ contains
select case (rc)
case (SQLITE_ROW)
count = sqlite3_column_int(stmt, 0)
write(output_unit, "(i0)") count
print *, 'logged in: ', count
write (message, "(i3)") count
rc = msend(connection, f_c_string(message, .true.), &
transfer(Len_Trim(f_c_string(message, .true.)), 0_c_size_t), -1_c_int64_t)
case (SQLITE_DONE)
exit step_loop
@ -172,17 +178,19 @@ contains
call db_error(rc, 'sqlite3_finalize()')
end function db_count_logged_in_users
integer function db_get_logged_in_users(db) result(rc)
integer function db_get_logged_in_users(db, connection) result(rc)
!! Prints number of courses per student to standard output.
type(db_type), intent(inout) :: db
integer(c_int), intent(inout) :: connection
character(len=256) :: message
type(c_ptr) :: stmt
character(len=24) :: username
integer :: apperance_r, apperance_g, apperance_b
real :: x_pos, y_pos
real(real64) :: x_pos, y_pos
rc = sqlite3_prepare_v2(db%ptr, &
"SELECT username, apperance_r, apperance_g, apperance_b, x_pos, y_pos " // &
"SELECT username, apperance_r, apperance_g, apperance_b, x_pos, y_pos "// &
"FROM users u WHERE u.logged_in = 1;", stmt)
call db_error(rc, 'sqlite3_prepare_v2()')
@ -197,9 +205,12 @@ contains
apperance_b = sqlite3_column_int(stmt, 3)
x_pos = sqlite3_column_double(stmt, 4)
y_pos = sqlite3_column_double(stmt, 5)
write(output_unit, "(a24, 1x, i3, 1x, i3, 1x, i3, 1x, f8.2, 1x, f8.2)") username(:Len_Trim(username)), &
apperance_r, apperance_g, apperance_b, x_pos, y_pos
write (message, "(i3, i3, i3, f8.2, f8.2, a24)") &
apperance_r, apperance_g, apperance_b, x_pos, y_pos, username(:Len_Trim(username))
rc = msend(connection, f_c_string(message, .true.), &
transfer(Len_Trim(f_c_string(message, .true.)), 0_c_size_t), -1_c_int64_t)
case (SQLITE_DONE)
exit step_loop
@ -285,15 +296,38 @@ contains
if (code == SQLITE_OK .or. code == SQLITE_DONE) return
if (present(proc) .and. present(err_msg)) then
write(12, '(a, ": ", a, " (", i0, ")")') proc, err_msg, code
print *, proc, err_msg, code
return
end if
if (present(proc)) then
write(12, '(a, ": ", i0)') proc, code
print *, proc, code
return
end if
write(12, '("unknown error: ", i0)') code
print *, 'unknown error: ', code
end subroutine db_error
! from ivanpribec `https://fortran-lang.discourse.group/t/best-practices-for-passing-c-strings/104/12`
function f_c_string(string, trim)
use, intrinsic :: iso_c_binding, only: c_char, c_null_char
implicit none
character(len=*), intent(in) :: string
logical, intent(in), optional :: trim
character(kind=c_char, len=:), allocatable :: f_c_string
logical :: trim_
trim_ = .true.
if (present(trim)) trim_ = trim
block
intrinsic trim
if (trim_) then
f_c_string = trim(string)//c_null_char
else
f_c_string = string//c_null_char
end if
end block
end function
end module db

View File

@ -1,2 +1,3 @@
#!/bin/sh
listen1 'tcp!*!35565' ~/.local/bin/fortran-mmo-server ../../common/sql/test.db3
#listen1 'tcp!*!35565'
~/.local/bin/fortran-mmo-server ../../common/sql/test.db3