Re: [PATCH 1/3] Add contrib/credentials/netrc with GPG support

On Mon, 04 Feb 2013 09:24:03 -0800 Junio C Hamano <gitster@pobox.com> wrote: 

JCH> [administrivia: I would really wish you didn't put "Mail-copies-to: JCH> never" above].

I normally post through GMane and don't need the extra CC on any list I read. I'll make an effort to remove that header here, and apologize for the inconvenience.

JCH> Ted Zlatanov <tzz@lifelogs.com> writes:

JCH> Please follow the styles of existing Perl scripts, e.g. indent with JCH> tab, etc. Style requests are not optional; it is a prerequisite to JCH> make the patch readable and reviewable.

Sorry, I didn't realize contrib/ stuff was under the same rules. I will attempt to make my contributions fit the project's requirements.

It would help if the requirements were codified as the fairly standard Emacs file-local variables, so I can just put them in the Perl code or in .dir-locals.el in the source tree. At least for Perl I'd like that, and it could be nice for the Emacs users who write C too.

Would you like me to propose that as a patch?

Either way, I guessed that these settings are what you want as far as tabs and indentation (I use cperl-mode but perl-mode is the same):

# -*- mode: cperl; tab-width: 8; cperl-indent-level: 4; indent-tabs-mode: t; -*-

...plus hanging braces and avoiding one-line blocks.  I hope that's right.

JCH> Do we really need to refer readers to Wikipedia or something to JCH> learn about extinct equid ungulates ;-)?

I think the marker's name is irrelevant, and hope you are OK with leaving it.

Since the change is a pretty big reformatting, should I squash my 3 commits plus the reformatting commit into one patch, or keep them as a series?

I am appending the script in its current form so you can review it and tell me if there's anything else I should add or change in the formatting.

Thanks Ted

#!/usr/bin/perl # -*- mode: cperl; tab-width: 8; cperl-indent-level: 4; indent-tabs-mode: t; -*-

use strict; use warnings;

use Getopt::Long; use File::Basename;

my $VERSION = "0.1";

my %options = (
               help => 0,
               debug => 0,

               # identical token maps, e.g. host -> host, will be inserted later
               tmap => {
                        port => 'protocol',
                        machine => 'host',
                        path => 'path',
                        login => 'username',
                        user => 'username',
                        password => 'password',
                       }
              );

# map each credential protocol token to itself on the netrc side $options{tmap}->{$_} = $_ foreach my $v (values %{$options{tmap}});

foreach my $suffix ('.gpg', '') {
    foreach my $base (qw/authinfo netrc/) {
	my $file = glob("~/.$base$suffix");
	next unless (defined $file && -f $file);
	$options{file} = $file ;
    }
}

Getopt::Long::Configure("bundling");

# TODO: maybe allow the token map $options{tmap} to be configurable.
GetOptions(\%options,
           "help|h",
           "debug|d",
           "file|f=s",
          );

if ($options{help}) {
    my $shortname = basename($0);
    $shortname =~ s/git-credential-//;

    print <<EOHIPPUS;

$0 [-f AUTHFILE] [-d] get

Version $VERSION by tzz\@lifelogs.com.  License: BSD.

Options:
  -f AUTHFILE: specify a netrc-style file
  -d: turn on debugging

To enable (note that Git will prepend "git-credential-" to the helper name and look for it in the path):

  git config credential.helper '$shortname -f AUTHFILE'

And if you want lots of debugging info:

  git config credential.helper '$shortname -f AUTHFILE -d'

Only "get" mode is supported by this credential helper. It opens AUTHFILE and looks for entries that match the requested search criteria:

 'port|protocol':
   The protocol that will be used (e.g., https). (protocol=X)

 'machine|host':
   The remote hostname for a network credential. (host=X)

 'path':
   The path with which the credential will be used. (path=X)

 'login|user|username':
   The credential’s username, if we already have one. (username=X)

Thus, when we get "protocol=https\nusername=tzz", this credential helper will look for lines in AUTHFILE that match

port https login tzz

OR

protocol https login tzz

OR... etc. acceptable tokens as listed above. Any unknown tokens are simply ignored.

Then, the helper will print out whatever tokens it got from the line, including "password" tokens, mapping e.g. "port" back to "protocol".

The first matching line is used. Tokens can be quoted as 'STRING' or "STRING".

No caching is performed by this credential helper.

EOHIPPUS

    exit;
}

