git.oblomov.eu Git - git/blob - contrib/credential/netrc/git-credential-netrc

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Getopt::Long;
   7 use File::Basename;
   8
   9 my $VERSION = "0.1";
  10
  11 my %options = (
  12                help => 0,
  13                debug => 0,
  14                verbose => 0,
  15                insecure => 0,
  16                file => [],
  17
  18                # identical token maps, e.g. host -> host, will be inserted later
  19                tmap => {
  20                         port => 'protocol',
  21                         machine => 'host',
  22                         path => 'path',
  23                         login => 'username',
  24                         user => 'username',
  25                         password => 'password',
  26                        }
  27               );
  28
  29 # Map each credential protocol token to itself on the netrc side.
  30 foreach (values %{$options{tmap}}) {
  31         $options{tmap}->{$_} = $_;
  32 }
  33
  34 # Now, $options{tmap} has a mapping from the netrc format to the Git credential
  35 # helper protocol.
  36
  37 # Next, we build the reverse token map.
  38
  39 # When $rmap{foo} contains 'bar', that means that what the Git credential helper
  40 # protocol calls 'bar' is found as 'foo' in the netrc/authinfo file.  Keys in
  41 # %rmap are what we expect to read from the netrc/authinfo file.
  42
  43 my %rmap;
  44 foreach my $k (keys %{$options{tmap}}) {
  45         push @{$rmap{$options{tmap}->{$k}}}, $k;
  46 }
  47
  48 Getopt::Long::Configure("bundling");
  49
  50 # TODO: maybe allow the token map $options{tmap} to be configurable.
  51 GetOptions(\%options,
  52            "help|h",
  53            "debug|d",
  54            "insecure|k",
  55            "verbose|v",
  56            "file|f=s@",
  57           );
  58
  59 if ($options{help}) {
  60         my $shortname = basename($0);
  61         $shortname =~ s/git-credential-//;
  62
  63         print <<EOHIPPUS;
  64
  65 $0 [-f AUTHFILE1] [-f AUTHFILEN] [-d] [-v] [-k] get
  66
  67 Version $VERSION by tzz\@lifelogs.com.  License: BSD.
  68
  69 Options:
  70
  71   -f|--file AUTHFILE : specify netrc-style files.  Files with the .gpg extension
  72                        will be decrypted by GPG before parsing.  Multiple -f
  73                        arguments are OK.  They are processed in order, and the
  74                        first matching entry found is returned via the credential
  75                        helper protocol (see below).
  76
  77                        When no -f option is given, .authinfo.gpg, .netrc.gpg,
  78                        .authinfo, and .netrc files in your home directory are used
  79                        in this order.
  80
  81   -k|--insecure      : ignore bad file ownership or permissions
  82
  83   -d|--debug         : turn on debugging (developer info)
  84
  85   -v|--verbose       : be more verbose (show files and information found)
  86
  87 To enable this credential helper:
  88
  89   git config credential.helper '$shortname -f AUTHFILE1 -f AUTHFILE2'
  90
  91 (Note that Git will prepend "git-credential-" to the helper name and look for it
  92 in the path.)
  93
  94 ...and if you want lots of debugging info:
  95
  96   git config credential.helper '$shortname -f AUTHFILE -d'
  97
  98 ...or to see the files opened and data found:
  99
 100   git config credential.helper '$shortname -f AUTHFILE -v'
 101
 102 Only "get" mode is supported by this credential helper.  It opens every AUTHFILE
 103 and looks for the first entry that matches the requested search criteria:
 104
 105  'port|protocol':
 106    The protocol that will be used (e.g., https). (protocol=X)
 107
 108  'machine|host':
 109    The remote hostname for a network credential. (host=X)
 110
 111  'path':
 112    The path with which the credential will be used. (path=X)
 113
 114  'login|user|username':
 115    The credential’s username, if we already have one. (username=X)
 116
 117 Thus, when we get this query on STDIN:
 118
 119 host=github.com
 120 protocol=https
 121 username=tzz
 122
 123 this credential helper will look for the first entry in every AUTHFILE that
 124 matches
 125
 126 machine github.com port https login tzz
 127
 128 OR
 129
 130 machine github.com protocol https login tzz
 131
 132 OR... etc. acceptable tokens as listed above.  Any unknown tokens are
 133 simply ignored.
 134
 135 Then, the helper will print out whatever tokens it got from the entry, including
 136 "password" tokens, mapping back to Git's helper protocol; e.g. "port" is mapped
 137 back to "protocol".  Any redundant entry tokens (part of the original query) are
 138 skipped.
 139
 140 Again, note that only the first matching entry from all the AUTHFILEs, processed
 141 in the sequence given on the command line, is used.
 142
 143 Netrc/authinfo tokens can be quoted as 'STRING' or "STRING".
 144
 145 No caching is performed by this credential helper.
 146
 147 EOHIPPUS
 148
 149         exit 0;
 150 }
 151
 152 my $mode = shift @ARGV;
 153
 154 # Credentials must get a parameter, so die if it's missing.
 155 die "Syntax: $0 [-f AUTHFILE1] [-f AUTHFILEN] [-d] get" unless defined $mode;
 156
 157 # Only support 'get' mode; with any other unsupported ones we just exit.
 158 exit 0 unless $mode eq 'get';
 159
 160 my $files = $options{file};
 161
 162 # if no files were given, use a predefined list.
 163 # note that .gpg files come first
 164 unless (scalar @$files) {
 165         my @candidates = qw[
 166                                    ~/.authinfo.gpg
 167                                    ~/.netrc.gpg
 168                                    ~/.authinfo
 169                                    ~/.netrc
 170                           ];
 171
 172         $files = $options{file} = [ map { glob $_ } @candidates ];
 173 }
 174
 175 my $query = read_credential_data_from_stdin();
 176
 177 FILE:
 178 foreach my $file (@$files) {
 179         my $gpgmode = $file =~ m/\.gpg$/;
 180         unless (-r $file) {
 181                 log_verbose("Unable to read $file; skipping it");
 182                 next FILE;
 183         }
 184
 185         # the following check is copied from Net::Netrc, for non-GPG files
 186         # OS/2 and Win32 do not handle stat in a way compatible with this check :-(
 187         unless ($gpgmode || $options{insecure} ||
 188                 $^O eq 'os2'
 189                 || $^O eq 'MSWin32'
 190                 || $^O eq 'MacOS'
 191                 || $^O =~ /^cygwin/) {
 192                 my @stat = stat($file);
 193
 194                 if (@stat) {
 195                         if ($stat[2] & 077) {
 196                                 log_verbose("Insecure $file (mode=%04o); skipping it",
 197                                             $stat[2] & 07777);
 198                                 next FILE;
 199                         }
 200
 201                         if ($stat[4] != $<) {
 202                                 log_verbose("Not owner of $file; skipping it");
 203                                 next FILE;
 204                         }
 205                 }
 206         }
 207
 208         my @entries = load_netrc($file, $gpgmode);
 209
 210         unless (scalar @entries) {
 211                 if ($!) {
 212                         log_verbose("Unable to open $file: $!");
 213                 } else {
 214                         log_verbose("No netrc entries found in $file");
 215                 }
 216
 217                 next FILE;
 218         }
 219
 220         my $entry = find_netrc_entry($query, @entries);
 221         if ($entry) {
 222                 print_credential_data($entry, $query);
 223                 # we're done!
 224                 last FILE;
 225         }
 226 }
 227
 228 exit 0;
 229
 230 sub load_netrc {
 231         my $file = shift @_;
 232         my $gpgmode = shift @_;
 233
 234         my $io;
 235         if ($gpgmode) {
 236                 my @cmd = (qw(gpg --decrypt), $file);
 237                 log_verbose("Using GPG to open $file: [@cmd]");
 238                 open $io, "-|", @cmd;
 239         } else {
 240                 log_verbose("Opening $file...");
 241                 open $io, '<', $file;
 242         }
 243
 244         # nothing to do if the open failed (we log the error later)
 245         return unless $io;
 246
 247         # Net::Netrc does this, but the functionality is merged with the file
 248         # detection logic, so we have to extract just the part we need
 249         my @netrc_entries = net_netrc_loader($io);
 250
 251         # these entries will use the credential helper protocol token names
 252         my @entries;
 253
 254         foreach my $nentry (@netrc_entries) {
 255                 my %entry;
 256                 my $num_port;
 257
 258                 if (!defined $nentry->{machine}) {
 259                         next;
 260                 }
 261                 if (defined $nentry->{port} && $nentry->{port} =~ m/^\d+$/) {
 262                         $num_port = $nentry->{port};
 263                         delete $nentry->{port};
 264                 }
 265
 266                 # create the new entry for the credential helper protocol
 267                 $entry{$options{tmap}->{$_}} = $nentry->{$_} foreach keys %$nentry;
 268
 269                 # for "host X port Y" where Y is an integer (captured by
 270                 # $num_port above), set the host to "X:Y"
 271                 if (defined $entry{host} && defined $num_port) {
 272                         $entry{host} = join(':', $entry{host}, $num_port);
 273                 }
 274
 275                 push @entries, \%entry;
 276         }
 277
 278         return @entries;
 279 }
 280
 281 sub net_netrc_loader {
 282         my $fh = shift @_;
 283         my @entries;
 284         my ($mach, $macdef, $tok, @tok);
 285
 286     LINE:
 287         while (<$fh>) {
 288                 undef $macdef if /\A\n\Z/;
 289
 290                 if ($macdef) {
 291                         next LINE;
 292                 }
 293
 294                 s/^\s*//;
 295                 chomp;
 296
 297                 while (length && s/^("((?:[^"]+|\\.)*)"|((?:[^\\\s]+|\\.)*))\s*//) {
 298                         (my $tok = $+) =~ s/\\(.)/$1/g;
 299                         push(@tok, $tok);
 300                 }
 301
 302             TOKEN:
 303                 while (@tok) {
 304                         if ($tok[0] eq "default") {
 305                                 shift(@tok);
 306                                 $mach = { machine => undef };
 307                                 next TOKEN;
 308                         }
 309
 310                         $tok = shift(@tok);
 311
 312                         if ($tok eq "machine") {
 313                                 my $host = shift @tok;
 314                                 $mach = { machine => $host };
 315                                 push @entries, $mach;
 316                         } elsif (exists $options{tmap}->{$tok}) {
 317                                 unless ($mach) {
 318                                         log_debug("Skipping token $tok because no machine was given");
 319                                         next TOKEN;
 320                                 }
 321
 322                                 my $value = shift @tok;
 323                                 unless (defined $value) {
 324                                         log_debug("Token $tok had no value, skipping it.");
 325                                         next TOKEN;
 326                                 }
 327
 328                                 # Following line added by rmerrell to remove '/' escape char in .netrc
 329                                 $value =~ s/\/\\/\\/g;
 330                                 $mach->{$tok} = $value;
 331                         } elsif ($tok eq "macdef") { # we ignore macros
 332                                 next TOKEN unless $mach;
 333                                 my $value = shift @tok;
 334                                 $macdef = 1;
 335                         }
 336                 }
 337         }
 338
 339         return @entries;
 340 }
 341
 342 sub read_credential_data_from_stdin {
 343         # the query: start with every token with no value
 344         my %q = map { $_ => undef } values(%{$options{tmap}});
 345
 346         while (<STDIN>) {
 347                 next unless m/^([^=]+)=(.+)/;
 348
 349                 my ($token, $value) = ($1, $2);
 350                 die "Unknown search token $token" unless exists $q{$token};
 351                 $q{$token} = $value;
 352                 log_debug("We were given search token $token and value $value");
 353         }
 354
 355         foreach (sort keys %q) {
 356                 log_debug("Searching for %s = %s", $_, $q{$_} || '(any value)');
 357         }
 358
 359         return \%q;
 360 }
 361
 362 # takes the search tokens and then a list of entries
 363 # each entry is a hash reference
 364 sub find_netrc_entry {
 365         my $query = shift @_;
 366
 367     ENTRY:
 368         foreach my $entry (@_)
 369         {
 370                 my $entry_text = join ', ', map { "$_=$entry->{$_}" } keys %$entry;
 371                 foreach my $check (sort keys %$query) {
 372                         if (!defined $entry->{$check}) {
 373                                 log_debug("OK: entry has no $check token, so any value satisfies check $check");
 374                         } elsif (defined $query->{$check}) {
 375                                 log_debug("compare %s [%s] to [%s] (entry: %s)",
 376                                           $check,
 377                                           $entry->{$check},
 378                                           $query->{$check},
 379                                           $entry_text);
 380                                 unless ($query->{$check} eq $entry->{$check}) {
 381                                         next ENTRY;
 382                                 }
 383                         } else {
 384                                 log_debug("OK: any value satisfies check $check");
 385                         }
 386                 }
 387
 388                 return $entry;
 389         }
 390
 391         # nothing was found
 392         return;
 393 }
 394
 395 sub print_credential_data {
 396         my $entry = shift @_;
 397         my $query = shift @_;
 398
 399         log_debug("entry has passed all the search checks");
 400  TOKEN:
 401         foreach my $git_token (sort keys %$entry) {
 402                 log_debug("looking for useful token $git_token");
 403                 # don't print unknown (to the credential helper protocol) tokens
 404                 next TOKEN unless exists $query->{$git_token};
 405
 406                 # don't print things asked in the query (the entry matches them)
 407                 next TOKEN if defined $query->{$git_token};
 408
 409                 log_debug("FOUND: $git_token=$entry->{$git_token}");
 410                 printf "%s=%s\n", $git_token, $entry->{$git_token};
 411         }
 412 }
 413 sub log_verbose {
 414         return unless $options{verbose};
 415         printf STDERR @_;
 416         printf STDERR "\n";
 417 }
 418
 419 sub log_debug {
 420         return unless $options{debug};
 421         printf STDERR @_;
 422         printf STDERR "\n";
 423 }