resty

#!/usr/bin/env perl

# Copyright (C) Yichun Zhang (agentzh)
# Copyright (C) Guanlan Dai

# TODO: port this script into the nginx core for greater flexibility
# and better performance.

# for maximum startup speed
#use strict;
#use warnings;

sub split_sh_args ($);
sub join_sh_args ($);
sub resolve_includes ($$);

our $VERSION = '0.29';

# OpenResty's build system would patch the following line to initialize
# the $nginx_path variable to point to the path of its own nginx binary
# directly.
my $nginx_path;

my $WNOHANG = 1;

my $is_win32 = ($^O eq 'MSWin32');
#$is_win32 = 1;

my $cwd;

my @all_args = @ARGV;

my (@http_confs, @stream_confs, @http_includes, @main_confs, @main_includes,
    @shdicts, @ns, @src_a);

my $errlog_level = "warn";
my ($use_gdb, $use_valgrind, $use_rr, $version, $gdb_opts, $user_runner);
my ($use_stap, $stap_opts);
my ($conns_num, @inc_dirs, $jit_dumper, $valgrind_opts, $resolve_ipv6);
my $lua_shared_dicts = '';
my $no_stream;

{
    # Note: we do not use external modules like Getopt::Long because we want
    # to maximum startup speed.
    my @args = @ARGV;
    my $nargs = @args;
    my $found_opts;
    while (@args) {
        my $arg = shift @args;

        if ($arg =~ /^-/) {
            $found_opts = 1;

            if ($arg eq '-I') {
                my $v = shift @args;
                if (!defined $v) {
                    die "option -I takes an argument but found none.\n";
                }
                push @inc_dirs, $v;
                next;
            }

            if ($arg =~ /^-I=?(.*)/) {
                push @inc_dirs, $1;
                next;
            }

            if ($arg eq '-e') {
                my $v = shift @args;
                if (!defined $v) {
                    die "option -e takes an argument but found none.\n";
                }
                push @src_a, $v;
                next;
            }

            if ($arg =~ /^-e=?(.*)/) {
                push @src_a, $1;
                next;
            }

            if ($arg eq '-l') {
                my $v = shift @args;
                if (!defined $v) {
                    die "option -l takes an argument but found none.\n";
                }

                my $quoted_lua_lib = quote_as_lua_str($v);
                my $lua = "require($quoted_lua_lib)";

                push @src_a, $lua;
                next;
            }

            if ($arg =~ /^-l=?(.*)/) {
                my $v = $1;
                my $quoted_lua_lib = quote_as_lua_str($v);
                my $lua = "require($quoted_lua_lib)";

                push @src_a, $lua;
                next;
            }

            if ($arg eq '-j') {
                if (defined $jit_dumper) {
                    die "duplicate -j option found.\n";
                }

                $jit_dumper = shift @args;
                if (!defined $jit_dumper) {
                    die "option -j takes an argument but found none.\n";
                }
                next;
            }

            if ($arg =~ /^-j=?(.*)/) {
                if (defined $jit_dumper) {
                    die "duplicate -j option found.\n";
                }

                $jit_dumper = $1;
                next;
            }

            if ($arg eq '-c') {
                $conns_num = shift @args;
                if (!defined $conns_num) {
                    die "option -c takes an argument but found none.\n";
                }
                next;
            }

            if ($arg =~ /^-c=?(.*)/) {
                $conns_num = $1;
                next;
            }

            if ($arg eq '--') {
                @ARGV = @args;
                last;
            }

            if ($arg =~ /^--ns=(.*)/) {
                push @ns, $1;
                next;
            }

            if ($arg eq '--ns') {
                my $v = shift @args;
                if (!defined $v) {
                    die "option --ns takes an argument but ",
                        "found none.\n";
                }
                push @ns, $v;
                next;
            }

            if ($arg =~ /^--shdict=(.*)/) {
                push @shdicts, $1;
                next;
            }

            if ($arg eq '--shdict') {
                my $v = shift @args;
                if (!defined $v) {
                    die "option --shdict takes an argument but ",
                        "found none.\n";
                }
                push @shdicts, $v;
                next;
            }

            if ($arg =~ /^--nginx=(.*)/) {
                $nginx_path = $1;
                next;
            }

            if ($arg eq '--nginx') {
                $nginx_path = shift @args;
                if (!defined $nginx_path) {
                    die "option --nginx takes an argument but ",
                        "found none.\n";
                }
                next;
            }

            if ($arg =~ /^--http-conf=(.*)/) {
                push @http_confs, $1;
                next;
            }

            if ($arg =~ /^--stream-conf=(.*)/) {
                push @stream_confs, $1;
                next;
            }

            if ($arg =~ /^--main-conf=(.*)/) {
                push @main_confs, $1;
                next;
            }

            if ($arg eq '--http-conf') {
                my $v = shift @args;
                if (!defined $v) {
                    die "option --http-conf takes an argument but ",
                        "found none.\n";
                }
                push @http_confs, $v;
                next;
            }

            if ($arg eq '--stream-conf') {
                my $v = shift @args;
                if (!defined $v) {
                    die "option --stream-conf takes an argument but ",
                        "found none.\n";
                }
                push @stream_confs, $v;
                next;
            }

            if ($arg eq '--main-conf') {
                my $v = shift @args;
                if (!defined $v) {
                    die "option --main-conf takes an argument but ",
                        "found none.\n";
                }
                push @main_confs, $v;
                next;
            }

            if ($arg =~ /^--http-include=(.*)/) {
                push @http_includes, $1;
                next;
            }

            if ($arg eq '--http-include') {
                my $v = shift @args;
                if (!defined $v) {
                    die "option --http-include takes an argument but ",
                        "found none.\n";
                }
                push @http_includes, $v;
                next;
            }

            if ($arg =~ /^--main-include=(.*)/) {
                push @main_includes, $1;
                next;
            }

            if ($arg eq '--main-include') {
                my $v = shift @args;
                if (!defined $v) {
                    die "option --main-include takes an argument but ",
                        "found none.\n";
                }
                push @main_includes, $v;
                next;
            }

            if ($arg =~ /^--valgrind-opts=(.*)/) {
                if (defined $valgrind_opts) {
                    die "ERROR: duplicate --valgrind-opts options\n";
                }

                $valgrind_opts = $1;
                $use_valgrind = 1;
                next;
            }

            if ($arg eq '--valgrind-opts') {
                if (defined $valgrind_opts) {
                    die "ERROR: duplicate --valgrind-opts options\n";
                }

                $valgrind_opts = shift @args;
                if (!defined $valgrind_opts) {
                    die "option --valgrind-opts takes an argument but ",
                        "found none.\n";
                }

                $use_valgrind = 1;
                next;
            }

            if ($arg =~ /^--errlog-level=(.*)/) {
                $errlog_level = $1;
                next;
            }

            if ($arg eq '--errlog-level') {
                $errlog_level = shift @args;
                if (!defined $errlog_level) {
                    die "option --errlog-level takes an argument but ",
                        "found none.\n";
                }
                next;
            }

            if ($arg eq '--resolve-ipv6') {
                $resolve_ipv6 = 1;
                next;
            }

            if ($arg =~ /^--user-runner=(.*)/) {
                if (defined $user_runner) {
                    die "ERROR: duplicate --odb options\n";
                }

                $user_runner = $1;
                next;
            }

            if ($arg eq '--user-runner') {
                if (defined $user_runner) {
                    die "ERROR: duplicate --user-runner options\n";
                }

                $user_runner = shift @args;
                if (!defined $user_runner) {
                    die "option --user-runner takes an argument but ",
                        "found none.\n";
                }
                next;
            }

            if ($arg eq '--stap') {
                $use_stap = 1;
                next;
            }

            if ($arg =~ /^--stap-opts=(.*)/) {
                if (defined $stap_opts) {
                    die "ERROR: duplicate --stap-opts options\n";
                }

                $stap_opts = $1;
                $use_stap = 1;
                next;
            }

            if ($arg eq '--stap-opts') {
                if (defined $stap_opts) {
                    die "ERROR: duplicate --stap-opts options\n";
                }

                $stap_opts = shift @args;
                if (!defined $stap_opts) {
                    die "option --stap-opts takes an argument but ",
                        "found none.\n";
                }

                $use_stap = 1;
                next;
            }

            if ($arg eq '--gdb') {
                $use_gdb = 1;
                next;
            }

            if ($arg =~ /^--gdb-opts=(.*)/) {
                if (defined $gdb_opts) {
                    die "ERROR: duplicate --gdb-opts options\n";
                }

                $gdb_opts = $1;
                $use_gdb = 1;
                next;
            }

            if ($arg eq '--gdb-opts') {
                if (defined $gdb_opts) {
                    die "ERROR: duplicate --gdb-opts options\n";
                }

                $gdb_opts = shift @args;
                if (!defined $gdb_opts) {
                    die "option --gdb-opts takes an argument but ",
                        "found none.\n";
                }

                $use_gdb = 1;
                next;
            }

            if ($arg eq '--valgrind') {
                $use_valgrind = 1;
                next;
            }

            if ($arg eq '--no-stream') {
                $no_stream = 1;
                next;
            }

            if ($arg eq '--rr') {
                $use_rr = 1;
                next;
            }

            if ($arg =~ /^(?:--help|-h)$/) {
                usage(0);
                last;
            }

            if ($arg =~ /^-[vV]$/) {
                $version = 1;
                next;
            }

            warn "ERROR: unknown option $arg\n\n";
            usage(1);

        } else {
            last if !$found_opts;
            unshift @args, $arg;
            last;
        }
    }

    if ($found_opts) {
        @ARGV = @args;
    }

    if (defined $conns_num) {
        if ($conns_num !~ /^\d+$/) {
            die "option -c value must be a number but found ",
                "'$conns_num'.\n";
        }
    }

    if (defined $errlog_level) {
        if ($errlog_level !~ /^[a-z]+$/) {
            die "bad --errlog-level option value: $errlog_level";
        }
    }

    if (@ns) {
        for my $v (@ns) {
            if ($v !~ /^ (?: \d{1,3} (?: \. \d{1,3} ){3}
                             | \[ [0-9a-fA-F:]+ \] ) $/x)
            {
                die "ERROR: Invalid --ns option value: $v\n",
                    "  (expecting an IP address)\n";
            }
        }
    }

    if (@shdicts) {
        for my $v (@shdicts) {
            if ($v !~ /^ [_a-zA-Z0-9]+ \s+ \d+ (?i) [km]? $/x) {
                die "ERROR: invalid --shdict option value: $v\n",
                    "  (expecting NAME SIZE)\n";
            }

            $lua_shared_dicts .= "lua_shared_dict $v;\n";
        }
    }
}

