src/main.f90: add server mode

This adds a sort of simplified JSON RPC. It makes possible to interface
with GRAY from any other program without writing bindings or using some
FFI. It works simply by starting GRAY in a subprocess and communicating
with it using a pipe.

Both requests and replies are a single line of text: commands are sent
to the stdin and GRAY replies with a JSON object on the stdout.
The commands include setting/getting any GRAY parameter, reloading the
input files, starting the simulation and quitting.

src/gray_cli.f90

@@ -12,6 +12,7 @@ module gray_cli
   type cli_options
     ! Switches
     logical :: quiet
+    logical :: server
     ! Files
     character(len=:), allocatable :: output_dir
     character(len=:), allocatable :: params_file
@@ -46,6 +47,7 @@ contains
     print '(a)', '  -v, --verbose             print more information messages;'
     print '(a)', '                            repeating -v increase the log verbosity'
     print '(a)', '  -q, --quiet               suppress all non-critical messages'
+    print '(a)', '  -S, --server              run in server mode: handle requests from stdin'
     print '(a)', '  -o, --output-dir DIR      specify where to write the output files'
     print '(a)', '                            (default: current directory)'
     print '(a)', '  -p, --params-file FILE    set the (legacy) parameters file'
@@ -90,6 +92,7 @@ contains
 
     print '(a)'      , 'switches:'
     print '(a,l)'    , '  - quiet: '   , opts%quiet
+    print '(a,l)'    , '  - server: '   , opts%server
     print '(a)'      , 'files:'
     print '(a,a)'    , '  output-dir: ' , opts%output_dir
     print '(a,a)'    , '  param-file: ' , opts%params_file
@@ -119,6 +122,7 @@ contains
     ! Default option values
     opts%verbose     = WARNING
     opts%quiet       = .false.
+    opts%server      = .false.
     opts%params_file = 'gray_params.data'
     opts%units       = [ucenr, usumm]
 
@@ -147,6 +151,9 @@ contains
         case ('-q', '--quiet')
           opts%quiet = .true.
 
+        case ('-S', '--server')
+          opts%server = .true.
+
         case ('-o', '--output-dir')
           call get_next_command(i, opts%output_dir)
 

src/ini_parser.f90

@@ -13,6 +13,7 @@
 module ini_parser
 
   use logger, only : log_error
+  use utils,  only : getline
 
   ! INI syntax constants
   character, parameter :: comment_sign  = ';'
@@ -148,29 +149,4 @@ contains
     close(ini)
   end subroutine parse_ini
 
-
-  subroutine getline(unit, line, error)
-    ! Reads a line into a deferred length string
-
-    ! subroutine arguments
-    integer,                       intent(in)  :: unit
-    character(len=:), allocatable, intent(out) :: line
-    integer,                       intent(out) :: error
-
-    integer, parameter     :: bufsize = 512
-    character(len=bufsize) :: buffer
-    integer :: chunk
-
-    allocate(character(len=0) :: line)
-    do
-      read(unit, '(a)', advance='no', iostat=error, size=chunk) buffer
-      if (error > 0) exit
-      line = line // buffer(:chunk)
-      if (error < 0) then
-        if (is_iostat_eor(error)) error = 0
-        exit
-      end if
-    end do
-  end subroutine getline
-
 end module ini_parser

src/main.f90

@@ -192,6 +192,15 @@ program main
      deallocate(extracol)
      deallocate(opts%params_file)
    end block sum
+  elseif (opts%server) then
+    ! Handle requests from stdin
+    block
+      logical :: done
+      do
+        call handle_one_request(done)
+        if (done) exit
+      end do
+    end block
   else
     ! Run the main GRAY routine
     call gray_main(params, data, results, err)
@@ -217,12 +226,14 @@ program main
   end block print_results
 
   ! Free memory
+  cleanup: block
     call deinit_equilibrium(data%equilibrium)
     call deinit_profiles(data%profiles)
     call deinit_misc
     call deinit_cli_options(opts)
     if (allocated(results%dpdv)) deallocate(results%dpdv, results%jcd)
     call close_units
+  end block cleanup
 
 contains
 
@@ -582,4 +593,123 @@ contains
     call dealloc_pec
   end subroutine sum_profiles
 
