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 Int $!saved-ucrt-stderr-fd;
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);

        # Third view: the shared UCRT's fd 2, which every ucrt-linked DLL's
        # fprintf(stderr) goes through (GLib/libvips warnings, sqlcipher
        # diagnostics).  ucrtbase bound it to the console at startup and
        # never re-reads the std-handle table, so without this a single
        # C-level warning line scrolls the terminal behind notcurses' back
        # and the next damage-diff render leaves a hole of stale text.
        # Same dup/dup2/restore dance as the POSIX branch below, only with
        # both descriptors created inside ucrtbase; best-effort, and a
        # failure leaves the two redirects above fully active.
        self!redirect-ucrt-stderr($clean-path);
        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 !redirect-ucrt-stderr(Str:D $clean-path --> Nil) {
    # _dup duplicates the kernel object into a fresh fd, so the original
    # stream survives for the restore below no matter what happens to
    # fd 2 in between.
    my $saved = try ucrt-dup(2);
    return unless $saved.defined && $saved >= 0;

    # _dup2 closes whatever HANDLE currently backs ucrt fd 2 — and that is
    # the very handle value MoarVM's own stderr (the IO::Handle preserved
    # by !replace-process-stderr) wraps, because both were seeded from the
    # same GetStdHandle at process start.  Letting the close through kills
    # $*ERR for the rest of the process ("Bad file descriptor" on the
    # first write after restore).  PROTECT_FROM_CLOSE makes _dup2's
    # internal CloseHandle fail harmlessly (release CRT ignores it; a
    # debugger surfaces it as a first-chance exception), and the flag is
    # dropped again straight after so process shutdown can close the
    # handle normally.
    my $orig-handle = try ucrt-get-osfhandle(2);
    my Bool $protected = False;
    if $orig-handle && $orig-handle.Int != 0 && $orig-handle.Int != -1 {
        $protected = ?(try windows-set-handle-information(
            $orig-handle,
            WINDOWS-HANDLE-FLAG-PROTECT-FROM-CLOSE,
            WINDOWS-HANDLE-FLAG-PROTECT-FROM-CLOSE,
        ));
    }
    LEAVE {
        try windows-set-handle-information(
            $orig-handle,
            WINDOWS-HANDLE-FLAG-PROTECT-FROM-CLOSE,
            0,
        ) if $protected;
    }
    unless $protected {
        try ucrt-close($saved);
        return;
    }

    my $log-fd = try ucrt-wopen(
        $clean-path.IO.absolute.Str,
        UCRT-O-WRONLY +| UCRT-O-APPEND +| UCRT-O-CREAT +| UCRT-O-BINARY,
        UCRT-S-IREAD-IWRITE,
    );
    unless $log-fd.defined && $log-fd >= 0 {
        try ucrt-close($saved);
        return;
    }
    my $rc = try ucrt-dup2($log-fd, 2);
    try ucrt-close($log-fd);
    unless $rc.defined && $rc >= 0 {
        try ucrt-close($saved);
        return;
    }
    $!saved-ucrt-stderr-fd = $saved;
}

method !restore-ucrt-stderr(--> Nil) {
    return unless $!saved-ucrt-stderr-fd.defined && $!saved-ucrt-stderr-fd >= 0;
    try ucrt-dup2($!saved-ucrt-stderr-fd, 2);
    try ucrt-close($!saved-ucrt-stderr-fd);
    $!saved-ucrt-stderr-fd = Int;
}

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-ucrt-stderr;
        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;
    };
}