my $mode = shift @ARGV;

# credentials may get 'get', 'store', or 'erase' as parameters but # only acknowledge 'get' die "Syntax: $0 [-f AUTHFILE] [-d] get" unless defined $mode;

# only support 'get' mode exit unless $mode eq 'get';

my $debug = $options{debug}; my $file = $options{file};

die "Sorry, you need to specify an existing netrc file (with or without a .gpg extension) with -f AUTHFILE"
 unless defined $file;

unless (-f $file) {
    print STDERR "Sorry, the specified netrc $file is not accessible\n" if $debug;
    exit 0;
}

my @data;
if ($file =~ m/\.gpg$/) {
    @data = load('-|', qw(gpg --decrypt), $file)
}
else {
    @data = load('<', $file);
}

chomp @data;

unless (scalar @data) {
    print STDERR "Sorry, we could not load data from [$file]\n" if $debug;
    exit;
}

# the query: start with every token with no value my %q = map { $_ => undef } values(%{$options{tmap}});

while (<STDIN>) {
    next unless m/([^=]+)=(.+)/;

    my ($token, $value) = ($1, $2);
    die "Unknown search token $1" unless exists $q{$token};
    $q{$token} = $value;
}

# build reverse token map
my %rmap;
foreach my $k (keys %{$options{tmap}}) {
    push @{$rmap{$options{tmap}->{$k}}}, $k;
}

# there are CPAN modules to do this better, but we want to avoid # dependencies and generally, complex netrc-style files are rare

if ($debug) {
    printf STDERR "searching for %s = %s\n", $_, $q{$_} || '(any value)'
     foreach sort keys %q;
}

LINE: foreach my $line (@data) {

    print STDERR "line [$line]\n" if $debug;
    my @tok;
    # gratefully stolen from Net::Netrc
    while (length $line &&
	   $line =~ s/^("((?:[^"]+|\\.)*)"|((?:[^\\\s]+|\\.)*))\s*//) {
	(my $tok = $+) =~ s/\\(.)/$1/g;
	push(@tok, $tok);
    }

    # skip blank lines, comments, etc.
    next LINE unless scalar @tok;

    my %tokens;
    while (@tok) {
	my ($k, $v) = (shift @tok, shift @tok);
	next unless defined $v;
	next unless exists $options{tmap}->{$k};
	$tokens{$options{tmap}->{$k}} = $v;
    }

    foreach my $check (sort keys %q) {
	if (exists $tokens{$check} && defined $q{$check}) {
	    print STDERR "comparing [$tokens{$check}] to [$q{$check}] in line [$line]\n" if $debug;
	    next LINE unless $tokens{$check} eq $q{$check};
	}
	else {
	    print STDERR "we could not find [$check] but it's OK\n" if $debug;
	}
    }

    print STDERR "line has passed all the search checks\n" if $debug;
 TOKEN:
    foreach my $token (sort keys %rmap) {
	print STDERR "looking for useful token $token\n" if $debug;
	next unless exists $tokens{$token}; # did we match?

	foreach my $rctoken (@{$rmap{$token}}) {
	    next TOKEN if defined $q{$rctoken};           # don't re-print given tokens
	}

	print STDERR "FOUND: $token=$tokens{$token}\n" if $debug;
	printf "%s=%s\n", $token, $tokens{$token};
    }

    last;
}

sub load {
    # this supports pipes too
    my $io = new IO::File(@_) or die "Could not open [@_]: $!\n";
    return <$io>;                          # whole file
}