From: Ted Zlatanov Date: Mon, 04 Feb 2013 19:54:30 GMT Subject: [PATCH] Add contrib/credentials/netrc with GPG support Message-ID: <87ehgvua6h.fsf@lifelogs.com> Signed-off-by: Ted Zlatanov --- contrib/credential/netrc/git-credential-netrc | 223 +++++++++++++++++++++++++ 1 files changed, 223 insertions(+), 0 deletions(-) create mode 100755 contrib/credential/netrc/git-credential-netrc diff --git a/contrib/credential/netrc/git-credential-netrc b/contrib/credential/netrc/git-credential-netrc new file mode 100755 index 0000000..7b43aa9 --- /dev/null +++ b/contrib/credential/netrc/git-credential-netrc @@ -0,0 +1,223 @@ +#!/usr/bin/perl + +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 < undef } values(%{$options{tmap}}); + +while () { + 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 +} -- 1.7.9.rc2