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 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 character(len=8) :: appearance 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 + 1 end if end do get_appearance appearance = transfer(request(s_idx:length), appearance) 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