if (defined $jit_dumper) {
    if ($jit_dumper eq 'v') {
        unshift @src_a, 'require "jit.v".on()';

    } elsif ($jit_dumper eq 'dump') {
        unshift @src_a, 'require "jit.dump".on()';

    } elsif ($jit_dumper eq 'off') {
        unshift @src_a, 'require "jit".off()';

    } else {
        warn "ERROR: unknown -j option value: $jit_dumper.\n";
        usage(1);
    }
}

#warn join ";", @src_a;

my $src;
if (@src_a) {
    $src = join '; ', @src_a;
}

if (!$nginx_path) {
    require FindBin;
    require Config;
    die if !%Config::Config;
    my $ext = $Config::Config{_exe};
    if (!$ext) {
        if ($^O eq 'msys') {
            $ext = '.exe';
        } else {
            $ext = '';
        }
    }

    if ($is_win32) {
        $nginx_path = File::Spec->catfile($FindBin::RealBin, "..", "nginx",
                                          "sbin", "nginx$ext");

    } else {
        $nginx_path = "$FindBin::RealBin/../nginx/sbin/nginx$ext";
    }

    if (!-f $nginx_path) {
        if ($is_win32) {
            $nginx_path = File::Spec->catfile($FindBin::RealBin, "nginx$ext");

        } else {
            $nginx_path = "$FindBin::RealBin/nginx$ext";
        }

        if (!-f $nginx_path) {
            $nginx_path = "nginx";  # find in PATH
        }
    }
}

