view release on metacpan or  search on metacpan

git-verify  view on Meta::CPAN

        my $line = 0;
        my @matches = ();
        while (<$keys>) {
            $line++;
            my $pos = index($_, $how);
            if ($pos >= 0) {
                $label = $1 if substr($_,$pos+length($how)) =~ /^\s*(\S[^\r\n]*)/;
                next if /^\s*\#/; # Ignore comments
                s/\s*$//;
                push @matches, [$line, $pos, $label, $_];
            }
        }
        close $keys;
        $label ||= "$ENV{USER}\@$ENV{REMOTE_ADDR}";
        (my $hint_user = lc($label =~ /^$ENV{USER}\@(.+)/ || $label =~ /^([^@]+)@/ ? $1 : $label)) =~ s/[^a-z0-9]+/_/g;
        if (@matches) {
            foreach my $k (@matches) {
                my $o = substr($k->[3],0,$k->[1]);
                $o =~ s/\s+$//;
                if ($o =~ /(?:^|,)command="[^\"]*git-server\b[^\"]*"/i and
                    $o =~ /(?:^|,)command="[^\"]*git-server[^\"]* (KEY|REMOTE_USER)=(\w+)\b[^\"]*"/i ||
                    $o =~ /(?:^|,)environment="(KEY|REMOTE_USER)=(\w+)\b[^\"]*"/i) {
                    my $var = $1;
                    my $user = $2;
                    if ($var eq "REMOTE_USER") {
                        print qq{REMOTE_USER: $user: Entry appears fine yet still malfunctioned somehow! [$ENV{SERVER_ADDR}:$keyfile] Line $k->[0]:$k->[3]\n};
                    }
                    else {
                        print "REMOTE_USER: $user: Line $k->[0] should use REMOTE_USER=$user instead of $var=$user: BAD\n";
                    }
                }
                elsif (length $o) {
                    print qq{REMOTE_USER: Preliminary directives exist [$o] but fail to define any REMOTE_USER: BAD! Try something like this in $keyfile Line $k->[0]:\n};
                    print qq{command="$bin REMOTE_USER=$hint_user" $k->[3]\n};
                }
                else {
                    print "REMOTE_USER: No options found! Try something like this in $keyfile Line $k->[0]:\n";
                    print qq{command="$bin REMOTE_USER=$hint_user" $k->[3]\n};
                }
            }
        }
        else {
            print "REMOTE_USER: [$ENV{SERVER_ADDR}:$keyfile] Unrecognized format allowed key but still not found. Try something like this:\n";
            print qq{command="$bin REMOTE_USER=$hint_user" $how $label\n\n};
        }
    }
    else {
        print "REMOTE_USER: BROKEN! Unable to read [$ENV{SERVER_ADDR}:$keyfile] [$!]\n";
    }
}
else {
    if (my $count = @repo_dirs) {
        print "Commandline filtering $count specified repos: OK\n";
    }
    else {
        print "Commandline scanning $ENV{HOME} for repos: OK\n";
    }
}

#3. Scan repos
-d ($ENV{HOME} ||= [getpwuid $<]->[7]) or die "HOME broken";
if (!@repo_dirs and opendir my $fh, $ENV{HOME}) {
    my @nodes = readdir $fh;
    closedir $fh;
    foreach my $node (@nodes) {
        push @repo_dirs, "$ENV{HOME}/$node" if -f "$ENV{HOME}/$node/config" && -d "$ENV{HOME}/$node/refs" && -d "$ENV{HOME}/$node/objects" or -f "$ENV{HOME}/$node/.git/config";
    }
}
my @repo_info;
if (@repo_dirs) {
    my %seen;
    foreach my $repo (@repo_dirs) {
        $repo =~ s{/+$}{}; # Remove trailing slashes.
        next if $repo =~ /\.workingdir$/;
        my $gitdir = undef;
        if (-d $repo) {
            $gitdir = $repo;
        }
        else {
            $repo =~ s/\.git$//;
            my @check = ("$repo.git/.git", "$repo.git", "$repo/.git", $repo);
            if (0 != index $repo, $ENV{HOME}) { # Not starting with $HOME
                push @check, map { "$ENV{HOME}/$_" } @check; # Try with prepended $HOME too
            }
            foreach (@check) {
                $gitdir = $_ and last if -d;
            }
        }
        next if !$gitdir;
        $gitdir = abs_path $gitdir; # Collapse duplicate slashes. Get rid of any "/./" silly sandwiches. Also removes trailing slashes (although should already be gone by now).
        (my $nice = $gitdir) =~ s{(?:/|\.git)+$}{};
        $nice =~ s{^\Q$ENV{HOME}\E/}{} if $ENV{REMOTE_USER}; # Hide $HOME if REMOTE
        next if $seen{$nice}++;
        my $conf = run_output_include_err "git","-C",$gitdir,"config","--list","--local";
        my $info = { nice => $nice, dir => $gitdir, config => $conf };
        my $include = $ENV{REMOTE_USER} ? 0 : 1;
        foreach my $setting (qw[acl.writers acl.readers acl.deploy core.bare proxy.url]) {
            my $name = $setting =~ /^(\w+)\.(\w+)$/ ? $2 : next;
            my $section = $1;
            if ($conf =~ /^\Q$setting\E=(.*)/m) {
                $info->{$name} = $1;
                $info->{permission} ||= $include = $name if !$include and $section eq "acl" and $1 =~ /(^|,)\Q$ENV{REMOTE_USER}\E($|,)/;
            }
            else {
                $info->{$name} = "";
            }
        }
        push @repo_info, $info if $include;
    }
}
print "Found ".scalar(@repo_info)." repos\n";
if (@repo_info) {
    foreach my $info (@repo_info) {
        my $access = $info->{permission} ? " [you have $info->{permission} permission]" : "";
        if ($info->{bare} eq "true") {
            if (my $proxy = $info->{url}) {
                if (-d "$info->{dir}.workingdir") {
                    print "$info->{nice}: Found Bare Repo proxy linked [$proxy]: OK$access\n";
                }
                else {
                    print "$info->{nice}: Found Bare Repo with broken proxy [$proxy]: POOR$access\n";