Package: src/packages/program.fdoc
Program¶
key | file |
---|---|
__init__.flx | share/lib/std/program/__init__.flx |
env.flx | share/lib/std/program/env.flx |
cmdopt.flx | share/lib/std/program/cmdopt.flx |
shell.flx | share/lib/std/program/shell.flx |
posix_shell.flx | share/lib/std/posix/shell.flx |
win32_shell.flx | share/lib/std/win32/shell.flx |
process.flx | share/lib/std/program/process.flx |
posix_errno.flx | share/lib/std/posix/errno.flx |
posix_process.flx | share/lib/std/posix/process.flx |
win32_process.flx | share/lib/std/win32/process.flx |
signal.flx | share/lib/std/program/signal.flx |
posix_signal.flx | share/lib/std/posix/signal.flx |
win32_signal.flx | share/lib/std/win32/signal.flx |
system.flx | share/lib/std/program/system.flx |
Synopsis¶
//[__init__.flx]
include "std/program/cmdopt";
include "std/program/system";
include "std/program/shell";
include "std/program/dynlink";
include "std/program/env";
include "std/program/process";
include "std/program/signal";
Environment Variables¶
//[env.flx]
//$ Access environment variables.
class Env_class[os]
{
//$ Separator for filename lists
virtual fun pathsep: 1 -> string;
//$ Get the value of a given variable.
//$ Returns empty string if the variable doesn't exist.
fun getenv:string -> string =
"::flx::rtl::strutil::atostr(std::getenv($1.c_str()))"
requires package "flx_strutil", Cxx_headers::cstdlib;
fun issetenv(s:string)=> getenv s != "";
//$ Get the value of a given variable.
//$ Returns specified default if the variable doesn't exist.
fun getenv(name:string,dflt:string):string=>let result = getenv(name) in
if String::len result != 0uz then result else dflt endif
;
fun getenvlist (name:string) : list[string] =>
split (getenv name, #pathsep)
;
}
instance Env_class[Win32] { fun pathsep() => ";"; }
instance Env_class[Posix] { fun pathsep() => ":"; }
class Env
{
if PLAT_WIN32 do
inherit Env_class[Win32];
else
inherit Env_class[Posix];
done
}
Command Line Options¶
//[cmdopt.flx]
open class CmdOpt
{
// Convert key/value pairs represented like -I path
// into form --include=path
noinline fun cvt-key-arg (keys: list[string * string]) (x:list[string]) =
{
var out = Empty[string];
var inp = x.iterator;
for word in inp do
match keys.find word with
| #None => out = Cons (word,out);
| Some prefix =>
match inp() with
| #None => println$ "Error, expected argument to option " + word;
| Some arg => out = Cons (prefix+"=" + arg, out);
endmatch;
endmatch;
done
return rev out;
}
// Parse key value pairs represented by --key=value.
// Allows multiple values to be given.
// Stores reversed list of values.
// Returns ordered list of non-handled elements.
var rekv = RE2 "(--.*)=(.*)";
noinline gen parse-key-multi-value (keys:list[string]) (d:strdict[list[string]]) (x:list[string]) =
{
var out = Empty[string];
var va = varray[StringPiece] (StringPiece "", StringPiece "", StringPiece "");
for opt in x do
if Match (rekv, StringPiece (opt), 0,ANCHOR_BOTH, va.stl_begin, va.len.int) do
var key = va . 1 . string;
if key in keys do
val value= va . 2 . string ;
val nuval = Cons (value, d.get_dflt (key,Empty[string]));
d.add key nuval;
else
out = Cons (opt, out);
done
else
out = Cons (opt, out);
done
done
return rev out;
}
// Parse key value pairs represented by --key=value.
// Keys must be unique.
// Stores reversed list of values.
// Returns ordered list of non-handled elements.
noinline gen parse-key-single-value (keys:list[string]) (d:strdict[string]) (x:list[string]) =
{
var out = Empty[string];
var va = varray[StringPiece] (StringPiece "", StringPiece "", StringPiece "");
for opt in x do
if Match (rekv, StringPiece (opt), 0,ANCHOR_BOTH, va.stl_begin, va.len.int) do
var key = va . 1 . string;
if key in keys do
val value= va . 2 . string ;
match d.get key with
| #None => d.add key value;
| _ => println$ "Duplicate option '" + opt +"'";
endmatch;
else
println$ "Invalid option '" + opt+"'";
done
else
out = Cons (opt, out);
done
done
return rev out;
}
// Parse keys given by --key.
// Allows multiple values.
// Stores count of occurences.
var rek = RE2 "(--.*)";
noinline gen parse-key (keys:list[string]) (d:strdict[int]) (x:list[string]) =
{
var out = Empty[string];
var va = varray[StringPiece] (StringPiece "", StringPiece "");
for opt in x do
if Match (rek, StringPiece (opt), 0,ANCHOR_BOTH, va.stl_begin, va.len.int) do
var key = va . 1 . string;
if key in keys do
val nuval =d.get_dflt (key,0) + 1;
d.add key nuval;
else
println$ "Invalid option '" + opt+"'";
done
else
out = Cons (opt, out);
done
done
return rev out;
}
// Parse keys given by -abcd
// Allows multiple values.
// Stores count of occurences.
// Replaces option letter with specified long option key.
// Returns ordered list of non-handled elements.
var resw = RE2 "(-.*)";
noinline gen parse-switches (switchmap: list[char * string] ) (d:strdict[int]) (x:list[string]) =
{
var out = Empty[string];
var va = varray[StringPiece] (StringPiece "", StringPiece "");
for opt in x do
if Match (resw, StringPiece (opt), 0,ANCHOR_BOTH, va.stl_begin, va.len.int) do
var switches = va . 1 . string . [1 to];
for switch in switches do
match switchmap.find switch with
| #None =>
println$ "Invalid option " + opt + " char '" + str switch+"'";
| Some key=>
val nuval = d.get_dflt (key,0) + 1;
d.add key nuval;
endmatch;
done
else
out = Cons (opt, out);
done
done
return rev out;
}
typedef cmdspec_t = (
split-key-value-spec: list[string * string],
multi-valued-keys-spec: list[string],
single-valued-keys-spec: list[string],
switches-spec: list[string],
short-switch-map-spec: list[char * string]
);
typedef cmdopt-parse-result_t = (
multi-valued-keys : strdict[list[string]],
single-valued-keys : strdict[string],
switches : strdict[int],
positional : list[string]
);
ctor cmdopt-parse-result_t () =>
(
multi-valued-keys = strdict[list[string]](),
single-valued-keys = strdict[string](),
switches = strdict[int](),
positional = Empty[string]
);
noinline gen parse-cmdline (spec:cmdspec_t) (x:list[string]) : cmdopt-parse-result_t = {
var result = cmdopt-parse-result_t ();
var nonk = cvt-key-arg spec.split-key-value-spec x;
nonk = parse-key-multi-value spec.multi-valued-keys-spec result.multi-valued-keys nonk;
nonk = parse-key-single-value spec.single-valued-keys-spec result.single-valued-keys nonk;
nonk = parse-key spec.switches-spec result.switches nonk;
&result.positional <- parse-switches spec.short-switch-map-spec result.switches nonk;
return result;
}
}
Process¶
//[process.flx]
class Process_class[os, process_status_t]
{
virtual gen popen_in : string -> Cstdio::ifile;
virtual gen pclose: Cstdio::ifile -> process_status_t;
}
class Process {
if PLAT_WIN32 do
inherit Win32Process;
else
inherit PosixProcess;
done
}
Posix Errno¶
//[posix_errno.flx]
open class Errno
{
pod type errno_t = "int" requires C89_headers::errno_h;
ctor int : errno_t = "$1";
ctor errno_t : int = "$1";
instance Eq[errno_t] {
fun == : errno_t * errno_t -> bool= "$1==$2";
}
inherit Eq[errno_t];
const errno : errno_t = "errno"; // SUCKS
const ENOERROR : errno_t = "0";
const EACCES: errno_t;
const ENOENT: errno_t;
const EAGAIN: errno_t;
const ENOMEM: errno_t;
const EEXIST: errno_t;
const EINVAL: errno_t;
const EINTR: errno_t; // call interrupted by a signal
proc maybe_exit(var n:int) { if n != 0 do System::exit(errno.int); done }
proc maybe_exit(var n:errno_t) { if n != ENOERROR do System::exit(n.int); done }
proc maybe_exit() { if errno != ENOERROR do System::exit(errno.int); done }
// Unfortunately we get the crappy GNU version of strerror_r
// even if we don't define _GNU_SOURCE
// This stupidity returns a char*, instead of a void.
// Unfortunately moron compilers complain about not using
// the returned result, but there is no legal way to use a void.
// There is no way out.
if PLAT_WIN32 do
proc strerror_r: errno_t * carray[char] * size = "(void)strerror_s($2, $3, $1);"
requires C89_headers::string_h /* on Linux.. on OSX it's in stdio.h */
;
else
proc strerror_r: errno_t * carray[char] * size =
"""
strerror_r($1, $2, $3);
"""
requires C89_headers::string_h
;
done
fun strerror(e:errno_t) : string = {
if e.int == 0 do
return "OK";
else
var b:array[char,1000];
var bad = "[strerror_r] Failed to find text for error number " + e.int.str;
var p = bad._unsafe_cstr;
CString::strncpy (carray (&b),p,1000.size); // safe because bad is a variable
Memory::free p.address;
strerror_r(e,carray (&b), b.len.size);
return string( carray (&b));
done
}
gen strerror()=> strerror errno;
instance Str[errno_t] { fun str (e:errno_t) => strerror e; }
inherit Str[errno_t];
// Auto error check support
class Check[T]
{
proc int_to_proc (var x:int) { if x == -1 do ehandler; done }
fun int_to_int (var x:int) = { if x == -1 do ehandler; done return x; }
fun pointer_to_pointer[U] (var p:&U) = { if C_hack::isNULL p do #ehandler; done return p; }
virtual fun ehandler: unit -> any;
}
type check_ignore = "";
instance Check[check_ignore]
{
fun ehandler ():any = {}
}
type check_throw = "";
instance Check[check_throw]
{
fun ehandler ():any = { raise #strerror; }
}
}
Posix Process¶
//[posix_process.flx]
class PosixProcess {
open PosixSignal;
instance Process_class[Posix, process_status_t]
{
gen popen_in: string -> Cstdio::ifile = 'popen($1.c_str(), "r")'
requires C89_headers::stdio_h;
gen pclose: Cstdio::ifile -> process_status_t = "pclose($1)";
}
inherit Process_class[Posix, process_status_t];
type process_status_t = "int" requires Posix_headers::sys_wait_h;
ctor int:process_status_t = "$1";
ctor process_status_t : int = "$1";
fun int_of_process_status_t: process_status_t -> int = "(int)$1";
fun WIFCONTINUED: process_status_t -> bool = "WIFCONTINUED($1)!=0";
fun WIFEXITED: process_status_t -> bool = "WIFEXITED($1)!=0";
fun WIFSIGNALED: process_status_t -> bool = "WIFSIGNALED($1)!=0";
fun WIFSTOPPED: process_status_t -> bool = "WIFSTOPPED($1)!=0";
fun WEXITSTATUS: process_status_t -> int = "WEXITSTATUS($1)";
fun WTERMSIG: process_status_t -> signal_t = "WTERMSIG($1)";
fun WSTOPSIG: process_status_t -> signal_t = "WSTOPSIG($1)";
// OSX only, not in Posix
fun WCOREDUMP: process_status_t -> int = "WCOREDUMP($1)";
fun str(x:process_status_t) = {
if WIFEXITED x do
val e = x.WEXITSTATUS;
return "Exit " + str e + ": " +e.errno_t.strerror;
elif WIFSIGNALED x do
val s = x.WTERMSIG;
return "SIGNAL " + s.int.str + ": " + s.str;
else
return "Unknown temination status " + x.int.str;
done
}
const environ: + (+char) = "environ" requires Posix_headers::unistd_h;
type exec_result_t = "int";
const bad_exec: exec_result_t = "-1";
fun == : exec_result_t * exec_result_t -> bool= "$1==$2";
gen execv:+char * + (+char) -> exec_result_t = "execv($1, $2)" requires Posix_headers::unistd_h;
gen execvp:+char * + (+char) -> exec_result_t = "execvp($1, $2)" requires Posix_headers::unistd_h;
gen execve:+char * + (+char) * + (+char) -> exec_result_t = "execve($1, $2, $3)" requires Posix_headers::unistd_h;
// do NOT try to fork Felix programs, it doesn't work
// because of threads already running. We use fork only
// to preceed exec() calls.
type pid_t = "pid_t" requires Posix_headers::unistd_h;
instance Str[pid_t] {
fun str: pid_t -> string = "::flx::rtl::strutil::str<int>($1)" requires package "flx_strutil";
}
ctor int: pid_t = "((int)$1)";
const child_process : pid_t = "0";
const bad_process : pid_t = "-1";
fun == : pid_t * pid_t -> bool= "$1==$2";
gen fork: unit -> pid_t = "fork()" requires Posix_headers::unistd_h;
variant spawn_result_t =
// returned to parent process
| BadFork of errno_t
| ProcessId of pid_t
// returned to child proces
| BadExec of errno_t
| BadSetup of int
;
gen spawnv(file: string, argv:+ (+char), setup:1->int) : spawn_result_t = {
var x = fork();
if x == child_process do // CHILD
var result = #setup;
if result != 0 do
return BadSetup result;
done
var y = execv(file.cstr, argv);
if y == bad_exec do
return BadExec errno;
else
return ProcessId x; // never taken! fool type system
done
elif x == bad_process do // PARENT
return BadFork errno;
else
return ProcessId x;
done
}
gen spawnvp(file: string, argv:+ (+char), setup:1->int) : spawn_result_t = {
var x = fork();
if x == child_process do // CHILD
var result = #setup;
if result != 0 do
return BadSetup result;
done
var y = execvp(file.cstr, argv);
if y == bad_exec do
return BadExec errno;
else
return ProcessId x; // never taken! fool type system
done
elif x == bad_process do // PARENT
return BadFork errno;
else
return ProcessId x;
done
}
gen spawnve(file: string, argv:+ (+char), env: + (+char), setup:1->int) : spawn_result_t = {
var x = fork();
if x == child_process do // CHILD
var result = #setup;
if result != 0 do
return BadSetup result;
done
var y = execve(file.cstr, argv, env);
if y == bad_exec do
return BadExec errno;
else
return ProcessId x; // never taken! fool type system
done
elif x == bad_process do // PARENT
return BadFork errno;
else
return ProcessId x;
done
}
type process_status_options_t = "int";
const WCONTINUED: process_status_options_t;
const WNOHANG: process_status_options_t;
const WUNTRACED: process_status_options_t;
const WNONE: process_status_options_t="0";
fun \| : process_status_options_t * process_status_options_t -> process_status_options_t = "$1|$2";
gen waitpid: pid_t * &process_status_t * process_status_options_t -> pid_t requires Posix_headers::sys_wait_h;
gen waitpid(pid:pid_t) = {
var status: process_status_t;
var pid' = waitpid(pid,&status,WNONE);
if pid' == bad_process do
println$ "Waitpid failed .. fix me!";
System::exit 1;
else
return status;
done
}
variant ProcesStatus = | Running | Stopped of process_status_t;
gen checkpid(pid:pid_t) = {
var status: process_status_t;
var pid' = waitpid(pid,&status,WNOHANG);
if pid' == bad_process do
println$ "Waitpid failed .. fix me!";
System::exit 1;
elif pid'.int == 0 do
return Running;
else
return Stopped status;
done
}
gen kill: pid_t * signal_t -> int;
const OUR_PROCESS_GROUP: pid_t = "0";
}
Win32 Process¶
//[win32_process.flx]
class Win32Process {
open Win32Signal;
instance Process_class[Win32, process_status_t]
{
gen popen_in: string -> Cstdio::ifile = '_popen($1.c_str(), "r")' requires C89_headers::stdio_h;
gen pclose: Cstdio::ifile -> process_status_t = "_pclose($1)" requires C89_headers::stdio_h;
}
inherit Process_class[Win32, process_status_t];
type process_status_t = "intptr_t";
ctor intptr:process_status_t = "$1";
ctor int:process_status_t = "int($1)";
ctor process_status_t : intptr = "$1";
fun int_of_process_status_t: process_status_t -> int = "(int)$1";
/*
fun WIFCONTINUED: process_status_t -> bool = "WIFCONTINUED($1)!=0";
fun WIFEXITED: process_status_t -> bool = "WIFEXITED($1)!=0";
fun WIFSIGNALED: process_status_t -> bool = "WIFSIGNALED($1)!=0";
fun WIFSTOPPED: process_status_t -> bool = "WIFSTOPPED($1)!=0";
fun WEXITSTATUS: process_status_t -> int = "WEXITSTATUS($1)";
fun WTERMSIG: process_status_t -> signal_t = "WTERMSIG($1)";
fun WSTOPSIG: process_status_t -> signal_t = "WSTOPSIG($1)";
// OSX only, not in Posix
fun WCOREDUMP: process_status_t -> int = "WCOREDUMP($1)";
fun str(x:process_status_t) = {
if WIFEXITED x do
val e = x.WEXITSTATUS;
return "Exit " + str e + ": " +e.errno_t.strerror;
elif WIFSIGNALED x do
val s = x.WTERMSIG;
return "SIGNAL " + s.int.str + ": " + s.str;
else
return "Unknown temination status " + x.int.str;
done
}
*/
const environ: + (+char) = "environ" requires Posix_headers::unistd_h;
type exec_result_t = "intptr_t";
const bad_exec: exec_result_t = "intptr_t(-1)";
fun == : exec_result_t * exec_result_t -> bool= "$1==$2";
gen execv:+char * + (+char) -> exec_result_t = "_execv($1, $2)" requires Win32_headers::process_h;
gen execvp:+char * + (+char) -> exec_result_t = "_execvp($1, $2)" requires Win32_headers::process_h;
gen execve:+char * + (+char) * + (+char) -> exec_result_t = "_execve($1, $2, $3)" requires Win32_headers::process_h;
// do NOT try to fork Felix programs, it doesn't work
// because of threads already running. We use fork only
// to preceed exec() calls.
type pid_t = "intptr_t" requires Posix_headers::unistd_h;
ctor intptr: pid_t = "($1)";
const bad_process : pid_t = "intptr_t(-1)";
fun == : pid_t * pid_t -> bool= "$1==$2";
instance Str[pid_t] {
fun str: pid_t -> string = "::flx::rtl::strutil::str<intptr_t>($1)" requires package "flx_strutil";
}
variant spawn_result_t =
// returned to parent process
| BadFork of errno_t
| ProcessId of pid_t
// returned to child proces (can't happen on Windows)
| BadExec of errno_t
| BadSetup of int
;
gen spawnv:+char * + (+char) -> pid_t = "_spawn(_P_NOWAIT,$1, $2)" requires Win32_headers::process_h;
gen spawnvp:+char * + (+char) -> pid_t = "_spawnvp(_P_NOWAIT,$1, $2)" requires Win32_headers::process_h;
gen spawnve:+char * + (+char) * + (+char) -> pid_t = "_spawnve(_P_NOWAIT,$1, $2, $3)" requires Win32_headers::process_h;
gen spawnv(file: string, argv:+ (+char), setup:1->int) : spawn_result_t = {
var x = spawnv(file.cstr, argv);
if x == bad_process do // PARENT
return BadFork errno;
else
return ProcessId x;
done
}
gen spawnvp(file: string, argv:+ (+char), setup:1->int) : spawn_result_t = {
var x = spawnvp(file.cstr, argv);
if x == bad_process do // PARENT
return BadFork errno;
else
return ProcessId x;
done
}
gen spawnve(file: string, argv:+ (+char), env: + (+char), setup:1->int) : spawn_result_t = {
var x = spawnve(file.cstr, argv, env);
if x == bad_process do // PARENT
return BadFork errno;
else
return ProcessId x;
done
}
/*
type process_status_options_t = "int";
const WCONTINUED: process_status_options_t;
const WNOHANG: process_status_options_t;
const WUNTRACED: process_status_options_t;
const WNONE: process_status_options_t="0";
fun \| : process_status_options_t * process_status_options_t -> process_status_options_t = "$1|$2";
// Use WaitForSingleObject
gen waitpid: pid_t * &process_status_t * process_status_options_t -> pid_t requires Posix_headers::sys_wait_h;
gen waitpid(pid:pid_t) = {
var status: process_status_t;
var pid' = waitpid(pid,&status,WNONE);
if pid' == bad_process do
println$ "Waitpid failed .. fix me!";
System::exit 1;
else
return status;
done
}
variant ProcesStatus = | Running | Stopped of process_status_t;
gen checkpid(pid:pid_t) = {
var status: process_status_t;
var pid' = waitpid(pid,&status,WNOHANG);
if pid' == bad_process do
println$ "Waitpid failed .. fix me!";
System::exit 1;
elif pid'.int == 0 do
return Running;
else
return Stopped status;
done
}
gen kill: pid_t * signal_t -> int;
const OUR_PROCESS_GROUP: pid_t = "0";
*/
}
System Call¶
//[system.flx]
class System
{
const argc:int = "PTF argc" requires property "needs_ptf";
const _argv:&&char= "PTF argv" requires property "needs_ptf";
fun argv:int -> string = '::std::string($1<0||$1>=PTF argc??"":PTF argv[$1])'
requires property "needs_ptf";
fun argv_dflt (x:int) (y:string) => match argv x with | "" => y | a => a;
fun args () => List::map (argv) (List::range argc);
proc setargs : + (+char) * size = "PTF argc=$2; PTF argv=$1;" requires property "needs_ptf";
proc setargs[N] (a:string^N)
{
gen myget(i:size)=>a.i.cstr;
var x = varray[+char] (a.len,a.len,myget);
setargs (x.stl_begin,x.len);
}
gen system (cmd:string) : int => Shell::system(cmd);
gen exit: int -> any = '::std::exit($1)' requires Cxx_headers::cstdlib;
gen abort: 1 -> any =
'(fprintf(stderr,"Felix code calling abort\\n"),::std::abort())'
requires Cxx_headers::cstdlib;
_gc_pointer type ptf_t = "thread_frame_t*";
const ptf:ptf_t = "ptf" requires property "needs_ptf";
//$ pexit examines the return code from a system call.
//$ If the code is 0 it exists with 0.
//$ On Windows:
//$ if the code is -1, it exits with errno.
//$ otherwise code 3
//$ On Unix:
//$ if the code is non-zero then
//$ if the callout aborted, return its abort code.
//$ if the callout died due to a signal, exit with code 2
//$ otherwise exit with code 3
//$ In both these cases a non-zero return causes a message
//$ to be printed on stderr.
if PLAT_WIN32 do
proc pexit(e:int)
{
if e != 0 do
if e == -1 do
err := errno;
eprintln$ "Error "+err.str+" in flx: " + strerror err;
System::exit err.int;
else
eprintln$ "Unknown error in shell " + str e;
System::exit 3;
done
done
System::exit e;
}
else
proc pexit(e:int)
{
if e != 0 do
if PosixProcess::WIFEXITED e.PosixProcess::process_status_t do
err := PosixProcess::WEXITSTATUS e.PosixProcess::process_status_t;
eprintln$ "Error "+err.str+" in flx: " + strerror err.errno_t;
System::exit err;
elif PosixProcess::WIFSIGNALED e.PosixProcess::process_status_t do
sig := Process::WTERMSIG e.PosixProcess::process_status_t;
eprintln$ "Shell terminated by signal " + str sig;
System::exit 2;
else
eprintln$ "Unknown error in shell " + str e;
System::exit 3;
done
done
System::exit e;
}
done
gen get_stdout(x:string) : int * string => Shell::get_stdout x;
}
Shell¶
//[shell.flx]
// Note Shell_class interface doesn't use process_status_t
// but the implementation does.
class Shell_class[OS, process_status_t]
{
// Quote a single argument.
// Note: kills Bash wildcard replacement.
virtual fun quote_arg:string->string;
fun quote_args (s:list[string]) : string => catmap[string] ' ' quote_arg s;
// Mainly for Windows we need a way to quote command line strings too.
virtual fun quote_line_for_system: string->string;
virtual fun parse: string -> list[string];
//------------------------------------------------------------
// system() function
//$ System command is ISO C and C++ standard.
gen raw_system: string -> int = "::std::system($1.c_str())"
requires Cxx_headers::cstdlib
;
//$ basic command with line quoting.
gen basic_system (cmd: string) :int =>
cmd.quote_line_for_system.raw_system
;
// string argument
gen system (cmd:string) = {
if Env::getenv "FLX_SHELL_ECHO" != "" do
eprintln$ "[system] " + cmd;
done
return basic_system cmd;
}
// list of string argument
gen system (args:list[string]) : int =>
args.quote_args.system
;
gen system[T with Iterable[T,string]] (args:T) : int =
{
var lst = Empty[string];
for arg in args do
lst = lst + arg;
done
return system lst;
}
//------------------------------------------------------------
// popen() function (get_stdout)
virtual fun quote_line_for_popen: string -> string;
//$ get_stdout is a synchronous version of popen_in/pclose pair.
virtual gen raw_get_stdout : string -> int * string;
gen basic_get_stdout (cmd: string) : int * string =>
cmd.quote_line_for_popen.raw_get_stdout
;
gen get_stdout (cmd:string) : int * string = {
if Env::getenv "FLX_SHELL_ECHO" != "" do
eprintln$ "[get_stdout] " + cmd;
done
return basic_get_stdout cmd;
}
// arbitrary Streamable argument
gen get_stdout (args:list[string]) : int * string =>
args.quote_args.get_stdout
;
gen get_stdout[T with Iterable[T,string]] (args:T) : int * string =
{
var lst = Empty[string];
for arg in args do
lst = lst + arg;
done
return get_stdout lst;
}
}
class Shell {
if PLAT_WIN32 do
inherit CmdExe;
else
inherit Bash;
done
}
Posix Shell (Bash)¶
//[posix_shell.flx]
// Note: shell functions here only work with Bash.
// However, the system() function always calls sh,
// and sh is always an ash, which is almost always bash
/* GNU Bash 3-2 Man page
QUOTING
Quoting is used to remove the special meaning of certain characters or words to the shell.
Quoting can be used to disable special treatment for special characters, to prevent reserved
words from being recognized as such, and to prevent parameter expansion.
Each of the metacharacters listed above under DEFINITIONS has special meaning to the shell and
must be quoted if it is to represent itself.
When the command history expansion facilities are being used (see HISTORY EXPANSION below), the
history expansion character, usually !, must be quoted to prevent history expansion.
There are three quoting mechanisms: the escape character, single quotes, and double quotes.
A non-quoted backslash (\) is the escape character. It preserves the literal value of the next
character that follows, with the exception of <newline>. If a \<newline> pair appears, and the
backslash is not itself quoted, the \<newline> is treated as a line continuation (that is, it is
removed from the input stream and effectively ignored).
Enclosing characters in single quotes preserves the literal value of each character within the
quotes. A single quote may not occur between single quotes, even when preceded by a backslash.
Enclosing characters in double quotes preserves the literal value of all characters within the
quotes, with the exception of $, `, \, and, when history expansion is enabled, !. The charac-
ters $ and ` retain their special meaning within double quotes. The backslash retains its spe-
cial meaning only when followed by one of the following characters: $, `, ", \, or <newline>. A
double quote may be quoted within double quotes by preceding it with a backslash. If enabled,
history expansion will be performed unless an ! appearing in double quotes is escaped using a
backslash. The backslash preceding the ! is not removed.
The special parameters * and @ have special meaning when in double quotes (see PARAMETERS
below).
Words of the form $'string' are treated specially. The word expands to string, with backslash-
escaped characters replaced as specified by the ANSI C standard. Backslash escape sequences, if
present, are decoded as follows:
\a alert (bell)
\b backspace
\e an escape character
\f form feed
\n new line
\r carriage return
\t horizontal tab
\v vertical tab
\\ backslash
\' single quote
\nnn the eight-bit character whose value is the octal value nnn (one to three digits)
\xHH the eight-bit character whose value is the hexadecimal value HH (one or two hex
digits)
\cx a control-x character
The expanded result is single-quoted, as if the dollar sign had not been present.
A double-quoted string preceded by a dollar sign ($) will cause the string to be translated
according to the current locale. If the current locale is C or POSIX, the dollar sign is
ignored. If the string is translated and replaced, the replacement is double-quoted.
*/
class Bash {
instance Shell_class[Posix, PosixProcess::process_status_t] {
// we can't use single quotes becase there's no way to represent a '
// in a single quoted string .. so we have to use double quotes and
// backslash the 4 special characters: " $ \ `
// I think this is all ..
fun quote_arg(s:string):string= {
var r = "";
for ch in s do
if ch in "\\\"" do // leave $ and ` in there, unquoted.
r += "\\"+ str ch;
else
r+= ch;
done
done
return '"'+r+'"';
}
fun quote_line_for_system (s:string) => s;
fun quote_line_for_popen (s:string) => s + " ";
gen raw_get_stdout(x:string) = {
var fout = PosixProcess::popen_in(x+" ");
if valid fout do
var output = load fout;
var result = PosixProcess::pclose fout;
return PosixProcess::WEXITSTATUS result, output;
else
println$ "Unable to run command '" + x "'";
return -1,"";
done
}
//$ Parse a bash command line into words.
fun parse (s:string) : list[string] =
{
var args = Empty[string];
var current = "";
variant mode_t = | copy | skip | quote | dquote | escape-copy | escape-dquote;
var mode = skip;
for ch in s do
match mode with
| #skip =>
if ch == char "\\" do
mode = escape-copy;
elif ch == char "'" do
mode = quote;
elif ch == char '"' do
mode = dquote;
elif ord ch > ord (char ' ') do
current += ch;
mode = copy;
done
| #copy =>
if ch == char "\\" do
mode = escape-copy;
elif ord ch <= ord (char ' ') do
mode = skip;
args += current;
current = "";
elif ch == char "'" do
mode = quote;
elif ch == char '"' do
mode = dquote;
else
current += ch;
done
| #escape-copy =>
current += ch;
mode = copy;
| #escape-dquote =>
mode = dquote;
if ch in '"\\$`' do
current += ch;
elif ch == char "'n" do ;
else
current += "\\" + ch;
done
| #dquote =>
if ch == char '"' do
mode = copy;
elif ch == char "\\" do
mode = escape-dquote;
else
current += ch;
done
| #quote =>
if ch == char "'" do
mode = copy;
else
current += ch;
done
endmatch;
done
match mode with
| #skip => ;
| _ => args += current;
endmatch;
return args;
}
}
inherit Shell_class[Posix, PosixProcess::process_status_t];
}
Win32 Shell (cmd.exe)¶
//[win32_shell.flx]
/* http://msdn.microsoft.com/en-us/library/17w5ykft.aspx
Microsoft Specific
Microsoft C/C++ startup code uses the following rules when interpreting
arguments given on the operating system command line:
Arguments are delimited by white space, which is either a space or a tab.
The caret character (^) is not recognized as an escape character or delimiter.
The character is handled completely by the command-line parser in the
operating system before being passed to the argv array in the program.
A string surrounded by double quotation marks ("string") is
interpreted as a single argument, regardless of white space contained within.
A quoted string can be embedded in an argument.
A double quotation mark preceded by a backslash (\") is
interpreted as a literal double quotation mark character (").
Backslashes are interpreted literally, unless they
immediately precede a double quotation mark.
If an even number of backslashes is followed by a
double quotation mark, one backslash is placed in the argv
array for every pair of backslashes, and the double quotation mark
is interpreted as a string delimiter.
If an odd number of backslashes is followed by a
double quotation mark, one backslash is placed in the argv
array for every pair of backslashes, and the double quotation mark
is "escaped" by the remaining backslash, causing a literal
double quotation mark (") to be placed in argv.
*/
class CmdExe
{
instance Shell_class[Win32, Win32Process::process_status_t]
{
fun quote_arg(s:string):string => '"' + s + '"';
fun quote_line_for_system(s:string) => '"' + s + '"';
fun quote_line_for_popen(s:string) => '"' + s + '"';
gen raw_get_stdout(x:string) = {
//eprintln("CMD.EXE: raw_get_stout of " + x);
var fout = Win32Process::popen_in(x);
if valid fout do
var output = load fout;
var result = Win32Process::pclose fout;
return Win32Process::int_of_process_status_t result, output;
else
println$ "Unable to run command '" + x "'";
return -1,"";
done
}
//$ Parse a CMD.EXE command line into words.
fun parse (s:string) : list[string] =
{
var args = Empty[string];
var current = "";
variant mode_t = | copy | skip | dquote | escape-copy | escape-dquote;
var mode = skip;
for ch in s do
match mode with
| #skip =>
if ch == char "\\" do
mode = escape-copy;
elif ch == char '"' do
mode = dquote;
elif ord ch > ord (char ' ') do
current += ch;
mode = copy;
done
| #copy =>
if ch == char "\\" do
mode = escape-copy;
elif ord ch <= ord (char ' ') do
mode = skip;
args += current;
current = "";
elif ch == char '"' do
mode = dquote;
else
current += ch;
done
| #escape-copy =>
mode = copy;
if ch == char '"' do
current += ch;
else
current += "\\" + ch;
done
| #escape-dquote =>
mode = dquote;
if ch == char '"' do
current += ch;
else
current += "\\" + ch;
done
| #dquote =>
if ch == char '"' do
mode = copy;
elif ch == char "\\" do
mode = escape-dquote;
else
current += ch;
done
endmatch;
done
match mode with
| #skip => ;
| _ => args += current;
endmatch;
return args;
}
}
inherit Shell_class[Win32, Win32Process::process_status_t];
}
Signals¶
//[signal.flx]
body ctrl_c_flag = """
static bool ctrl_c_flag = false;
bool get_ctrl_c_flag() { return ctrl_c_flag; }
void set_ctrl_c_flag(int) { ctrl_c_flag = true; }
""";
class Signal_class [os] {
gen get_ctrl_c_flag: 1 -> bool requires ctrl_c_flag;
proc set_ctrl_c_flag: int requires ctrl_c_flag;
virtual proc trap_ctrl_c: 1;
}
class Signal {
if PLAT_WIN32 do
inherit Win32Signal;
else
inherit PosixSignal;
done
}
Posix Signal¶
//[posix_signal.flx]
class PosixSignal {
requires C89_headers::signal_h;
type signal_t = "int";
ctor signal_t: int = "$1";
ctor int: signal_t = "$1";
type sig_t = "sig_t"; // what a pity posix calls the handler sig_t
gen signal: signal_t * sig_t -> sig_t = "signal($1, $2)";
instance Eq[signal_t] {
fun == : signal_t * signal_t -> bool = "$1==$2";
}
inherit Eq[signal_t];
// http://pubs.opengroup.org/onlinepubs/009695399/basedefs/signal.h.html
const
SIGABRT, SIGALRM, SIGBUS, SIGCHLD, SIGCONT, SIGFPE, SIGHUP, SIGILL, SIGINT, SIGKILL,
SIGPIPE, SIGQUIT, SIGSEGV, SIGSTOP, SIGTERM, SIGTSTP, SIGTTN, SIGTTOU, SIGUSR1, SIGUSR2,
SIGPOLL, SIGPROF, SIGSYS, SIGTRAP, SIGURG, SIGVTALRM, SIGXCPU,SIGXSZ
: signal_t;
instance Str[signal_t] {
fun str: signal_t -> string =
| $(SIGABRT) => "SIGABRT"
| $(SIGALRM) => "SIGALRM"
| $(SIGBUS) => "SIGBUS"
| $(SIGCHLD) => "SIGCHLD"
| $(SIGCONT) => "SIGCONT"
| $(SIGFPE) => "SIGFPE"
| $(SIGHUP) => "SIGHUP"
| $(SIGILL) => "SIGILL"
| $(SIGINT) => "SIGINT"
| $(SIGKILL) => "SIGKILL"
| $(SIGPIPE) => "SIGPIPE"
| $(SIGQUIT) => "SIGQUIT"
| $(SIGSEGV) => "SIGSEGV"
| $(SIGSTOP) => "SIGSTOP"
| $(SIGTERM) => "SIGTERM"
| $(SIGTSTP) => "SIGTSTP"
// | $(SIGTTN) => "SIGTTN" // not in OSX
| $(SIGTTOU) => "SIGTTOU"
| $(SIGUSR1) => "SIGUSR1"
| $(SIGUSR2) => "SIGUSR2"
// | $(SIGPOLL) => "SIGPOLL" // not in OSX
| $(SIGPROF) => "SIGPROF"
| $(SIGSYS) => "SIGSYS"
| $(SIGTRAP) => "SIGTRAP"
| $(SIGURG) => "SIGURG"
| $(SIGVTALRM) => "SIGVTALRM"
| $(SIGXCPU) => "SIGXCPU"
// | $(SIGXSZ) => "SIGXSZ" // not in OSX
| x => "signal " + x.int.str
;
}
inherit Str[signal_t];
body "void null_signal_handler(int){}";
const null_signal_handler: sig_t;
proc ignore_signal(s:signal_t) { C_hack::ignore(signal(s, null_signal_handler)); }
// http://pubs.opengroup.org/onlinepubs/007904975/functions/sigaction.html
body ctrl_c_handling = """
void set_ctrl_c_flag(int);
void trap_ctrl_c () {
struct sigaction sa;
sa.sa_handler = set_ctrl_c_flag;
sigemptyset(&sa.sa_mask);
sa.sa_flags = SA_RESTART;
sigaction(SIGINT, &sa, NULL);
}
""" requires ctrl_c_flag;
inherit Signal_class[Posix];
instance Signal_class[Posix] {
proc trap_ctrl_c: unit requires ctrl_c_handling;
}
}
Win32 Signal¶
//[win32_signal.flx]
class Win32Signal {
requires C89_headers::signal_h;
type signal_t = "int";
ctor signal_t: int = "$1";
ctor int: signal_t = "$1";
header sig_t_def = "typedef void (__cdecl *sig_t)(int);";
type sig_t = "sig_t" requires sig_t_def;
gen signal: signal_t * sig_t -> sig_t = "signal($1, $2)";
instance Eq[signal_t] {
fun == : signal_t * signal_t -> bool = "$1==$2";
}
inherit Eq[signal_t];
// http://pubs.opengroup.org/onlinepubs/009695399/basedefs/signal.h.html
const
SIGABRT, SIGFPE, SIGILL, SIGINT,
SIGSEGV, SIGTERM
: signal_t;
instance Str[signal_t] {
fun str: signal_t -> string =
| $(SIGABRT) => "SIGABRT"
| $(SIGFPE) => "SIGFPE"
| $(SIGILL) => "SIGILL"
| $(SIGINT) => "SIGINT"
| $(SIGSEGV) => "SIGSEGV"
| $(SIGTERM) => "SIGTERM"
| x => "signal " + x.int.str
;
}
inherit Str[signal_t];
body "void null_signal_handler(int){}";
const null_signal_handler: sig_t;
proc ignore_signal(s:signal_t) { C_hack::ignore(signal(s, null_signal_handler)); }
// http://pubs.opengroup.org/onlinepubs/007904975/functions/sigaction.html
body ctrl_c_handling = """
void set_ctrl_c_flag(int);
void trap_ctrl_c () {
(void)signal(SIGINT,set_ctrl_c_flag);
}
""" requires ctrl_c_flag;
inherit Signal_class[Win32];
instance Signal_class[Win32] {
proc trap_ctrl_c: unit requires ctrl_c_handling;
}
}