#warn $nginx_path;

if ($version) {
    warn "resty $VERSION\n";
    my $cmd = "$nginx_path -V";
    exec $cmd or die "Failed to run command \"$cmd\": $!\n";
}

my $lua_package_path_config = '';
if (@inc_dirs) {
    my $package_path = "";
    my $package_path2 = "";
    my $package_cpath = "";
    for my $dir (@inc_dirs) {
        #if (!-d $dir) {
            #die "Search directory $dir is not found.\n";
            #next;
        #}

        if ($is_win32) {
            $package_path .= File::Spec->catfile($dir, "?.ljbc;");
            $package_path .= File::Spec->catfile($dir, "?.lua;");
            $package_path2 .= File::Spec->catfile($dir, "?/init.ljbc;");
            $package_path2 .= File::Spec->catfile($dir, "?/init.lua;");
            $package_cpath .= File::Spec->catfile($dir, "?.so;");

        } else {
            $package_path .= "$dir/?.ljbc;$dir/?.lua;$dir/?/init.ljbc;$dir/?/init.lua;";
            $package_cpath .= "$dir/?.so;";
        }
    }

    $lua_package_path_config = <<_EOC_;

    lua_package_path "$package_path;";
    lua_package_cpath "$package_cpath;";
_EOC_
}

