contrib/credential/netrc/git-credential-netrc.perl

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