view release on metacpan or  search on metacpan

t/157-encoding-user-name.t  view on Meta::CPAN

# was false, repair_mojibake never ran, and `karr repair` answered "already at
# version 2; nothing to repair". There was no path back from inside karr.
#
# git_user_email had the same gap, and _run_git's captured stderr (used as
# the body of last_error on a CLI transport failure) was the same class of
# raw octets printed straight to a :encoding(UTF-8) handle.
#
# The fix is one line each: _config_string runs through from_octets, and
# _run_git decodes the merged stderr buffer before it leaves.

# Wide character in print would noise the diagnostics on an encoding test, so
# pin the UTF-8 layer here too.
binmode( Test::More->builder->$_, ':encoding(UTF-8)' )
  for qw( output failure_output todo_output );

my $NAME = "Ãœnicode Tester";   # U+00DC; octet-sequence c3 9c
my $EMAIL = 'tëst@example.com';  # contains U+00EB
my $RAW_NAME_OCTETS  = encode_utf8($NAME);
my $RAW_EMAIL_OCTETS = encode_utf8($EMAIL);

# In-process runner (t/lib/TestKarr.pm): same ($cwd, @argv) signature and
# { exit, stdout, stderr } return as the open3 helper this file used to carry,
# dispatched through the shared App::karr::Dispatch path. KARR_TEST_SUBPROC=1
# restores the old open3 path.
sub _run_karr { return run_karr(@_) }

sub _init_repo {
    my $repo = tempdir( CLEANUP => 1 );
    system( 'git', 'init', '-q', $repo ) == 0 or BAIL_OUT('git init failed');
    # `git config` itself takes the value as bytes, so the libgit2 read above
    # gets exactly the UTF-8 octets we want to spot on the way back.
    system( 'git', '-C', $repo, 'config', 'user.email', $RAW_EMAIL_OCTETS ) == 0 or BAIL_OUT('git config failed');
    system( 'git', '-C', $repo, 'config', 'user.name',  $RAW_NAME_OCTETS )  == 0 or BAIL_OUT('git config failed');
    return $repo;
}

# Read the raw bytes git stores for one ref, untouched by karr's layer.
sub _blob {
    my ( $repo, $ref ) = @_;
    open my $fh, '-|', 'git', '-C', $repo, 'cat-file', '-p', "$ref:data"
        or die "git cat-file: $!";
    binmode $fh;
    my $raw = do { local $/; <$fh> };
    close $fh;
    return defined $raw ? $raw : '';
}

# "Encoded exactly once" as an assertion: the UTF-8 octets are present, the
# double-encode is not, and the whole payload is valid UTF-8.
sub is_single_utf8 {
    my ( $bytes, $text, $name ) = @_;
    my $ok = 1;
    $ok &&= ok( index( $bytes, encode_utf8($text) ) >= 0, "$name: present as UTF-8 octets" );
    $ok &&= is( index( $bytes, encode_utf8( encode_utf8($text) ) ), -1, "$name: not double-encoded" );
    $ok &&= ok( defined eval { decode( 'UTF-8', $bytes, FB_CROAK | LEAVE_SRC ) },
        "$name: payload is valid UTF-8" );
    diag( "offending bytes: " . unpack( 'H*', $bytes ) ) unless $ok;
    return $ok;
}

subtest 'git_user_name returns decoded characters, not raw octets' => sub {
    my $repo = _init_repo();
    my $git  = App::karr::Git->new( dir => $repo );

    is( $git->git_user_name,  $NAME,
        'git_user_name returns the characters, not the UTF-8 octets' );
    ok( utf8::is_utf8( $git->git_user_name ),
        '...and the string is flagged as characters' );

    is( $git->git_user_email, $EMAIL,
        'git_user_email returns the characters' );
    is( $git->git_user_identity, "$NAME <$EMAIL>",
        'git_user_identity combines both halves as characters' );
};

subtest 'the activity log stores the identity as singly-encoded UTF-8' => sub {
    # The reproduction in ticket #157: a non-ASCII user.name written to the
    # log ref came out as the mojibake of the correct text, because the value
    # went into json_encode as bytes, was treated as characters, and to_octets
    # encoded those bytes a second time on the way to the ref.
    my $repo = _init_repo();
    is( _run_karr( $repo, 'init', '--name', 'Identity Board' )->{exit}, 0, 'board initialized' );

    my $git = App::karr::Git->new( dir => $repo );
    my $store = App::karr::BoardStore->new( git => $git );
    $git->write_ref( 'refs/karr/meta/next-id', "1\n" );

    my $cmd = App::karr::Cmd::Create->new( store => $store );
    my $err = do {
        local $@;
        eval {
            local *STDOUT;
            open STDOUT, '>', \my $null or die $!;
            $cmd->execute( ['task one'], [] );
        };
        $@;
    };
    is( $err, '', 'create executes cleanly' ) or diag("died with: $err");

    # ls the log ref, not the config.ref content (which is metadata).
    my $git_log = `git -C $repo for-each-ref --format='%(refname)' refs/karr/log/`;
    my ($log_ref) = split /\n/, $git_log;
    ok( $log_ref, 'a log ref was written' );

    my $raw = _blob( $repo, $log_ref );
    is_single_utf8( $raw, $NAME, 'log ref name field' );

    # The email is part of the log ref path (percent-encoded in the ref name),
    # not the JSON payload. The log entry's only identity field is the agent
    # name, so this is the right place to look.

    # And the characters read back through the normal activity log path.
    my $log = App::karr::ActivityLog->new( git => $git );
    my @entries = $log->entries;
    is( scalar @entries, 1, 'one entry was logged' );
    is( $entries[0]{agent}, $NAME, 'the entry records the characters, not bytes' );
};

subtest 'show --json reports the identity as characters' => sub {
    # The other side of the bug: the same bytes that corrupted the log ref
    # could have shown up in the task ref via Task::to_json_hash had the