# SPDX-License-Identifier: BSD-2-Clause

function _eval3_io(form, env, d,       car, a) {
    car = _car(form)

    if(car == _symbol("printf"))
        # oo tricky, varargs. note we are sending the cddr in unevaluated.
        return _printf(_eval3(_cadr(form), env, env, d+1),
                       _cddr(form), env, d+1)
    else if(car == _symbol("unsafe-system"))
        return _unsafe_system(_eval3(_cadr(form), env, env, d+1))
    else if(car == _symbol("getline"))
        return _getline()
    else if(car == _symbol("with-ors"))
        return _with_ors(_eval3(_cadr(form), env, env, d+1),
                         _cddr(form), env, d+1) # to be evaluated using evprog
    else if(car == _symbol("with-rs"))
        return _with_rs(_eval3(_cadr(form), env, env, d+1),
                        _cddr(form), env, d+1) # to be evaluated using evprog
    else if(car == _symbol("with-fs"))
        return _with_fs(_eval3(_cadr(form), env, env, d+1),
                        _cddr(form), env, d+1) # to be evaluated using evprog
    else if(car == _symbol("with-output-to"))
        return _with_output_to(_eval3(_cadr(form), env, env, d+1),
                               _eval3(_caddr(form), env, env, d+1),
                               _cdddr(form), env, d+1) # to be evprogged
    else if(car == _symbol("with-input-from"))
        return _with_input_from(_eval3(_cadr(form), env, env, d+1),
                                _eval3(_caddr(form), env, env, d+1),
                                _cdddr(form), env, d+1) # to be evprogged
    else if(car == _symbol("getenv"))
        return _getenv(_eval3(_cadr(form), env, env, d+1))
    else if(car == _symbol("setenv"))
        return _setenv(_eval3(_cadr(form), env, env, d+1),
                       _eval3(_caddr(form), env, env, d+1))
    else if(car == _symbol("fflush"))
        return _fflush()
    else if(car == _symbol("close"))
        return _close(_eval3(_cadr(form), env, env, d+1))
    else if(car == _symbol("load"))
        return _load(_eval3(_cadr(form), env, env, d+1))
    else _builtin_mischaracterization("_eval3_io", car)
}