my $luafile = shift;
if (!defined $src and !defined $luafile) {
    die qq{Neither Lua input file nor -e "" option specified.\n};
}

my $conns = $conns_num || 64;

my @nameservers;

if (@ns > 0) {
    unshift @nameservers, @ns;

} else {
    # try to read the nameservers used by the system resolver:
    if (open my $in, "/etc/resolv.conf") {
        while (<$in>) {
            if (/^\s*nameserver\s+(\d+(?:\.\d+){3})(?:\s+|$)/) {
                unshift @nameservers, $1;
                if (@nameservers > 10) {
                    last;
                }
            }
        }
        close $in;
    }
}

if (!@nameservers) {
    # default to Google's open DNS servers
    unshift @nameservers, "8.8.8.8", "8.8.4.4";
}

if (!$resolve_ipv6) {
    push @nameservers, "ipv6=off";
}

#warn "@nameservers\n";

my $prefix_dir;
if ($^O eq 'msys') {
    # to work around a bug in msys perl (at least 5.8.8 msys 64int)
    $prefix_dir = "resty_cli_temp";
    if (-d $prefix_dir) {
        system("rm -rf $prefix_dir") == 0 or die $!;
    }
    mkdir $prefix_dir or die "failed to mkdir $prefix_dir: $!";

} else {
    if ($is_win32 || !-d '/tmp') {
        require File::Temp;
        $prefix_dir = File::Temp::tempdir(CLEANUP => 1);

        if ($^O eq 'MSWin32') {
            require Win32;
            $prefix_dir = Win32::GetLongPathName($prefix_dir);
        }

    } else {
        my $tmpdir = '/tmp/resty_';
        my $N = 1000;

        for (my $i = 0; $i < $N; $i++) {
            my $name;
            for (my $j = 0; $j < 10; $j++) {
                my $code = 65 + int rand 26;
                if (int rand 2 == 0) {
                    $code += 32;
                }

                $name .= chr $code;
            }

            my $dir = $tmpdir . $name;
            next if -d $dir;

            mkdir $dir or die "Cannot mkdir $dir: $!\n";
            $prefix_dir = $dir;
            last;
        }

        if (!defined $prefix_dir) {
            die "failed to derive a random temp directory name after $N ",
                "attempts\n";
        }
    }
}
#warn "prefix dir: $prefix_dir\n";

my $child_pid;

END {
    if (!$is_win32 && defined($child_pid) && defined $prefix_dir) {
        my $saved_status = $?;
        system("rm -rf $prefix_dir") == 0
            or warn "failed to remove temp directory $prefix_dir: $!";
        $? = $saved_status;  # restore the exit code
    }
}

my $logs_dir;
if ($is_win32) {
    $logs_dir = File::Spec->catfile($prefix_dir, "logs");

} else {
    $logs_dir = "$prefix_dir/logs";
}
mkdir $logs_dir or die "failed to mkdir $logs_dir: $!";

my $conf_dir;
if ($is_win32) {
    $conf_dir = File::Spec->catfile($prefix_dir, "conf");

} else {
    $conf_dir = "$prefix_dir/conf";
}
mkdir $conf_dir or die "failed to mkdir $conf_dir: $!";

my $inline_lua = '';
my $quoted_luafile;
if (defined $src) {
    my $file;
    if ($is_win32) {
        $file = File::Spec->catfile($conf_dir, "a.lua");

    } else {
        $file = "$conf_dir/a.lua";
    }

    open my $out, ">$file"
        or die "Cannot open $file for writing: $!\n";
    print $out $src;
    close $out;
    my $chunk_name = "=(command line -e)";
    $quoted_luafile = quote_as_lua_str($file);

    $inline_lua = <<"_EOC_";
                local fname = $quoted_luafile
                local f = assert(io.open(fname, "r"))
                local chunk = f:read("*a")
                local inline_gen = assert(loadstring(chunk, "$chunk_name"))
_EOC_
}

