#!/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
}