function _printf(fmt, unevald, env, d,      dlave, evald, s, a, i, p) {
    # mostly like _sprintf above
    n = 1
    dlave = _nil()
    for(; !_is_null(unevald); unevald=_cdr(unevald)) {
        dlave = _cons(_eval3(_car(unevald), env, env, d+1), dlave)
    }
    evald = _nreverse(dlave)
    _list_to_flat_awk_array_of_any(evald, a)
    i = 1
    s = ""
    fmt = _STRING[fmt]
    while(fmt != "") {
        if(match(fmt, /%/)) {
            # vv printf the bit before the %
            if(_OUTPUT_REDIR_NAME) {
                if(_OUTPUT_REDIR_KIND == ">") {
                    printf substr(fmt, 1, RSTART-1) > _OUTPUT_REDIR_NAME
                    # don't re-overwrite the file with the next bit
                    _OUTPUT_REDIR_KIND = ">>"
                } else if(_OUTPUT_REDIR_KIND == ">>") {
                    printf substr(fmt, 1, RSTART-1) >> _OUTPUT_REDIR_NAME
                } else if(_OUTPUT_REDIR_KIND == "|") {
                    printf substr(fmt, 1, RSTART-1) | _OUTPUT_REDIR_NAME
                }
            } else {
                printf substr(fmt, 1, RSTART-1)
            }
            # ^^
            fmt = substr(fmt, RSTART)
            # now do the %
            if(match(fmt, /^%%/)) {
                # vv printf a percent character
                if(_OUTPUT_REDIR_NAME) {
                    if(_OUTPUT_REDIR_KIND == ">") { # shouldn't be, by now
                        printf "%%" > _OUTPUT_REDIR_NAME
                        _OUTPUT_REDIR_KIND = ">>"
                    } else if(_OUTPUT_REDIR_KIND == ">>") {
                        printf "%%" >> _OUTPUT_REDIR_NAME
                    } else if(_OUTPUT_REDIR_KIND == "|") {
                        printf "%%" | _OUTPUT_REDIR_NAME
                    }
                } else {
                    printf "%%"
                }
                # ^^
                fmt = substr(fmt, 3)
                continue
            }
            # now the %-thing is at the beginning of fmt. how long is
            # it? (grammar derived from FreeBSD printf(3); your libc
            # may vary)
            match(fmt,/^%[*#+ 0-9.'-]*[diouxXfFeEgGaAcsb]/);
            if(i > length(a)) {
                logg_err("_printf", "not enough values for printf!")
                return _nil()
            } else {
                p = a[i++]
            }
            # RLENGTH is the length of the format specifier
            # vv printf %omgwtfbbq, p
            if(_OUTPUT_REDIR_NAME) {
                if(_OUTPUT_REDIR_KIND == ">") {
                    printf substr(fmt,1,RLENGTH), p > _OUTPUT_REDIR_NAME
                    _OUTPUT_REDIR_KIND = ">>"
                } else if(_OUTPUT_REDIR_KIND == ">>") {
                    printf substr(fmt,1,RLENGTH), p >> _OUTPUT_REDIR_NAME
                } else if(_OUTPUT_REDIR_KIND == "|") {
                    printf substr(fmt,1,RLENGTH), p | _OUTPUT_REDIR_NAME
                }
            } else {
                printf substr(fmt,1,RLENGTH), p
            }
            # ^^
            fmt = substr(fmt, RLENGTH+1)
        } else {
            # vv no more %, printf the rest
#            logg_dbg("_printf", "printfing " fmt)
            if(_OUTPUT_REDIR_NAME) {
                if(_OUTPUT_REDIR_KIND == ">") {
                    printf fmt > _OUTPUT_REDIR_NAME
                    _OUTPUT_REDIR_KIND = ">>"
                } else if(_OUTPUT_REDIR_KIND == ">>") {
                    printf fmt >> _OUTPUT_REDIR_NAME
                } else if(_OUTPUT_REDIR_KIND == "|") {
                    printf fmt | _OUTPUT_REDIR_NAME
                }
            } else {
                printf fmt
            }
            # ^^
            fmt = ""
        }
    }
    return _nil()
}

# This is unsafe because you pass in a single string, which is passed
# straight to the shell. If the string contains any user-controlled
# input, calling unsafe-system with it introduces a command injection
# vulnerability, CWE-78.
function _unsafe_system(s) {
    if(_TYPE[s] == "s") {
        return _number(system(_STRING[s]))
    } else {
        logg_err("_unsafe_system", "non-string operand " _repr(s))
        return _nil()
    }
}


function _getline(        a, rv) {
    if(_INPUT_REDIR_NAME) {
        if(_INPUT_REDIR_KIND == "<") {
            rv = getline a < _INPUT_REDIR_NAME
        } else if(_INPUT_REDIR_KIND == "|") {
            rv = _INPUT_REDIR_NAME | getline a
        }
    } else {
        rv = getline a
    }
    return _cons(_string(a), _cons(_number(rv), _nil()))
}


function _with_ors(new_ors, forms, env, d,       old_ors, rv) {
    old_ors = ORS
    if(_TYPE[new_ors] == "s") {
        ORS = _STRING[new_ors]
        rv = _evprog(forms, env, env, d)
        ORS = old_ors
        return rv
    } else {
        logg_err("_with_ors", "with-ors needs a string")
        return _nil()
    }
}

function _with_rs(new_rs, forms, env, d,       old_rs, rv) {
    old_rs = RS
    if(_TYPE[new_rs] == "s") {
        RS = _STRING[new_rs]
        rv = _evprog(forms, env, env, d)
        RS = old_rs
        return rv
    } else {
        logg_err("_with_rs", "with-rs needs a string")
        return _nil()
    }
}

function _with_fs(new_fs, forms, env, d,       old_fs, rv) {
    old_fs = FS
    if(_TYPE[new_fs] == "s") {
        FS = _STRING[new_fs]
        rv = _evprog(forms, env, env, d)
        FS = old_fs
        return rv
    } else {
        logg_err("_with_fs", "with-fs needs a string")
        return _nil()
    }
}



# it is up to every function that produces output under programmatic
# control to check these globals. they start out uninitialized and
# are only set within the body of with-output-to.
function _with_output_to(redir_kind, name, forms, env, d,       old_redir_kind, old_name, rv) {
    old_redir_kind = _OUTPUT_REDIR_KIND
    old_name       = _OUTPUT_NAME
    if(_TYPE[redir_kind] == "s") {
        if(_TYPE[name] == "s") {
            _OUTPUT_REDIR_KIND = _STRING[redir_kind]
            _OUTPUT_REDIR_NAME = _STRING[name]
            rv = _evprog(forms, env, env, d)
            _OUTPUT_REDIR_KIND = old_redir_kind
            _OUTPUT_REDIR_NAME = old_name
            return rv
        } else {
            logg_err("_with_output_to", "file or command should be a string")
            return _nil()
        }
    } else {
        logg_err("_with_output_to", "redir kind should be a string: \">\", \">>\" or \"|\"")
        return _nil()
    }
}


# same as above. every function that consumes input, check these
# globals. they are only set within the body of with-output-to. note:
# (with-input-from "|" "echo foo" (getline)) in glotawk corresponds
# with "echo foo" | getline in awk.
function _with_input_from(redir_kind, name, forms, env, d,       old_redir_kind, old_name, rv) {
    old_redir_kind = _INPUT_REDIR_KIND
    old_name       = _INPUT_NAME
    if(_TYPE[redir_kind] == "s") {
        if(_TYPE[name] == "s") {
            _INPUT_REDIR_KIND = _STRING[redir_kind]
            _INPUT_REDIR_NAME = _STRING[name]
            rv = _evprog(forms, env, env, d)
            _INPUT_REDIR_KIND = old_redir_kind
            _INPUT_REDIR_NAME = old_name
            return rv
        } else {
            logg_err("_with_input_from", "file or command should be a string")
            return _nil()
        }
    } else {
        logg_err("_with_input_from", "redir kind should be a string: \"<\" or \"|\"")
        return _nil()
    }
}

function _fflush() {
    if(_OUTPUT_REDIR_NAME) {
        fflush(_OUTPUT_REDIR_NAME)
    } else {
        fflush("/dev/stdout")
    }
    return _nil()
}

function _close(thing) {
    if(_TYPE[thing] == "s") {
        close(_STRING[thing])
    } else {
        logg_err("_close", "file or command to close should be a string")
    }
    return _nil()
}

function _getenv(var) {
    if(_TYPE[var] == "s") {
        if(_STRING[var] in ENVIRON)
            return _string(ENVIRON[_STRING[var]])
        else
            return _nil()
    } else {
        logg_err("_getenv", "environment variable name should be a string")
        return _nil()
    }
}

function _setenv(var, val) {
    if(_TYPE[var] == "s") {
        if(_TYPE[val] == "s") {
            ENVIRON[_STRING[var]] = _STRING[val]
            return val
        } else {
            logg_err("_setenv", "environment variable value should be a string")
            return _nil()
        }
    } else {
        logg_err("_setenv", "environment variable name should be a string")
        return _nil()
    }
}

function _load(fn,       my_tokens, my_where, my_inside_string, my_to_eval) {
    # arrays
    delete my_tokens
    delete my_where
    delete my_inside_string
    delete my_to_eval
    if(_TYPE[fn] == "s") {
        # eval_read_str appears to work with multiple forms, but not
        # partial forms across calls. scarcely surprising.
        while((getline < _STRING[fn]) > 0) {
            tokenize($0, my_tokens, my_where, my_inside_string)
            read_forms_into(my_to_eval, my_tokens, my_where, my_inside_string)
            _just_eval_all(my_to_eval)      # may not contain anything
            delete my_to_eval
        }
        _incomplete_parse_at_end(my_tokens, my_where, my_inside_string)
        close(fn)
        return _true()
    } else {
        logg_err("_load", "filename to load from should be a string")
        return _nil()
    }
}