Selkie.git | lib/Selkie/App/Internal/ | ErrorLog.rakumod

---

=begin pod

=head1 NAME

Selkie::App::Internal::ErrorLog - internal stderr redirection role for Selkie::App

=head1 DESCRIPTION

Implementation detail composed by C<Selkie::App>. Use C<Selkie::App.set-error-log>
or the C<error-log> constructor argument from application code.

=end pod

unit role Selkie::App::Internal::ErrorLog;

use NativeCall;
use Selkie::App::Internal::ErrorLogPlatform;

has Int $!saved-stderr-fd;
has IO::Handle $!saved-process-stderr;
has Pointer $!saved-windows-stderr-handle;
has Pointer $!windows-error-log-handle;
has Bool $!windows-stderr-synchronized = False;
has IO::Handle $!error-log-handle;

my constant INVALID-HANDLE-VALUE = -1;

my Lock $ERROR-LOG-LOCK .= new;

method !try-log(Str:D $step, &block) {
    block();
    CATCH {
        default {
            my $msg = .message;
            my $bt  = .?backtrace.?full.?Str // '';
            try $*ERR.say("[shutdown:$step] $msg");
            try $*ERR.say($bt) if $bt;
        }
    }
}

method !close-error-log-handle(--> Nil) {
    if $!error-log-handle {
        try $!error-log-handle.close;
        $!error-log-handle = Nil;
    }
}

method !replace-process-stderr(IO::Handle:D $handle --> Nil) {
    $!saved-process-stderr = PROCESS::<$ERR>;
    # Preserve Rakudo's process-level Scalar. Binding the symbol with := to a
    # method parameter or attribute container gives PROCESS::<$ERR> that
    # container's lifetime and can hang Windows during write or finalization.
    PROCESS::<$ERR> = $handle;
}

method !restore-process-stderr(--> Nil) {
    if $!saved-process-stderr.defined {
        PROCESS::<$ERR> = $!saved-process-stderr;
        $!saved-process-stderr = IO::Handle;
    }
}

method !install-error-log-unlocked(Str:D $path --> Nil) {
    my Str $clean-path = $path.trim;
    return if $clean-path.chars == 0;

    my $parent = $clean-path.IO.parent;
    try $parent.mkdir unless $parent.e;

    my $handle = try open $clean-path, :a;
    return unless $handle;
    $!error-log-handle = $handle;

    my $banner = "=== session {DateTime.now.truncated-to('second')} ===\n";
    try $handle.print($banner);
    try $handle.flush;

    if IS-WINDOWS {
        # MoarVM is built /MT on official Windows Rakudo releases, giving it
        # a private CRT descriptor table.  Passing native-descriptor to
        # ucrtbase._dup2 corrupts a different table and can close the kernel
        # handle cached behind MoarVM's fd 2.  Redirect the Raku object and
        # the Win32 standard-handle table independently instead.
        my $saved-windows-handle = try windows-get-std-handle(
            WINDOWS-STD-ERROR-HANDLE,
        );
        my $log-windows-handle = try windows-create-file(
            $clean-path.IO.absolute.Str,
            WINDOWS-FILE-APPEND-DATA +| WINDOWS-SYNCHRONIZE,
            WINDOWS-FILE-SHARE-ALL,
            Pointer,
            WINDOWS-OPEN-ALWAYS,
            WINDOWS-FILE-ATTRIBUTE-NORMAL,
            Pointer,
        );
        my $synchronized = $saved-windows-handle.defined
            && $saved-windows-handle.Int != INVALID-HANDLE-VALUE
            && $log-windows-handle.defined
            && $log-windows-handle.Int != INVALID-HANDLE-VALUE
            && $log-windows-handle.Int != 0
            && (try windows-set-std-handle(
                WINDOWS-STD-ERROR-HANDLE,
                $log-windows-handle,
            ));

        unless $synchronized {
            try windows-close-handle($log-windows-handle)
                if $log-windows-handle.defined
                    && $log-windows-handle.Int != INVALID-HANDLE-VALUE
                    && $log-windows-handle.Int != 0;
            self!close-error-log-handle;
            return;
        }

        $!saved-windows-stderr-handle = $saved-windows-handle;
        $!windows-error-log-handle = $log-windows-handle;
        $!windows-stderr-synchronized = True;
        self!replace-process-stderr($handle);
        return;
    }

    my $log-fd = $handle.native-descriptor;
    unless $log-fd.defined && $log-fd >= 0 {
        self!close-error-log-handle;
        return;
    }

    # NativeCall resolves lazily.  An optional error log must never prevent
    # the application from starting if a platform runtime is missing a
    # symbol, so thrown resolution/call failures and negative return codes
    # both take the same fail-open cleanup path.
    my $saved = try fd-dup(2);
    unless $saved.defined && $saved >= 0 {
        self!close-error-log-handle;
        return;
    }

    my $rc = try fd-dup2($log-fd, 2);
    unless $rc.defined && $rc >= 0 {
        try fd-close($saved);
        self!close-error-log-handle;
        return;
    }

    $!saved-stderr-fd = $saved;
}

method !install-error-log(Str:D $path --> Nil) {
    $ERROR-LOG-LOCK.protect: {
        self!install-error-log-unlocked($path);
    };
}

method !uninstall-error-log-unlocked(--> Nil) {
    if IS-WINDOWS && $!windows-stderr-synchronized {
        self!restore-process-stderr;
        my $restored = $!saved-windows-stderr-handle.defined
            && (try windows-set-std-handle(
                WINDOWS-STD-ERROR-HANDLE,
                $!saved-windows-stderr-handle,
            ));
        # If SetStdHandle unexpectedly fails, retain the log HANDLE rather
        # than leaving the process table pointing at a closed HANDLE.
        try windows-close-handle($!windows-error-log-handle)
            if $restored && $!windows-error-log-handle.defined;

        $!saved-windows-stderr-handle = Pointer;
        $!windows-error-log-handle = Pointer;
        $!windows-stderr-synchronized = False;
        self!close-error-log-handle;
        return;
    }

    if $!saved-stderr-fd.defined && $!saved-stderr-fd >= 0 {
        try fd-dup2($!saved-stderr-fd, 2);
        try fd-close($!saved-stderr-fd);
        $!saved-stderr-fd = Int;
    }
    self!close-error-log-handle;
}

method !uninstall-error-log(--> Nil) {
    $ERROR-LOG-LOCK.protect: {
        self!uninstall-error-log-unlocked;
    };
}