+
+  subroutine handle_one_request(done)
+    ! Handles a user request from the stdin
+    !
+    ! Available commands:
+    !  - run                            run a simulation
+    !  - set ID=VAL                     update the value of a GRAY parameter
+    !  - reload (profiles|equilibrium)  reload the input files
+    !  - quit                           stop the program
+    !
+    ! All replies are JSON encoded, include a boolean `error` to
+    ! indicate a failure and, optionally, contain an explanation
+    ! in the `msg` string.
+    use, intrinsic :: iso_fortran_env, only : input_unit
+
+    use ini_parser,  only : ERR_SUCCESS, ERR_VALUE, ERR_UNKNOWN
+    use gray_params, only : update_parameter
+    use utils,       only : getline
+
+    ! subroutine arguments
+    logical, intent(out) :: done ! user requested to stop
+
+    ! local variables
+    integer :: sep, err
+    character(len=:), target, allocatable :: line
+    character(len=:), pointer :: cmd, args
+
+    ! read one command from stdin
+    call getline(input_unit, line, err)
+    if (err /= 0) return
+
+    sep = index(line, ' ')
+    if (sep /= 0) then
+      ! command has arguments
+      cmd  => line(1:sep - 1)
+      args => line(sep + 1:)
+    else
+      ! no arguments
+      cmd => line
+    end if
+
+    done = .false.
+
+    select case (cmd)
+      ! run the simulation
+      case ('run')
+        call gray_main(params, data, results, err)
+        if (err /= 0) then
+          print '(a, g0, a)', '{"error": true, "error_code": ', &
+                               err, ', "msg": "simulation failed"}'
+        else if (params%raytracing%realtime) then
+          print '(a, 3(a,g0), a)', &
+            '{"error": false, "error_code": 0, "result": ', &
+            '{"rho_peak": ', results%rho_peak,              &
+            ', "power": null',                              &
+            ', "current": null}}'
+        else
+          print '(a, 3(a,g0), a)', &
+            '{"error": false, "error_code": 0, "result": ', &
+            '{"rho_peak": ', results%rho_peak,              &
+            ', "power": ', results%pabs,                    &
+            ', "current": ', results%icd, '}}'
+        end if
+
+      ! stop the program
+      case ('quit')
+        print '(a)', '{"error": false, "msg": "quitting"}'
+        done = .true.
+
+      ! set a GRAY parameter
+      case ('set')
+        ! args split at "=" (id=value)
+        block
+          character(len=:), pointer :: id, val
+
+          sep = index(args, '=')
+          id  => args(1:sep - 1)
+          val => args(sep + 1:)
+
+          select case (update_parameter(params, id, val))
+            case (ERR_VALUE)
+              print '(a)', '{"error": true, "msg": "invalid value"}'
+            case (ERR_UNKNOWN)
+              print '(a)', '{"error": true, "msg": "unknown parameter"}'
+            case (ERR_SUCCESS)
+              print '(a)', '{"error": false, "msg": "done"}'
+          end select
+        end block
+
+      ! reload inputs
+      case ('reload')
+        select case (args)
+          case ('equilibrium')
+            call init_equilibrium(params, data, err)
+            if (err /= 0) then
+              print '(a)', '{"error": true, "msg": "equilibrium initialisation failed"}'
+            else
+              print '(a)', '{"error": false, "msg": "equilibrium reloaded"}'
+            end if
+          case ('profiles')
+            call init_profiles(params%profiles, params%equilibrium%factb, &
+                               params%antenna%pos, data%profiles, err)
+            if (err /= 0) then
+              print '(a)', '{"error": true, "msg": "profiles initialisation failed"}'
+            else
+              print '(a)', '{"error": false, "msg": "profiles reloaded"}'
+            end if
+          case default
+            print '(a)', '{"error": true, "msg": "invalid type"}'
+        end select
+
+      case default
+        print '(a)', '{"error": true, msg: "invalid command"}'
+    end select
+
+    deallocate(line)
+
+  end subroutine handle_one_request
+
 end program main

src/utils.f90

@@ -340,6 +340,7 @@ contains
     end if
   end function dirname
 
+
   function isrelative(filepath)
     ! Check if `filepath` is a relative or an absolute path
 
@@ -350,4 +351,30 @@ contains
     isrelative = (filepath(1:1) /= '/')
   end function isrelative
 
+
+  subroutine getline(unit, line, error)
+    ! Reads a line into a deferred length string
+
+    ! subroutine arguments
+    integer,                       intent(in)  :: unit
+    character(len=:), allocatable, intent(out) :: line
+    integer,                       intent(out) :: error
+
+    integer, parameter     :: bufsize = 512
+    character(len=bufsize) :: buffer
+    integer :: chunk
+
+    allocate(character(len=0) :: line)
+    do
+      read(unit, '(a)', advance='no', iostat=error, size=chunk) buffer
+      if (error > 0) exit
+      line = line // buffer(:chunk)
+      if (error < 0) then
+        if (is_iostat_eor(error)) error = 0
+        exit
+      end if
+    end do
+  end subroutine getline
+
+
 end module utils