view release on metacpan or  search on metacpan

lib/PAX/StandaloneRuntime.pm  view on Meta::CPAN

        stopped   => '🚨',
        paused    => '🚨',
        insecure  => '🚨',
        reloading => '🚨',
        missing   => '🚨',
        error     => '🚨',
        dirty     => '🚨',
        down      => '🚨',
    },
};

sub _trace {
    return if !$ENV{PAX_STANDALONE_TRACE};
    my ($message) = @_;
    $message //= '';
    print STDERR "[pax-standalone] $message\n";
}

sub _capture_system_command {
    my (@command) = @_;
    my $exit_code = -1;
    my ($stdout, $stderr) = Capture::Tiny::capture {
        system @command;
        $exit_code = $? == -1 ? -1 : ($? >> 8);
    };
    return ($stdout, $stderr, $exit_code);
}

sub _system_command_missing {
    my ($stderr, $exit_code) = @_;
    return 1 if !defined $exit_code || $exit_code < 0 || $exit_code == 127;
    return 1 if defined $stderr && $stderr =~ /(?:can't exec|not found|no such file or directory)/i;
    return 0;
}

sub run {
    my ($class, %args) = @_;
    my $entrypoint = $args{entrypoint} // shift(@ARGV);
    _state();
    if (!defined $entrypoint || !_entrypoint_looks_valid($entrypoint)) {
        my $fallback = _resolve_entrypoint_from_manifest($entrypoint);
        if (defined $fallback) {
            _trace("entrypoint fallback from manifest: '" . ($entrypoint // '<undef>') . "' -> '$fallback'");
            $entrypoint = $fallback;
        }
    }
    die 'entrypoint required' if !defined $entrypoint;
    if (!_entrypoint_looks_valid($entrypoint)) {
        die "entrypoint is not a valid executable unit: $entrypoint";
    }
    my @argv = @{ $args{argv} // \@ARGV };
    my $self_path = _standalone_executable_path();
    _install_namespace_compat();
    _install_require_hook();
    _install_pending_wrappers();

    local $0 = $self_path if defined $self_path && $self_path ne '';
    if (@argv && $argv[0] eq '--pax-standalone-helper') {
        shift @argv;
        my $helper = shift @argv // die "standalone helper name required\n";
        local @ARGV = @argv;
        return _run_standalone_managed_helper($helper, @argv);
    }

    local @ARGV = @argv;
    my $rv = _run_entrypoint($entrypoint);

    _install_pending_wrappers();
    return $rv;
}

sub _entrypoint_looks_valid {
    my ($entrypoint) = @_;
    return 0 if !defined $entrypoint;
    return 0 if $entrypoint =~ /\A-/;
    return 0 if $entrypoint =~ /\A\s*\z/;
    return 1;
}

sub _resolve_entrypoint_from_manifest {
    my ($entrypoint) = @_;
    my $state = _state();
    my $manifest_entrypoint = $state->{manifest}{entrypoint}{logical_path} // '';
    if ($manifest_entrypoint ne '') {
        my $candidate = File::Spec->catfile($state->{root}, 'code', split m{/}, $manifest_entrypoint);
        return $candidate if -f $candidate;
    }
    my @unit_candidates = grep {
        my $unit = $_;
        my $unit_kind = $unit->{unit_kind} // '';
        my $packaging = $unit->{packaging} // '';
        ($unit_kind // '') eq 'entrypoint' || ($packaging // '') =~ /\A(compiled|hybrid|residual)_(?:dispatch|cli_router|script)_pcu_v1\z/;
    } @{ $state->{manifest}{code_units} // [] };
    for my $unit (@unit_candidates) {
        my $logical = $unit->{logical_path} // '';
        next if $logical eq '';
        my $candidate = File::Spec->catfile($state->{root}, 'code', split m{/}, $logical);
        return $candidate if -f $candidate;
    }
    return;
}

sub _state {
    return $STATE if $STATE;
    my $manifest_path = $ENV{PAX_STANDALONE_MANIFEST_PATH} or die 'PAX_STANDALONE_MANIFEST_PATH not set';
    open my $fh, '<', $manifest_path or die "cannot read $manifest_path: $!";
    local $/;
    my $manifest = _runtime_json_decode(<$fh>);
    my $root = $ENV{PAX_STANDALONE_TMPDIR} or die 'PAX_STANDALONE_TMPDIR not set';
    my $app_namespace = _normalize_namespace($manifest->{app}{namespace} // '');
    if (!$app_namespace) {
        $app_namespace = _normalize_namespace($manifest->{app}{compat}{namespace} // '');
    }
    my $legacy_namespace = _normalize_namespace($manifest->{app}{compat}{legacy_namespace} // '');
    $legacy_namespace = $app_namespace if $legacy_namespace eq '';
    my %by_region = map { ($_->{region_name} // '') => $_ } @{ $manifest->{native_dispatch} // [] };
    my %compiled_packages;
    my %compiled = map {
        my $key = $_->{require_path} // '';
        length($key) ? ($key => $_) : ()
    } grep {
        my $packaging = $_->{packaging} // '';
        (($packaging eq 'compiled_pcu_v1') || ($packaging eq 'hybrid_compiled_pcu_v1'))
    } @{ $manifest->{code_units} // [] };
    for my $unit (@{ $manifest->{code_units} // [] }) {

lib/PAX/StandaloneRuntime.pm  view on Meta::CPAN

    my $class = _standalone_internal_cli_class() or return;
    _load_package_by_module_name($class);
    my $full = $class . '::helper_content';
    return if !defined &{$full};
    local $ENV{PAX_STANDALONE_EXECUTABLE} = '';
    no strict 'refs';
    my $content = &{$full}($name);
    return if !defined $content || $content eq '';
    return ($content, $name);
}

sub _standalone_embedded_asset_path {
    my ($name) = @_;
    return if !defined $name || $name eq '';
    my $state = _state();
    for my $asset (@{ $state->{manifest}{assets} // [] }) {
        next if ref($asset) ne 'HASH';
        my $logical = $asset->{logical_path} // '';
        next if $logical eq '';
        next if $logical ne $name && $logical !~ m{(?:^|/)\Q$name\E\z};
        my $path = File::Spec->catfile($state->{root}, 'assets', split m{/}, $logical);
        return $path if -f $path;
    }
    return;
}

sub _share_dist_private_cli_dir {
    my ($dist_name) = @_;
    return if !defined $dist_name || $dist_name eq '';
    my $ok = eval {
        require File::ShareDir;
        1;
    };
    return if !$ok;
    my $root = eval { File::ShareDir::dist_dir($dist_name) };
    return if !$root || !-d $root;
    my $candidate = File::Spec->catdir($root, 'private-cli');
    return -d $candidate ? $candidate : undef;
}

sub _run_standalone_managed_helper {
    my ($helper, @argv) = @_;
    my ($helper_source, $helper_path) = _standalone_internal_cli_asset_content($helper);
    die "standalone managed helper '$helper' is unavailable\n" if !defined $helper_source || $helper_source eq '';
    my $self_path = _standalone_executable_path();
    local $ENV{DEVELOPER_DASHBOARD_ENTRYPOINT} = $self_path if defined $self_path && $self_path ne '';
    my ($source, $path, @helper_argv);
    if ($helper eq '_dashboard-core' || _standalone_helper_delegates_to_dashboard_core($helper_source)) {
        my ($core_source, $core_path) = _standalone_internal_cli_asset_content('_dashboard-core');
        die "standalone managed helper core is unavailable\n" if !defined $core_source || $core_source eq '';
        $source = $core_source;
        $path = $core_path;
        @helper_argv = @argv;
        unshift @helper_argv, $helper if $helper ne '_dashboard-core';
    }
    else {
        $source = $helper_source;
        $path = $helper_path;
        @helper_argv = @argv;
    }
    local @ARGV = @helper_argv;
    local $0 = $path if defined $path && $path ne '';
    my $wrapped = "package main;\n#line 1 \"$path\"\n" . $source;
    my $rv = eval $wrapped;
    die $@ if $@;
    return 0 if !defined $rv;
    return $rv;
}

sub _direct_standalone_helper_name_from_path {
    my ($path) = @_;
    return if !defined $path || $path eq '';
    my $name = basename($path);
    return if !defined $name || $name eq '';
    return $name;
}

sub _standalone_helper_delegates_to_dashboard_core {
    my ($source) = @_;
    return 0 if !defined $source || $source eq '';
    return 1 if $source =~ /_dashboard-core/
        && $source =~ /basename\(\$0\)/
        && $source =~ /exec\s+\{\s*\$\^X\s*\}\s+\$\^X,\s+\$core,\s+\$command,\s+\@ARGV;/s;
    return 0;
}

sub _install_pending_wrappers {
    my $state = _state();
    for my $full (sort keys %{ $state->{by_region} }) {
        next if $state->{wrapped}{$full};
        next if !$full || ($full !~ /::/);
        my $cv = _code_for($full) or next;
        my $meta = $state->{by_region}{$full};
        next if !$meta->{executable_logical_path};
        my $original = $cv;
        no strict 'refs';
        no warnings 'redefine';
        *{$full} = sub {
            my @args = @_;
            if (_eligible_i64_args(\@args)) {
                my $guard = PAX::GuardManager->new(
                    epochs => $state->{manifest}{runtime_epochs} // {},
                )->validate_or_deopt({
                    region_id => $meta->{region_id},
                    region_name => $meta->{region_name},
                    guards => $meta->{guards} // [],
                    deopt => $meta->{deopt} // {},
                }, args => [ @args[0, 1] ], context => 'scalar');

                if (($guard->{status} // '') eq 'native_allowed') {
                    my $probe = File::Spec->catfile($state->{root}, split m{/}, $meta->{executable_logical_path});
                    chmod 0700, $probe if -f $probe;
                    my $result = $state->{native_runner}->run_i64_binary(
                        path => $probe,
                        left => $args[0],
                        right => $args[1],
                    );
                    if (($result->{status} // '') eq 'ok' && defined $result->{value}) {
                        _log_native_hit($full);
                        return $result->{value};
                    }