2023-08-26 13:58:47 -04:00
|
|
|
program main
|
|
|
|
use www
|
|
|
|
implicit none
|
|
|
|
|
|
|
|
character, dimension(:), allocatable :: form_data
|
|
|
|
character(len=32) :: index_path
|
2023-09-02 19:16:55 -04:00
|
|
|
character(len=128):: db_path
|
2023-08-26 13:58:47 -04:00
|
|
|
integer :: err, i, length
|
|
|
|
logical :: exist
|
|
|
|
|
2023-09-02 19:16:55 -04:00
|
|
|
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
|
|
|
|
|
2023-08-26 13:58:47 -04:00
|
|
|
call getarg(1, index_path)
|
|
|
|
call getarg(2, db_path)
|
|
|
|
|
|
|
|
call request(form_data, length)
|
|
|
|
|
|
|
|
if (length .gt. 0) then
|
2023-09-02 22:09:31 -04:00
|
|
|
inquire (file=trim(adjustl(db_path)), exist=exist)
|
2023-09-02 19:16:55 -04:00
|
|
|
if (.not. exist) then
|
|
|
|
call create_db(db_path)
|
2023-08-26 13:58:47 -04:00
|
|
|
end if
|
2023-09-02 19:16:55 -04:00
|
|
|
|
|
|
|
call add_user(db_path, form_data, length)
|
2023-08-26 13:58:47 -04:00
|
|
|
end if
|
|
|
|
|
2023-09-02 19:16:55 -04:00
|
|
|
call write_index(index_path)
|
|
|
|
|
2023-08-26 13:58:47 -04:00
|
|
|
if (allocated(form_data)) deallocate (form_data, stat=err)
|
|
|
|
if (err /= 0) print *, "index_html: Deallocation request denied"
|
|
|
|
|
2023-09-02 19:16:55 -04:00
|
|
|
close (unit=12)
|
2023-08-26 13:58:47 -04:00
|
|
|
contains
|
|
|
|
|
2023-09-02 19:16:55 -04:00
|
|
|
subroutine create_db(db_path)
|
2023-08-26 13:58:47 -04:00
|
|
|
character(len=128), intent(in) :: db_path
|
2023-09-02 19:16:55 -04:00
|
|
|
character(len=:), allocatable :: command
|
2023-08-26 13:58:47 -04:00
|
|
|
|
2023-09-02 22:09:31 -04:00
|
|
|
command = 'sqlite3 '//trim(adjustl(db_path)) &
|
|
|
|
//' ''CREATE TABLE users ' &
|
2023-09-02 19:16:55 -04:00
|
|
|
//'(id INTEGER PRIMARY KEY ASC, ' &
|
|
|
|
//'username TEXT, password TEXT, ' &
|
|
|
|
//'apperance TEXT, x_pos INTEGER, ' &
|
|
|
|
//'y_pos INTEGER, last_login INTEGER, ' &
|
2023-09-02 22:09:31 -04:00
|
|
|
//' created INTEGER);'''
|
2023-09-02 19:16:55 -04:00
|
|
|
write (12, *) command
|
|
|
|
call execute_command_line(command)
|
2023-08-26 13:58:47 -04:00
|
|
|
|
2023-09-02 19:16:55 -04:00
|
|
|
end subroutine create_db
|
2023-08-26 13:58:47 -04:00
|
|
|
|
2023-09-02 19:16:55 -04:00
|
|
|
subroutine add_user(db_path, request, length)
|
|
|
|
character(len=128), intent(in) :: db_path
|
|
|
|
character, dimension(:), allocatable, intent(in) :: request
|
|
|
|
integer, intent(in) :: length
|
|
|
|
|
|
|
|
character(len=:), allocatable :: command
|
|
|
|
character(len=32) :: created
|
2023-09-02 22:09:31 -04:00
|
|
|
integer :: i, s_u_idx, e_u_idx, s_p_idx, e_p_idx, s_a_idx
|
2023-09-02 19:16:55 -04:00
|
|
|
|
|
|
|
get_username: do i = 1, length
|
|
|
|
if (request(i) .eq. '=') then
|
2023-09-02 22:09:31 -04:00
|
|
|
s_u_idx = i + 1
|
2023-09-02 19:16:55 -04:00
|
|
|
end if
|
|
|
|
|
|
|
|
if (request(i) .eq. '&') then
|
2023-09-02 22:09:31 -04:00
|
|
|
e_u_idx = i - 1
|
2023-09-02 19:16:55 -04:00
|
|
|
exit get_username
|
|
|
|
end if
|
|
|
|
end do get_username
|
2023-09-02 22:09:31 -04:00
|
|
|
! username = transfer(request(s_idx:e_idx), username)
|
2023-09-02 19:16:55 -04:00
|
|
|
|
2023-09-02 22:09:31 -04:00
|
|
|
get_password: do i = e_u_idx + 2, length
|
2023-09-02 19:16:55 -04:00
|
|
|
if (request(i) .eq. '=') then
|
2023-09-02 22:09:31 -04:00
|
|
|
s_p_idx = i + 1
|
2023-09-02 19:16:55 -04:00
|
|
|
end if
|
|
|
|
|
|
|
|
if (request(i) .eq. '&') then
|
2023-09-02 22:09:31 -04:00
|
|
|
e_p_idx = i - 1
|
2023-09-02 19:16:55 -04:00
|
|
|
exit get_password
|
|
|
|
end if
|
|
|
|
end do get_password
|
2023-09-02 22:09:31 -04:00
|
|
|
! password = transfer(request(s_idx:e_idx), password)
|
2023-09-02 19:16:55 -04:00
|
|
|
|
2023-09-02 22:09:31 -04:00
|
|
|
get_appearance: do i = e_p_idx + 2, length
|
2023-09-02 19:16:55 -04:00
|
|
|
if (request(i) .eq. '=') then
|
2023-09-02 22:09:31 -04:00
|
|
|
s_a_idx = i + 1
|
2023-09-02 19:16:55 -04:00
|
|
|
end if
|
|
|
|
end do get_appearance
|
2023-09-02 22:09:31 -04:00
|
|
|
! appearance = transfer(request(s_a_idx:length), appearance)
|
2023-09-02 19:16:55 -04:00
|
|
|
|
|
|
|
write (created, *) time()
|
|
|
|
|
2023-09-02 22:09:31 -04:00
|
|
|
command = 'sqlite3 ' &
|
|
|
|
//trim(adjustl(db_path)) &
|
|
|
|
//' "INSERT INTO users (username,password' &
|
|
|
|
//',apperance,x_pos,y_pos,last_login,created) VALUES (''' &
|
|
|
|
//request(s_u_idx:e_u_idx) &
|
|
|
|
//''',''' &
|
|
|
|
//request(s_p_idx:e_p_idx) &
|
|
|
|
//''',''' &
|
|
|
|
//request(s_a_idx:length) &
|
|
|
|
//''',0,0,0,' &
|
|
|
|
//created//');"'
|
2023-09-02 19:16:55 -04:00
|
|
|
write (12, *) command
|
|
|
|
call execute_command_line(command)
|
|
|
|
|
|
|
|
end subroutine add_user
|
2023-08-26 13:58:47 -04:00
|
|
|
|
|
|
|
end program main
|