Merge branch 'wc/make-funnynames-shared-lazy-prereq'
[git] / 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 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->repository()->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 }