Skip to content

Commit

Permalink
Refactoring and reformatting.
Browse files Browse the repository at this point in the history
  • Loading branch information
@interkosmos
interkosmos committed Jul 14, 2024
1 parent 79966e4 commit 4bafa74
Show file tree
Hide file tree
Showing 10 changed files with 204 additions and 180 deletions.
24 changes: 10 additions & 14 deletions app/dmapi.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -37,8 +37,8 @@ program dmapi

! Program parameters.
integer, parameter :: APP_DB_TIMEOUT = DB_TIMEOUT_DEFAULT !! SQLite 3 busy timeout in mseconds.
integer, parameter :: APP_MAX_NLOGS = 10000 !! Maximum number of logs per request.
integer, parameter :: APP_MAX_NOBSERVS = 10000 !! Maximum number of observations per request.
integer, parameter :: APP_MAX_NLOGS = 10000 !! Max. number of logs per request.
integer, parameter :: APP_MAX_NOBSERVS = 10000 !! Max. number of observations per request.
integer, parameter :: APP_NROUTES = 15 !! Total number of pages.
logical, parameter :: APP_CSV_HEADER = .false. !! Add CSV header by default.
logical, parameter :: APP_READ_ONLY = .false. !! Default database access mode.
Expand Down Expand Up @@ -76,10 +76,9 @@ program dmapi
cgi_route_type('/timeseries', route_timeseries) ]

! Read environment variables.
rc = dm_env_get('DM_DB_BEAT', db_beat, n); if (dm_is_error(rc)) call dm_stop(STOP_FAILURE)
rc = dm_env_get('DM_DB_LOG', db_log, n); if (dm_is_error(rc)) call dm_stop(STOP_FAILURE)
rc = dm_env_get('DM_DB_OBSERV', db_observ, n); if (dm_is_error(rc)) call dm_stop(STOP_FAILURE)

rc = dm_env_get('DM_DB_BEAT', db_beat, n)
rc = dm_env_get('DM_DB_LOG', db_log, n)
rc = dm_env_get('DM_DB_OBSERV', db_observ, n)
rc = dm_env_get('DM_READ_ONLY', read_only, APP_READ_ONLY)

! Set API routes.
Expand Down Expand Up @@ -203,7 +202,7 @@ subroutine route_beat(env)
end if

! Validate node id.
if (dm_cgi_auth(env)) then
if (dm_cgi_auth_basic(env)) then
if (env%remote_user /= beat%node_id) then
call api_error(HTTP_UNAUTHORIZED, 'node id does not match user name', E_RPC_AUTH)
exit response_block
Expand Down Expand Up @@ -459,7 +458,7 @@ subroutine route_log(env)
end if

! Validate node id.
if (dm_cgi_auth(env)) then
if (dm_cgi_auth_basic(env)) then
if (env%remote_user /= log%node_id) then
call api_error(HTTP_UNAUTHORIZED, 'node id does not match user name', E_RPC_AUTH)
exit response_block
Expand Down Expand Up @@ -792,7 +791,7 @@ subroutine route_node(env)
end if

! Validate node id.
if (dm_cgi_auth(env)) then
if (dm_cgi_auth_basic(env)) then
if (env%remote_user /= node%id) then
call api_error(HTTP_UNAUTHORIZED, 'node id does not match user name', E_RPC_AUTH)
exit response_block
Expand Down Expand Up @@ -929,7 +928,6 @@ subroutine route_nodes(env)
! Optional GET parameters.
call dm_cgi_query(env, param)
rc = dm_cgi_get(param, 'header', header, APP_CSV_HEADER)

! Return CSV.
call dm_fcgi_header(MIME_CSV, code)
call dm_fcgi_out(dm_csv_from(nodes, header=header))
Expand Down Expand Up @@ -1049,7 +1047,7 @@ subroutine route_observ(env)
end if

! Validate node id.
if (dm_cgi_auth(env)) then
if (dm_cgi_auth_basic(env)) then
if (env%remote_user /= observ%node_id) then
call api_error(HTTP_UNAUTHORIZED, 'node id does not match user name', E_RPC_AUTH)
exit response_block
Expand Down Expand Up @@ -1458,7 +1456,7 @@ subroutine route_sensor(env)
end if