my $file_lua = '';
if (defined $luafile) {
    if (!-e $luafile) {
        die "Lua input file $luafile not found.\n";
    }

    my $chunk_name = quote_as_lua_str("\@$luafile");
    $quoted_luafile = quote_as_lua_str($luafile);
    $file_lua = <<"_EOC_";
                local fname = $quoted_luafile
                local f = assert(io.open(fname, "r"))
                local chunk = f:read("*a")
                local file_gen = assert(loadstring(chunk, $chunk_name))
_EOC_
}

my @user_args =  @ARGV;
my $args = gen_lua_code_for_args(\@user_args, \@all_args);

my $loader = <<_EOC_;
            local gen
            do
                $args
$inline_lua
$file_lua

                gen = function()
                  if inline_gen then inline_gen() end
                  if file_gen then file_gen() end
                end
            end
_EOC_

my $env_list = '';
for my $var (sort keys %ENV) {
    #warn $var;
    $env_list .= "env $var;\n";
}

my $main_include_directives = resolve_includes 'main', \@main_includes;
my $http_include_directives = resolve_includes 'http', \@http_includes;

my $http_conf_lines = join "", map { "    $_\n" } @http_confs;
my $stream_conf_lines = join "", map { "    $_\n" } @stream_confs;
my $main_conf_lines = join "", map { "    $_\n" } @main_confs;

my $conf_file;
if ($is_win32) {
    $conf_file = File::Spec->catfile($conf_dir, "nginx.conf");

} else {
    $conf_file = "$conf_dir/nginx.conf";
}

open my $out, ">$conf_file"
    or die "Cannot open $conf_file for writing: $!\n";

print $out <<_EOC_;
daemon off;
master_process off;
worker_processes 1;
pid logs/nginx.pid;

$env_list

error_log stderr $errlog_level;
#error_log stderr debug;

events {
    worker_connections $conns;
}

$main_conf_lines
$main_include_directives
_EOC_

if (!$no_stream) {
    print $out <<_EOC_;

stream {
    access_log off;
    lua_socket_log_errors off;
    resolver @nameservers;
    lua_regex_cache_max_entries 40960;
$lua_package_path_config
$stream_conf_lines
}
_EOC_
}

print $out <<_EOC_;

http {
    access_log off;
    lua_socket_log_errors off;
    resolver @nameservers;
    lua_regex_cache_max_entries 40960;
    $lua_shared_dicts
$lua_package_path_config
$http_conf_lines
    $http_include_directives
    init_by_lua_block {
        ngx.config.is_console = true

        local stdout = io.stdout
        local ngx_null = ngx.null
        local maxn = table.maxn
        local unpack = unpack
        local concat = table.concat

        local expand_table
        function expand_table(src, inplace)
            local n = maxn(src)
            local dst = inplace and src or {}
            for i = 1, n do
                local arg = src[i]
                local typ = type(arg)
                if arg == nil then
                    dst[i] = "nil"

                elseif typ == "boolean" then
                    if arg then
                        dst[i] = "true"
                    else
                        dst[i] = "false"
                    end

                elseif arg == ngx_null then
                    dst[i] = "null"

                elseif typ == "table" then
                    dst[i] = expand_table(arg, false)

                elseif typ ~= "string" then
                    dst[i] = tostring(arg)

                else
                    dst[i] = arg
                end
            end
            return concat(dst)
        end

        local function output(...)
            local args = {...}

            return stdout:write(expand_table(args, true))
        end

        ngx.orig_print = ngx.print
        ngx.print = output

        ngx.orig_say = ngx.say
        ngx.say = function (...)
                local ok, err = output(...)
                if ok then
                    return output("\\n")
                end
                return ok, err
            end
        print = ngx.say

        ngx.flush = function (...) return stdout:flush() end
        -- we cannot close stdout here due to a bug in Lua:
        ngx.eof = function (...) return true end
        ngx.orig_exit = ngx.exit
        ngx.exit = os.exit
    }

    init_worker_by_lua_block {
        local exit = os.exit
        local stderr = io.stderr
        local ffi = require "ffi"

        local function handle_err(err)
            if err then
                err = string.gsub(err, "^init_worker_by_lua:%d+: ", "")
                stderr:write("ERROR: ", err, "\\n")
            end
            return exit(1)
        end

        local ok, err = pcall(function ()
            if not ngx.config
               or not ngx.config.ngx_lua_version
               or ngx.config.ngx_lua_version < 10009
            then
                error("at least ngx_lua 0.10.9 is required")
            end

            local signal_graceful_exit =
                require("ngx.process").signal_graceful_exit
            if not signal_graceful_exit then
                error("lua-resty-core library is too old; "
                      .. "missing the signal_graceful_exit() function "
                      .. "in ngx.process")
            end

$loader
            -- print("calling timer.at...")
            local ok, err = ngx.timer.at(0, function ()
                -- io.stderr:write("timer firing")
                local ok, err = xpcall(gen, function (err)
                    -- level 3: we skip this function and the
                    -- error() call itself in our stacktrace
                    local trace = debug.traceback(err, 3)
                    return handle_err(trace)
                end)
                if not ok then
                    return handle_err(err)
                end
                if ffi.abi("win") then
                    return exit(0)
                end
                signal_graceful_exit()
            end)
            if not ok then
                return handle_err(err)
            end
            -- print("timer created")
        end)

        if not ok then
            return handle_err(err)
        end
    }
}
_EOC_

