cvs_acls.in revision 1.1 1 1.1 christos #! @PERL@ -T
2 1.1 christos # -*-Perl-*-
3 1.1 christos
4 1.1 christos # Copyright (C) 1994-2005 The Free Software Foundation, Inc.
5 1.1 christos
6 1.1 christos # This program is free software; you can redistribute it and/or modify
7 1.1 christos # it under the terms of the GNU General Public License as published by
8 1.1 christos # the Free Software Foundation; either version 2, or (at your option)
9 1.1 christos # any later version.
10 1.1 christos #
11 1.1 christos # This program is distributed in the hope that it will be useful,
12 1.1 christos # but WITHOUT ANY WARRANTY; without even the implied warranty of
13 1.1 christos # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 1.1 christos # GNU General Public License for more details.
15 1.1 christos
16 1.1 christos ###############################################################################
17 1.1 christos ###############################################################################
18 1.1 christos ###############################################################################
19 1.1 christos #
20 1.1 christos # THIS SCRIPT IS PROBABLY BROKEN. REMOVING THE -T SWITCH ON THE #! LINE ABOVE
21 1.1 christos # WOULD FIX IT, BUT THIS IS INSECURE. WE RECOMMEND FIXING THE ERRORS WHICH THE
22 1.1 christos # -T SWITCH WILL CAUSE PERL TO REPORT BEFORE RUNNING THIS SCRIPT FROM A CVS
23 1.1 christos # SERVER TRIGGER. PLEASE SEND PATCHES CONTAINING THE CHANGES YOU FIND
24 1.1 christos # NECESSARY TO RUN THIS SCRIPT WITH THE TAINT-CHECKING ENABLED BACK TO THE
25 1.1 christos # <@PACKAGE_BUGREPORT@> MAILING LIST.
26 1.1 christos #
27 1.1 christos # For more on general Perl security and taint-checking, please try running the
28 1.1 christos # `perldoc perlsec' command.
29 1.1 christos #
30 1.1 christos ###############################################################################
31 1.1 christos ###############################################################################
32 1.1 christos ###############################################################################
33 1.1 christos
34 1.1 christos =head1 Name
35 1.1 christos
36 1.1 christos cvs_acls - Access Control List for CVS
37 1.1 christos
38 1.1 christos =head1 Synopsis
39 1.1 christos
40 1.1 christos In 'commitinfo':
41 1.1 christos
42 1.1 christos repository/path/to/restrict $CVSROOT/CVSROOT/cvs_acls [-d][-u $USER][-f <logfile>]
43 1.1 christos
44 1.1 christos where:
45 1.1 christos
46 1.1 christos -d turns on debug information
47 1.1 christos -u passes the client-side userId to the cvs_acls script
48 1.1 christos -f specifies an alternate filename for the restrict_log file
49 1.1 christos
50 1.1 christos In 'cvsacl':
51 1.1 christos
52 1.1 christos {allow.*,deny.*} [|user,user,... [|repos,repos,... [|branch,branch,...]]]
53 1.1 christos
54 1.1 christos where:
55 1.1 christos
56 1.1 christos allow|deny - allow: commits are allowed; deny: prohibited
57 1.1 christos user - userId to be allowed or restricted
58 1.1 christos repos - file or directory to be allowed or restricted
59 1.1 christos branch - branch to be allowed or restricted
60 1.1 christos
61 1.1 christos See below for examples.
62 1.1 christos
63 1.1 christos =head1 Licensing
64 1.1 christos
65 1.1 christos cvs_acls - provides access control list functionality for CVS
66 1.1 christos
67 1.1 christos Copyright (c) 2004 by Peter Connolly <peter.connolly@cnet.com>
68 1.1 christos All rights reserved.
69 1.1 christos
70 1.1 christos This program is free software; you can redistribute it and/or modify
71 1.1 christos it under the terms of the GNU General Public License as published by
72 1.1 christos the Free Software Foundation; either version 2 of the License, or
73 1.1 christos (at your option) any later version.
74 1.1 christos
75 1.1 christos This program is distributed in the hope that it will be useful,
76 1.1 christos but WITHOUT ANY WARRANTY; without even the implied warranty of
77 1.1 christos MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
78 1.1 christos GNU General Public License for more details.
79 1.1 christos
80 1.1 christos You should have received a copy of the GNU General Public License
81 1.1 christos along with this program; if not, write to the Free Software
82 1.1 christos Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
83 1.1 christos
84 1.1 christos =head1 Description
85 1.1 christos
86 1.1 christos This script--cvs_acls--is invoked once for each directory within a
87 1.1 christos "cvs commit". The set of files being committed for that directory as
88 1.1 christos well as the directory itself, are passed to this script. This script
89 1.1 christos checks its 'cvsacl' file to see if any of the files being committed
90 1.1 christos are on the 'cvsacl' file's restricted list. If any of the files are
91 1.1 christos restricted, then the cvs_acls script passes back an exit code of 1
92 1.1 christos which disallows the commits for that directory.
93 1.1 christos
94 1.1 christos Messages are returned to the committer indicating the file(s) that
95 1.1 christos he/she are not allowed to committ. Additionally, a site-specific
96 1.1 christos set of messages (e.g., contact information) can be included in these
97 1.1 christos messages.
98 1.1 christos
99 1.1 christos When a commit is prohibited, log messages are written to a restrict_log
100 1.1 christos file in $CVSROOT/CVSROOT. This default file can be redirected to
101 1.1 christos another destination.
102 1.1 christos
103 1.1 christos The script is triggered from the 'commitinfo' file in $CVSROOT/CVSROOT/.
104 1.1 christos
105 1.1 christos =head1 Enhancements
106 1.1 christos
107 1.1 christos This section lists the bug fixes and enhancements added to cvs_acls
108 1.1 christos that make up the current cvs_acls.
109 1.1 christos
110 1.1 christos =head2 Fixed Bugs
111 1.1 christos
112 1.1 christos This version attempts to get rid the following bugs from the
113 1.1 christos original version of cvs_acls:
114 1.1 christos
115 1.1 christos =over 2
116 1.1 christos
117 1.1 christos =item *
118 1.1 christos Multiple entries on an 'cvsacl' line will be matched individually,
119 1.1 christos instead of requiring that all commit files *exactly* match all
120 1.1 christos 'cvsacl' entries. Commiting a file not in the 'cvsacl' list would
121 1.1 christos allow *all* files (including a restricted file) to be committed.
122 1.1 christos
123 1.1 christos [IMO, this basically made the original script unuseable for our
124 1.1 christos situation since any arbitrary combination of committed files could
125 1.1 christos avoid matching the 'cvsacl's entries.]
126 1.1 christos
127 1.1 christos =item *
128 1.1 christos Handle specific filename restrictions. cvs_acls didn't restrict
129 1.1 christos individual files specified in 'cvsacl'.
130 1.1 christos
131 1.1 christos =item *
132 1.1 christos Correctly handle multiple, specific filename restrictions
133 1.1 christos
134 1.1 christos =item *
135 1.1 christos Prohibit mix of dirs and files on a single 'cvsacl' line
136 1.1 christos [To simplify the logic and because this would be normal usage.]
137 1.1 christos
138 1.1 christos =item *
139 1.1 christos Correctly handle a mixture of branch restrictions within one work
140 1.1 christos directory
141 1.1 christos
142 1.1 christos =item *
143 1.1 christos $CVSROOT existence is checked too late
144 1.1 christos
145 1.1 christos =item *
146 1.1 christos Correctly handle the CVSROOT=:local:/... option (useful for
147 1.1 christos interactive testing)
148 1.1 christos
149 1.1 christos =item *
150 1.1 christos Replacing shoddy "$universal_off" logic
151 1.1 christos (Thanks to Karl-Konig Konigsson for pointing this out.)
152 1.1 christos
153 1.1 christos =back
154 1.1 christos
155 1.1 christos =head2 Enhancements
156 1.1 christos
157 1.1 christos =over 2
158 1.1 christos
159 1.1 christos =item *
160 1.1 christos Checks modules in the 'cvsacl' file for valid files and directories
161 1.1 christos
162 1.1 christos =item *
163 1.1 christos Accurately report restricted entries and their matching patterns
164 1.1 christos
165 1.1 christos =item *
166 1.1 christos Simplified and commented overly complex PERL REGEXPs for readability
167 1.1 christos and maintainability
168 1.1 christos
169 1.1 christos =item *
170 1.1 christos Skip the rest of processing if a mismatch on portion of the 'cvsacl' line
171 1.1 christos
172 1.1 christos =item *
173 1.1 christos Get rid of opaque "karma" messages in favor of user-friendly messages
174 1.1 christos that describe which user, file(s) and branch(es) were disallowed.
175 1.1 christos
176 1.1 christos =item *
177 1.1 christos Add optional 'restrict_msg' file for additional, site-specific
178 1.1 christos restriction messages.
179 1.1 christos
180 1.1 christos =item *
181 1.1 christos Take a "-u" parameter for $USER from commit_prep so that the script
182 1.1 christos can do restrictions based on the client-side userId rather than the
183 1.1 christos server-side userId (usually 'cvs').
184 1.1 christos
185 1.1 christos (See discussion below on "Admin Setup" for more on this point.)
186 1.1 christos
187 1.1 christos =item *
188 1.1 christos Added a lot more debug trace
189 1.1 christos
190 1.1 christos =item *
191 1.1 christos Tested these restrictions with concurrent use of pserver and SSH
192 1.1 christos access to model our transition from pserver to ext access.
193 1.1 christos
194 1.1 christos =item *
195 1.1 christos Added logging of restricted commit attempts.
196 1.1 christos Restricted commits can be sent to a default file:
197 1.1 christos $CVSROOT/CVSROOT/restrictlog or to one passed to the script
198 1.1 christos via the -f command parameter.
199 1.1 christos
200 1.1 christos =back
201 1.1 christos
202 1.1 christos =head2 ToDoS
203 1.1 christos
204 1.1 christos =over 2
205 1.1 christos
206 1.1 christos =item *
207 1.1 christos Need to deal with pserver/SSH transition with conflicting umasks?
208 1.1 christos
209 1.1 christos =item *
210 1.1 christos Use a CPAN module to handle command parameters.
211 1.1 christos
212 1.1 christos =item *
213 1.1 christos Use a CPAN module to clone data structures.
214 1.1 christos
215 1.1 christos =back
216 1.1 christos
217 1.1 christos =head1 Version Information
218 1.1 christos
219 1.1 christos This is not offered as a fix to the original 'cvs_acls' script since it
220 1.1 christos differs substantially in goals and methods from the original and there
221 1.1 christos are probably a significant number of people out there that still require
222 1.1 christos the original version's functionality.
223 1.1 christos
224 1.1 christos The 'cvsacl' file flags of 'allow' and 'deny' were intentionally
225 1.1 christos changed to 'allow' and 'deny' because there are enough differences
226 1.1 christos between the original script's behavior and this one's that we wanted to
227 1.1 christos make sure that users will rethink their 'cvsacl' file formats before
228 1.1 christos plugging in this newer script.
229 1.1 christos
230 1.1 christos Please note that there has been very limited cross-platform testing of
231 1.1 christos this script!!! (We did not have the time or resources to do exhaustive
232 1.1 christos cross-platform testing.)
233 1.1 christos
234 1.1 christos It was developed and tested under Red Hat Linux 9.0 using PERL 5.8.0.
235 1.1 christos Additionally, it was built and tested under Red Hat Linux 7.3 using
236 1.1 christos PERL 5.6.1.
237 1.1 christos
238 1.1 christos $Id: cvs_acls.in,v 1.1 2009/04/07 22:10:10 christos Exp $
239 1.1 christos
240 1.1 christos This version is based on the 1.11.13 version of cvs_acls
241 1.1 christos peter.connolly (at] cnet.com (Peter Connolly)
242 1.1 christos
243 1.1 christos Access control lists for CVS. dgg (at] ksr.com (David G. Grubbs)
244 1.1 christos Branch specific controls added by voisine (at] bytemobile.com (Aaron Voisine)
245 1.1 christos
246 1.1 christos =head1 Installation
247 1.1 christos
248 1.1 christos To use this program, do the following four things:
249 1.1 christos
250 1.1 christos 0. Install PERL, version 5.6.1 or 5.8.0.
251 1.1 christos
252 1.1 christos 1. Admin Setup:
253 1.1 christos
254 1.1 christos There are two choices here.
255 1.1 christos
256 1.1 christos a) The first option is to use the $ENV{"USER"}, server-side userId
257 1.1 christos (from the third column of your pserver 'passwd' file) as the basis for
258 1.1 christos your restrictions. In this case, you will (at a minimum) want to set
259 1.1 christos up a new "cvsadmin" userId and group on the pserver machine.
260 1.1 christos CVS administrators will then set up their 'passwd' file entries to
261 1.1 christos run either as "cvs" (for regular users) or as "cvsadmin" (for power
262 1.1 christos users). Correspondingly, your 'cvsacl' file will only list 'cvs'
263 1.1 christos and 'cvsadmin' as the userIds in the second column.
264 1.1 christos
265 1.1 christos Commentary: A potential weakness of this is that the xinetd
266 1.1 christos cvspserver process will need to run as 'root' in order to switch
267 1.1 christos between the 'cvs' and the 'cvsadmin' userIds. Some sysadmins don't
268 1.1 christos like situations like this and may want to chroot the process.
269 1.1 christos Talk to them about this point...
270 1.1 christos
271 1.1 christos b) The second option is to use the client-side userId as the basis for
272 1.1 christos your restrictions. In this case, all the xinetd cvspserver processes
273 1.1 christos can run as userId 'cvs' and no 'root' userId is required. If you have
274 1.1 christos a 'passwd' file that lists 'cvs' as the effective run-time userId for
275 1.1 christos all your users, then no changes to this file are needed. Your 'cvsacl'
276 1.1 christos file will use the individual, client-side userIds in its 2nd column.
277 1.1 christos
278 1.1 christos As long as the userIds in pserver's 'passwd' file match those userIds
279 1.1 christos that your Linux server know about, this approach is ideal if you are
280 1.1 christos planning to move from pserver to SSH access at some later point in time.
281 1.1 christos Just by switching the CVSROOT var from CVSROOT=:pserver:<userId>... to
282 1.1 christos CVSROOT=:ext:<userId>..., users can switch over to SSH access without
283 1.1 christos any other administrative changes. When all users have switched over to
284 1.1 christos SSH, the inherently insecure xinetd cvspserver process can be disabled.
285 1.1 christos [http://ximbiot.com/cvs/manual/cvs-1.11.17/cvs_2.html#SEC32]
286 1.1 christos
287 1.1 christos :TODO: The only potential glitch with the SSH approach is the possibility
288 1.1 christos that each user can have differing umasks that might interfere with one
289 1.1 christos another, especially during a transition from pserver to SSH. As noted
290 1.1 christos in the ToDo section, this needs a good strategy and set of tests for that
291 1.1 christos yet...
292 1.1 christos
293 1.1 christos 2. Put two lines, as the *only* non-comment lines, in your commitinfo file:
294 1.1 christos
295 1.1 christos ALL $CVSROOT/CVSROOT/commit_prep
296 1.1 christos ALL $CVSROOT/CVSROOT/cvs_acls [-d][-u $USER ][-f <logfilename>]
297 1.1 christos
298 1.1 christos where "-d" turns on debug trace
299 1.1 christos "-u $USER" passes the client-side userId to cvs_acls
300 1.1 christos "-f <logfilename"> overrides the default filename used to log
301 1.1 christos restricted commit attempts.
302 1.1 christos
303 1.1 christos (These are handled in the processArgs() subroutine.)
304 1.1 christos
305 1.1 christos If you are using client-side userIds to restrict access to your
306 1.1 christos repository, make sure that they are in this order since the commit_prep
307 1.1 christos script is required in order to pass the $USER parameter.
308 1.1 christos
309 1.1 christos A final note about the repository matching pattern. The example above
310 1.1 christos uses "ALL" but note that this means that the cvs_acls script will run
311 1.1 christos for each and every commit in your repository. Obviously, in a large
312 1.1 christos repository this adds up to a lot of overhead that may not be necesary.
313 1.1 christos A better strategy is to use a repository pattern that is more specific
314 1.1 christos to the areas that you wish to secure.
315 1.1 christos
316 1.1 christos 3. Install this file as $CVSROOT/CVSROOT/cvs_acls and make it executable.
317 1.1 christos
318 1.1 christos 4. Create a file named CVSROOT/cvsacl and optionally add it to
319 1.1 christos CVSROOT/checkoutlist and check it in. See the CVS manual's
320 1.1 christos administrative files section about checkoutlist. Typically:
321 1.1 christos
322 1.1 christos $ cvs checkout CVSROOT
323 1.1 christos $ cd CVSROOT
324 1.1 christos [ create the cvsacl file, include 'commitinfo' line ]
325 1.1 christos [ add cvsacl to checkoutlist ]
326 1.1 christos $ cvs add cvsacl
327 1.1 christos $ cvs commit -m 'Added cvsacl for use with cvs_acls.' cvsacl checkoutlist
328 1.1 christos
329 1.1 christos Note: The format of the 'cvsacl' file is described in detail immediately
330 1.1 christos below but here is an important set up point:
331 1.1 christos
332 1.1 christos Make sure to include a line like the following:
333 1.1 christos
334 1.1 christos deny||CVSROOT/commitinfo CVSROOT/cvsacl
335 1.1 christos allow|cvsadmin|CVSROOT/commitinfo CVSROOT/cvsacl
336 1.1 christos
337 1.1 christos that restricts access to commitinfo and cvsacl since this would be one of
338 1.1 christos the easiest "end runs" around this ACL approach. ('commitinfo' has the
339 1.1 christos line that executes the cvs_acls script and, of course, all the
340 1.1 christos restrictions are in 'cvsacl'.)
341 1.1 christos
342 1.1 christos 5. (Optional) Create a 'restrict_msg' file in the $CVSROOT/CVSROOT directory.
343 1.1 christos Whenever there is a restricted file or dir message, cvs_acls will look
344 1.1 christos for this file and, if it exists, print its contents as part of the
345 1.1 christos commit-denial message. This gives you a chance to print any site-specific
346 1.1 christos information (e.g., who to call, what procedures to look up,...) whenever
347 1.1 christos a commit is denied.
348 1.1 christos
349 1.1 christos =head1 Format of the cvsacl file
350 1.1 christos
351 1.1 christos The 'cvsacl' file determines whether you may commit files. It contains lines
352 1.1 christos read from top to bottom, keeping track of whether a given user, repository
353 1.1 christos and branch combination is "allowed" or "denied." The script will assume
354 1.1 christos "allowed" on all repository paths until 'allow' and 'deny' rules change
355 1.1 christos that default.
356 1.1 christos
357 1.1 christos The normal pattern is to specify an 'deny' rule to turn off
358 1.1 christos access to ALL users, then follow it with a matching 'allow' rule that will
359 1.1 christos turn on access for a select set of users. In the case of multiple rules for
360 1.1 christos the same user, repository and branch, the last one takes precedence.
361 1.1 christos
362 1.1 christos Blank lines and lines with only comments are ignored. Any other lines not
363 1.1 christos beginning with "allow" or "deny" are logged to the restrict_log file.
364 1.1 christos
365 1.1 christos Lines beginning with "allow" or "deny" are assumed to be '|'-separated
366 1.1 christos triples: (All spaces and tabs are ignored in a line.)
367 1.1 christos
368 1.1 christos {allow.*,deny.*} [|user,user,... [|repos,repos,... [|branch,branch,...]]]
369 1.1 christos
370 1.1 christos 1. String starting with "allow" or "deny".
371 1.1 christos 2. Optional, comma-separated list of usernames.
372 1.1 christos 3. Optional, comma-separated list of repository pathnames.
373 1.1 christos These are pathnames relative to $CVSROOT. They can be directories or
374 1.1 christos filenames. A directory name allows or restricts access to all files and
375 1.1 christos directories below it. One line can have either directories or filenames
376 1.1 christos but not both.
377 1.1 christos 4. Optional, comma-separated list of branch tags.
378 1.1 christos If not specified, all branches are assumed. Use HEAD to reference the
379 1.1 christos main branch.
380 1.1 christos
381 1.1 christos Example: (Note: No in-line comments.)
382 1.1 christos
383 1.1 christos # ----- Make whole repository unavailable.
384 1.1 christos deny
385 1.1 christos
386 1.1 christos # ----- Except for user "dgg".
387 1.1 christos allow|dgg
388 1.1 christos
389 1.1 christos # ----- Except when "fred" or "john" commit to the
390 1.1 christos # module whose repository is "bin/ls"
391 1.1 christos allow|fred, john|bin/ls
392 1.1 christos
393 1.1 christos # ----- Except when "ed" commits to the "stable"
394 1.1 christos # branch of the "bin/ls" repository
395 1.1 christos allow|ed|/bin/ls|stable
396 1.1 christos
397 1.1 christos =head1 Program Logic
398 1.1 christos
399 1.1 christos CVS passes to @ARGV an absolute directory pathname (the repository
400 1.1 christos appended to your $CVSROOT variable), followed by a list of filenames
401 1.1 christos within that directory that are to be committed.
402 1.1 christos
403 1.1 christos The script walks through the 'cvsacl' file looking for matches on
404 1.1 christos the username, repository and branch.
405 1.1 christos
406 1.1 christos A username match is simply the user's name appearing in the second
407 1.1 christos column of the cvsacl line in a space-or-comma separate list. If
408 1.1 christos blank, then any user will match.
409 1.1 christos
410 1.1 christos A repository match:
411 1.1 christos
412 1.1 christos =over 2
413 1.1 christos
414 1.1 christos =item *
415 1.1 christos Each entry in the modules section of the current 'cvsacl' line is
416 1.1 christos examined to see if it is a dir or a file. The line must have
417 1.1 christos either files or dirs, but not both. (To simplify the logic.)
418 1.1 christos
419 1.1 christos =item *
420 1.1 christos If neither, then assume the 'cvsacl' file was set up in error and
421 1.1 christos skip that 'allow' line.
422 1.1 christos
423 1.1 christos =item *
424 1.1 christos If a dir, then each dir pattern is matched separately against the
425 1.1 christos beginning of each of the committed files in @ARGV.
426 1.1 christos
427 1.1 christos =item *
428 1.1 christos If a file, then each file pattern is matched exactly against each
429 1.1 christos of the files to be committed in @ARGV.
430 1.1 christos
431 1.1 christos =item *
432 1.1 christos Repository and branch must BOTH match together. This is to cover
433 1.1 christos the use case where a user has multiple branches checked out in
434 1.1 christos a single work directory. Commit files can be from different
435 1.1 christos branches.
436 1.1 christos
437 1.1 christos A branch match is either:
438 1.1 christos
439 1.1 christos =over 4
440 1.1 christos
441 1.1 christos =item *
442 1.1 christos When no branches are listed in the fourth column. ("Match any.")
443 1.1 christos
444 1.1 christos =item *
445 1.1 christos All elements from the fourth column are matched against each of
446 1.1 christos the tag names for $ARGV[1..$#ARGV] found in the %branches file.
447 1.1 christos
448 1.1 christos =back
449 1.1 christos
450 1.1 christos =item *
451 1.1 christos 'allow' match remove that match from the tally map.
452 1.1 christos
453 1.1 christos =item *
454 1.1 christos Restricted ('deny') matches are saved in the %repository_matches
455 1.1 christos table.
456 1.1 christos
457 1.1 christos =item *
458 1.1 christos If there is a match on user, repository and branch:
459 1.1 christos
460 1.1 christos If repository, branch and user match
461 1.1 christos if 'deny'
462 1.1 christos add %repository_matches entries to %restricted_entries
463 1.1 christos else if 'allow'
464 1.1 christos remove %repository_matches entries from %restricted_entries
465 1.1 christos
466 1.1 christos =item *
467 1.1 christos At the end of all the 'cvsacl' line checks, check to see if there
468 1.1 christos are any entries in the %restricted_entries. If so, then deny the
469 1.1 christos commit.
470 1.1 christos
471 1.1 christos =back
472 1.1 christos
473 1.1 christos =head2 Pseudocode
474 1.1 christos
475 1.1 christos read CVS/Entries file and create branch{file}->{branch} hash table
476 1.1 christos + for each 'allow' and 'deny' line in the 'cvsacl' file:
477 1.1 christos | user match?
478 1.1 christos | - Yes: set $user_match = 1;
479 1.1 christos | repository and branch match?
480 1.1 christos | - Yes: add to %repository_matches;
481 1.1 christos | did user, repository match?
482 1.1 christos | - Yes: if 'deny' then
483 1.1 christos | add %repository_matches -> %restricted_entries
484 1.1 christos | if 'allow' then
485 1.1 christos | remove %repository_matches <- %restricted_entries
486 1.1 christos + end for loop
487 1.1 christos any saved restrictions?
488 1.1 christos no: exit,
489 1.1 christos set exit code allowing commits and exit
490 1.1 christos yes: report restrictions,
491 1.1 christos set exit code prohibiting commits and exit
492 1.1 christos
493 1.1 christos =head2 Sanity Check
494 1.1 christos
495 1.1 christos 1) file allow trumps a dir deny
496 1.1 christos deny||java/lib
497 1.1 christos allow||java/lib/README
498 1.1 christos 2) dir allow can undo a file deny
499 1.1 christos deny||java/lib/README
500 1.1 christos allow||java/lib
501 1.1 christos 3) file deny trumps a dir allow
502 1.1 christos allow||java/lib
503 1.1 christos deny||java/lib/README
504 1.1 christos 4) dir deny trumps a file allow
505 1.1 christos allow||java/lib/README
506 1.1 christos deny||java/lib
507 1.1 christos ... so last match always takes precedence
508 1.1 christos
509 1.1 christos =cut
510 1.1 christos
511 1.1 christos $debug = 0; # Set to 1 for debug messages
512 1.1 christos
513 1.1 christos %repository_matches = (); # hash of match file and pattern from 'cvsacl'
514 1.1 christos # repository_matches --> [branch, matching-pattern]
515 1.1 christos # (Used during module/branch matching loop)
516 1.1 christos
517 1.1 christos %restricted_entries = (); # hash table of restricted commit files (from @ARGV)
518 1.1 christos # restricted_entries --> branch
519 1.1 christos # (If user/module/branch all match on an 'deny'
520 1.1 christos # line, then entries added to this map.)
521 1.1 christos
522 1.1 christos %branch; # hash table of key: commit file; value: branch
523 1.1 christos # Built from ".../CVS/Entries" file of directory
524 1.1 christos # currently being examined
525 1.1 christos
526 1.1 christos # ---------------------------------------------------------------- get CVSROOT
527 1.1 christos $cvsroot = $ENV{'CVSROOT'};
528 1.1 christos die "Must set CVSROOT\n" if !$cvsroot;
529 1.1 christos if ($cvsroot =~ /:([\/\w]*)$/) { # Filter ":pserver:", ":local:"-type prefixes
530 1.1 christos $cvsroot = $1;
531 1.1 christos }
532 1.1 christos
533 1.1 christos # ------------------------------------------------------------- set file paths
534 1.1 christos $entries = "CVS/Entries"; # client-side file???
535 1.1 christos $cvsaclfile = $cvsroot . "/CVSROOT/cvsacl";
536 1.1 christos $restrictfile = $cvsroot . "/CVSROOT/restrict_msg";
537 1.1 christos $restrictlog = $cvsroot . "/CVSROOT/restrict_log";
538 1.1 christos
539 1.1 christos # --------------------------------------------------------------- process args
540 1.1 christos $user_name = processArgs(\@ARGV);
541 1.1 christos
542 1.1 christos print("$$ \@ARGV after processArgs is: @ARGV.\n") if $debug;
543 1.1 christos print("$$ ========== Begin $PROGRAM_NAME for \"$ARGV[0]\" repository. ========== \n") if $debug;
544 1.1 christos
545 1.1 christos # --------------------------------------------------------------- filter @ARGV
546 1.1 christos eval "print STDERR \$die='Unknown parameter $1\n' if !defined \$$1; \$$1=\$';"
547 1.1 christos while ($ARGV[0] =~ /^(\w+)=/ && shift(@ARGV));
548 1.1 christos exit 255 if $die; # process any variable=value switches
549 1.1 christos
550 1.1 christos print("$$ \@ARGV after shift processing contains:",join("\, ",@ARGV),".\n") if $debug;
551 1.1 christos
552 1.1 christos # ---------------------------------------------------------------- get cvsroot
553 1.1 christos ($repository = shift) =~ s:^$cvsroot/::;
554 1.1 christos grep($_ = $repository . '/' . $_, @ARGV);
555 1.1 christos
556 1.1 christos print("$$ \$cvsroot is: $cvsroot.\n") if $debug;
557 1.1 christos print "$$ Repos: $repository\n","$$ ==== ",join("\n$$ ==== ",@ARGV),"\n" if $debug;
558 1.1 christos
559 1.1 christos $exit_val = 0; # presume good exit value for commit
560 1.1 christos
561 1.1 christos # ----------------------------------------------------------------------------
562 1.1 christos # ---------------------------------- create hash table $branch{file -> branch}
563 1.1 christos # ----------------------------------------------------------------------------
564 1.1 christos
565 1.1 christos # Here's a typical Entries file:
566 1.1 christos #
567 1.1 christos # /checkoutlist/1.4/Wed Feb 4 23:51:23 2004//
568 1.1 christos # /cvsacl/1.3/Tue Feb 24 23:05:43 2004//
569 1.1 christos # ...
570 1.1 christos # /verifymsg/1.1/Fri Mar 16 19:56:24 2001//
571 1.1 christos # D/backup////
572 1.1 christos # D/temp////
573 1.1 christos
574 1.1 christos open(ENTRIES, $entries) || die("Cannot open $entries.\n");
575 1.1 christos print("$$ File / Branch\n") if $debug;
576 1.1 christos my $i = 0;
577 1.1 christos while(<ENTRIES>) {
578 1.1 christos chop;
579 1.1 christos next if /^\s*$/; # Skip blank lines
580 1.1 christos $i = $i + 1;
581 1.1 christos if (m|
582 1.1 christos / # 1st slash
583 1.1 christos ([\w.-]*) # file name -> $1
584 1.1 christos / # 2nd slash
585 1.1 christos .* # revision number
586 1.1 christos / # 3rd slash
587 1.1 christos .* # date and time
588 1.1 christos / # 4th slash
589 1.1 christos .* # keyword
590 1.1 christos / # 5th slash
591 1.1 christos T? # 'T' constant
592 1.1 christos (\w*) # branch -> #2
593 1.1 christos |x) {
594 1.1 christos $branch{$repository . '/' . $1} = ($2) ? $2 : "HEAD";
595 1.1 christos print "$$ CVS Entry $i: $1/$2\n" if $debug;
596 1.1 christos }
597 1.1 christos }
598 1.1 christos close(ENTRIES);
599 1.1 christos
600 1.1 christos # ----------------------------------------------------------------------------
601 1.1 christos # ------------------------------------- evaluate each active line from 'cvsacl'
602 1.1 christos # ----------------------------------------------------------------------------
603 1.1 christos open (CVSACL, $cvsaclfile) || exit(0); # It is ok for cvsacl file not to exist
604 1.1 christos while (<CVSACL>) {
605 1.1 christos chop;
606 1.1 christos next if /^\s*\#/; # skip comments
607 1.1 christos next if /^\s*$/; # skip blank lines
608 1.1 christos # --------------------------------------------- parse current 'cvsacl' line
609 1.1 christos print("$$ ==========\n$$ Processing \'cvsacl\' line: $_.\n") if $debug;
610 1.1 christos ($cvsacl_flag, $cvsacl_userIds, $cvsacl_modules, $cvsacl_branches) = split(/[\s,]*\|[\s,]*/, $_);
611 1.1 christos
612 1.1 christos # ------------------------------ Validate 'allow' or 'deny' line prefix
613 1.1 christos if ($cvsacl_flag !~ /^allow/ && $cvsacl_flag !~ /^deny/) {
614 1.1 christos print ("Bad cvsacl line: $_\n") if $debug;
615 1.1 christos $log_text = sprintf "Bad cvsacl line: %s", $_;
616 1.1 christos write_restrictlog_record($log_text);
617 1.1 christos next;
618 1.1 christos }
619 1.1 christos
620 1.1 christos # -------------------------------------------------- init loop match flags
621 1.1 christos $user_match = 0;
622 1.1 christos %repository_matches = ();
623 1.1 christos
624 1.1 christos # ------------------------------------------------------------------------
625 1.1 christos # ---------------------------------------------------------- user matching
626 1.1 christos # ------------------------------------------------------------------------
627 1.1 christos # $user_name considered "in user list" if actually in list or is NULL
628 1.1 christos $user_match = (!$cvsacl_userIds || grep ($_ eq $user_name, split(/[\s,]+/,$cvsacl_userIds)));
629 1.1 christos print "$$ \$user_name: $user_name \$user_match match flag is: $user_match.\n" if $debug;
630 1.1 christos if (!$user_match) {
631 1.1 christos next; # no match, skip to next 'cvsacl' line
632 1.1 christos }
633 1.1 christos
634 1.1 christos # ------------------------------------------------------------------------
635 1.1 christos # ---------------------------------------------------- repository matching
636 1.1 christos # ------------------------------------------------------------------------
637 1.1 christos if (!$cvsacl_modules) { # blank module list = all modules
638 1.1 christos if (!$cvsacl_branches) { # blank branch list = all branches
639 1.1 christos print("$$ Adding all modules to \%repository_matches; null " .
640 1.1 christos "\$cvsacl_modules and \$cvsacl_branches.\n") if $debug;
641 1.1 christos for $commit_object (@ARGV) {
642 1.1 christos $repository_matches{$commit_object} = [$branch{$commit_object}, $cvsacl_modules];
643 1.1 christos print("$$ \$repository_matches{$commit_object} = " .
644 1.1 christos "[$branch{$commit_object}, $cvsacl_modules].\n") if $debug;
645 1.1 christos }
646 1.1 christos }
647 1.1 christos else { # need to check for repository match
648 1.1 christos @branch_list = split (/[\s,]+/,$cvsacl_branches);
649 1.1 christos print("$$ Branches from \'cvsacl\' record: ", join(", ",@branch_list),".\n") if $debug;
650 1.1 christos for $commit_object (@ARGV) {
651 1.1 christos if (grep($branch{$commit_object}, @branch_list)) {
652 1.1 christos $repository_matches{$commit_object} = [$branch{$commit_object}, $cvsacl_modules];
653 1.1 christos print("$$ \$repository_matches{$commit_object} = " .
654 1.1 christos "[$branch{$commit_object}, $cvsacl_modules].\n") if $debug;
655 1.1 christos }
656 1.1 christos }
657 1.1 christos }
658 1.1 christos }
659 1.1 christos else {
660 1.1 christos # ----------------------------------- check every argument combination
661 1.1 christos # parse 'cvsacl' modules to array
662 1.1 christos my @module_list = split(/[\s,]+/,$cvsacl_modules);
663 1.1 christos # ------------- Check all modules in list for either file or directory
664 1.1 christos my $fileType = "";
665 1.1 christos if (($fileType = checkFileness(@module_list)) eq "") {
666 1.1 christos next; # skip bad file types
667 1.1 christos }
668 1.1 christos # ---------- Check each combination of 'cvsacl' modules vs. @ARGV files
669 1.1 christos print("$$ Checking matches for \@module_list: ", join("\, ",@module_list), ".\n") if $debug;
670 1.1 christos # loop thru all command-line commit objects
671 1.1 christos for $commit_object (@ARGV) {
672 1.1 christos # loop thru all modules on 'cvsacl' line
673 1.1 christos for $cvsacl_module (@module_list) {
674 1.1 christos print("$$ Is \'cvsacl\': $cvsacl_modules pattern in: \@ARGV " .
675 1.1 christos "\$commit_object: $commit_object?\n") if $debug;
676 1.1 christos # Do match of beginning of $commit_object
677 1.1 christos checkModuleMatch($fileType, $commit_object, $cvsacl_module);
678 1.1 christos } # end for commit objects
679 1.1 christos } # end for cvsacl modules
680 1.1 christos } # end if
681 1.1 christos
682 1.1 christos print("$$ Matches for: \%repository_matches: ", join("\, ", (keys %repository_matches)), ".\n") if $debug;
683 1.1 christos
684 1.1 christos # ------------------------------------------------------------------------
685 1.1 christos # ----------------------------------------------------- setting exit value
686 1.1 christos # ------------------------------------------------------------------------
687 1.1 christos if ($user_match && %repository_matches) {
688 1.1 christos print("$$ An \"$cvsacl_flag\" match on User(s): $cvsacl_userIds; Module(s):" .
689 1.1 christos " $cvsacl_modules; Branch(es): $cvsacl_branches.\n") if $debug;
690 1.1 christos if ($cvsacl_flag eq "deny") {
691 1.1 christos # Add all matches to the hash of restricted modules
692 1.1 christos foreach $commitFile (keys %repository_matches) {
693 1.1 christos print("$$ Adding \%repository_matches entry: $commitFile.\n") if $debug;
694 1.1 christos $restricted_entries{$commitFile} = $repository_matches{$commitFile}[0];
695 1.1 christos }
696 1.1 christos }
697 1.1 christos else {
698 1.1 christos # Remove all matches from the restricted modules hash
699 1.1 christos foreach $commitFile (keys %repository_matches) {
700 1.1 christos print("$$ Removing \%repository_matches entry: $commitFile.\n") if $debug;
701 1.1 christos delete $restricted_entries{$commitFile};
702 1.1 christos }
703 1.1 christos }
704 1.1 christos }
705 1.1 christos print "$$ ==== End of processing for \'cvsacl\' line: $_.\n" if $debug;
706 1.1 christos }
707 1.1 christos close(CVSACL);
708 1.1 christos
709 1.1 christos # ----------------------------------------------------------------------------
710 1.1 christos # --------------------------------------- determine final 'commit' disposition
711 1.1 christos # ----------------------------------------------------------------------------
712 1.1 christos if (%restricted_entries) { # any restricted entries?
713 1.1 christos $exit_val = 1; # don't commit
714 1.1 christos print("**** Access denied: Insufficient authority for user: '$user_name\' " .
715 1.1 christos "to commit to \'$repository\'.\n**** Contact CVS Administrators if " .
716 1.1 christos "you require update access to these directories or files.\n");
717 1.1 christos print("**** file(s)/dir(s) restricted were:\n\t", join("\n\t",keys %restricted_entries), "\n");
718 1.1 christos printOptionalRestrictionMessage();
719 1.1 christos write_restrictlog();
720 1.1 christos }
721 1.1 christos elsif (!$exit_val && $debug) {
722 1.1 christos print "**** Access allowed: Sufficient authority for commit.\n";
723 1.1 christos }
724 1.1 christos
725 1.1 christos print "$$ ==== \$exit_val = $exit_val\n" if $debug;
726 1.1 christos exit($exit_val);
727 1.1 christos
728 1.1 christos # ----------------------------------------------------------------------------
729 1.1 christos # -------------------------------------------------------------- end of "main"
730 1.1 christos # ----------------------------------------------------------------------------
731 1.1 christos
732 1.1 christos
733 1.1 christos # ----------------------------------------------------------------------------
734 1.1 christos # -------------------------------------------------------- process script args
735 1.1 christos # ----------------------------------------------------------------------------
736 1.1 christos sub processArgs {
737 1.1 christos
738 1.1 christos # This subroutine is passed a reference to @ARGV.
739 1.1 christos
740 1.1 christos # If @ARGV contains a "-u" entry, use that as the effective userId. In this
741 1.1 christos # case, the userId is the client-side userId that has been passed to this
742 1.1 christos # script by the commit_prep script. (This is why the commit_prep script must
743 1.1 christos # be placed *before* the cvs_acls script in the commitinfo admin file.)
744 1.1 christos
745 1.1 christos # Otherwise, pull the userId from the server-side environment.
746 1.1 christos
747 1.1 christos my $userId = "";
748 1.1 christos my ($argv) = shift; # pick up ref to @ARGV
749 1.1 christos my @argvClone = (); # immutable copy for foreach loop
750 1.1 christos for ($i=0; $i<(scalar @{$argv}); $i++) {
751 1.1 christos $argvClone[$i]=$argv->[$i];
752 1.1 christos }
753 1.1 christos
754 1.1 christos print("$$ \@_ to processArgs is: @_.\n") if $debug;
755 1.1 christos
756 1.1 christos # Parse command line arguments (file list is seen as one arg)
757 1.1 christos foreach $arg (@argvClone) {
758 1.1 christos print("$$ \$arg for processArgs loop is: $arg.\n") if $debug;
759 1.1 christos # Set $debug flag?
760 1.1 christos if ($arg eq '-d') {
761 1.1 christos shift @ARGV;
762 1.1 christos $debug = 1;
763 1.1 christos print("$$ \$debug flag set on.\n") if $debug;
764 1.1 christos print STDERR "Debug turned on...\n";
765 1.1 christos }
766 1.1 christos # Passing in a client-side userId?
767 1.1 christos elsif ($arg eq '-u') {
768 1.1 christos shift @ARGV;
769 1.1 christos $userId = shift @ARGV;
770 1.1 christos print("$$ client-side \$userId set to: $userId.\n") if $debug;
771 1.1 christos }
772 1.1 christos # An override for the default restrictlog file?
773 1.1 christos elsif ($arg eq '-f') {
774 1.1 christos shift @ARGV;
775 1.1 christos $restrictlog = shift @ARGV;
776 1.1 christos }
777 1.1 christos else {
778 1.1 christos next;
779 1.1 christos }
780 1.1 christos }
781 1.1 christos
782 1.1 christos # No client-side userId passed? then get from server env
783 1.1 christos if (!$userId) {
784 1.1 christos $userId = $ENV{"USER"} if !($userId = $ENV{"LOGNAME"});
785 1.1 christos print("$$ server-side \$userId set to: $userId.\n") if $debug;
786 1.1 christos }
787 1.1 christos
788 1.1 christos print("$$ processArgs returning \$userId: $userId.\n") if $debug;
789 1.1 christos return $userId;
790 1.1 christos
791 1.1 christos }
792 1.1 christos
793 1.1 christos
794 1.1 christos # ----------------------------------------------------------------------------
795 1.1 christos # --------------------- Check all modules in list for either file or directory
796 1.1 christos # ----------------------------------------------------------------------------
797 1.1 christos sub checkFileness {
798 1.1 christos
799 1.1 christos # Module patterns on the 'cvsacl' record can be files or directories.
800 1.1 christos # If it's a directory, we pattern-match the directory name from 'cvsacl'
801 1.1 christos # against the left side of the committed filename to see if the file is in
802 1.1 christos # that hierarchy. By contrast, files use an explicit match. If the entries
803 1.1 christos # are neither files nor directories, then the cvsacl file has been set up
804 1.1 christos # incorrectly; we return a "" and the caller skips that line as invalid.
805 1.1 christos #
806 1.1 christos # This function determines whether the entries on the 'cvsacl' record are all
807 1.1 christos # directories or all files; it cannot be a mixture. This restriction put in
808 1.1 christos # to simplify the logic (without taking away much functionality).
809 1.1 christos
810 1.1 christos my @module_list = @_;
811 1.1 christos print("$$ Checking \"fileness\" or \"dir-ness\" for \@module_list entries.\n") if $debug;
812 1.1 christos print("$$ Entries are: ", join("\, ",@module_list), ".\n") if $debug;
813 1.1 christos my $filetype = "";
814 1.1 christos for $cvsacl_module (@module_list) {
815 1.1 christos my $reposDirName = $cvsroot . '/' . $cvsacl_module;
816 1.1 christos my $reposFileName = $reposDirName . "\,v";
817 1.1 christos print("$$ In checkFileness: \$reposDirName: $reposDirName; \$reposFileName: $reposFileName.\n") if $debug;
818 1.1 christos if (((-d $reposDirName) && ($filetype eq "file")) || ((-f $reposFileName) && ($filetype eq "dir"))) {
819 1.1 christos print("Can\'t mix files and directories on single \'cvsacl\' file record; skipping entry.\n");
820 1.1 christos print(" Please contact a CVS administrator.\n");
821 1.1 christos $filetype = "";
822 1.1 christos last;
823 1.1 christos }
824 1.1 christos elsif (-d $reposDirName) {
825 1.1 christos $filetype = "dir";
826 1.1 christos print("$$ $reposDirName is a directory.\n") if $debug;
827 1.1 christos }
828 1.1 christos elsif (-f $reposFileName) {
829 1.1 christos $filetype = "file";
830 1.1 christos print("$$ $reposFileName is a regular file.\n") if $debug;
831 1.1 christos }
832 1.1 christos else {
833 1.1 christos print("***** Item to commit was neither a regular file nor a directory.\n");
834 1.1 christos print("***** Current \'cvsacl\' line ignored.\n");
835 1.1 christos print("***** Possible problem with \'cvsacl\' admin file. Please contact a CVS administrator.\n");
836 1.1 christos $filetype = "";
837 1.1 christos $text = sprintf("Module entry on cvsacl line: %s is not a valid file or directory.\n", $cvsacl_module);
838 1.1 christos write_restrictlog_record($text);
839 1.1 christos last;
840 1.1 christos } # end if
841 1.1 christos } # end for
842 1.1 christos
843 1.1 christos print("$$ checkFileness will return \$filetype: $filetype.\n") if $debug;
844 1.1 christos return $filetype;
845 1.1 christos }
846 1.1 christos
847 1.1 christos
848 1.1 christos # ----------------------------------------------------------------------------
849 1.1 christos # ----------------------------------------------------- check for module match
850 1.1 christos # ----------------------------------------------------------------------------
851 1.1 christos sub checkModuleMatch {
852 1.1 christos
853 1.1 christos # This subroutine checks for a match between the directory or file pattern
854 1.1 christos # specified in the 'cvsacl' file (i.e., $cvsacl_modules) versus the commit file
855 1.1 christos # objects passed into the script via @ARGV (i.e., $commit_object).
856 1.1 christos
857 1.1 christos # The directory pattern only has to match the beginning portion of the commit
858 1.1 christos # file's name for a match since all files under that directory are considered
859 1.1 christos # a match. File patterns must exactly match.
860 1.1 christos
861 1.1 christos # Since (theoretically, if not normally in practice) a working directory can
862 1.1 christos # contain a mixture of files from different branches, this routine checks to
863 1.1 christos # see if there is also a match on branch before considering the file
864 1.1 christos # comparison a match.
865 1.1 christos
866 1.1 christos my $match_flag = "";
867 1.1 christos
868 1.1 christos print("$$ \@_ in checkModuleMatch is: @_.\n") if $debug;
869 1.1 christos my ($type,$commit_object,$cvsacl_module) = @_;
870 1.1 christos
871 1.1 christos if ($type eq "file") { # Do exact file match of $commit_object
872 1.1 christos if ($commit_object eq $cvsacl_module) {
873 1.1 christos $match_flag = "file";
874 1.1 christos } # Do dir match at beginning of $commit_object
875 1.1 christos }
876 1.1 christos elsif ($commit_object =~ /^$cvsacl_module\//) {
877 1.1 christos $match_flag = "dir";
878 1.1 christos }
879 1.1 christos
880 1.1 christos if ($match_flag) {
881 1.1 christos print("$$ \$repository: $repository matches \$commit_object: $commit_object.\n") if $debug;
882 1.1 christos if (!$cvsacl_branches) { # empty branch pattern matches all
883 1.1 christos print("$$ blank \'cvsacl\' branch matches all commit files.\n") if $debug;
884 1.1 christos $repository_matches{$commit_object} = [$branch{$commit_object}, $cvsacl_module];
885 1.1 christos print("$$ \$repository_matches{$commit_object} = [$branch{$commit_object}, $cvsacl_module].\n") if $debug;
886 1.1 christos }
887 1.1 christos else { # otherwise check branch hash table
888 1.1 christos @branch_list = split (/[\s,]+/,$cvsacl_branches);
889 1.1 christos print("$$ Branches from \'cvsacl\' record: ", join(", ",@branch_list),".\n") if $debug;
890 1.1 christos if (grep(/$branch{$commit_object}/, @branch_list)) {
891 1.1 christos $repository_matches{$commit_object} = [$branch{$commit_object}, $cvsacl_module];
892 1.1 christos print("$$ \$repository_matches{$commit_object} = [$branch{$commit_object}, " .
893 1.1 christos "$cvsacl_module].\n") if $debug;
894 1.1 christos }
895 1.1 christos }
896 1.1 christos }
897 1.1 christos
898 1.1 christos }
899 1.1 christos
900 1.1 christos # ----------------------------------------------------------------------------
901 1.1 christos # ------------------------------------------------------- check for file match
902 1.1 christos # ----------------------------------------------------------------------------
903 1.1 christos sub printOptionalRestrictionMessage {
904 1.1 christos
905 1.1 christos # This subroutine optionally prints site-specific file restriction information
906 1.1 christos # whenever a restriction condition is met. If the file 'restrict_msg' does
907 1.1 christos # not exist, the routine immediately exits. If there is a 'restrict_msg' file
908 1.1 christos # then all the contents are printed at the end of the standard restriction
909 1.1 christos # message.
910 1.1 christos
911 1.1 christos # As seen from examining the definition of $restrictfile, the default filename
912 1.1 christos # is: $CVSROOT/CVSROOT/restrict_msg.
913 1.1 christos
914 1.1 christos open (RESTRICT, $restrictfile) || return; # It is ok for cvsacl file not to exist
915 1.1 christos while (<RESTRICT>) {
916 1.1 christos chop;
917 1.1 christos # print out each line
918 1.1 christos print("**** $_\n");
919 1.1 christos }
920 1.1 christos
921 1.1 christos }
922 1.1 christos
923 1.1 christos # ----------------------------------------------------------------------------
924 1.1 christos # ---------------------------------------------------------- write log message
925 1.1 christos # ----------------------------------------------------------------------------
926 1.1 christos sub write_restrictlog {
927 1.1 christos
928 1.1 christos # This subroutine iterates through the list of restricted entries and logs
929 1.1 christos # each one to the error logfile.
930 1.1 christos
931 1.1 christos # write each line in @text out separately
932 1.1 christos foreach $commitfile (keys %restricted_entries) {
933 1.1 christos $log_text = sprintf "Commit attempt by: %s for: %s on branch: %s",
934 1.1 christos $user_name, $commitfile, $branch{$commitfile};
935 1.1 christos write_restrictlog_record($log_text);
936 1.1 christos }
937 1.1 christos
938 1.1 christos }
939 1.1 christos
940 1.1 christos # ----------------------------------------------------------------------------
941 1.1 christos # ---------------------------------------------------------- write log message
942 1.1 christos # ----------------------------------------------------------------------------
943 1.1 christos sub write_restrictlog_record {
944 1.1 christos
945 1.1 christos # This subroutine receives a scalar string and writes it out to the
946 1.1 christos # $restrictlog file as a separate line. Each line is prepended with the date
947 1.1 christos # and time in the format: "2004/01/30 12:00:00 ".
948 1.1 christos
949 1.1 christos $text = shift;
950 1.1 christos
951 1.1 christos # return quietly if there is a problem opening the log file.
952 1.1 christos open(FILE, ">>$restrictlog") || return;
953 1.1 christos
954 1.1 christos (@time) = localtime();
955 1.1 christos
956 1.1 christos # write each line in @text out separately
957 1.1 christos $log_record = sprintf "%04d/%02d/%02d %02d:%02d:%02d %s.\n",
958 1.1 christos $time[5]+1900, $time[4]+1, $time[3], $time[2], $time[1], $time[0], $text;
959 1.1 christos print FILE $log_record;
960 1.1 christos print("$$ restrict_log record being written: $log_record to $restrictlog.\n") if $debug;
961 1.1 christos
962 1.1 christos close(FILE);
963 1.1 christos }
964