! Validate node id.
if (dm_cgi_auth(env)) then
if (dm_cgi_auth_basic(env)) then
if (env%remote_user /= sensor%node_id) then
call api_error(HTTP_UNAUTHORIZED, 'node id does not match user name', E_RPC_AUTH)
exit response_block
Expand Down Expand Up @@ -1596,7 +1594,6 @@ subroutine route_sensors(env)
! Optional GET parameters.
call dm_cgi_query(env, param)
rc = dm_cgi_get(param, 'header', header, APP_CSV_HEADER)

! Return CSV.
call dm_fcgi_header(MIME_CSV, code)
call dm_fcgi_out(dm_csv_from(sensors, header=header))
Expand Down Expand Up @@ -1845,7 +1842,6 @@ subroutine route_targets(env)
! Optional GET parameters.
call dm_cgi_query(env, param)
rc = dm_cgi_get(param, 'header', header, APP_CSV_HEADER)

! Return CSV.
call dm_fcgi_header(MIME_CSV, code)
call dm_fcgi_out(dm_csv_from(targets, header=header))
Expand Down
39 changes: 20 additions & 19 deletions src/dm_cgi.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -68,7 +68,7 @@ module dm_cgi
end interface dm_cgi_get

! Public procedures.
public :: dm_cgi_auth
public :: dm_cgi_auth_basic
public :: dm_cgi_content
public :: dm_cgi_decode
public :: dm_cgi_env
Expand Down Expand Up @@ -96,12 +96,13 @@ module dm_cgi
! ******************************************************************
! PUBLIC PROCEDURES.
! ******************************************************************
logical function dm_cgi_auth(env) result(auth)
!! Returns `.true.` if CGI environment variable `AUTH` is set.
logical function dm_cgi_auth_basic(env) result(auth)
!! Returns `.true.` if CGI environment variable `AUTH` is set to
!! `Basic`.
type(cgi_env_type), intent(inout) :: env !! CGI environment type.

auth = (len_trim(env%auth_type) > 0)
end function dm_cgi_auth
auth = (env%auth_type == 'Basic')
end function dm_cgi_auth_basic

integer function dm_cgi_content(env, content) result(rc)
!! Reads HTTP request body (POST method). We have to rely on _read(2)_
Expand All @@ -121,7 +122,7 @@ integer function dm_cgi_content(env, content) result(rc)
character(len=:), allocatable, target, intent(out) :: content !! Returned request body.

integer :: stat
integer(kind=c_size_t) :: nc, sz
integer(kind=c_size_t) :: nn, sz

rc = E_ALLOC
allocate (character(len=env%content_length) :: content, stat=stat)
Expand All @@ -130,14 +131,14 @@ integer function dm_cgi_content(env, content) result(rc)
rc = E_EMPTY
if (env%content_length == 0) return

nc = int(env%content_length, kind=c_size_t)
sz = c_read(STDIN_FILENO, c_loc(content), nc)
nn = int(env%content_length, kind=c_size_t)
sz = c_read(STDIN_FILENO, c_loc(content), nn)

rc = E_EOF
if (sz == 0) return

rc = E_READ
if (sz /= nc) return
if (sz /= nn) return

rc = E_NONE
end function dm_cgi_content
Expand All @@ -147,26 +148,26 @@ integer function dm_cgi_decode(input, output) result(rc)
character(len=*), intent(in) :: input !! Encoded input string.
character(len=len(input)), intent(out) :: output !! Decoded output string.

integer :: i, j, k, n, m
integer :: i, ii, j, jj, k
integer :: stat

n = len_trim(input)
m = len(output)
ii = len_trim(input)
jj = len(output)
output = ' '

rc = E_BOUNDS
if (m < n) return
if (jj < ii) return

i = 1
j = 1

do
if (i > n) exit
if (j > m) return
if (i > ii) exit
if (j > jj) return

select case (input(i:i))
case ('%')
if (i + 2 > n) exit
if (i + 2 > ii) exit
read (input(i + 1:i + 2), '(z2)', iostat=stat) k

