148 lines
4.1 KiB
Fortran
148 lines
4.1 KiB
Fortran
program main
|
|
use www
|
|
use db
|
|
implicit none
|
|
|
|
character, dimension(:), allocatable :: form_data
|
|
character(len=32) :: index_path
|
|
character(len=128):: db_path
|
|
integer :: err, i, length
|
|
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
|
|
|
|
call getarg(1, index_path)
|
|
call getarg(2, db_path)
|
|
|
|
call request(form_data, length)
|
|
|
|
if (length .gt. 0) then
|
|
inquire (file=db_path(:Len_Trim(db_path)), exist=exist)
|
|
if (.not. exist) then
|
|
call create_db(db_path)
|
|
end if
|
|
|
|
call add_user(db_path, form_data, length)
|
|
end if
|
|
|
|
call write_index(index_path)
|
|
|
|
if (allocated(form_data)) deallocate (form_data, stat=err)
|
|
if (err /= 0) print *, "index_html: Deallocation request denied"
|
|
|
|
close (unit=12)
|
|
contains
|
|
|
|
subroutine create_db(db_path)
|
|
character(len=128), intent(in) :: db_path
|
|
|
|
! character(len=:), allocatable :: command
|
|
type(db_type) :: db
|
|
integer :: rc
|
|
|
|
rc = db_open(db, db_path(:Len_Trim(db_path)))
|
|
rc = db_create_users(db)
|
|
rc = db_close(db)
|
|
|
|
! command = 'sqlite3 '//db_path &
|
|
! //' ''CREATE TABLE users ' &
|
|
! //'(id INTEGER PRIMARY KEY ASC, ' &
|
|
! //'username TEXT, password TEXT, ' &
|
|
! //'apperance TEXT, x_pos INTEGER, ' &
|
|
! //'y_pos INTEGER, last_login INTEGER, ' &
|
|
! //' created INTEGER);'''
|
|
! write (12, *) command
|
|
! call execute_command_line(command)
|
|
|
|
end subroutine create_db
|
|
|
|
subroutine add_user(db_path, request, length)
|
|
character(len=128), intent(in) :: db_path
|
|
character, dimension(:), allocatable, intent(in) :: request
|
|
integer, intent(in) :: length
|
|
|
|
integer :: i, j, s_idx, e_idx, username_len, password_len
|
|
character(len=24) :: username
|
|
character(len=24) :: password
|
|
character(len=32) :: created
|
|
character(len=8) :: appearance
|
|
logical :: start = .false.
|
|
|
|
type(db_type) :: db
|
|
integer :: rc
|
|
|
|
! character(len=:), allocatable :: command
|
|
|
|
j = 1
|
|
get_username: do i = 1, length
|
|
if (request(i) .eq. '=') then
|
|
s_idx = i + 1
|
|
start = .true.
|
|
end if
|
|
|
|
if (request(i) .eq. '&') then
|
|
e_idx = i - 1
|
|
start = .false.
|
|
exit get_username
|
|
end if
|
|
|
|
if (start) then
|
|
username(j:j) = request(i + 1)
|
|
j = j + 1
|
|
end if
|
|
end do get_username
|
|
username_len = j - 2
|
|
|
|
j = 1
|
|
get_password: do i = e_idx + 2, length
|
|
if (request(i) .eq. '=') then
|
|
s_idx = i + 1
|
|
start = .true.
|
|
end if
|
|
|
|
if (request(i) .eq. '&') then
|
|
e_idx = i - 1
|
|
start = .false.
|
|
exit get_password
|
|
end if
|
|
|
|
if (start) then
|
|
password(j:j) = request(i + 1)
|
|
j = j + 1
|
|
end if
|
|
end do get_password
|
|
password_len = j - 2
|
|
|
|
get_appearance: do i = e_idx + 2, length
|
|
if (request(i) .eq. '=') then
|
|
s_idx = i + 1
|
|
end if
|
|
end do get_appearance
|
|
appearance = transfer(request(s_idx:length), appearance)
|
|
|
|
! write (created, *) time()
|
|
! command = 'sqlite3 '//db_path(:Len_Trim(db_path)) &
|
|
! //' "INSERT INTO users (username,password' &
|
|
! //',apperance,x_pos,y_pos,last_login,created) VALUES (''' &
|
|
! //username(:username_len) &
|
|
! //''',''' &
|
|
! //password(:password_len) &
|
|
! //''',''' &
|
|
! //appearance(:Len_Trim(appearance)) &
|
|
! //''',0,0,0,' &
|
|
! //created(:Len_Trim(created))//');"'
|
|
! call execute_command_line(command)
|
|
|
|
rc = db_open(db, db_path(:Len_Trim(db_path)))
|
|
rc = db_add_user(db, username(:username_len), password(:password_len), appearance(:Len_Trim(appearance)), 0, 0, 0, time())
|
|
rc = db_close(db)
|
|
|
|
end subroutine add_user
|
|
|
|
end program main
|