diff --git a/git-cvsserver.perl b/git-cvsserver.perl
index 28041060c8a36ac2b89ee179501c2ec726f4606b..8b97fb80cf8bd231bd4f278bf60793dda942d596 100755 (executable)
--- a/git-cvsserver.perl
+++ b/git-cvsserver.perl
exit 1;
}
$line = <STDIN>; chomp $line;
- unless ($line eq 'anonymous') {
- print "E Only anonymous user allowed via pserver\n";
- print "I HATE YOU\n";
- exit 1;
+ my $user = $line;
+ $line = <STDIN>; chomp $line;
+ my $password = $line;
+
+ unless ($user eq 'anonymous') {
+ # Trying to authenticate a user
+ if (not exists $cfg->{gitcvs}->{authdb}) {
+ print "E the repo config file needs a [gitcvs.authdb] section with a filename\n";
+ print "I HATE YOU\n";
+ exit 1;
+ }
+ my $auth_ok;
+ open PASSWD, "<$cfg->{gitcvs}->{authdb}" or die $!;
+ while(<PASSWD>) {
+ if (m{^\Q$user\E:(.*)}) {
+ if (crypt($user, $1) eq $1) {
+ $auth_ok = 1;
+ }
+ };
+ }
+ unless ($auth_ok) {
+ print "I HATE YOU\n";
+ exit 1;
+ }
+ # else fall through to LOVE
}
- $line = <STDIN>; chomp $line; # validate the password?
+
+ # For checking whether the user is anonymous on commit
+ $state->{user} = $user;
+
$line = <STDIN>; chomp $line;
unless ($line eq "END $request REQUEST") {
die "E Do not understand $line -- expecting END $request REQUEST\n";
$state->{localdir} = $data;
$state->{repository} = $repository;
$state->{path} = $repository;
- $state->{path} =~ s/^$state->{CVSROOT}\///;
+ $state->{path} =~ s/^\Q$state->{CVSROOT}\E\///;
$state->{module} = $1 if ($state->{path} =~ s/^(.*?)(\/|$)//);
$state->{path} .= "/" if ( $state->{path} =~ /\S/ );
$log->info("req_ci : " . ( defined($data) ? $data : "[NULL]" ));
- if ( $state->{method} eq 'pserver')
+ if ( $state->{method} eq 'pserver' and $state->{user} eq 'anonymous' )
{
- print "error 1 pserver access cannot commit\n";
+ print "error 1 anonymous user cannot commit via pserver\n";
cleanupWorkTree();
exit;
}
$author;
}
+
+sub descramble
+{
+ # This table is from src/scramble.c in the CVS source
+ my @SHIFTS = (
+ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15,
+ 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31,
+ 114,120, 53, 79, 96,109, 72,108, 70, 64, 76, 67,116, 74, 68, 87,
+ 111, 52, 75,119, 49, 34, 82, 81, 95, 65,112, 86,118,110,122,105,
+ 41, 57, 83, 43, 46,102, 40, 89, 38,103, 45, 50, 42,123, 91, 35,
+ 125, 55, 54, 66,124,126, 59, 47, 92, 71,115, 78, 88,107,106, 56,
+ 36,121,117,104,101,100, 69, 73, 99, 63, 94, 93, 39, 37, 61, 48,
+ 58,113, 32, 90, 44, 98, 60, 51, 33, 97, 62, 77, 84, 80, 85,223,
+ 225,216,187,166,229,189,222,188,141,249,148,200,184,136,248,190,
+ 199,170,181,204,138,232,218,183,255,234,220,247,213,203,226,193,
+ 174,172,228,252,217,201,131,230,197,211,145,238,161,179,160,212,
+ 207,221,254,173,202,146,224,151,140,196,205,130,135,133,143,246,
+ 192,159,244,239,185,168,215,144,139,165,180,157,147,186,214,176,
+ 227,231,219,169,175,156,206,198,129,164,150,210,154,177,134,127,
+ 182,128,158,208,162,132,167,209,149,241,153,251,237,236,171,195,
+ 243,233,253,240,194,250,191,155,142,137,245,235,163,242,178,152
+ );
+ my ($str) = @_;
+
+ # This should never happen, the same password format (A) bas been
+ # used by CVS since the beginning of time
+ die "invalid password format $1" unless substr($str, 0, 1) eq 'A';
+
+ my @str = unpack "C*", substr($str, 1);
+ my $ret = join '', map { chr $SHIFTS[$_] } @str;
+ return $ret;
+}
+
+
package GITCVS::log;
####