if (stat == 0) then
Expand Down Expand Up @@ -234,7 +235,7 @@ function dm_cgi_key(param, loc) result(str)
character(len=:), allocatable :: str !! Key or empty.

if ((param%cursor == 0) .or. (loc < 1) .or. (loc > param%cursor)) then
str = ''
allocate (character(len=0) :: str)
return
end if

Expand All @@ -257,7 +258,7 @@ function dm_cgi_value(param, loc) result(str)
character(len=:), allocatable :: str !! Value or empty.

if ((param%cursor == 0) .or. (loc < 1) .or. (loc > param%cursor)) then
str = ''
allocate (character(len=0) :: str)
return
end if

Expand Down Expand Up @@ -471,7 +472,7 @@ integer function cgi_get_logical(param, key, value, default, required) result(rc
rc = E_TYPE
call dm_string_to(param%values(loc), i, stat)
if (stat /= E_NONE) return
value = .not. (i == 0)
value = (i /= 0)
rc = E_NONE
end function cgi_get_logical

Expand Down
16 changes: 8 additions & 8 deletions src/dm_env.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -123,7 +123,7 @@ integer function env_get_int64(name, value, default, exists) result(rc)
integer :: n, stat
integer(kind=i8) :: i

rc = E_EMPTY
rc = E_EMPTY
value = 0

if (present(default)) value = default
Expand All @@ -136,7 +136,7 @@ integer function env_get_int64(name, value, default, exists) result(rc)
if (rc /= E_NONE) return

value = i
rc = E_NONE
rc = E_NONE
end function env_get_int64

integer function env_get_logical(name, value, default, exists) result(rc)
Expand All @@ -160,7 +160,7 @@ integer function env_get_logical(name, value, default, exists) result(rc)
if (present(exists)) exists = .true.

value = (i > 0)
rc = E_NONE
rc = E_NONE
end function env_get_logical

integer function env_get_real32(name, value, default, exists) result(rc)
Expand All @@ -175,7 +175,7 @@ integer function env_get_real32(name, value, default, exists) result(rc)
integer :: n, stat
real(kind=r4) :: f

rc = E_EMPTY
rc = E_EMPTY
value = 0

if (present(default)) value = default
Expand All @@ -188,7 +188,7 @@ integer function env_get_real32(name, value, default, exists) result(rc)
if (rc /= E_NONE) return

value = f
rc = E_NONE
rc = E_NONE
end function env_get_real32

integer function env_get_real64(name, value, default, exists) result(rc)
Expand All @@ -203,7 +203,7 @@ integer function env_get_real64(name, value, default, exists) result(rc)
integer :: n, stat
real(kind=r8) :: f

rc = E_EMPTY
rc = E_EMPTY
value = 0

if (present(default)) value = default
Expand All @@ -216,7 +216,7 @@ integer function env_get_real64(name, value, default, exists) result(rc)
if (rc /= E_NONE) return

value = f
rc = E_NONE
rc = E_NONE
end function env_get_real64

integer function env_get_string(name, value, n, exists) result(rc)
Expand All @@ -229,7 +229,7 @@ integer function env_get_string(name, value, n, exists) result(rc)

integer :: stat

rc = E_EMPTY
rc = E_EMPTY
value = ' '
if (present(exists)) exists = .false.

Expand Down
14 changes: 14 additions & 0 deletions src/dm_jsonl.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -58,6 +58,7 @@ module dm_jsonl
function jsonl_from_beats(beats) result(jsonl)
!! Returns array of beats in JSON Lines format.
use :: dm_beat

type(beat_type), intent(inout) :: beats(:) !! Array of beat types.
character(len=:), allocatable :: jsonl !! Allocatable JSON Lines string.

Expand All @@ -82,6 +83,7 @@ end function jsonl_from_beats
function jsonl_from_data_points(data_points) result(jsonl)
!! Returns array of data points in JSON Lines format.
use :: dm_dp

type(dp_type), intent(inout) :: data_points(:) !! Data points array.
character(len=:), allocatable :: jsonl !! Allocatable JSON Lines string.

Expand All @@ -106,6 +108,7 @@ end function jsonl_from_data_points
function jsonl_from_logs(logs) result(jsonl)
!! Returns array of logs in JSON Lines format.
use :: dm_log

type(log_type), intent(inout) :: logs(:) !! Array of log types.
character(len=:), allocatable :: jsonl !! Allocatable JSON Lines string.

Expand All @@ -130,6 +133,7 @@ end function jsonl_from_logs
function jsonl_from_nodes(nodes) result(jsonl)
!! Returns array of nodes in JSON Lines format.
use :: dm_node

type(node_type), intent(inout) :: nodes(:) !! Array of node types.
character(len=:), allocatable :: jsonl !! Allocatable JSON Lines string.

Expand All @@ -154,6 +158,7 @@ end function jsonl_from_nodes
function jsonl_from_observs(observs) result(jsonl)
!! Returns array of observations in JSON Lines format.
use :: dm_observ

type(observ_type), intent(inout) :: observs(:) !! Array of observations.
character(len=:), allocatable :: jsonl !! Allocatable JSON Lines string.

Expand All @@ -178,6 +183,7 @@ end function jsonl_from_observs
function jsonl_from_sensors(sensors) result(jsonl)
!! Returns array of sensors in JSON Lines format.
use :: dm_sensor

type(sensor_type), intent(inout) :: sensors(:) !! Array of sensors.
character(len=:), allocatable :: jsonl !! Allocatable JSON Lines string.

Expand All @@ -202,6 +208,7 @@ end function jsonl_from_sensors
function jsonl_from_targets(targets) result(jsonl)
!! Returns array of targets in JSON Lines format.
use :: dm_target

type(target_type), intent(inout) :: targets(:) !! Array of targets.
character(len=:), allocatable :: jsonl !! Allocatable JSON Lines string.

Expand All @@ -226,6 +233,7 @@ end function jsonl_from_targets
integer function jsonl_write_beats(beats, unit) result(rc)
!! Writes beats to file or standard output.
use :: dm_beat

type(beat_type), intent(inout) :: beats(:) !! Beat array.
integer, intent(in), optional :: unit !! File unit.

Expand All @@ -252,6 +260,7 @@ end function jsonl_write_beats
integer function jsonl_write_data_points(data_points, unit) result(rc)
!! Writes data_points to file or standard output.
use :: dm_dp

type(dp_type), intent(inout) :: data_points(:) !! Data point array.
integer, intent(in), optional :: unit !! File unit.

Expand All @@ -278,6 +287,7 @@ end function jsonl_write_data_points
integer function jsonl_write_logs(logs, unit) result(rc)
!! Writes logs to file or standard output.
use :: dm_log

type(log_type), intent(inout) :: logs(:) !! Log array.
integer, intent(in), optional :: unit !! File unit.

Expand All @@ -304,6 +314,7 @@ end function jsonl_write_logs
integer function jsonl_write_nodes(nodes, unit) result(rc)
!! Writes nodes to file or standard output.
use :: dm_node

type(node_type), intent(inout) :: nodes(:) !! Node array.
integer, intent(in), optional :: unit !! File unit.

Expand All @@ -330,6 +341,7 @@ end function jsonl_write_nodes
integer function jsonl_write_observs(observs, unit) result(rc)
!! Writes observations to file or standard output.
use :: dm_observ

type(observ_type), intent(inout) :: observs(:) !! Observation array.
integer, intent(in), optional :: unit !! File unit.

Expand All @@ -356,6 +368,7 @@ end function jsonl_write_observs
integer function jsonl_write_sensors(sensors, unit) result(rc)
!! Writes sensors to file or standard output.
use :: dm_sensor

type(sensor_type), intent(inout) :: sensors(:) !! Sensor array.
integer, intent(in), optional :: unit !! File unit.

Expand All @@ -382,6 +395,7 @@ end function jsonl_write_sensors
integer function jsonl_write_targets(targets, unit) result(rc)
!! Writes targets to file or standard output.
use :: dm_target

type(target_type), intent(inout) :: targets(:) !! Target array.
integer, intent(in), optional :: unit !! File unit.

Expand Down
Loading

0 comments on commit 4bafa74

Please sign in to comment.