|
183 | 183 | exit 1; |
184 | 184 | } |
185 | 185 | $line = <STDIN>; chomp $line; |
186 | | - unless ($line eq 'anonymous') { |
187 | | - print "E Only anonymous user allowed via pserver\n"; |
188 | | - print "I HATE YOU\n"; |
189 | | - exit 1; |
| 186 | + my $user = $line; |
| 187 | + $line = <STDIN>; chomp $line; |
| 188 | + my $password = $line; |
| 189 | + |
| 190 | + unless ($user eq 'anonymous') { |
| 191 | + # Trying to authenticate a user |
| 192 | + if (not exists $cfg->{gitcvs}->{users}) { |
| 193 | + print "E the repo config file needs a [gitcvs.users] section with user/password key-value pairs\n"; |
| 194 | + print "I HATE YOU\n"; |
| 195 | + exit 1; |
| 196 | + } elsif (exists $cfg->{gitcvs}->{users} and not exists $cfg->{gitcvs}->{users}->{$user}) { |
| 197 | + #print "E the repo config file has a [gitcvs.users] section but the user $user is not defined in it\n"; |
| 198 | + print "I HATE YOU\n"; |
| 199 | + exit 1; |
| 200 | + } else { |
| 201 | + my $descrambled_password = descramble($password); |
| 202 | + my $cleartext_password = $cfg->{gitcvs}->{users}->{$user}; |
| 203 | + if ($descrambled_password ne $cleartext_password) { |
| 204 | + #print "E The password supplied for user $user was incorrect\n"; |
| 205 | + print "I HATE YOU\n"; |
| 206 | + exit 1; |
| 207 | + } |
| 208 | + # else fall through to LOVE |
| 209 | + } |
190 | 210 | } |
191 | | - $line = <STDIN>; chomp $line; # validate the password? |
| 211 | + |
| 212 | + # For checking whether the user is anonymous on commit |
| 213 | + $state->{user} = $user; |
| 214 | + |
192 | 215 | $line = <STDIN>; chomp $line; |
193 | 216 | unless ($line eq "END $request REQUEST") { |
194 | 217 | die "E Do not understand $line -- expecting END $request REQUEST\n"; |
@@ -314,7 +337,7 @@ sub req_Root |
314 | 337 | } |
315 | 338 | foreach my $line ( @gitvars ) |
316 | 339 | { |
317 | | - next unless ( $line =~ /^(gitcvs)\.(?:(ext|pserver)\.)?([\w-]+)=(.*)$/ ); |
| 340 | + next unless ( $line =~ /^(gitcvs)\.(?:(ext|pserver|users)\.)?([\w-]+)=(.*)$/ ); |
318 | 341 | unless ($2) { |
319 | 342 | $cfg->{$1}{$3} = $4; |
320 | 343 | } else { |
@@ -1271,9 +1294,9 @@ sub req_ci |
1271 | 1294 |
|
1272 | 1295 | $log->info("req_ci : " . ( defined($data) ? $data : "[NULL]" )); |
1273 | 1296 |
|
1274 | | - if ( $state->{method} eq 'pserver') |
| 1297 | + if ( $state->{method} eq 'pserver' and $state->{user} eq 'anonymous' ) |
1275 | 1298 | { |
1276 | | - print "error 1 pserver access cannot commit\n"; |
| 1299 | + print "error 1 anonymous user cannot commit via pserver\n"; |
1277 | 1300 | cleanupWorkTree(); |
1278 | 1301 | exit; |
1279 | 1302 | } |
@@ -2586,6 +2609,40 @@ sub cvs_author |
2586 | 2609 | $author; |
2587 | 2610 | } |
2588 | 2611 |
|
| 2612 | + |
| 2613 | +sub descramble |
| 2614 | +{ |
| 2615 | + # This table is from src/scramble.c in the CVS source |
| 2616 | + my @SHIFTS = ( |
| 2617 | + 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, |
| 2618 | + 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, |
| 2619 | + 114,120, 53, 79, 96,109, 72,108, 70, 64, 76, 67,116, 74, 68, 87, |
| 2620 | + 111, 52, 75,119, 49, 34, 82, 81, 95, 65,112, 86,118,110,122,105, |
| 2621 | + 41, 57, 83, 43, 46,102, 40, 89, 38,103, 45, 50, 42,123, 91, 35, |
| 2622 | + 125, 55, 54, 66,124,126, 59, 47, 92, 71,115, 78, 88,107,106, 56, |
| 2623 | + 36,121,117,104,101,100, 69, 73, 99, 63, 94, 93, 39, 37, 61, 48, |
| 2624 | + 58,113, 32, 90, 44, 98, 60, 51, 33, 97, 62, 77, 84, 80, 85,223, |
| 2625 | + 225,216,187,166,229,189,222,188,141,249,148,200,184,136,248,190, |
| 2626 | + 199,170,181,204,138,232,218,183,255,234,220,247,213,203,226,193, |
| 2627 | + 174,172,228,252,217,201,131,230,197,211,145,238,161,179,160,212, |
| 2628 | + 207,221,254,173,202,146,224,151,140,196,205,130,135,133,143,246, |
| 2629 | + 192,159,244,239,185,168,215,144,139,165,180,157,147,186,214,176, |
| 2630 | + 227,231,219,169,175,156,206,198,129,164,150,210,154,177,134,127, |
| 2631 | + 182,128,158,208,162,132,167,209,149,241,153,251,237,236,171,195, |
| 2632 | + 243,233,253,240,194,250,191,155,142,137,245,235,163,242,178,152 |
| 2633 | + ); |
| 2634 | + my ($str) = @_; |
| 2635 | + |
| 2636 | + # This should never happen, the same password format (A) bas been |
| 2637 | + # used by CVS since the beginning of time |
| 2638 | + die "invalid password format $1" unless substr($str, 0, 1) eq 'A'; |
| 2639 | + |
| 2640 | + my @str = unpack "C*", substr($str, 1); |
| 2641 | + my $ret = join '', map { chr $SHIFTS[$_] } @str; |
| 2642 | + return $ret; |
| 2643 | +} |
| 2644 | + |
| 2645 | + |
2589 | 2646 | package GITCVS::log; |
2590 | 2647 |
|
2591 | 2648 | #### |
|
0 commit comments