1#! @PERL@
2# -*-Perl-*-
3#
4# Access control lists for CVS.  dgg@ksr.com (David G. Grubbs)
5#
6# CVS "commitinfo" for matching repository names, running the program it finds
7# on the same line.  More information is available in the CVS man pages.
8#
9# ==== INSTALLATION:
10#
11# To use this program as I intended, do the following four things:
12#
13# 0. Install PERL.  :-)
14#
15# 1. Put one line, as the *only* non-comment line, in your commitinfo file:
16#
17#	DEFAULT		/usr/local/bin/cvs_acls
18#
19# 2. Install this file as /usr/local/bin/cvs_acls and make it executable.
20#
21# 3. Create a file named $CVSROOT/CVSROOT/avail.
22#
23# ==== FORMAT OF THE avail FILE:
24#
25# The avail file determines whether you may commit files.  It contains lines
26# read from top to bottom, keeping track of a single "bit".  The "bit"
27# defaults to "on".  It can be turned "off" by "unavail" lines and "on" by
28# "avail" lines.  ==> Last one counts.
29#
30# Any line not beginning with "avail" or "unavail" is ignored.
31#
32# Lines beginning with "avail" or "unavail" are assumed to be '|'-separated
33# triples: (All spaces and tabs are ignored in a line.)
34#
35#   {avail.*,unavail.*} [| user,user,... [| repos,repos,...]]
36#
37#    1. String starting with "avail" or "unavail".
38#    2. Optional, comma-separated list of usernames.
39#    3. Optional, comma-separated list of repository pathnames.
40#	These are pathnames relative to $CVSROOT.  They can be directories or
41#	filenames.  A directory name allows access to all files and
42#	directories below it.
43#
44# Example:  (Text from the ';;' rightward may not appear in the file.)
45#
46#	unavail			;; Make whole repository unavailable.
47#	avail|dgg		;; Except for user "dgg".
48#	avail|fred, john|bin/ls	;; Except when "fred" or "john" commit to
49#				;; the module whose repository is "bin/ls"
50#
51# PROGRAM LOGIC:
52#
53#	CVS passes to @ARGV an absolute directory pathname (the repository
54#	appended to your $CVSROOT variable), followed by a list of filenames
55#	within that directory.
56#
57#	We walk through the avail file looking for a line that matches both
58#	the username and repository.
59#
60#	A username match is simply the user's name appearing in the second
61#	column of the avail line in a space-or-comma separate list.
62#
63#	A repository match is either:
64#		- One element of the third column matches $ARGV[0], or some
65#		  parent directory of $ARGV[0].
66#		- Otherwise *all* file arguments ($ARGV[1..$#ARGV]) must be
67#		  in the file list in one avail line.
68#	    - In other words, using directory names in the third column of
69#	      the avail file allows committing of any file (or group of
70#	      files in a single commit) in the tree below that directory.
71#	    - If individual file names are used in the third column of
72#	      the avail file, then files must be committed individually or
73#	      all files specified in a single commit must all appear in
74#	      third column of a single avail line.
75#
76
77$debug = 0;
78$cvsroot = $ENV{'CVSROOT'};
79$availfile = $cvsroot . "/CVSROOT/avail";
80$myname = $ENV{"USER"} if !($myname = $ENV{"LOGNAME"});
81
82eval "print STDERR \$die='Unknown parameter $1\n' if !defined \$$1; \$$1=\$';"
83    while ($ARGV[0] =~ /^(\w+)=/ && shift(@ARGV));
84exit 255 if $die;		# process any variable=value switches
85
86die "Must set CVSROOT\n" if !$cvsroot;
87($repos = shift) =~ s:^$cvsroot/::;
88grep($_ = $repos . '/' . $_, @ARGV);
89
90print "$$ Repos: $repos\n","$$ ==== ",join("\n$$ ==== ",@ARGV),"\n" if $debug;
91
92$exit_val = 0;				# Good Exit value
93
94$universal_off = 0;
95open (AVAIL, $availfile) || exit(0);	# It is ok for avail file not to exist
96while (<AVAIL>) {
97    chop;
98    next if /^\s*\#/;
99    next if /^\s*$/;
100    ($flagstr, $u, $m) = split(/[\s,]*\|[\s,]*/, $_);
101
102    # Skip anything not starting with "avail" or "unavail" and complain.
103    (print "Bad avail line: $_\n"), next
104	if ($flagstr !~ /^avail/ && $flagstr !~ /^unavail/);
105
106    # Set which bit we are playing with. ('0' is OK == Available).
107    $flag = (($& eq "avail") ? 0 : 1);
108
109    # If we find a "universal off" flag (i.e. a simple "unavail") remember it
110    $universal_off = 1 if ($flag && !$u && !$m);
111
112    # $myname considered "in user list" if actually in list or is NULL
113    $in_user = (!$u || grep ($_ eq $myname, split(/[\s,]+/,$u)));
114    print "$$ \$myname($myname) in user list: $_\n" if $debug && $in_user;
115
116    # Module matches if it is a NULL module list in the avail line.  If module
117    # list is not null, we check every argument combination.
118    if (!($in_repo = !$m)) {
119	@tmp = split(/[\s,]+/,$m);
120	for $j (@tmp) {
121	    # If the repos from avail is a parent(or equal) dir of $repos, OK
122	    $in_repo = 1, last if ($repos eq $j || $repos =~ /^$j\//);
123	}
124	if (!$in_repo) {
125	    $in_repo = 1;
126	    for $j (@ARGV) {
127		last if !($in_repo = grep ($_ eq $j, @tmp));
128	    }
129	}
130    }
131    print "$$ \$repos($repos) in repository list: $_\n" if $debug && $in_repo;
132
133    $exit_val = $flag if ($in_user && $in_repo);
134    print "$$ ==== \$exit_val = $exit_val\n$$ ==== \$flag = $flag\n" if $debug;
135}
136close(AVAIL);
137print "$$ ==== \$exit_val = $exit_val\n" if $debug;
138print "**** Access denied: Insufficient Karma ($myname|$repos)\n" if $exit_val;
139print "**** Access allowed: Personal Karma exceeds Environmental Karma.\n"
140	if $universal_off && !$exit_val;
141exit($exit_val);
142