close $out;

my $label;
if (defined $src) {
    $label = "-e '$src'";
    if (defined $luafile) {
        $label .= " $luafile";
    }
} else {
    $label = $luafile;
}

$label =~ s/[\r\n]//g;
my @cmd = ($nginx_path,
           '-g', '# ' . $label,
           '-p', "$prefix_dir/", '-c', "conf/nginx.conf");

if ($use_gdb) {
    if ($use_valgrind) {
        die "ERROR: options --gdb and --valgrind cannot be specified at the ",
            "same time.\n";
    }

    if ($use_rr) {
        die "ERROR: options --gdb and --rr cannot be specified at the ",
            "same time.\n";
    }

    if ($use_stap) {
        die "ERROR: options --gdb and --stap cannot be specified at the ",
            "same time.\n";
    }

    #warn "use gdb opts: $gdb_opts";

    unshift @cmd, "gdb", defined $gdb_opts ? (split_sh_args $gdb_opts) : (),
                  "--args",

} elsif ($use_rr) {
    if ($use_valgrind) {
        die "ERROR: options --rr and --valgrind cannot be specified at the ",
            "same time.\n";
    }

    if ($use_stap) {
        die "ERROR: options --rr and --stap cannot be specified at the ",
            "same time.\n";
    }

    unshift @cmd, "rr", "record",

} elsif ($use_stap) {
    if ($use_valgrind) {
        die "ERROR: options --stap and --valgrind cannot be specified at the ",
            "same time.\n";
    }

    @cmd = ("stap", defined $stap_opts ? (split_sh_args $stap_opts) : (),
            '-c', join_sh_args \@cmd);

} elsif ($use_valgrind) {
    my @new = ('valgrind');
    if (defined $valgrind_opts) {
        push @new, split_sh_args $valgrind_opts;
    }

    unshift @cmd, @new;

} elsif (defined $user_runner) {
    unshift @cmd, split_sh_args $user_runner;
    #warn "cmd: @cmd";
}

for my $sig (qw/ INT TERM QUIT HUP USR1 USR2 WINCH PIPE /) {
    $SIG{$sig} = \&forward_signal;
}

my $pid = fork();

if (!defined $pid) {
    die "fork() failed: $!\n";
}

if ($pid == 0) {  # child process
    #use Data::Dumper;
    #warn "exec ", Dumper \@cmd;
    #warn "exec [@cmd]...";
    exec(@cmd)
        or die "ERROR: failed to run command \"@cmd\": $!\n";

} else {
    $child_pid = $pid;
    waitpid($child_pid, 0);
    my $rc = 0;
    if ($?) {
        $rc = ($? >> 8);
        if ($rc == 0) {
            $rc = $?;
        }
    }
    exit $rc;
}

