147 lines
3.8 KiB
Fortran
147 lines
3.8 KiB
Fortran
program main
|
|
use, intrinsic :: iso_c_binding
|
|
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
|
|
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)
|
|
|
|
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
|
|
integer :: appearance_r, appearance_g, appearance_b
|
|
real(kind=c_double) :: x_pos = 0.0_c_double
|
|
real(kind=c_double) :: y_pos = 0.0_c_double
|
|
logical :: start = .false.
|
|
|
|
type(db_type) :: db
|
|
integer :: rc
|
|
|
|
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 + 4
|
|
end if
|
|
end do get_appearance
|
|
|
|
appearance_r = hex2int(request(s_idx), request(s_idx+1))
|
|
appearance_g = hex2int(request(s_idx+2), request(s_idx+3))
|
|
appearance_b = hex2int(request(s_idx+4), request(s_idx+5))
|
|
|
|
rc = db_open(db, db_path(:Len_Trim(db_path)))
|
|
rc = db_add_user(db, username(:username_len), password(:password_len), &
|
|
appearance_r, appearance_g, appearance_b, x_pos, y_pos, 0, time())
|
|
rc = db_close(db)
|
|
|
|
end subroutine add_user
|
|
|
|
integer function hex2int(h1, h2) result(val)
|
|
character, intent(in) :: h1
|
|
character, intent(in) :: h2
|
|
integer :: a, b
|
|
|
|
if (ichar(h1) .le. ichar('9')) then
|
|
a = ichar(h1) - ichar('0')
|
|
else
|
|
a = iand(ichar(h1), 7) + 9
|
|
end if
|
|
|
|
if (ichar(h2) .le. ichar('9')) then
|
|
b = ichar(h2) - ichar('0')
|
|
else
|
|
b = iand(ichar(h2), 7) + 9
|
|
end if
|
|
|
|
val = shiftl(a, 4) + b
|
|
end function hex2int
|
|
|
|
end program main
|