# -*- Mode: perl; indent-tabs-mode: nil -*- # # The contents of this file are subject to the Mozilla Public License # Version 1.0 (the "License"); you may not use this file except in # compliance with the License. You may obtain a copy of the License at # http://www.mozilla.org/MPL/ # # Software distributed under the License is distributed on an "AS IS" # basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the # License for the specific language governing rights and limitations # under the License. # # The Original Code is the Despot Account Administration System. # # The Initial Developer of the Original Code is Netscape Communications # Corporation. Portions created by Netscape are Copyright (C) 1998 # Netscape Communications Corporation. All Rights Reserved. # # Contributor(s): Terry Weissman # This file gets munged and checked into your CVSROOT directory as # 'commitcheck.pl'. To make it work, you need to add a line to your # CVSROOT/commitinfo file that says something like: # # ALL $CVSROOT/CVSROOT/commitcheck.pl $debug = 0; $origrepository = shift(@ARGV); @files = @ARGV; $envcvsroot = $ENV{'CVSROOT'}; open( REP, "; chop($repository); close(REP); $repository =~ s:^$envcvsroot/::; # Iterate over the body of the message collecting information. # $doit = 0; $| = 1; if( $debug){ print STDERR "----------------------------------------------\n"; print STDERR "files: @files\n"; print STDERR "origrepository: $origrepository\n"; print STDERR " repository: $repository\n"; print STDERR "----------------------------------------------\n"; } open(ENT, " ){ chop; ($d,$fn,$rev,$mod_time,$sticky,$tag) = split(/\//); if ($tag =~ /^T(.*)$/) { $fbranch{$fn} = $1; } } close ENT; foreach $f (@files) { $b = ""; if (defined $fbranch{$f}) {$b = $fbranch{$f};} if ($b eq "") {$b = "HEAD";} $t = GetT($b, "$repository/$f"); if ($debug) { print STDERR "GetT returned '$t' for '$repository/$f' branch '$b'\n"; } if ($t eq "") { $t = $defaultid; } if (!defined $mode{$t} || $mode{$t} eq "Open") { next; } if ($debug) { print STDERR "Checking twig $t\n"; } # OK, we have a match. See if we're allowed to checkin here. if ($username eq "") { $username = $ENV{"CVS_USER"} || getlogin || (getpwuid($<))[0] || "nobody"; if ($debug) { print STDERR "Username is $username\n"; print STDERR "getlogin returns " . getlogin . "\n"; print STDERR '(getpwuid($<))[0] returns ' . (getpwuid($<))[0] . "\n"; print STDERR "Environment:\n"; foreach $key (sort(keys %ENV)) { print STDERR $key, '=', $ENV{$key}, "\n"; } } } $ok = 0; $s = $super{$t}; foreach $u (@$s) { if ($debug) { print STDERR "Checking against super $u\n"; } if ($u eq $username) { $ok = 1; break; } } if ($mode{$t} eq "Restricted") { my $b = $blessed{$t}; foreach $u (@$b) { if ($debug) { print STDERR "Checking against blessed $u\n"; } if ($u eq $username) { $ok = 1; break; } } } if (!$ok) { print STDERR "You may not check into partition $fullname{$t}\n"; print STDERR "the file $repository/$f on branch $b\n"; print STDERR "If you think you should be allowed to, send mail to\n"; print STDERR "one of the below people:\n"; $s = $super{$t}; foreach $u (@$s) { $u =~ s/%/@/; print STDERR " $u\n"; } exit 1; } } exit 0;