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.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