sub usage {
    my $rc = shift;
    my $msg = <<_EOC_;
resty [options] [lua-file [args]]

Options:
    -c NUM              Set maximal connection count (default: 64).
    -e PROG             Run the inlined Lua code in "prog".

    --errlog-level LEVEL
                        Set nginx error_log level.
                        Can be debug, info, notice, warn, error, crit, alert,
                        or emerg.

    --gdb               Use GDB to run the underlying nginx C process.

    --gdb-opts OPTS     Pass extra command-line options to GDB.

    --help              Print this help.

    --http-conf CONF    Specifies nginx.conf snippet inserted into the http {}
                        configuration block (multiple instances are supported).

    --http-include PATH Include the specified file in the nginx http
                        configuration block (multiple instances are supported).

    -I DIR              Add dir to the search paths for Lua libraries.

    -j dump             Use LuaJIT's jit.dump module to output detailed info of
                        the traces generated by the JIT compiler.

    -j off              Turn off the LuaJIT JIT compiler.

    -j v                Use LuaJIT's jit.v module to output brief info of the
                        traces generated by the JIT compiler.

    -l LIB              Require library "lib".

    --main-conf CONF    Specifies nginx.conf snippet inserted into the nginx
                        main {} configuration block (multiple instances are
                        supported).

    --main-include PATH Include the specified file in the nginx main
                        configuration block (multiple instances are supported).

    --nginx             Specify the nginx path (this option might be removed
                        in the future).

    --no-stream         Disable the stream {} configuration in auto-generated
                        nginx.conf.

    --ns IP             Specify a custom name server (multiple instances are
                        supported).

    --resolve-ipv6      Make the nginx resolver lookup both IPv4 and IPv6
                        addresses.

    --rr                Use Mozilla rr to record the execution of the
                        underlying nginx C process.

    --shdict 'NAME SIZE'
                        Create the specified lua shared dicts in the http
                        configuration block (multiple instances are supported).

    --stap
                        Use sysetmtap to run the underlying nginx C process.

    --stap-opts OPTS
                        Pass extra systemtap command line options.

    --user-runner CMD   Use CMD as user runner for the underlying nginx process.

    -V                  Print version numbers and nginx configurations.

    --valgrind          Use valgrind to run nginx.

    --valgrind-opts OPTS
                        Pass extra options to valgrind.

For bug reporting instructions, please see:

    <https://openresty.org/en/community.html>

Copyright (C) Yichun Zhang (agentzh). All rights reserved.
_EOC_
    if ($rc == 0) {
        print $msg;
        exit(0);
    }

    warn $msg;
    exit($rc);
}

sub get_bracket_level {
    my %bracket_levels;
    my $bracket_level = 0;
    my $max_level = 0;

    # scan all args and store level of closing brackets
    for my $arg (@_) {
        while ($arg =~ /\](=*)\]/g) {
            my $level = length($1);
            if ($level > $max_level) {
                $max_level = $level;
            }
            $bracket_levels{$level} = 1;
        }
    }

    # if args contain closing bracket
    if (%bracket_levels) {
        # find the shortest form of the long brackets accordingly
        for (my $i = 1; $i < $max_level; $i++) {
            if (!exists $bracket_levels{$i}) {
                $bracket_level = $i;
                last;
            }
        }

        if ($bracket_level == 0) {
            $bracket_level = $max_level + 1;
        }
        return $bracket_level;
    }
    return 1;
}

sub quote_as_lua_str {
    my ($str) = @_;
    my $bracket_level = get_bracket_level($str);
    my $left_bracket = "[" . "=" x $bracket_level . "[";
    my $right_bracket = "]" . "=" x $bracket_level . "]";

    return $left_bracket . $str . $right_bracket;
}

sub gen_lua_code_for_args {
    my ($user_args, $all_args) = @_;

    my $luasrc = "arg = {}\n";

    # arg[n] (n = 0)
    $luasrc .= "arg[0] = $quoted_luafile\n";

    # arg[n] (n > 0)
    for my $i (0 .. $#user_args) {
        my $index = $i + 1;
        my $quoted_arg = quote_as_lua_str($user_args[$i]);
        $luasrc .= "arg[$index] = $quoted_arg\n";
    }

    my $left_num = $#all_args - $#user_args;

=begin cmt

    # arg[n] (n < 0)
    for my $i (0 .. $left_num - 2) {
        my $index = 0 - $left_num + $i + 1;
        my $quoted_arg = quote_as_lua_str($all_args[$i]);
        $luasrc .= "arg[$index] = $quoted_arg\n";
    }

=end cmt

=cut

    # args[n] (n = the index of resty-cli itself)
    my $index = 0 - $left_num;
    my $quoted_arg = quote_as_lua_str($0);
    $luasrc .= "arg[$index] = $quoted_arg\n";

    #warn $luasrc;
    return $luasrc;
}

sub resolve_includes ($$) {
    my ($type, $paths) = @_;

    if (!defined $cwd) {
        if ($is_win32) {
            require File::Spec;

        } else {
            $cwd = `pwd`;
            if (!$cwd || $?) {
                require Cwd;
                $cwd = Cwd::cwd();

            } else {
                chomp $cwd;
            }
        }
    }

    my $s = '';
    for my $path (@$paths) {
        if (!-f $path) {
          die "ERROR: could not find $type include file '$path'";
        }

        my $abs_path;
        if ($is_win32) {
            $abs_path = File::Spec->rel2abs($path);

        } elsif ($path =~ m{^/}) {
            $abs_path = $path;

        } else {
            $abs_path = "$cwd/$path";
        }

        $s .= "include $abs_path;";
    }

    return $s;
}

