stdlib/spawn.ajla

   1 {*
   2  * Copyright (C) 2024 Mikulas Patocka
   3  *
   4  * This file is part of Ajla.
   5  *
   6  * Ajla is free software: you can redistribute it and/or modify it under the
   7  * terms of the GNU General Public License as published by the Free Software
   8  * Foundation, either version 3 of the License, or (at your option) any later
   9  * version.
  10  *
  11  * Ajla is distributed in the hope that it will be useful, but WITHOUT ANY
  12  * WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  13  * A PARTICULAR PURPOSE. See the GNU General Public License for more details.
  14  *
  15  * You should have received a copy of the GNU General Public License along with
  16  * Ajla. If not, see <https://www.gnu.org/licenses/>.
  17  *}
  18
  19 unit spawn;
  20
  21 uses io;
  22 uses treemap;
  23
  24 type phandle;
  25
  26 fn spawn_raw(w : world, d : dhandle, lh : list(tuple2(int, handle)), f : bytes, args : list(bytes), env : treemap(bytes, bytes)) : (world, phandle);
  27 fn spawn(w : world, d : dhandle, h : list(handle), f : bytes, args : list(bytes), env : treemap(bytes, bytes)) : (world, phandle);
  28 fn spawn_command(cmdline : bytes, env : treemap(bytes, bytes)) : (bytes, list(bytes));
  29 fn wait(w : world, p : phandle) : (world, int);
  30 fn get_process_output(w : world, d : dhandle, h : list(handle), f : bytes, args : list(bytes), env : treemap(bytes, bytes)) : bytes;
  31
  32 type main_function_type := fn(world, dhandle, list(handle), list(bytes), treemap(bytes, bytes)) : world;
  33 fn load_program(w : world, f : bytes) : (world, main_function_type);
  34
  35 implementation
  36
  37 uses exception;
  38 uses pcode;
  39
  40 type phandle := internal_type;
  41
  42 fn env2string~inline(env : treemap(bytes, bytes)) : bytes
  43 [
  44         var result := empty(byte);
  45         for e in treemap_iterator(env) do [
  46                 if list_search(e.k, '=') >= 0 then
  47                         continue;
  48                 if list_search(e.k, 0) >= 0 then
  49                         continue;
  50                 if list_search(e.v, 0) >= 0 then
  51                         continue;
  52                 result += e.k;
  53                 result +<= '=';
  54                 result += e.v;
  55                 result +<= 0;
  56         ]
  57         result +<= 0;
  58         return result;
  59 ]
  60
  61 fn spawn_raw(w : world, d : dhandle, lh : list(tuple2(int, handle)), f : bytes, args : list(bytes), env : treemap(bytes, bytes)) : (world, phandle)
  62 [
  63         var env_str := env2string(env);
  64         var ph : phandle;
  65         var w2 : world;
  66         pcode IO IO_Spawn 2 6 0 =w2 =ph w d lh f args env_str;
  67         return w2, ph;
  68 ]
  69
  70 fn spawn(w : world, d : dhandle, h : list(handle), f : bytes, args : list(bytes), env : treemap(bytes, bytes)) : (world, phandle)
  71 [
  72         var lh := empty(tuple2(int, handle));
  73         for i := 0 to len(h) do [
  74                 lh +<= tuple2(int, handle).[ v1 : i, v2 : h[i] ];
  75         ]
  76         return spawn_raw(w, d, lh, f, [ f ] + args, env);
  77 ]
  78
  79 fn break_dos_cmdline(cmdline : bytes) : list(bytes)
  80 [
  81         var result := empty(bytes);
  82         var this_line := "";
  83         var in_quotes := false;
  84         for i := 0 to len(cmdline) do [
  85                 var c := cmdline[i];
  86                 if c = ' ', not in_quotes then [
  87                         if len(this_line) = 0 then
  88                                 continue;
  89                         result +<= this_line;
  90                         this_line := "";
  91                         continue;
  92                 ]
  93                 if c = '"' then [
  94                         in_quotes := not in_quotes;
  95                 ] else [
  96                         this_line +<= c;
  97                 ]
  98         ]
  99         if len(this_line) > 0 then
 100                 result +<= this_line;
 101         return result;
 102 ]
 103
 104 fn spawn_command(cmdline : bytes, env : treemap(bytes, bytes)) : (bytes, list(bytes))
 105 [
 106         var cmd_env cmd_shell cmd_c : bytes;
 107         var cmd_string : list(bytes);
 108         var os := sysprop(SystemProperty_OS);
 109         if os = SystemProperty_OS_DOS then [
 110                 cmd_env := "COMSPEC";
 111                 cmd_shell := "C:\COMMAND.COM";
 112                 cmd_c := "/C";
 113                 cmd_string := break_dos_cmdline(cmdline);
 114         ] else if os = SystemProperty_OS_OS2 then [
 115                 cmd_env := "COMSPEC";
 116                 cmd_shell := "C:\OS2\CMD.EXE";
 117                 cmd_c := "/C";
 118                 cmd_string := break_dos_cmdline(cmdline);
 119         ] else if os = SystemProperty_OS_Windows then [
 120                 cmd_env := "COMSPEC";
 121                 cmd_shell := "C:\Windows\system32\cmd.exe";
 122                 cmd_c := "/C";
 123                 cmd_string := break_dos_cmdline(cmdline);
 124         ] else [
 125                 cmd_env := "SHELL";
 126                 cmd_shell := "/bin/sh";
 127                 cmd_c := "-c";
 128                 cmd_string := [ cmdline ];
 129         ]
 130         var s := treemap_search(env, cmd_env);
 131         if s is j then
 132                 cmd_shell := s.j;
 133         return cmd_shell, [ cmd_c ] + cmd_string;
 134 ]
 135
 136 fn wait(w : world, p : phandle) : (world, int)
 137 [
 138         var ret : int;
 139         var w2 : world;
 140         pcode IO IO_Wait 2 2 0 =w2 =ret w p;
 141         return w2, ret;
 142 ]
 143
 144 fn process_read_lazy(w : world, r : handle, ph : phandle) : bytes
 145 [
 146         var b : bytes;
 147         w, b := read_partial~strict(w, r, 16384);
 148         if len(b) = 0 then [
 149                 var i : int;
 150                 w, i := wait(w, ph);
 151                 if i <> 0 then [
 152                         b := exception_make(bytes, ec_syscall, error_subprocess, i, true);
 153                 ]
 154                 return b;
 155         ]
 156         return b + process_read_lazy~lazy(w, r, ph);
 157 ]
 158
 159 fn get_process_output(w : world, d : dhandle, h : list(handle), f : bytes, args : list(bytes), env : treemap(bytes, bytes)) : bytes
 160 [
 161         var rh wh : handle;
 162         w, rh, wh := pipe(w);
 163         var ph : phandle;
 164         w, ph := spawn(w, d, list(handle).[ h[0], wh, h[2] ], f, args, env);
 165         return process_read_lazy(w, rh, ph);
 166 ]
 167
 168 fn load_program(w : world, f : bytes) : (world, main_function_type)
 169 [
 170         var main : main_function_type;
 171         var w2 : world;
 172         pcode IO IO_Load_Program 2 2 0 =w2 =main w f;
 173         return w2, main;
 174 ]