diff --git a/adoc/dmfeed.adoc b/adoc/dmfeed.adoc index e40c277..1ddf028 100644 --- a/adoc/dmfeed.adoc +++ b/adoc/dmfeed.adoc @@ -52,6 +52,9 @@ file modification of the feed, the output file is not updated, unless argument *--email*, *-M* _address_:: E-mail address of feed author. +*--entries*, *-E* _count_:: + Maximum number of entries in feed (default is 50). + *--force*, *-F*:: Force writing of output file. If not set, the output file will be updated only if new log records are available. @@ -72,9 +75,6 @@ file modification of the feed, the output file is not updated, unless argument *--name*, *-n* _name_:: Name of instance and table in given configuration file (default is `dmfeed`). -*--entries*, *-E* _count_:: - Maximum number of entries in feed (default is 50). - *--node*, *-N* _id_:: Select log messages of the given node id. diff --git a/app/dmfeed.f90 b/app/dmfeed.f90 index 7b20855..999a48f 100644 --- a/app/dmfeed.f90 +++ b/app/dmfeed.f90 @@ -22,9 +22,9 @@ program dmfeed character(len=FILE_PATH_LEN) :: database = ' ' !! Path to log database. character(len=FILE_PATH_LEN) :: output = ' ' !! Output path of Atom file (stdout if empty). character(len=NODE_ID_LEN) :: node = ' ' !! Optional node id. + integer :: entries = 50 !! Max. number of entries in feed. integer :: min_level = LVL_DEBUG !! Minimum log level integer :: max_level = LVL_CRITICAL !! Maximum log level. - integer :: entries = 50 !! Max. number of entries in feed. logical :: force = .false. !! Force writing of output file. type(atom_type) :: atom !! Atom type. end type app_type @@ -83,9 +83,9 @@ integer function read_args(app) result(rc) arg_type('database', short='d', type=ARG_TYPE_DB), & ! -d, --database arg_type('output', short='o', type=ARG_TYPE_CHAR), & ! -o, --output arg_type('node', short='N', type=ARG_TYPE_ID), & ! -N, --node + arg_type('entries', short='E', type=ARG_TYPE_INTEGER), & ! -E, --entries arg_type('minlevel', short='L', type=ARG_TYPE_INTEGER), & ! -L, --minlevel arg_type('maxlevel', short='K', type=ARG_TYPE_INTEGER), & ! -K, --maxlevel - arg_type('entries', short='E', type=ARG_TYPE_INTEGER), & ! -E, --entries arg_type('force', short='F', type=ARG_TYPE_BOOL), & ! -F, --force arg_type('author', short='A', type=ARG_TYPE_CHAR), & ! -A, --author arg_type('email', short='M', type=ARG_TYPE_CHAR), & ! -M, --email @@ -111,9 +111,9 @@ integer function read_args(app) result(rc) rc = dm_arg_get(args( 3), app%database) rc = dm_arg_get(args( 4), app%output) rc = dm_arg_get(args( 5), app%node) - rc = dm_arg_get(args( 6), app%min_level) - rc = dm_arg_get(args( 7), app%max_level) - rc = dm_arg_get(args( 8), app%entries) + rc = dm_arg_get(args( 6), app%entries) + rc = dm_arg_get(args( 7), app%min_level) + rc = dm_arg_get(args( 8), app%max_level) rc = dm_arg_get(args( 9), app%force) rc = dm_arg_get(args(10), app%atom%author) rc = dm_arg_get(args(11), app%atom%email) @@ -178,9 +178,9 @@ integer function read_config(app) result(rc) rc = dm_config_get(config, 'database', app%database) rc = dm_config_get(config, 'output', app%output) rc = dm_config_get(config, 'node', app%node) + rc = dm_config_get(config, 'entries', app%entries) rc = dm_config_get(config, 'minlevel', app%min_level) rc = dm_config_get(config, 'maxlevel', app%max_level) - rc = dm_config_get(config, 'entries', app%entries) rc = dm_config_get(config, 'force', app%force) rc = dm_config_get(config, 'author', app%atom%author) rc = dm_config_get(config, 'email', app%atom%email) diff --git a/config/dmfeed.conf.sample b/config/dmfeed.conf.sample index 426c03a..a8b3d98 100644 --- a/config/dmfeed.conf.sample +++ b/config/dmfeed.conf.sample @@ -21,11 +21,11 @@ -- author - Name of feed author or organisation (optional). -- database - Path to DMPACK log database. -- email - E-mail of feed author (optional). +-- entries - Maximum number of entries is feed (default 50, optional). -- force - Force writing of output file even if no new logs are available. -- id - 36 characters long UUID (with hyphens) of the Atom feed. -- maxlevel - Maximum log level (0 to 5, optional). -- minlevel - Minimum log level (0 to 5, optional). --- nentries - Maximum number of entries is feed (default 50, optional). -- node - Sensor node id, selects only related logs (optional). -- output - Path to output file (if empty, feed is printed to standard output). -- subtitle - Subtitle of the feed (optional). @@ -43,9 +43,9 @@ dmfeed = { url = "https://example.com/feed.xml", database = "/var/dmpack/log.sqlite", node = "dummy-node", + entries = 100, minlevel = LVL_WARNING, maxlevel = LVL_CRITICAL, - nentries = 100, xsl = "feed.xsl", output = "/var/www/feed.xml", force = false diff --git a/guide/guide.adoc b/guide/guide.adoc index 7410587..0107a7e 100644 --- a/guide/guide.adoc +++ b/guide/guide.adoc @@ -848,18 +848,19 @@ $ dmexport --database observ.sqlite --type observ --format csv --node dummy-node === dmfeed [[dmfeed]] -This program creates a web feed from log messages in Atom Syndication Format. -The log messages are read from database and written as XML to standard output -or file. +The *dmfeed* program creates a web feed from log messages in Atom Syndication +Format. The log messages are read from database and written as XML to standard +output or file. The feed id has to be a 36 characters long UUID with hyphens. News aggregators use the id to identify the feed. Therefore, the id should not be reused among different feeds. Run <> to generate a valid UUID4. -The time stamp of the feed in the updated element is set to the date and time of +The time stamp of the feed in element _updated_ is set to the date and time of the last log message. If no logs have been added to the database since the last file modification of the feed, the output file is not updated, unless argument -`--force` is passed. +`--force` is passed. To update the feed periodically, add *dmfeed* to +<>. If an XSLT style sheet is given, web browsers may be able to display the Atom feed in HTML format. Set the option to the (relative) path of the public XSL on @@ -876,13 +877,13 @@ the web server. An example style sheet `feed.xsl` is located in | `--config _file_` | `-c` | – | Path to configuration file. | `--database _file_` | `-d` | – | Path to SQLite log database. | `--email _address_` | `-M` | – | E-mail address of feed author. +| `--entries _count_` | `-E` | 50 | Maximum number of entries in feed (max. 500). | `--force` | `-F` | – | Force file output even if no new log records are available. | `--help` | `-h` | – | Output available command-line arguments and quit. | `--id _uuid_` | `-I` | – | UUID of the feed, 36 characters long with hyphens. | `--maxlevel _level_` | `-K` | 5 | Select log messages of the given maximum <> (between 1 and 5). Must be greater or equal the minimum level. | `--minlevel _level_` | `-L` | 1 | Select log messages of the given minimum <> (between 1 and 5). | `--name _name_` | `-n` | `dmfeed` | Name of instance and table in given configuration file. -| `--entries _count_` | `-E` | 50 | Maximum number of entries in feed (max. 500). | `--node _id_` | `-N` | – | Select log messages of the given node id. | `--output _file_` | `-o` | _stdout_ | Path of the output file. If empty or `-`, the Atom feed will be printed to standard output. | `--subtitle _string_` | `-G` | – | Sub-title of feed. @@ -916,9 +917,8 @@ $ cp /usr/local/share/dmpack/feed.xsl /var/www/ .... If `/var/www/` is served by a web server, feed readers can subscribe to the -feed. To update the feed periodically, add *dmfeed* to <>. -Furthermore, we may translate feed and style sheet into a single HTML document -`feed.html`, using an arbitrary XSLT processor, for instance: +feed. Additionally, we may translate feed and style sheet into a single HTML +document `feed.html`, using an arbitrary XSLT processor, for instance: .... $ xsltproc --output feed.html /var/www/feed.xsl /var/www/feed.xml @@ -4557,17 +4557,18 @@ The maximum message size has to be at least 16384 bytes. === Cron On Unix-like operating system, link:https://en.wikipedia.org/wiki/Cron[cron] is -usually used to run jobs periodically. For example, in order to update an XML +usually used to run jobs periodically. For instance, in order to update an XML feed, or to generate HTML reports, add a schedule of the task to perform to the -local _crontab(5)_ file. +_crontab(5)_ file of a local user. -For example, we can edit the cron jobs of user `www` with _crontab(1)_: +Edit the cron jobs of user `www` with _crontab(1)_: .... # crontab -u www -e .... -The following _crontab(5)_ file adds a task to generate reports every hour: +The following _crontab(5)_ entry adds a task to generate reports every hour, +using utility script `mkreport.sh`: [source,crontab] .... @@ -4577,16 +4578,19 @@ MAILTO=/dev/null @hourly -q /usr/local/share/dmpack/mkreport.sh .... -The shell script `mkreport.sh` must have the execution bits set. Update the -script to your configuration. Furthermore, we can update an Atom XML feed of -logs with <>: +Status mails and logging are disabled. The shell script `mkreport.sh` must have +the execution bits set. Modify the script according to your set-up. + +Additionally, we may update an Atom XML feed of logs by running <> every +five minutes: [source,crontab] .... */5 * * * * -q /usr/local/bin/dmfeed --config /usr/local/etc/dmpack/dmfeed.conf .... -The feed is updated every five minutes if new logs have arrived. +The feed is updated only if new logs have arrived in the meantime, unless option +_force_ is enabled. == GeoCOM API diff --git a/man/dmfeed.1 b/man/dmfeed.1 index 271fc89..04ab57a 100644 --- a/man/dmfeed.1 +++ b/man/dmfeed.1 @@ -2,12 +2,12 @@ .\" Title: dmfeed .\" Author: Philipp Engel .\" Generator: Asciidoctor 2.0.20 -.\" Date: 2024-03-05 +.\" Date: 2024-03-06 .\" Manual: User Commands .\" Source: DMFEED .\" Language: English .\" -.TH "DMFEED" "1" "2024-03-05" "DMFEED" "User Commands" +.TH "DMFEED" "1" "2024-03-06" "DMFEED" "User Commands" .ie \n(.g .ds Aq \(aq .el .ds Aq ' .ss \n[.ss] 0 @@ -78,6 +78,11 @@ Path to SQLite log database. E\-mail address of feed author. .RE .sp +\fB\-\-entries\fP, \fB\-E\fP \fIcount\fP +.RS 4 +Maximum number of entries in feed (default is 50). +.RE +.sp \fB\-\-force\fP, \fB\-F\fP .RS 4 Force writing of output file. If not set, the output file will be updated @@ -110,11 +115,6 @@ Select log messages of the given minimum log level (from 1 to 5). Name of instance and table in given configuration file (default is \f(CRdmfeed\fP). .RE .sp -\fB\-\-entries\fP, \fB\-E\fP \fIcount\fP -.RS 4 -Maximum number of entries in feed (default is 50). -.RE -.sp \fB\-\-node\fP, \fB\-N\fP \fIid\fP .RS 4 Select log messages of the given node id. diff --git a/src/dm_geocom.f90 b/src/dm_geocom.f90 index 51d22cb..3730d20 100644 --- a/src/dm_geocom.f90 +++ b/src/dm_geocom.f90 @@ -15,7 +15,7 @@ module dm_geocom !! integer :: rc ! DMPACK return code. !! type(geocom_class) :: geocom ! GeoCOM object. !! - !! call geocom%open('/dev/ttyUSB0', GEOCOM_COM_BAUD_115200, retries=1, error=rc) + !! call geocom%open('/dev/ttyUSB0', GEOCOM_COM_BAUD_115200, retries=1, verbose=.true. error=rc) !! !! if (dm_is_error(rc)) then !! dm_error_out(rc) @@ -46,8 +46,8 @@ module dm_geocom integer :: rc = E_NONE !! Last DMPACK return code. integer :: grc = GRC_OK !! Last GeoCOM return code. logical :: verbose = .true. !! Print error messages to stderr. - type(request_type) :: request !! Last request. - type(tty_type) :: tty !! TTY type for serial connection to sensor. + type(request_type) :: request !! Last request sent to sensor. + type(tty_type) :: tty !! TTY type for serial connection. contains ! Public class methods. procedure, public :: close => geocom_close @@ -258,8 +258,8 @@ end subroutine geocom_open subroutine geocom_send(this, request, error) !! Sends request to configured TTY. - use :: dm_regex - use :: dm_time + use :: dm_regex, only: dm_regex_request + use :: dm_time, only: dm_time_now class(geocom_class), intent(inout) :: this !! GeoCOM object. type(request_type), intent(inout) :: request !! Request to send. @@ -489,6 +489,9 @@ subroutine geocom_do_measure(this, tmc_prog, inc_mode) !! If a distance measurement is performed in measurement program !! `GEOCOM_TMC_DEF_DIST`, the distance sensor will work with the set !! EDM mode. + !! + !! This function sets measurement program `GEOCOM_TMC_DEF_DIST` and + !! inclination mode `GEOCOM_TMC_MEA_INC` by default. class(geocom_class), intent(inout) :: this !! GeoCOM object. integer, intent(in) :: tmc_prog !! TMC measurement program (`GEOCOM_TMC_MEASURE_PRG`). integer, intent(in), optional :: inc_mode !! Inclination measurement mode (`GEOCOM_TMC_INCLINE_PRG`). @@ -522,7 +525,6 @@ subroutine geocom_download(this, block_number, block_value, block_length) integer, intent(out) :: block_length !! Block length. integer :: block_number_ - integer :: rc type(request_type) :: request block_value = achar(0) @@ -569,7 +571,8 @@ end subroutine geocom_fine_adjust subroutine geocom_get_angle(this, hz, v, inc_mode) !! Sends *TMC_GetAngle5* request to sensor. Starts an angle measurement - !! and returns the results. + !! and returns the results. This function sets inclination mode + !! `GEOCOM_TMC_MEA_INC` by default. class(geocom_class), intent(inout) :: this !! GeoCOM object. real(kind=r8), intent(out) :: hz !! Horizontal angle [rad]. real(kind=r8), intent(out) :: v !! Vertical angle [rad]. @@ -583,6 +586,9 @@ subroutine geocom_get_angle(this, hz, v, inc_mode) call dm_geocom_api_request_get_angle(request, inc_mode) call this%send(request) + + call dm_request_get(this%request, 'hz', hz) + call dm_request_get(this%request, 'v', v) end subroutine geocom_get_angle subroutine geocom_get_angle_complete(this, hz, v, angle_accuracy, angle_time, trans_inc, long_inc, & @@ -590,6 +596,7 @@ subroutine geocom_get_angle_complete(this, hz, v, angle_accuracy, angle_time, tr !! Sends *TMC_GetAngle1* request to sensor. Performs a complete angle !! measurement. The function starts an angle and, depending on the !! configuration, an inclination measurement, and returns the results. + !! This function sets inclination mode `GEOCOM_TMC_MEA_INC` by default. class(geocom_class), intent(inout) :: this !! GeoCOM object. real(kind=r8), intent(out) :: hz !! Horizontal angle [rad]. real(kind=r8), intent(out) :: v !! Vertical angle [rad]. diff --git a/src/dm_tty.f90 b/src/dm_tty.f90 index 28be1e0..3e01ac5 100644 --- a/src/dm_tty.f90 +++ b/src/dm_tty.f90 @@ -92,10 +92,12 @@ module dm_tty public :: dm_tty_open public :: dm_tty_parity_from_name public :: dm_tty_read + public :: dm_tty_read_byte public :: dm_tty_read_bytes - public :: dm_tty_read_raw public :: dm_tty_read_request public :: dm_tty_set_attributes + public :: dm_tty_set_blocking + public :: dm_tty_set_timeout public :: dm_tty_stop_bits_from_value public :: dm_tty_valid_baud_rate public :: dm_tty_valid_byte_size @@ -205,6 +207,7 @@ integer function dm_tty_flush(tty, input, output) result(rc) !! passed `tty` type is invalid, or `E_SYSTEM` if the system call !! failed. use :: unix, only: c_tcflush, TCIFLUSH, TCIOFLUSH, TCOFLUSH + type(tty_type), intent(inout) :: tty !! TTY type. logical, intent(in), optional :: input !! Flush input buffer. logical, intent(in), optional :: output !! Flush output buffer. @@ -254,6 +257,7 @@ integer function dm_tty_open(tty, path, baud_rate, byte_size, parity, stop_bits) !! * `E_IO` if opening the TTY failed. !! * `E_SYSTEM` if setting the TTY attributes or flushing the buffers failed. use :: unix + type(tty_type) , intent(inout) :: tty !! TTY type. character(len=*), intent(in), optional :: path !! Device path. integer, intent(in), optional :: baud_rate !! Baud rate enumerator (`TTY_B_*`). @@ -307,7 +311,7 @@ integer function dm_tty_open(tty, path, baud_rate, byte_size, parity, stop_bits) ! Open TTY. rc = E_IO - tty%fd = c_open(trim(tty%path) // c_null_char, flags, int(0, kind=c_mode_t)) + tty%fd = c_open(trim(tty%path) // c_null_char, flags, 0_c_mode_t) if (tty%fd < 0) return rc = dm_tty_set_attributes(tty) @@ -340,7 +344,22 @@ integer function dm_tty_parity_from_name(name, error) result(parity) if (present(error)) error = E_NONE end function dm_tty_parity_from_name - integer function dm_tty_read_bytes(tty, buffer, del, nbytes) result(rc) + integer function dm_tty_read_byte(tty, byte) result(rc) + !! Reads single byte from file descriptor. + use :: unix + + type(tty_type), intent(inout) :: tty !! TTY type. + character, target, intent(out) :: byte !! Byte read. + + integer(kind=c_size_t) :: sz + + rc = E_READ + sz = c_read(tty%fd, c_loc(byte), 1_c_size_t) + if (sz <= 0) return + rc = E_NONE + end function dm_tty_read_byte + + integer function dm_tty_read_bytes(tty, bytes, del, nbytes) result(rc) !! Reads from TTY into `buf` until delimiter `del` occurs. The !! number of bytes read is returned in `n`. !! @@ -349,16 +368,16 @@ integer function dm_tty_read_bytes(tty, buffer, del, nbytes) result(rc) !! * `E_BOUNDS` if end of buffer is reached. !! * `E_READ` if the read operation failed. type(tty_type), intent(inout) :: tty !! TTY type. - character(len=*), intent(inout) :: buffer !! Input buffer. + character(len=*), intent(inout) :: bytes !! Input buffer. character(len=*), intent(in) :: del !! Delimiter. integer(kind=i8), intent(out), optional :: nbytes !! Number of bytes read. character :: a integer :: i, j, k - integer(kind=i8) :: n, sz + integer(kind=i8) :: n i = 1 - j = len(buffer) + j = len(bytes) k = len(del) n = 0_i8 @@ -366,35 +385,21 @@ integer function dm_tty_read_bytes(tty, buffer, del, nbytes) result(rc) rc = E_BOUNDS if (i > j) exit - rc = E_READ - sz = dm_tty_read_raw(tty, a) + rc = dm_tty_read_byte(tty, a) + if (dm_is_error(rc)) exit - if (sz > 0) then - buffer(i:i) = a - i = i + 1 - n = n + 1 + bytes(i:i) = a + i = i + 1 + n = n + 1 - rc = E_NONE - if (buffer(i - k:i) == del) exit - cycle - end if - - exit + rc = E_NONE + if (bytes(i - k:i) == del) exit + cycle end do if (present(nbytes)) nbytes = n end function dm_tty_read_bytes - integer(kind=i8) function dm_tty_read_raw(tty, byte) result(n) - !! Reads single byte from file descriptor, and returns `1_i0` on - !! success. - use :: unix, only: c_read - type(tty_type), intent(inout) :: tty !! TTY type. - character, target, intent(out) :: byte !! Byte read. - - n = int(c_read(tty%fd, c_loc(byte), 1_c_size_t), kind=i8) - end function dm_tty_read_raw - integer function dm_tty_read_request(tty, request) result(rc) !! Reads TTY response into request. The request delimiter is unescaped. !! The response is escaped before being stored in the request. @@ -405,6 +410,7 @@ integer function dm_tty_read_request(tty, request) result(rc) !! * `E_READ` if reading from TTY failed. use :: dm_ascii, only: dm_ascii_escape, dm_ascii_unescape use :: dm_request + type(tty_type), intent(inout) :: tty !! TTY type. type(request_type), intent(inout) :: request !! Request type. @@ -421,16 +427,20 @@ integer function dm_tty_read_request(tty, request) result(rc) end function dm_tty_read_request integer function dm_tty_set_attributes(tty) result(rc) - !! Sets terminal attributes. Returns `E_INVALID` if the passed TTY is - !! invalid, or `E_SYSTEM` if one of the system calls failed. + !! Sets terminal attributes. + !! + !! The function returns the following error codes: + !! + !! * `E_INVALID` if TTY is not connected. + !! * `E_SYSTEM` if system calls failed. use :: unix + type(tty_type), intent(inout) :: tty !! TTY type. integer(kind=c_speed_t) :: baud_rate integer(kind=c_int) :: byte_size integer(kind=c_int) :: parity integer(kind=c_int) :: stop_bits - integer(kind=c_int) :: flags integer(kind=c_int), target :: stat type(c_termios) :: termios @@ -541,10 +551,10 @@ integer function dm_tty_set_attributes(tty) result(rc) termios%c_cflag = iand(termios%c_cflag, not(CSIZE)) ! Unset byte size. termios%c_cflag = iand(termios%c_cflag, not(CSTOPB)) ! Unset stop bits. termios%c_cflag = iand(termios%c_cflag, not(PARENB + PARODD)) ! Unset parity. - termios%c_cflag = ior(termios%c_cflag, byte_size) ! Set byte size. - termios%c_cflag = ior(termios%c_cflag, stop_bits) ! Set stop bits. - termios%c_cflag = ior(termios%c_cflag, parity) ! Set parity. - termios%c_cflag = ior(termios%c_cflag, ior(CLOCAL, CREAD)) ! Ignore modem controls, enable reading. + termios%c_cflag = ior (termios%c_cflag, byte_size) ! Set byte size. + termios%c_cflag = ior (termios%c_cflag, stop_bits) ! Set stop bits. + termios%c_cflag = ior (termios%c_cflag, parity) ! Set parity. + termios%c_cflag = ior (termios%c_cflag, ior(CLOCAL, CREAD)) ! Ignore modem controls, enable reading. ! Local modes. termios%c_lflag = iand(termios%c_lflag, not(ECHO + ECHOE + ECHONL)) ! No echo. @@ -559,27 +569,82 @@ integer function dm_tty_set_attributes(tty) result(rc) else ! Timeout in deciseconds for non-canonical read. termios%c_cc(VMIN) = 0 - termios%c_cc(VTIME) = int(min(255, tty%timeout * 10), kind=c_cc_t) + termios%c_cc(VTIME) = int(max(0, min(255, tty%timeout * 10)), kind=c_cc_t) end if ! Set attributes. if (c_tcsetattr(tty%fd, TCSANOW, termios) /= 0) return ! Set RTS, DTR. - if (c_ioctl(tty%fd, int(TIOCMGET, kind=c_unsigned_long), c_loc(stat)) /= 0) return - if (tty%rts) stat = ior(stat, TIOCM_RTS) - if (tty%dtr) stat = ior(stat, TIOCM_DTR) - if (c_ioctl(tty%fd, int(TIOCMSET, kind=c_unsigned_long), c_loc(stat)) /= 0) return + if (tty%rts .or. tty%dtr) then + stat = 0 + if (c_ioctl(tty%fd, int(TIOCMGET, kind=c_unsigned_long), c_loc(stat)) /= 0) return + if (tty%rts) stat = ior(stat, TIOCM_RTS) + if (tty%dtr) stat = ior(stat, TIOCM_DTR) + if (c_ioctl(tty%fd, int(TIOCMSET, kind=c_unsigned_long), c_loc(stat)) /= 0) return + end if ! Set blocking read. - if (tty%blocking) then - flags = c_fcntl(tty%fd, F_GETFL, 0) + rc = dm_tty_set_blocking(tty, tty%blocking) + end function dm_tty_set_attributes + + integer function dm_tty_set_blocking(tty, blocking) result(rc) + !! Sets TTY to blocking or non-blocking. + !! + !! The function returns the following error codes: + !! + !! * `E_INVALID` if TTY is not connected. + !! * `E_SYSTEM` if system calls failed. + use :: unix + + type(tty_type), intent(inout) :: tty !! TTY type. + logical, intent(in) :: blocking !! Blocking mode. + + integer(kind=c_int) :: flags + + rc = E_INVALID + if (tty%fd < 0) return + + rc = E_SYSTEM + flags = c_fcntl(tty%fd, F_GETFL, 0) + + if (blocking) then flags = iand(flags, not(O_NONBLOCK)) - if (c_fcntl(tty%fd, F_SETFL, flags) /= 0) return + else + flags = ior(flags, O_NONBLOCK) end if + if (c_fcntl(tty%fd, F_SETFL, flags) /= 0) return + tty%blocking = blocking rc = E_NONE - end function dm_tty_set_attributes + end function dm_tty_set_blocking + + integer function dm_tty_set_timeout(tty, timeout) result(rc) + !! Sets timeout of given TTY. A timeout of 0 results in blocking read + !! without timeout. The minimum timeout is 0 seconds, the maximum is 25 + !! seconds. + !! + !! The function returns the following error codes: + !! + !! * `E_INVALID` if TTY is not connected. + !! * `E_SYSTEM` if system calls failed. + use :: unix + + type(tty_type), intent(inout) :: tty !! TTY type. + integer, intent(in) :: timeout !! Timeout in seconds. + + type(c_termios) :: termios + + rc = E_INVALID + if (tty%fd < 0) return + + rc = E_SYSTEM + if (c_tcgetattr(tty%fd, termios) /= 0) return + termios%c_cc(VTIME) = int(max(0, min(255, timeout * 10)), kind=c_cc_t) + if (c_tcsetattr(tty%fd, TCSANOW, termios) /= 0) return + + tty%timeout = timeout + end function dm_tty_set_timeout integer function dm_tty_stop_bits_from_value(value, error) result(stop_bits) !! Returns stop bits enumerator from numeric value. If the value is @@ -679,29 +744,28 @@ pure elemental logical function dm_tty_valid_timeout(timeout) result(valid) if (timeout >= 0) valid = .true. end function dm_tty_valid_timeout - integer function dm_tty_write_bytes(tty, bytes, n, flush) result(rc) + integer function dm_tty_write_bytes(tty, bytes, nbytes, flush) result(rc) !! Writes given string to TTY. Returns `E_WRITE` on error. The function - !! may cause an access violation if `n` is greater than the length of - !! `bytes`. + !! may cause an access violation if `nbytes` is greater than the length + !! of `bytes`. !! !! The function returns the following error codes: !! !! * `E_SYSTEM` if flushing the input buffer failed. !! * `E_WRITE` if writing to TTY failed. use :: unix, only: c_write - type(tty_type), intent(inout) :: tty !! TTY type. - character(len=*), intent(in) :: bytes !! Bytes to send. - integer, intent(in), optional :: n !! Number of bytes to send. - logical, intent(in), optional :: flush !! Flush input buffer. - character(kind=c_char), target :: a - integer :: i, n_ - integer(kind=c_size_t) :: k + type(tty_type), intent(inout) :: tty !! TTY type. + character(len=*), target, intent(in) :: bytes !! Bytes to send. + integer, intent(in), optional :: nbytes !! Number of bytes to send. + logical, intent(in), optional :: flush !! Flush input buffer. + + integer(kind=c_size_t) :: n, sz - if (present(n)) then - n_ = n + if (present(nbytes)) then + n = int(nbytes, kind=c_size_t) else - n_ = len(bytes) + n = len(bytes, kind=c_size_t) end if if (present(flush)) then @@ -709,12 +773,12 @@ integer function dm_tty_write_bytes(tty, bytes, n, flush) result(rc) if (dm_is_error(rc)) return end if + rc = E_NONE + if (n == 0) return + rc = E_WRITE - do i = 1, n_ - a = bytes(i:i) - k = c_write(tty%fd, c_loc(a), 1_c_size_t) - if (k /= 1) return - end do + sz = c_write(tty%fd, c_loc(bytes), n) + if (sz /= n) return rc = E_NONE end function dm_tty_write_bytes @@ -729,6 +793,7 @@ integer function dm_tty_write_request(tty, request, flush) result(rc) !! * `E_WRITE` if writing to TTY failed. use :: dm_ascii, only: dm_ascii_unescape use :: dm_request + type(tty_type), intent(inout) :: tty !! TTY type. type(request_type), intent(inout) :: request !! Request type logical, intent(in), optional :: flush !! Flush input buffer. @@ -741,12 +806,13 @@ integer function dm_tty_write_request(tty, request, flush) result(rc) end if raw = dm_ascii_unescape(request%request) - rc = dm_tty_write(tty, trim(raw)) + rc = dm_tty_write(tty, raw, nbytes=len_trim(raw)) end function dm_tty_write_request subroutine dm_tty_close(tty) !! Closes file descriptor. use :: unix, only: c_close + type(tty_type), intent(inout) :: tty !! TTY type. if (c_close(tty%fd) == 0) tty%fd = -1