view release on metacpan or  search on metacpan

git-verify  view on Meta::CPAN

    * Secured ~/.ssh/authorized_keys format, including "REMOTE_USER" settings
    * Make sure ~/.ssh/authorized_keys has at least one ADMIN user
    * ADMIN and ACL Management (if "ADMIN")
    * Create / Remove repos (if "ADMIN")
    * Validate or Configure "any-user"@server feature (if "ADMIN")

=head1 SUPPORTED

    * Only allow safe read-only operations appropriate for REMOTE_USER powers.
    * Validate git-server installation.
    * Verify AllowAgentForwarding setting for two-way sync feature.
    * Verify AcceptEnv setting.
    * Check ExposeAuthInfo functionality to be able to determine key info, if desired.
    * List accessible repos specified or scanned.
    * Files and Directories and ~/.ssh/authorized_keys chmod permissions.

=head1 AUTHOR

Rob Brown <bbb@cpan.org>

=head1 COPYRIGHT AND LICENSE

Copyright 2025-2026 by Rob Brown <bbb@cpan.org>

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

=cut

use strict;
use warnings;
use Cwd qw(abs_path);
use FindBin qw($RealBin);

our $VERSION = "0.045";

if (@ARGV and local $_ = $ARGV[0] || die "Bad arg\n" and !/^--/) {
    s{^ssh://(|[^/:]+\@)\[([a-z0-9\-\.\:]+)\]:(\d+)(?:$|/)}{}i ||
    s{^ssh://(|[^/:]+\@)\[?([a-z0-9\-\.]+)\]?:\[?(\d+)\]?(?:$|/)}{}i ||
    s{^ssh://(|[^/:]+\@)\[?([a-z0-9\-\.\:]+)\]?(?:$|/)}{}i ||
    s{^(|[^/:]+\@)\[([a-z0-9\-\.]+):(\d+)\](?:$|:)}{}i ||
    s{^(|[^/:]+\@)\[([a-z0-9\-\.\:]+)\]()(?:$|:)}{}i ||
    s{^(|[^/:]+\@)([a-z0-9\-\.]+)()(?:$|:)}{}i and do {
        my $userprefix = $1;
        my $remotehost = $2;
        my $remoteport = $3 || 22;
        my $resolvable = undef;
        $resolvable = gethostbyname($remotehost) or eval {
            require Socket;
            my ($err, @res) = Socket::getaddrinfo($remotehost,22,{socktype=>Socket::SOCK_STREAM(),family=>Socket::AF_UNSPEC(),flags=>((eval{Socket::AI_ALL()}||0)|(eval{Socket::AI_V4MAPPED()}||0))});
            $resolvable = @res;
            1;
        } or eval {
            require File::Which; # Try "dig" as last-ditch effort:
            my $dig = File::Which::which("dig") or die "no dig";
            $resolvable = `$dig +short $remotehost A $remotehost AAAA 2>/dev/null`;
            1;
        } or $resolvable = 1; # If IPv6 resolvers are unavailable, then assume it's valid, and just blindly run ssh
        if ($resolvable) {
            length()?$ARGV[0]=$_:shift;
            $ENV{XMODIFIERS}="client=".abs_path($0)."\@v$VERSION";
            my $search = q{$_=shift and 1+s/'/'"'"'/g and`(which '$_' git-verify|grep . || find . ~ /usr/local/bin /usr/bin /bin -name git-verify) 2>/dev/null`=~m{^(.+)}&&exec $1,@ARGV;warn"Cannot find git-verify on ".`hostname`."[$1][$!]['$_' @ARGV]...
            pipe my $FAKE_STDIN, my $prog;
            print $prog $search;
            close $prog;
            open STDIN, "<&", $FAKE_STDIN;
            exec qw[ssh
                -o PubKeyAuthentication=yes
                -o KbdInteractiveAuthentication=no
                -o PasswordAuthentication=no
                -o SendEnv=XMODIFIERS
                -p], $remoteport,
                "$userprefix$remotehost","perl","-",abs_path($0),(
                !(grep {m{[^\w/\-.]}} @ARGV) ? @ARGV :     # Unable to find any potentionally stank chars so it's safe to pass @ARGV as is.
                ("--escaperepos",map{unpack"H*",$_}@ARGV)  # Otherwise, encode every character for all repos just to be extra safe.
            ) or die "$0: remote verification failed.\n";
        }
    };
}

my @repo_dirs = @ARGV;
if (!@repo_dirs) {
    local $_ = $ENV{SSH_ORIGINAL_COMMAND} || "";
    @repo_dirs = split;
    splice @repo_dirs, 0, 2 if $repo_dirs[0] && $repo_dirs[1] && $repo_dirs[0] eq "perl" && $repo_dirs[1] eq "-";
    shift @repo_dirs if $repo_dirs[0] && $repo_dirs[0] =~ m{(^|/)git-verify$};
}
if (@repo_dirs and $repo_dirs[0] eq "--escaperepos") {
    shift @repo_dirs;
    foreach (@repo_dirs) {
        $_ = pack "H*",$_;
    }
}
if (!@repo_dirs and !$ENV{GIT_SERVER_VERSION} and my $gitdir = $ENV{GIT_DIR}) {
    # Not running within git-server properly, so use a wrapper to avoid this problem in the future.
    eval {
        require File::Spec;
        my $fixed = 0;
        foreach my $path (File::Spec->path) {
            if (-d $path and -w _) { # First writeable directory in $PATH
                foreach (qw[git-upload-pack git-receive-pack]) {
                    symlink "$RealBin/git-packer","$path/$_" and ++$fixed and warn "Installed symlink: $path/$_ -> $RealBin/git-packer\n" if !-e "$path/$_";
                }
                last if $fixed;
            }
        }
    };
    @repo_dirs = (abs_path $gitdir);
}

sub run_how_cmd {
    my $stderr = shift;
    my @cmd = @_;
    if (my $pid = open my $fh_out, "-|") {
        # Parent process waiting for kid to say something
        my $output = join "", <$fh_out>;
        waitpid $pid, 0;
        my $exit_status = $?;
        close $fh_out;
        $? = $exit_status;
        return $output;
    }