Merge branch 'rr/test-3200-style'
[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
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 $query->{$check}) {
373                                 log_debug("compare %s [%s] to [%s] (entry: %s)",
374                                           $check,
375                                           $entry->{$check},
376                                           $query->{$check},
377                                           $entry_text);
378                                 unless ($query->{$check} eq $entry->{$check}) {
379                                         next ENTRY;
380                                 }
381                         } else {
382                                 log_debug("OK: any value satisfies check $check");
383                         }
384                 }
385
386                 return $entry;
387         }
388
389         # nothing was found
390         return;
391 }
392
393 sub print_credential_data {
394         my $entry = shift @_;
395         my $query = shift @_;
396
397         log_debug("entry has passed all the search checks");
398  TOKEN:
399         foreach my $git_token (sort keys %$entry) {
400                 log_debug("looking for useful token $git_token");
401                 # don't print unknown (to the credential helper protocol) tokens
402                 next TOKEN unless exists $query->{$git_token};
403
404                 # don't print things asked in the query (the entry matches them)
405                 next TOKEN if defined $query->{$git_token};
406
407                 log_debug("FOUND: $git_token=$entry->{$git_token}");
408                 printf "%s=%s\n", $git_token, $entry->{$git_token};
409         }
410 }
411 sub log_verbose {
412         return unless $options{verbose};
413         printf STDERR @_;
414         printf STDERR "\n";
415 }
416
417 sub log_debug {
418         return unless $options{debug};
419         printf STDERR @_;
420         printf STDERR "\n";
421 }