sub forward_signal {
    my $signame = shift;

    if ($signame eq 'HUP') {
        $signame = 'QUIT';
    }

    if ($child_pid) {
        #warn "killing $child_pid with $signame ...\n";

        my $loaded_time_hires;

        if ($signame eq 'INT' || $signame eq 'PIPE') {
            # Note: we use eval here just because explicit use of %!
            # would trigger auto-loading of the Errno module, which
            # hurts script startup time.
            eval q#
                if (kill(QUIT => $child_pid) == 0) {
                    if (not $!{ESRCH}) {
                        die "failed to send QUIT signal to process ",
                            "$child_pid: $!";
                    }
                }
            #;
            if ($@) {
                die "failed to eval: $@";
            }

            require Time::HiRes;
            $loaded_time_hires = 1;

            Time::HiRes::sleep(0.1);

            kill KILL => $child_pid;
            exit($signame eq 'INT' ? 130 : 141);

        } else {
            # Note: we use eval here just because explicit use of %!
            # would trigger auto-loading of the Errno module, which
            # hurts script startup time.
            eval q#
                if (kill($signame => $child_pid) == 0) {
                    if (not $!{ESRCH}) {
                        die "failed to send $signame signal to process ",
                            "$child_pid: $!";
                    }
                }
            #;
            if ($@) {
                die "failed to eval: $@";
            }
        }

        if (!$loaded_time_hires) {
            require Time::HiRes;
        }

        my $nap = 0.001;
        my $total_nap = 0;
        while ($total_nap < 0.1) {
            #warn "sleeping $nap";
            $nap *= 1.5;
            $total_nap += $nap;

            Time::HiRes::sleep($nap);

            # Note: we use eval here just because explicit use of %!
            # would trigger auto-loading of the Errno module, which
            # hurts script startup time.

            my ($ret, $echild);
            eval qq#
                \$ret = waitpid \$child_pid, $WNOHANG;
                \$echild = \$!{ECHILD};
            #;
            if ($@) {
                die "failed to eval: $@";
            }

            next if $ret == 0;
            exit 0 if $echild;
            if ($ret < 0) {
                die "failed to wait on child process $child_pid: $!";
            }

            my $rc = 0;
            if ($signame eq 'INT') {
                $rc = 130;

            } elsif ($signame eq 'TERM') {
                $rc = 143;
            }

            if ($?) {
                $rc = ($? >> 8);
                if ($rc == 0) {
                    $rc = $?;
                }
            }
            exit $rc;
        }
    }
}

sub join_sh_args ($) {
    my $args = shift;
    my @args = @$args;
    for (@args) {
        s/([\\\s'"><`\[\]\&\$#*?!()|;])/\\$1/g;
    }
    return join " ", @args;
}

sub split_sh_args ($) {
    my $s = shift;

    my @cmd;
    while (1) {
        if ($s =~ /\G (\s*) "([^"]*)" /gmscx) {
            my ($sep, $v) = ($1, $2);
            #warn "sep: [$sep], v: [$v]";
            if (!$sep && @cmd) {
                $cmd[-1] .= $v;

            } else {
                push @cmd, $v;
            }

        } elsif ($s =~ /\G (\s*) '([^']*)' /gmscx) {
            my ($sep, $v) = ($1, $2);
            #warn "sep: [$sep], v: [$v]";
            if (!$sep && @cmd) {
                $cmd[-1] .= $v;

            } else {
                push @cmd, $v;
            }

        } elsif ($s =~ /\G (\s*) ( (?: \\. | [^\s'"\\]+ )+ ) /gmscx) {
            my ($sep, $v) = ($1, $2);
            #warn "sep: [$sep], v: [$v]";
            $v =~ s/\\(.)/$1/g;
            if (!$sep && @cmd) {
                $cmd[-1] .= $v;

            } else {
                push @cmd, $v;
            }

        } elsif ($s =~ /\G \s* (\S.*) /gmscx) {
            die "syntax error: $1";

        } else {
            last;
        }
    }

    #use Data::Dumper;
    #warn "cmd: ", Dumper \@cmd;
    return @cmd;
}