git-svn: move Git::SVN::Prompt into its own file
git-svn.perl is very long (around 6500 lines) and although it is nicely split into modules, some new readers do not even notice --- it is too distracting to see all this functionality collected in a single file. Splitting it into multiple files would make it easier for people to read individual modules straight through and to experiment with components separately. Let's start with Git::SVN::Prompt. For simplicity, we install this as a module in the standard search path, just like the existing Git and Git::I18N modules. In the process, add a manpage explaining its interface and that it is not likely to be useful for other projects to avoid confusion. Signed-off-by: Jonathan Nieder <jrnieder@gmail.com> Signed-off-by: Eric Wong <normalperson@yhbt.net>
Jonathan Nieder committed
May 27, 2012 at 19:39 UTC
c102f4cf729a65b3520dbb17b52aa0c4fe4d4b29
3 files changed
+204
-144
git-svn.perl
+1
-144
@@ -80,6 +80,7 @@ use File::Find;
80
use Getopt::Long qw/:config gnu_getopt no_ignore_case auto_abbrev/;
81
use IPC::Open3;
82
use Git;
83
+use Git::SVN::Prompt qw//;
84
use Memoize; # core since 5.8.0, Jul 2002
85
86
BEGIN {
@@ -4327,150 +4328,6 @@ sub remove_username {
4328
$_[0] =~ s{^([^:]*://)[^@]+@}{$1};
4329
}
4330
4330
-package Git::SVN::Prompt;
4331
-use strict;
4332
-use warnings;
4333
-require SVN::Core;
4334
-use vars qw/$_no_auth_cache $_username/;
4335
-
4336
-sub simple {
4337
- my ($cred, $realm, $default_username, $may_save, $pool) = @_;
4338
- $may_save = undef if $_no_auth_cache;
4339
- $default_username = $_username if defined $_username;
4340
- if (defined $default_username && length $default_username) {
4341
- if (defined $realm && length $realm) {
4342
- print STDERR "Authentication realm: $realm\n";
4343
- STDERR->flush;
4344
- }
4345
- $cred->username($default_username);
4346
- } else {
4347
- username($cred, $realm, $may_save, $pool);
4348
- }
4349
- $cred->password(_read_password("Password for '" .
4350
- $cred->username . "': ", $realm));
4351
- $cred->may_save($may_save);
4352
- $SVN::_Core::SVN_NO_ERROR;
4353
-}
4354
-
4355
-sub ssl_server_trust {
4356
- my ($cred, $realm, $failures, $cert_info, $may_save, $pool) = @_;
4357
- $may_save = undef if $_no_auth_cache;
4358
- print STDERR "Error validating server certificate for '$realm':\n";
4359
- {
4360
- no warnings 'once';
4361
- # All variables SVN::Auth::SSL::* are used only once,
4362
- # so we're shutting up Perl warnings about this.
4363
- if ($failures & $SVN::Auth::SSL::UNKNOWNCA) {
4364
- print STDERR " - The certificate is not issued ",
4365
- "by a trusted authority. Use the\n",
4366
- " fingerprint to validate ",
4367
- "the certificate manually!\n";
4368
- }
4369
- if ($failures & $SVN::Auth::SSL::CNMISMATCH) {
4370
- print STDERR " - The certificate hostname ",
4371
- "does not match.\n";
4372
- }
4373
- if ($failures & $SVN::Auth::SSL::NOTYETVALID) {
4374
- print STDERR " - The certificate is not yet valid.\n";
4375
- }
4376
- if ($failures & $SVN::Auth::SSL::EXPIRED) {
4377
- print STDERR " - The certificate has expired.\n";
4378
- }
4379
- if ($failures & $SVN::Auth::SSL::OTHER) {
4380
- print STDERR " - The certificate has ",
4381
- "an unknown error.\n";
4382
- }
4383
- } # no warnings 'once'
4384
- printf STDERR
4385
- "Certificate information:\n".
4386
- " - Hostname: %s\n".
4387
- " - Valid: from %s until %s\n".
4388
- " - Issuer: %s\n".
4389
- " - Fingerprint: %s\n",
4390
- map $cert_info->$_, qw(hostname valid_from valid_until
4391
- issuer_dname fingerprint);
4392
- my $choice;
4393
-prompt:
4394
- print STDERR $may_save ?
4395
- "(R)eject, accept (t)emporarily or accept (p)ermanently? " :
4396
- "(R)eject or accept (t)emporarily? ";
4397
- STDERR->flush;
4398
- $choice = lc(substr(<STDIN> || 'R', 0, 1));
4399
- if ($choice =~ /^t$/i) {
4400
- $cred->may_save(undef);
4401
- } elsif ($choice =~ /^r$/i) {
4402
- return -1;
4403
- } elsif ($may_save && $choice =~ /^p$/i) {
4404
- $cred->may_save($may_save);
4405
- } else {
4406
- goto prompt;
4407
- }
4408
- $cred->accepted_failures($failures);
4409
- $SVN::_Core::SVN_NO_ERROR;
4410
-}
4411
-
4412
-sub ssl_client_cert {
4413
- my ($cred, $realm, $may_save, $pool) = @_;
4414
- $may_save = undef if $_no_auth_cache;
4415
- print STDERR "Client certificate filename: ";
4416
- STDERR->flush;
4417
- chomp(my $filename = <STDIN>);
4418
- $cred->cert_file($filename);
4419
- $cred->may_save($may_save);
4420
- $SVN::_Core::SVN_NO_ERROR;
4421
-}
4422
-
4423
-sub ssl_client_cert_pw {
4424
- my ($cred, $realm, $may_save, $pool) = @_;
4425
- $may_save = undef if $_no_auth_cache;
4426
- $cred->password(_read_password("Password: ", $realm));
4427
- $cred->may_save($may_save);
4428
- $SVN::_Core::SVN_NO_ERROR;
4429
-}
4430
-
4431
-sub username {
4432
- my ($cred, $realm, $may_save, $pool) = @_;
4433
- $may_save = undef if $_no_auth_cache;
4434
- if (defined $realm && length $realm) {
4435
- print STDERR "Authentication realm: $realm\n";
4436
- }
4437
- my $username;
4438
- if (defined $_username) {
4439
- $username = $_username;
4440
- } else {
4441
- print STDERR "Username: ";
4442
- STDERR->flush;
4443
- chomp($username = <STDIN>);
4444
- }
4445
- $cred->username($username);
4446
- $cred->may_save($may_save);
4447
- $SVN::_Core::SVN_NO_ERROR;
4448
-}
4449
-
4450
-sub _read_password {
4451
- my ($prompt, $realm) = @_;
4452
- my $password = '';
4453
- if (exists $ENV{GIT_ASKPASS}) {
4454
- open(PH, "-|", $ENV{GIT_ASKPASS}, $prompt);
4455
- $password = <PH>;
4456
- $password =~ s/[\012\015]//; # \n\r
4457
- close(PH);
4458
- } else {
4459
- print STDERR $prompt;
4460
- STDERR->flush;
4461
- require Term::ReadKey;
4462
- Term::ReadKey::ReadMode('noecho');
4463
- while (defined(my $key = Term::ReadKey::ReadKey(0))) {
4464
- last if $key =~ /[\012\015]/; # \n\r
4465
- $password .= $key;
4466
- }
4467
- Term::ReadKey::ReadMode('restore');
4468
- print STDERR "\n";
4469
- STDERR->flush;
4470
- }
4471
- $password;
4472
-}
4473
-
4331
package SVN::Git::Fetcher;
4332
use vars qw/@ISA $_ignore_regex $_preserve_empty_dirs $_placeholder_filename
4333
@deleted_gpath %added_placeholder $repo_id/;
perl/Git/SVN/Prompt.pm
new
+202
@@ -0,0 +1,202 @@
1
+package Git::SVN::Prompt;
2
+use strict;
3
+use warnings;
4
+require SVN::Core;
5
+use vars qw/$_no_auth_cache $_username/;
6
+
7
+sub simple {
8
+ my ($cred, $realm, $default_username, $may_save, $pool) = @_;
9
+ $may_save = undef if $_no_auth_cache;
10
+ $default_username = $_username if defined $_username;
11
+ if (defined $default_username && length $default_username) {
12
+ if (defined $realm && length $realm) {
13
+ print STDERR "Authentication realm: $realm\n";
14
+ STDERR->flush;
15
+ }
16
+ $cred->username($default_username);
17
+ } else {
18
+ username($cred, $realm, $may_save, $pool);
19
+ }
20
+ $cred->password(_read_password("Password for '" .
21
+ $cred->username . "': ", $realm));
22
+ $cred->may_save($may_save);
23
+ $SVN::_Core::SVN_NO_ERROR;
24
+}
25
+
26
+sub ssl_server_trust {
27
+ my ($cred, $realm, $failures, $cert_info, $may_save, $pool) = @_;
28
+ $may_save = undef if $_no_auth_cache;
29
+ print STDERR "Error validating server certificate for '$realm':\n";
30
+ {
31
+ no warnings 'once';
32
+ # All variables SVN::Auth::SSL::* are used only once,
33
+ # so we're shutting up Perl warnings about this.
34
+ if ($failures & $SVN::Auth::SSL::UNKNOWNCA) {
35
+ print STDERR " - The certificate is not issued ",
36
+ "by a trusted authority. Use the\n",
37
+ " fingerprint to validate ",
38
+ "the certificate manually!\n";
39
+ }
40
+ if ($failures & $SVN::Auth::SSL::CNMISMATCH) {
41
+ print STDERR " - The certificate hostname ",
42
+ "does not match.\n";
43
+ }
44
+ if ($failures & $SVN::Auth::SSL::NOTYETVALID) {
45
+ print STDERR " - The certificate is not yet valid.\n";
46
+ }
47
+ if ($failures & $SVN::Auth::SSL::EXPIRED) {
48
+ print STDERR " - The certificate has expired.\n";
49
+ }
50
+ if ($failures & $SVN::Auth::SSL::OTHER) {
51
+ print STDERR " - The certificate has ",
52
+ "an unknown error.\n";
53
+ }
54
+ } # no warnings 'once'
55
+ printf STDERR
56
+ "Certificate information:\n".
57
+ " - Hostname: %s\n".
58
+ " - Valid: from %s until %s\n".
59
+ " - Issuer: %s\n".
60
+ " - Fingerprint: %s\n",
61
+ map $cert_info->$_, qw(hostname valid_from valid_until
62
+ issuer_dname fingerprint);
63
+ my $choice;
64
+prompt:
65
+ print STDERR $may_save ?
66
+ "(R)eject, accept (t)emporarily or accept (p)ermanently? " :
67
+ "(R)eject or accept (t)emporarily? ";
68
+ STDERR->flush;
69
+ $choice = lc(substr(<STDIN> || 'R', 0, 1));
70
+ if ($choice =~ /^t$/i) {
71
+ $cred->may_save(undef);
72
+ } elsif ($choice =~ /^r$/i) {
73
+ return -1;
74
+ } elsif ($may_save && $choice =~ /^p$/i) {
75
+ $cred->may_save($may_save);
76
+ } else {
77
+ goto prompt;
78
+ }
79
+ $cred->accepted_failures($failures);
80
+ $SVN::_Core::SVN_NO_ERROR;
81
+}
82
+
83
+sub ssl_client_cert {
84
+ my ($cred, $realm, $may_save, $pool) = @_;
85
+ $may_save = undef if $_no_auth_cache;
86
+ print STDERR "Client certificate filename: ";
87
+ STDERR->flush;
88
+ chomp(my $filename = <STDIN>);
89
+ $cred->cert_file($filename);
90
+ $cred->may_save($may_save);
91
+ $SVN::_Core::SVN_NO_ERROR;
92
+}
93
+
94
+sub ssl_client_cert_pw {
95
+ my ($cred, $realm, $may_save, $pool) = @_;
96
+ $may_save = undef if $_no_auth_cache;
97
+ $cred->password(_read_password("Password: ", $realm));
98
+ $cred->may_save($may_save);
99
+ $SVN::_Core::SVN_NO_ERROR;
100
+}
101
+
102
+sub username {
103
+ my ($cred, $realm, $may_save, $pool) = @_;
104
+ $may_save = undef if $_no_auth_cache;
105
+ if (defined $realm && length $realm) {
106
+ print STDERR "Authentication realm: $realm\n";
107
+ }
108
+ my $username;
109
+ if (defined $_username) {
110
+ $username = $_username;
111
+ } else {
112
+ print STDERR "Username: ";
113
+ STDERR->flush;
114
+ chomp($username = <STDIN>);
115
+ }
116
+ $cred->username($username);
117
+ $cred->may_save($may_save);
118
+ $SVN::_Core::SVN_NO_ERROR;
119
+}
120
+
121
+sub _read_password {
122
+ my ($prompt, $realm) = @_;
123
+ my $password = '';
124
+ if (exists $ENV{GIT_ASKPASS}) {
125
+ open(PH, "-|", $ENV{GIT_ASKPASS}, $prompt);
126
+ $password = <PH>;
127
+ $password =~ s/[\012\015]//; # \n\r
128
+ close(PH);
129
+ } else {
130
+ print STDERR $prompt;
131
+ STDERR->flush;
132
+ require Term::ReadKey;
133
+ Term::ReadKey::ReadMode('noecho');
134
+ while (defined(my $key = Term::ReadKey::ReadKey(0))) {
135
+ last if $key =~ /[\012\015]/; # \n\r
136
+ $password .= $key;
137
+ }
138
+ Term::ReadKey::ReadMode('restore');
139
+ print STDERR "\n";
140
+ STDERR->flush;
141
+ }
142
+ $password;
143
+}
144
+
145
+1;
146
+__END__
147
+
148
+Git::SVN::Prompt - authentication callbacks for git-svn
149
+
150
+=head1 SYNOPSIS
151
+
152
+ use Git::SVN::Prompt qw(simple ssl_client_cert ssl_client_cert_pw
153
+ ssl_server_trust username);
154
+ use SVN::Client ();
155
+
156
+ my $cached_simple = SVN::Client::get_simple_provider();
157
+ my $git_simple = SVN::Client::get_simple_prompt_provider(\&simple, 2);
158
+ my $cached_ssl = SVN::Client::get_ssl_server_trust_file_provider();
159
+ my $git_ssl = SVN::Client::get_ssl_server_trust_prompt_provider(
160
+ \&ssl_server_trust);
161
+ my $cached_cert = SVN::Client::get_ssl_client_cert_file_provider();
162
+ my $git_cert = SVN::Client::get_ssl_client_cert_prompt_provider(
163
+ \&ssl_client_cert, 2);
164
+ my $cached_cert_pw = SVN::Client::get_ssl_client_cert_pw_file_provider();
165
+ my $git_cert_pw = SVN::Client::get_ssl_client_cert_pw_prompt_provider(
166
+ \&ssl_client_cert_pw, 2);
167
+ my $cached_username = SVN::Client::get_username_provider();
168
+ my $git_username = SVN::Client::get_username_prompt_provider(
169
+ \&username, 2);
170
+
171
+ my $ctx = new SVN::Client(
172
+ auth => [
173
+ $cached_simple, $git_simple,
174
+ $cached_ssl, $git_ssl,
175
+ $cached_cert, $git_cert,
176
+ $cached_cert_pw, $git_cert_pw,
177
+ $cached_username, $git_username
178
+ ]);
179
+
180
+=head1 DESCRIPTION
181
+
182
+This module is an implementation detail of the "git svn" command.
183
+It implements git-svn's authentication policy. Do not use it unless
184
+you are developing git-svn.
185
+
186
+The interface will change as git-svn evolves.
187
+
188
+=head1 DEPENDENCIES
189
+
190
+L<SVN::Core>.
191
+
192
+=head1 SEE ALSO
193
+
194
+L<SVN::Client>.
195
+
196
+=head1 INCOMPATIBILITIES
197
+
198
+None reported.
199
+
200
+=head1 BUGS
201
+
202
+None.
perl/Makefile.PL
+1
@@ -27,6 +27,7 @@ MAKE_FRAG
27
my %pm = (
28
'Git.pm' => '$(INST_LIBDIR)/Git.pm',
29
'Git/I18N.pm' => '$(INST_LIBDIR)/Git/I18N.pm',
30
+ 'Git/SVN/Prompt.pm' => '$(INST_LIBDIR)/Git/SVN/Prompt.pm',
31
);
32
33
# We come with our own bundled Error.pm. It's not in the set of default