diff --git a/app/dmfeed.f90 b/app/dmfeed.f90 index a978cb2..3412e51 100644 --- a/app/dmfeed.f90 +++ b/app/dmfeed.f90 @@ -178,15 +178,15 @@ subroutine create_feed(app, error) is_file = (len_trim(app%output) > 0 .and. app%output /= '-') - ! Connect to database. - rc = dm_db_open(db, app%database, timeout=DB_TIMEOUT_DEFAULT) + feed_block: block + ! Connect to database. + rc = dm_db_open(db, app%database, timeout=DB_TIMEOUT_DEFAULT) - if (dm_is_error(rc)) then - call dm_error_out(rc, 'failed to open database') - return - end if + if (dm_is_error(rc)) then + call dm_error_out(rc, 'failed to open database') + exit feed_block + end if - feed_block: block ! Get logs from database. if (len_trim(app%node) > 0) then rc = dm_db_select(db = db, & diff --git a/app/dmfs.f90 b/app/dmfs.f90 index 2af0020..ba751b4 100644 --- a/app/dmfs.f90 +++ b/app/dmfs.f90 @@ -221,11 +221,12 @@ integer function read_observ(observ, node_id, sensor_id, debug) result(rc) character(len=*), intent(in) :: sensor_id !! Sensor id of observation. logical, intent(in), optional :: debug !! Output debug messages. - character(len=LOG_MESSAGE_LEN) :: message - integer :: delay, i, j, fu, stat - logical :: debug_ - type(request_type), pointer :: request ! Next request to execute. - type(response_type), pointer :: response ! Single response in request. + integer :: delay + integer :: fu, stat + integer :: i, j + logical :: debug_ + type(request_type), pointer :: request ! Next request to execute. + type(response_type), pointer :: response ! Single response in request. debug_ = .true. if (present(debug)) debug_ = debug @@ -269,9 +270,7 @@ integer function read_observ(observ, node_id, sensor_id, debug) result(rc) ! Read until the request pattern matches. read_loop: do - rc = E_READ - request%response = ' ' - + rc = E_EOF read (fu, '(a)', iostat=stat) request%response if (is_iostat_end(stat)) exit read_loop if (stat /= 0) cycle read_loop @@ -280,7 +279,7 @@ integer function read_observ(observ, node_id, sensor_id, debug) result(rc) rc = dm_regex_request(request) if (dm_is_error(rc)) then - call dm_log(LOG_WARNING, 'failed to match response', observ=observ, error=rc) + if (debug_) call dm_log(LOG_DEBUG, 'line does not match pattern', observ=observ, error=rc) cycle read_loop end if @@ -288,8 +287,8 @@ integer function read_observ(observ, node_id, sensor_id, debug) result(rc) do j = 1, request%nresponses response => request%responses(j) if (dm_is_ok(response%error)) cycle - call dm_log(LOG_WARNING, 'failed to read response ' // response%name, & - observ=observ, error=response%error) + call dm_log(LOG_WARNING, 'failed to extract response ' // trim(response%name) // & + ' of request ' // dm_itoa(i), observ=observ, error=response%error) end do ! Cycle on error or exit on success. @@ -302,7 +301,7 @@ integer function read_observ(observ, node_id, sensor_id, debug) result(rc) ! Save response and return code. request%response = dm_ascii_escape(request%response) - request%error = rc + request%error = rc ! Create log message and repeat. if (dm_is_error(rc)) then @@ -311,7 +310,7 @@ integer function read_observ(observ, node_id, sensor_id, debug) result(rc) cycle req_loop end if - if (debug) then ! Log only if needed. + if (debug_) then call dm_log(LOG_DEBUG, 'finished request ' // dm_itoa(i) // ' of ' // & dm_itoa(observ%nrequests), observ=observ) end if @@ -320,9 +319,9 @@ integer function read_observ(observ, node_id, sensor_id, debug) result(rc) delay = max(0, request%delay) if (delay <= 0) cycle req_loop - if (debug) then ! Log only if needed. - write (message, '("next request of observ ", a, " in ", i0, " sec")') trim(observ%name), delay / 1000 - call dm_log(LOG_DEBUG, message) + if (debug_) then + call dm_log(LOG_DEBUG, 'next request of observ ' // trim(observ%name) // & + ' in ' // dm_itoa(delay / 1000) // ' sec', observ=observ) end if call dm_usleep(delay * 1000) @@ -371,7 +370,7 @@ subroutine run(app) exit job_loop end if - call dm_log(LOG_DEBUG, dm_itoa(njobs) // ' job(s) left in job queue') + if (debug) call dm_log(LOG_DEBUG, dm_itoa(njobs) // ' job(s) left in job queue') ! Get next job as deep copy. rc = dm_job_list_next(app%jobs, job) @@ -384,12 +383,20 @@ subroutine run(app) if (job%valid) then observ => job%observ + if (debug) then + call dm_log(LOG_DEBUG, 'starting observ ' // trim(observ%name) // & + ' for sensor ' // app%sensor, observ=observ) + end if + ! Read observation from file system. - call dm_log(LOG_DEBUG, 'starting observ ' // trim(observ%name) // ' for sensor ' // app%sensor, observ=observ) rc = read_observ(observ, app%node, app%sensor, debug=debug) + if (debug) then + call dm_log(LOG_DEBUG, 'finished observ ' // trim(observ%name) // & + ' for sensor ' // app%sensor, observ=observ) + end if + ! Forward observation via message queue. - call dm_log(LOG_DEBUG, 'finished observ ' // trim(observ%name) // ' for sensor ' // app%sensor, observ=observ) rc = dm_mqueue_forward(observ, app%name, APP_MQ_BLOCKING) ! Output observation. @@ -399,7 +406,7 @@ subroutine run(app) ! Wait delay time of the job if set (absolute). delay = max(0, job%delay) if (delay <= 0) cycle job_loop - call dm_log(LOG_DEBUG, 'next job in ' // dm_itoa(delay / 1000) // ' sec') + if (debug) call dm_log(LOG_DEBUG, 'next job in ' // dm_itoa(delay / 1000) // ' sec', observ=observ) call dm_usleep(delay * 1000) end do job_loop end subroutine run diff --git a/app/dmpipe.f90 b/app/dmpipe.f90 index 1183fc5..b151ae7 100644 --- a/app/dmpipe.f90 +++ b/app/dmpipe.f90 @@ -240,6 +240,7 @@ subroutine run(app) integer :: delay, njobs integer :: i, j, rc integer(kind=i8) :: sz + logical :: debug type(job_type), target :: job ! Next job to run. type(pipe_type) :: pipe ! Pipe to process. @@ -247,6 +248,8 @@ subroutine run(app) type(request_type), pointer :: request ! Next request to execute. type(response_type), pointer :: response ! Response in request. + debug = (app%debug .or. app%verbose) + call dm_log(LOG_INFO, 'started ' // app%name) ! Run until no jobs are left. @@ -254,11 +257,11 @@ subroutine run(app) njobs = dm_job_list_count(app%jobs) if (njobs == 0) then - call dm_log(LOG_DEBUG, 'no jobs left') + if (debug) call dm_log(LOG_DEBUG, 'no jobs left') exit job_loop end if - call dm_log(LOG_DEBUG, dm_itoa(njobs) // ' job(s) left in job queue') + if (debug) call dm_log(LOG_DEBUG, dm_itoa(njobs) // ' job(s) left in job queue') ! Get next job as deep copy. rc = dm_job_list_next(app%jobs, job) @@ -272,7 +275,7 @@ subroutine run(app) ! Get pointer to job observation. observ => job%observ - call dm_log(LOG_DEBUG, 'starting observ ' // observ%name, observ=observ) + if (debug) call dm_log(LOG_DEBUG, 'starting observ ' // observ%name, observ=observ) ! Initialise observation. observ%id = dm_uuid4() @@ -281,7 +284,7 @@ subroutine run(app) observ%timestamp = dm_time_now() if (observ%nrequests == 0) then - call dm_log(LOG_DEBUG, 'no requests in observ ' // observ%name, observ=observ) + if (debug) call dm_log(LOG_DEBUG, 'no requests in observ ' // observ%name, observ=observ) exit observ_if end if @@ -314,7 +317,8 @@ subroutine run(app) rc = dm_regex_request(request) if (dm_is_error(rc)) then - call dm_log(LOG_WARNING, 'failed to match response', observ=observ, error=rc) + call dm_log(LOG_WARNING, 'response to request ' // dm_itoa(i) // ' does not match pattern', & + observ=observ, error=rc) cycle read_loop end if @@ -346,13 +350,15 @@ subroutine run(app) ! Wait the set delay time of the request. delay = max(0, request%delay) if (delay <= 0) cycle req_loop - call dm_log(LOG_DEBUG, 'next request of observ ' // trim(observ%name) // & - ' in ' // dm_itoa(delay / 1000) // ' sec') + if (debug) then + call dm_log(LOG_DEBUG, 'next request of observ ' // trim(observ%name) // & + ' in ' // dm_itoa(delay / 1000) // ' sec', observ=observ) + end if call dm_usleep(delay * 1000) end do req_loop ! Forward observation. - call dm_log(LOG_DEBUG, 'finished observ ' // observ%name, observ=observ) + if (debug) call dm_log(LOG_DEBUG, 'finished observ ' // observ%name, observ=observ) rc = dm_mqueue_forward(observ, app%name, APP_MQ_BLOCKING) ! Output observation. @@ -362,7 +368,7 @@ subroutine run(app) ! Wait the set delay time of the job (absolute). delay = max(0, job%delay) if (delay <= 0) cycle job_loop - call dm_log(LOG_DEBUG, 'next job in ' // dm_itoa(delay / 1000) // ' sec') + if (debug) call dm_log(LOG_DEBUG, 'next job in ' // dm_itoa(delay / 1000) // ' sec', observ=observ) call dm_usleep(delay * 1000) end do job_loop end subroutine run diff --git a/app/dmserial.f90 b/app/dmserial.f90 index f3c61f8..34bcb02 100644 --- a/app/dmserial.f90 +++ b/app/dmserial.f90 @@ -322,11 +322,14 @@ integer function read_observ(tty, observ, debug) result(rc) logical, intent(in), optional :: debug !! Output debug messages. character(len=REQUEST_REQUEST_LEN) :: raw_request ! Raw request (unescaped). + character(len=REQUEST_RESPONSE_LEN) :: raw_response ! Raw response (unescaped). character(len=REQUEST_DELIMITER_LEN) :: raw_delimiter ! Raw delimiter (unescaped). - integer :: delay, i, j - logical :: debug_ ! Create debug messages only if necessary. - type(request_type), pointer :: request ! Next request to execute. - type(response_type), pointer :: response ! Single response in request. + + integer :: delay + integer :: i, j + logical :: debug_ ! Create debug messages only if necessary. + type(request_type), pointer :: request ! Next request to execute. + type(response_type), pointer :: response ! Single response in request. debug_ = .true. if (present(debug)) debug_ = debug @@ -349,21 +352,20 @@ integer function read_observ(tty, observ, debug) result(rc) if (debug_) then call dm_log(LOG_DEBUG, 'starting request ' // dm_itoa(i) // ' of ' // & dm_itoa(observ%nrequests), observ=observ) + call dm_log(LOG_DEBUG, 'sending request: ' // request%request, observ=observ) end if - ! Set raw values. - raw_request = dm_ascii_unescape(request%request) - raw_delimiter = dm_ascii_unescape(request%delimiter) - - ! Set default error of responses. + ! Prepare request. rc = dm_request_set_response_error(request, E_INCOMPLETE) - ! Send request to sensor. - if (debug_) call dm_log(LOG_DEBUG, 'sending request: ' // raw_request, observ=observ) + raw_request = dm_ascii_unescape(request%request) + raw_delimiter = dm_ascii_unescape(request%delimiter) + raw_response = ' ' request%response = ' ' request%timestamp = dm_time_now() + ! Send request to sensor. request%error = dm_tty_flush(tty, output=.false.) request%error = dm_tty_write(tty, trim(raw_request)) @@ -373,13 +375,15 @@ integer function read_observ(tty, observ, debug) result(rc) cycle req_loop end if + ! Ignore sensor response if no delimiter is set. if (len_trim(raw_delimiter) == 0) then if (debug_) call dm_log(LOG_DEBUG, 'no delimiter set in request ' // dm_itoa(i), observ=observ) cycle req_loop end if - ! Read raw sensor response from TTY. - request%error = dm_tty_read(tty, request%response, trim(raw_delimiter)) + ! Read sensor response from TTY. + request%error = dm_tty_read(tty, raw_response, trim(raw_delimiter)) + request%response = dm_ascii_escape(raw_response) if (dm_is_error(request%error)) then call dm_log(LOG_ERROR, 'failed to read from TTY ' // app%tty, & @@ -387,20 +391,18 @@ integer function read_observ(tty, observ, debug) result(rc) cycle req_loop end if - if (debug_) call dm_log(LOG_DEBUG, 'received raw response: ' // request%response, observ=observ) + if (debug_) call dm_log(LOG_DEBUG, 'received response: ' // raw_response, observ=observ) + ! Do not extract responses if no pattern is set. if (len_trim(request%pattern) == 0) then if (debug_) call dm_log(LOG_DEBUG, 'no pattern in request ' // dm_itoa(i), observ=observ) cycle req_loop end if ! Try to extract the response values if a regex pattern is given. - if (debug_) call dm_log(LOG_DEBUG, 'extracting response values', observ=observ) + if (debug_) call dm_log(LOG_DEBUG, 'extracting response values of request ' // dm_itoa(i), observ=observ) request%error = dm_regex_request(request) - ! Unescape raw response. - request%response = dm_ascii_escape(request%response) - if (dm_is_error(request%error)) then call dm_log(LOG_WARNING, 'response to request ' // dm_itoa(i) // ' does not match pattern', & observ=observ, error=request%error) @@ -413,7 +415,7 @@ integer function read_observ(tty, observ, debug) result(rc) if (dm_is_error(response%error)) then call dm_log(LOG_WARNING, 'failed to extract response ' // trim(response%name) // & - ' to request ' // dm_itoa(i), observ=observ, error=response%error) + ' of request ' // dm_itoa(i), observ=observ, error=response%error) cycle end if @@ -431,10 +433,9 @@ integer function read_observ(tty, observ, debug) result(rc) ! Wait the set delay time of the request. delay = max(0, request%delay) if (delay <= 0) cycle req_loop - if (debug_) then call dm_log(LOG_DEBUG, 'next request of observ ' // trim(observ%name) // & - ' in ' // dm_itoa(delay / 1000) // ' sec') + ' in ' // dm_itoa(delay / 1000) // ' sec', observ=observ) end if call dm_usleep(delay * 1000) @@ -496,12 +497,20 @@ integer function run(app, tty) result(rc) observ%sensor_id = app%sensor observ%path = trim(app%tty) + if (debug) then + call dm_log(LOG_DEBUG, 'starting observ ' // trim(observ%name) // & + ' for sensor ' // app%sensor, observ=observ) + end if + ! Read observation from TTY. - call dm_log(LOG_DEBUG, 'starting observ ' // trim(observ%name) // ' for sensor ' // app%sensor, observ=observ) rc = read_observ(tty, observ, debug=debug) + if (debug) then + call dm_log(LOG_DEBUG, 'finished observ ' // trim(observ%name) // & + ' for sensor ' // app%sensor, observ=observ) + end if + ! Forward observation. - call dm_log(LOG_DEBUG, 'finished observ ' // trim(observ%name) // ' for sensor ' // app%sensor, observ=observ) rc = dm_mqueue_forward(observ, app%name, blocking=APP_MQ_BLOCKING) ! Output observation. @@ -511,7 +520,7 @@ integer function run(app, tty) result(rc) ! Wait the set delay time of the job (absolute). delay = max(0, job%delay) if (delay <= 0) cycle job_loop - if (debug) call dm_log(LOG_DEBUG, 'next job in ' // dm_itoa(delay / 1000) // ' sec') + if (debug) call dm_log(LOG_DEBUG, 'next job in ' // dm_itoa(delay / 1000) // ' sec', observ=observ) call dm_usleep(delay * 1000) end do job_loop diff --git a/src/dm_fcgi.f90 b/src/dm_fcgi.f90 index fa7adf0..7a49b22 100644 --- a/src/dm_fcgi.f90 +++ b/src/dm_fcgi.f90 @@ -22,9 +22,9 @@ end function fcgi_accept ! int FCGI_getchar(void) function fcgi_getchar() bind(c, name='FCGI_getchar') - import :: c_char + import :: c_int implicit none - character(kind=c_char) :: fcgi_getchar + integer(kind=c_int) :: fcgi_getchar end function fcgi_getchar ! int FCGI_puts(const char *str) @@ -51,8 +51,9 @@ integer function dm_fcgi_content(env, content) result(rc) !! Reads HTTP request body (POST method). type(cgi_env_type), intent(inout) :: env !! CGI environment. character(len=:), allocatable, intent(out) :: content !! Returned request body. - integer :: stat - integer(kind=i8) :: i + + integer :: stat + integer(kind=i8) :: i rc = E_NONE if (env%content_length <= 0) return @@ -62,7 +63,7 @@ integer function dm_fcgi_content(env, content) result(rc) if (stat /= 0) return do i = 1, env%content_length - content(i:i) = fcgi_getchar() + content(i:i) = achar(fcgi_getchar()) end do rc = E_NONE diff --git a/src/dm_version.f90 b/src/dm_version.f90 index 5bffe14..aa1bbe6 100644 --- a/src/dm_version.f90 +++ b/src/dm_version.f90 @@ -29,15 +29,15 @@ module dm_version private :: dm_version_to_string_long private :: dm_version_to_string_short contains - pure function dm_version_to_string_app(app_name, app_major, app_minor, app_patch, library) result(str) + pure function dm_version_to_string_app(name, major, minor, patch, library) result(str) !! Returns allocatable string of application version, with optional !! DMPACK library version appended if `library` is `.true.`. - character(len=*), intent(in) :: app_name !! App name. - integer, intent(in) :: app_major !! App major version. - integer, intent(in) :: app_minor !! App minor version. - integer, intent(in) :: app_patch !! App patch version. - logical, intent(in), optional :: library !! Append DMPACK library version. - character(len=:), allocatable :: str !! App and library version string. + character(len=*), intent(in) :: name !! App name. + integer, intent(in) :: major !! App major version. + integer, intent(in) :: minor !! App minor version. + integer, intent(in) :: patch !! App patch version. + logical, intent(in), optional :: library !! Append DMPACK library version. + character(len=:), allocatable :: str !! App and library version string. logical :: library_ @@ -45,10 +45,10 @@ pure function dm_version_to_string_app(app_name, app_major, app_minor, app_patch if (present(library)) library_ = library if (library_) then - str = trim(app_name) // ' ' // dm_version_to_string(app_major, app_minor, app_patch) // & + str = trim(name) // ' ' // dm_version_to_string(major, minor, patch) // & ' (DMPACK ' // DM_VERSION_STRING // ')' else - str = trim(app_name) // ' ' // dm_version_to_string(app_major, app_minor, app_patch) + str = trim(name) // ' ' // dm_version_to_string(major, minor, patch) end if end function dm_version_to_string_app