defaria.com/cvsadm/CVSAdm.pm

   1 ################################################################################
   2 #
   3 # File:         CVSAdm.pm
   4 # Description:  Routines for generating portions of CVSAdm
   5 # Author:       Andrew@DeFaria.com
   6 # Created:      Fri Jul  8 12:35:48 PDT 2005
   7 # Modified:
   8 # Language:     Perl
   9 #
  10 # (c) Copyright 2005, LynuxWorks Inc., all rights reserved.
  11 #
  12 ################################################################################
  13 package CVSAdm;
  14
  15 use strict;
  16 use CGI qw (:standard *table start_Tr end_Tr start_div end_div);
  17 use Fcntl ':flock'; # import LOCK_* constants
  18 use vars qw (@ISA @EXPORT);
  19 use Exporter;
  20
  21 @ISA = qw (Exporter);
  22
  23 @EXPORT = qw (
  24   AddGroup
  25   AddSysUser
  26   AddUser
  27   CVSCommit
  28   CVSRepositories
  29   CVSServers
  30   CVSUpdate
  31   DeleteGroup
  32   DeleteSysUser
  33   DeleteUser
  34   DisplayError
  35   DisplayMsg
  36   Footing
  37   Groups
  38   Heading
  39   IsAdmin
  40   IsReader
  41   IsWriter
  42   PasswdEntry
  43   SystemUser
  44   SystemUsers
  45   UpdateGroup
  46   UpdateSysUser
  47   UpdateUser
  48   UserInGroup
  49   Users
  50 );
  51 # CVSAdm web app runs from a web server therefore it's running as an
  52 # unprivileged user (usually the user apache) yet we want to maintain
  53 # CVS user/group/sysuser information on CVS servers. As such we need a
  54 # list of CVS servers to adminster. The $cvsadm_conf file describes the
  55 # servers and repositories that we are allowed to manage. We will then
  56 # rely on CVS itself to checkout the CVSROOT directory, modify the files
  57 # appropriately then use CVS to commit these changes.
  58 my $cvsadm_conf = "cvsadm.conf";
  59
  60 # These are the lists of special files that cvsadm managed under CVSROOT
  61 # for cvsadm
  62 my @cvsfiles = (
  63   "passwd",
  64   "groups",
  65   "sysusers",
  66   "readers",
  67   "writers"
  68 );
  69
  70 my $heading_done = 0;
  71
  72 # Forwards
  73 sub Add;
  74 sub AddGroup;
  75 sub AddSysUser;
  76 sub AddUser;
  77 sub CVSCommit;
  78 sub CVSRepositories;
  79 sub CVSServers;
  80 sub CVSUpdate;
  81 sub DeleteGroup;
  82 sub DeleteSysUser;
  83 sub DeleteUser;
  84 sub DisplayError;
  85 sub DisplayMsg;
  86 sub Footing;
  87 sub Groups;
  88 sub Heading;
  89 sub InFile;
  90 sub IsAdmin;
  91 sub IsReader;
  92 sub IsWriter;
  93 sub Lock;
  94 sub Login;
  95 sub OpenPasswd;
  96 sub PasswdEntry;
  97 sub Remove;
  98 sub Read;
  99 sub SystemUser;
 100 sub SystemUsers;
 101 sub Unlock;
 102 sub UpdateAccess;
 103 sub UpdateGroup;
 104 sub UpdateSysUser;
 105 sub UpdateUser;
 106 sub UserInGroup;
 107 sub Users;
 108
 109 sub Add {
 110   my $cvs_server        = shift;
 111   my $repository        = shift;
 112   my $file              = shift;
 113   my $userid            = shift;
 114
 115   my $filename = $file;
 116   $file = "$cvs_server/$repository/CVSROOT/$file";
 117
 118   return if !-f $file;
 119
 120   Lock $file;
 121
 122   my @lines = Read $file;
 123   my $found = 0;
 124
 125   foreach (@lines) {
 126     my $line = $_;
 127     chomp $line;
 128
 129     $found = 1 if $line eq $userid;
 130   } # foreach
 131
 132   push @lines, $userid . "\n" if !$found;
 133
 134   my $euid = cookie "CVSAdmUser";
 135   my $commit_msg =
 136     $euid eq "cvsroot"          ?
 137       "Adding $userid"          :
 138       "$euid added $userid";
 139
 140   CVSCommit $cvs_server, $repository, $filename, $commit_msg, sort (@lines);
 141
 142   Unlock $file;
 143 } # Add
 144
 145 sub AddGroup {
 146   my $cvs_server        = shift;
 147   my $repository        = shift;
 148   my $group             = shift;
 149
 150   my $groups = "$cvs_server/$repository/CVSROOT/groups";
 151
 152   Lock $groups;
 153
 154   my @groups = Read $groups;
 155
 156   foreach (@groups) {
 157     my $line = $_;
 158     chomp $line;
 159     return 1, "Group $group already exists" if $group eq $line;
 160   } # foreach
 161
 162   push @groups, $group . "\n";
 163
 164   my $euid = cookie "CVSAdmUser";
 165   my $commit_msg =
 166     $euid eq "cvsroot"          ?
 167       "Added group $group"      :
 168       "$euid added group $group";
 169
 170   CVSCommit $cvs_server, $repository, "groups", $commit_msg, sort (@groups);
 171
 172   Unlock $groups;
 173
 174   return 0, "Added group $group";
 175 } # AddGroup
 176
 177 sub AddSysUser {
 178   my $cvs_server        = shift;
 179   my $repository        = shift;
 180   my $sysuser           = shift;
 181
 182   my $sysusers = "$cvs_server/$repository/CVSROOT/sysusers";
 183
 184   Lock $sysusers;
 185
 186   my @sysusers = Read $sysusers;
 187
 188   foreach (@sysusers) {
 189     my $line = $_;
 190     chomp $line;
 191     return 1, "Sysuser $sysuser already exists" if $sysuser eq $line;
 192   } # foreach
 193
 194   push @sysusers, $sysuser . "\n";
 195
 196   CVSCommit $cvs_server, $repository, "sysusers", "Added sysuser $sysuser", sort (@sysusers);
 197
 198   Unlock $sysusers;
 199
 200   return 0, "Added sysuser $sysuser";
 201 } # AddSysUser
 202
 203 sub AddUser {
 204   my $cvs_server        = shift;
 205   my $repository        = shift;
 206   my %user_record       = @_;
 207
 208   # Check if userid already exists
 209   my %passwd = OpenPasswd $cvs_server, $repository;
 210
 211   return 1,
 212     "Userid "                   .
 213     $user_record {userid}       .
 214     " already exists"
 215   if $passwd{$user_record {userid}};
 216
 217   # Format passwd entry
 218   my %fields;
 219   $fields {password}    = crypt $user_record {password}, "xx";
 220   $fields {system_user} = $user_record {system_user};
 221   $fields {fullname}    = $user_record {fullname};
 222   $fields {email}       = $user_record {email};
 223
 224   # Handle groups (comma separated)
 225   my @groups = split /,/, $user_record {groups};
 226   $fields {groups}      = \@groups;
 227
 228   $passwd {$user_record {userid}} = \%fields;
 229
 230   my $passwd = "$cvs_server/$repository/CVSROOT/passwd";
 231
 232   Lock $passwd;
 233
 234   my @passwd;
 235
 236   foreach (sort (keys %passwd)) {
 237     my %fields = %{$passwd {$_}};
 238
 239     my $first_time = 1;
 240     my $group_str;
 241
 242     foreach (@{$fields {groups}}) {
 243       if ($first_time) {
 244         $group_str = $_;
 245         $first_time = 0;
 246       } else {
 247         $group_str .= ",$_";
 248       } # if
 249     } # foreach
 250
 251     my $passwd_line =
 252       $_                        . ":" .
 253       $fields {password}        . ":" .
 254       $fields {system_user}     . ":" .
 255       $fields {fullname}        . ":" .
 256       $fields {email}           . ":" .
 257       $group_str                . "\n";
 258
 259     push @passwd, $passwd_line;
 260   } # foreach
 261
 262   my $euid = cookie "CVSAdmUser";
 263   my $commit_msg =
 264     $euid eq "cvsroot"                          ?
 265       "Added user " . $user_record {userid}     :
 266       "$euid added" . $user_record {userid};
 267
 268   CVSCommit $cvs_server, $repository, "passwd", $commit_msg, sort (@passwd);
 269
 270   Unlock $passwd;
 271
 272   # Update readers and writers
 273   UpdateAccess $cvs_server, $repository, $user_record {userid}, $user_record {$repository};
 274
 275   return 0, "Added user " . $user_record {userid};
 276 } # AddUser
 277
 278 sub CVSCommit {
 279   my $cvs_server        = shift;
 280   my $repository        = shift;
 281   my $filename          = shift;
 282   my $message           = shift;
 283   my @filedata          = @_;
 284
 285   #my $logfile = "/tmp/commit.log";
 286   my $logfile = "/dev/null";
 287
 288   my $CVSROOT = "$cvs_server/$repository/CVSROOT";
 289   my $cvsroot = ":pserver:cvsroot\@$cvs_server:/cvs/$repository";
 290
 291   chdir $CVSROOT
 292     or DisplayError "Unable to chdir to $CVSROOT";
 293
 294   open FILE, ">$filename"
 295     or DisplayError "Unable to open file $filename";
 296
 297   foreach (@filedata) {
 298     print FILE $_;
 299   } # foreach
 300
 301   close FILE;
 302
 303   my $status = system "cvs -d $cvsroot commit -m \"$message\" $filename > $logfile 2>&1";
 304
 305   DisplayError "Unable to commit $filename (Status: $status)" if $status ne 0;
 306
 307   chdir "../../.."
 308     or DisplayError "Unable to chdir ../../..";
 309 } # CVSCommit
 310
 311 sub CVSRepositories {
 312   my $cvs_server = shift;
 313
 314   my %cvs_servers = CVSServers;
 315
 316   return sort @{$cvs_servers {$cvs_server}};
 317 } # CVSRepositories
 318
 319 sub CVSServers {
 320   my %cvs_servers;
 321
 322   open CVSADM_CONF, $cvsadm_conf
 323     or DisplayError "Unable to open $cvsadm_conf - $!";
 324
 325   my @lines = grep {!/^#/} <CVSADM_CONF>;
 326
 327   foreach (@lines) {
 328     my ($server, $repository) = split;
 329
 330     if (defined $cvs_servers {$server}) {
 331       my @repositories = @{$cvs_servers {$server}};
 332       push @{$cvs_servers {$server}}, $repository;
 333     } else {
 334       push @{$cvs_servers {$server}}, $repository;
 335     } # if
 336   } # foreach
 337
 338   return %cvs_servers;
 339 } # CVSServers
 340
 341 sub CVSUpdate {
 342   # Checkout or update @cvs_files in $cvs_server, $repository
 343   my $cvs_server        = shift;
 344   my $repository        = shift;
 345
 346   my $status  = 0;
 347   my $CVSROOT = "$cvs_server/$repository/CVSROOT";
 348   my $cvsroot = ":pserver:$cvs_server:/cvs/$repository";
 349
 350   my $logfile = "/tmp/checkout.log";
 351   `rm -f $logfile`;
 352
 353   if (!-d $CVSROOT) {
 354     # Filestore for this repository does not exist. Create it and
 355     # check it out
 356     $status = system "mkdir -p $CVSROOT";
 357
 358     DisplayError "Unable to create directory $CVSROOT (Status: $status)" if $status ne 0;
 359
 360     chdir "$cvs_server/$repository"
 361       or DisplayError "Unable to chdir to $cvs_server/$repository";
 362
 363     $status = system "cvs -d $cvsroot checkout CVSROOT > $logfile 2>&1";
 364
 365     DisplayError "Unable to checkout $cvs_server/$repository/CVSROOT" if $status ne 0;
 366
 367     chdir "../.."
 368       or DisplayError "Unable to chdir ../..";
 369
 370     return 0;
 371   } # if
 372
 373   chdir "$cvs_server/$repository"
 374     or DisplayError "Unable to chdir to $cvs_server/$repository";
 375
 376   foreach (@cvsfiles) {
 377     # There may be no readers or writers files. Attempt to check them
 378     # out but allow failures to happen without increasing $status
 379     if ($_ eq "readers" or $_ eq "writers") {
 380       if (!-f "CVSROOT/$_") {
 381         system "cvs -d $cvsroot checkout CVSROOT/$_ >> $logfile 2>&1";
 382       } else {
 383         $status += system "cvs -d $cvsroot update CVSROOT/$_ >> $logfile 2>&1";
 384       } # if
 385     } else {
 386       $status += system "cvs -d $cvsroot checkout CVSROOT/$_ >> $logfile 2>&1";
 387     } # if
 388   } # foreach
 389
 390   chdir "../.."
 391     or DisplayError "Unable to chdir ../..";
 392
 393   return $status;
 394 } # CVSUpdate
 395
 396 sub DeleteGroup {
 397   my $cvs_server        = shift;
 398   my $repository        = shift;
 399   my $group             = shift;
 400
 401   # Do not allow the cvsadm group to be deleted
 402   return 1, "You cannot delete the cvsadm group" if $group eq "cvsadm";
 403
 404   my $groups = "$cvs_server/$repository/CVSROOT/groups";
 405
 406   Lock $groups;
 407
 408   my @groups = Read $groups;
 409   my @new_groups;
 410
 411   foreach (@groups) {
 412     my $line = $_;
 413     chomp $line;
 414
 415     next if $group eq $line;
 416
 417     push @new_groups, "$line\n";
 418   } # foreach
 419
 420   CVSCommit $cvs_server, $repository, "groups", "Removed group $group", sort (@new_groups);
 421
 422   Unlock $groups;
 423
 424   # Remove mention of this group from passwd file
 425   my $passwd = "$cvs_server/$repository/CVSROOT/passwd";
 426
 427   Lock $passwd;
 428
 429   my @lines = Read $passwd;
 430   my @new_lines;
 431
 432   foreach (@lines) {
 433     my $line = $_;
 434     chomp $line;
 435
 436     my @fields = split /:/, $line;
 437
 438     if ($fields [5] !~ /$group/) {
 439       push @new_lines, "$line\n";
 440       next;
 441     } # if
 442
 443     # Parse groups
 444     chomp $fields [5];
 445     my @old_groups = split /,/, $fields [5];
 446     @groups = ();
 447
 448     foreach (@old_groups) {
 449       push @groups, $_ if $_ ne $group;
 450     } # foreach
 451
 452     my $first_time = 1;
 453     my $group_str;
 454
 455     foreach (@groups) {
 456       if ($first_time) {
 457         $group_str      = $_;
 458         $first_time     = 0;
 459       } else {
 460         $group_str     .= ",$_";
 461       } # if
 462     } # foreach
 463
 464     my $passwd_line =
 465       $fields [0]       . ":" .
 466       $fields [1]       . ":" .
 467       $fields [2]       . ":" .
 468       $fields [3]       . ":" .
 469       $fields [4]       . ":" .
 470       $group_str        . "\n";
 471
 472     push @new_lines, $passwd_line;
 473   } # foreach
 474
 475   CVSCommit $cvs_server, $repository, "passwd", "Removed references to group $group from passwd", sort (@new_lines);
 476
 477   Unlock $passwd;
 478
 479   return 0, "Deleted group $group";
 480 } # DeleteGroup
 481
 482 sub DeleteSysUser {
 483   my $cvs_server        = shift;
 484   my $repository        = shift;
 485   my $sysuser           = shift;
 486
 487   # Do not allow the cvsroot sysuser to be deleted
 488   return 1, "You cannot delete the cvsroot system user" if $sysuser eq "cvsroot";
 489
 490   my $sysusers = "$cvs_server/$repository/CVSROOT/sysusers";
 491
 492   Lock $sysusers;
 493
 494   my @sysusers = Read $sysusers;
 495   my @new_sysusers;
 496
 497   foreach (@sysusers) {
 498     my $line = $_;
 499     chomp $line;
 500
 501     next if $sysuser eq $line;
 502
 503     push @new_sysusers, "$line\n";
 504   } # foreach
 505
 506   CVSCommit $cvs_server, $repository, "sysusers", "Removed sysuser $sysuser", sort (@new_sysusers);
 507
 508   Unlock $sysusers;
 509
 510   return 0, "Deleted system user $sysuser";
 511 } # DeleteSysUser
 512
 513 sub DeleteUser {
 514   my $cvs_server        = shift;
 515   my $repository        = shift;
 516   my $userid            = shift;
 517
 518   # Do not allow the cvsroot user to be deleted
 519   return 1, "You cannot delete the cvsroot user" if $userid eq "cvsroot";
 520
 521   my $passwd = "$cvs_server/$repository/CVSROOT/passwd";
 522
 523   Lock $passwd;
 524
 525   my @passwd = Read $passwd;
 526   my @new_passwd;
 527
 528   foreach (@passwd) {
 529     my $line = $_;
 530     chomp $line;
 531
 532     my @fields = split /:/, $line;
 533
 534     next if $fields [0] eq $userid;
 535
 536     push @new_passwd, "$line\n";
 537   } # foreach
 538
 539   my $euid = cookie "CVSAdmUser";
 540   my $commit_msg =
 541     $euid eq "cvsroot"          ?
 542       "Removed user $userid"    :
 543       "$euid removed user $userid";
 544
 545   CVSCommit $cvs_server, $repository, "passwd", "Removed user $userid", sort (@new_passwd);
 546
 547   Unlock $passwd;
 548
 549   return 0, "Deleted user $userid";
 550 } # DeleteUser
 551
 552 sub DisplayError {
 553   my $errmsg = shift;
 554   my $status = shift;
 555
 556   if (!$heading_done) {
 557     # Put out a header so we can display the error message
 558     Heading (
 559       "",
 560       "",
 561       "CVSAdm: Error: $errmsg",
 562       "CVSAdm: Error: $errmsg",
 563     );
 564     $heading_done = 1;
 565   } # if
 566
 567   print h3 ({-class => "error",
 568              -align => "center"}, "ERROR: " . $errmsg);
 569
 570   if (!defined $status) {
 571     Footing;
 572     exit 1;
 573   } # if
 574 } # DisplayError
 575
 576 sub DisplayMsg {
 577   my $msg = shift;
 578
 579   print h3 ({-class => "msg",
 580              -align => "center"}, $msg);
 581 } # DisplayMsg
 582
 583 sub Footing {
 584   my $table_name = shift;
 585
 586   # General footing (copyright). Note we calculate the current year
 587   # so that the copyright automatically extends itself.
 588   my $year = substr ((scalar (localtime)), 20, 4);
 589
 590   print start_div {-class => "copyright"};
 591   print "Copyright &copy; ",
 592     a ({-href => "http://defaria.com"},
 593       "Andrew DeFaria"),
 594         " $year - All rights reserved";
 595   print end_div;
 596
 597   print end_div; # This div ends "content" which was started in Heading
 598   print "<script language='JavaScript1.2'>AdjustTableWidth (\"$table_name\");</script>"
 599     if defined $table_name;
 600   print end_html;
 601 } # Footing
 602
 603 sub Groups {
 604   my $cvs_server        = shift;
 605   my $repository        = shift;
 606
 607   my $groups = "$cvs_server/$repository/CVSROOT/groups";
 608
 609   my @lines = Read $groups;
 610   my @groups;
 611
 612   foreach (@lines) {
 613     chomp;
 614     push @groups, $_;
 615   } # foreach
 616
 617   return @groups;
 618 } # Groups
 619
 620 sub Heading {
 621   # This subroutine puts out the header for web pages. It is called by
 622   # various cgi scripts thus has a few parameters.
 623   my $action            = shift; # One of getcookie, setcookie, unsetcookie
 624   my $userid            = shift; # User id (if setting a cookie)
 625   my $title             = shift; # Title string
 626   my $h1                = shift; # H1 header
 627   my $h2                = shift; # H2 header (optional)
 628   my $table_name        = shift; # Name of table in page, if any
 629
 630   my @java_scripts;
 631   my $cookie;
 632
 633   # Incorporate CVSAdmUtils.js
 634   push @java_scripts, [
 635     {-language  => "JavaScript1.2",
 636      -src       => "CVSAdmUtils.js"}];
 637
 638   # Since Heading is called from various scripts we sometimes need to
 639   # set a cookie, other times delete a cookie but most times return the
 640   # cookie.
 641   if ($action eq "getcookie") {
 642     # Get userid from cookie
 643     $userid = cookie ("CVSAdmUser");
 644   } elsif ($action eq "setcookie") {
 645     $cookie = cookie (
 646        -name    => "CVSAdmUser",
 647        -value   => "$userid",
 648        -expires => "+1y",
 649        -path    => "/cvsadm"
 650     );
 651   } elsif ($action eq "unsetcookie") {
 652     $cookie = cookie (
 653        -name    => "CVSAdmUser",
 654        -value   => "",
 655        -expires => "-1d",
 656        -path    => "/cvsadm"
 657     );
 658   } # if
 659
 660   print
 661     header     (-title  => "$title",
 662                 -cookie => $cookie);
 663
 664   if (defined $table_name) {
 665     print
 666       start_html (-title        => "$title",
 667                   -author       => "ADeFaria\@lnxw.com",
 668                   -style        => {-src        => "CVSAdmStyle.css"},
 669                   -onResize     => "AdjustTableWidth (\"$table_name\");",
 670                   -head         => [
 671                     Link ({-rel  => "icon",
 672                            -href => "http://wwww.lynuxworks.com/favicon.ico"})
 673                   ],
 674                   -script       => @java_scripts);
 675   } else {
 676     print
 677       start_html (-title        => "$title",
 678                   -author       => "ADeFaria\@lnxw.com",
 679                   -style        => {-src        => "CVSAdmStyle.css"},
 680                   -head         => [
 681                     Link ({-rel  => "icon",
 682                            -href => "http://wwww.lynuxworks.com/favicon.ico"})
 683                    ],
 684                   -script       => @java_scripts);
 685   } # if
 686
 687   print start_div {class => "heading"};
 688 #   if (defined $userid and $userid ne "") {
 689 #     $h1 .= " (userid: $userid)";
 690 #   } else {
 691 #     $h1 .= " (userid: undefined)";
 692 #   } # if
 693
 694   print h2 {-align      => "center",
 695             -class      => "header"},
 696       $h1;
 697
 698 #   if ($action eq "setcookie") {
 699 #     $h2 .= " - Set CVSAdmUser to $userid";
 700 #   } elsif ($action eq "unsetcookie") {
 701 #     $h2 .= " - Unset CVSAdmUser";
 702 #   } else {
 703 #     $h2 .= " - Action = $action";
 704 #   } # if
 705
 706   if (defined $h2 && $h2 ne "") {
 707     print h3 {-align    => "center",
 708               -class    => "header"},
 709       $h2;
 710   } # if
 711   print end_div;
 712
 713   # Start body content
 714   print start_div {-class => "content"};
 715
 716   $heading_done = 1;
 717   return $userid
 718 } # Heading
 719
 720 ### CVS Read/Write access ##############################################
 721 # CVS decides read/write access based on the presence of the user name
 722 # in the files readers and writers in the repository. Additionally
 723 # either or both of these files may be missing.
 724 #
 725 # The CVS Manual says:
 726 #       If `readers' exists, and this user is listed in it, then she
 727 #       gets read-only access. Or if `writers' exists, and this user
 728 #       is NOT listed in it, then she also gets read-only access (this
 729 #       is true even if `readers' exists but she is not listed
 730 #       there). Otherwise, she gets full read-write access.
 731 #
 732 #       Of course there is a conflict if the user is listed in both
 733 #       files. This is resolved in the more conservative way, it being
 734 #       better to protect the repository too much than too little:
 735 #       such a user gets read-only access.
 736 #
 737 # Based on that the following describe the access granted to a user.
 738 #
 739 # case  readers         writers         read access     write access
 740 # ----  -----------     -----------     -----------     ------------
 741 #   1   No File         No File             No              No
 742 #   2   No File         Not Present         Yes             No
 743 #   3   No File         Present             Yes             Yes
 744 #   4   Not Present     No File             No              No
 745 #   5   Not Present     Not Present         Yes             No
 746 #   6   Not Present     Present             Yes             Yes
 747 #   7   Present         No File             Yes             No
 748 #   8   Present         Not Present         Yes             No
 749 #   9   Present         Present             Yes             No
 750 #
 751 # Case 1: A strict intepretation of the CVS manual might lead you to
 752 # believe that since readers does not exist and writers does not exist
 753 # then it would fall into the "Otherwise" statement at the end of the
 754 # first paragraph. However an argument can be made that the user is
 755 # also not listed in the writers file because the writers file is not
 756 # present. But I believe that no access should be granted.
 757 #
 758 # Case 2: Readers does not exist and the user is not listed in writers
 759 # so read only access.
 760 #
 761 # Case 3: Readers does not exist but the user is listed in writers. So
 762 # the user has write access. Does this imply read access? Does
 763 # write-only access exist?
 764 #
 765 # Case 4: User is not listed in the readers file and there is no writers
 766 # file. This case is not covered by the CVS manual. My assumption is
 767 # therefore no access. Again a strict interpretation might argue the
 768 # "Otherwise" clause but I think not.
 769 #
 770 # Case 5: User is not listed in the readers file nor in the writers file
 771 # therefore read only access.
 772 #
 773 # Case 6: User is not listed in the readers file but is listed in the
 774 # writers file. User gets read/write access.
 775 #
 776 # Case 7: User is listed in the readers file but there is no writers
 777 # file. Read only access.
 778 #
 779 # Case 8: User is listed in the readers file but not present in writers
 780 # file. Read only access.
 781 #
 782 # Case 9: User is listed in the readers file and the writers file. This
 783 # is the conflict. Resolve the conflict by only providing read access.
 784 ### CVS Read/Write access ##############################################
 785 sub InFile {
 786   my $userid    = shift;
 787   my $file      = shift;
 788
 789   return 0 if !-f $file;
 790
 791   my @lines = Read $file;
 792
 793   foreach (@lines) {
 794     my $line = $_;
 795     chomp $line;
 796     return 2 if $line eq $userid;
 797   } # foreach
 798
 799   return 1;
 800 } # InFile
 801
 802 sub IsAdmin {
 803   my $cvs_server        = shift;
 804   my $repository        = shift;
 805   my $userid            = shift;
 806
 807   return 0 if !defined $userid;
 808   return 1 if $userid eq "cvsroot";
 809
 810   return UserInGroup ($cvs_server, $repository, $userid, "cvsadm");
 811 } # IsAdmin
 812
 813 sub IsReader {
 814   my $cvs_server        = shift;
 815   my $repository        = shift;
 816   my $userid            = shift;
 817
 818   my $reader_status = InFile $userid, "$cvs_server/$repository/CVSROOT/readers";
 819   my $writer_status = InFile $userid, "$cvs_server/$repository/CVSROOT/writers";
 820
 821   if ($reader_status eq 0) {
 822     # No reader file
 823     if ($writer_status eq 0) {
 824       # No writer file
 825       return 0; # Read access denied
 826     } elsif ($writer_status eq 1) {
 827       # Userid is not present in writers file
 828       return 1; # Read access granted
 829     } else {
 830       # Userid is present in writers file (implied read access)
 831       return 1; # Read access granted
 832     } # if
 833   } elsif ($reader_status eq 1) {
 834     # Userid is not in readers file
 835     if ($writer_status eq 0) {
 836       # No writer file
 837       return 0; # Read access denied
 838     } elsif ($writer_status eq 1) {
 839       # Userid is not present in writers file
 840       return 1; # Read access granted
 841     } else {
 842       # Userid is present in writers file (implied read access)
 843       return 1; # Read access granted
 844     } # if
 845   } else {
 846     # Userid is present in readers file
 847     if ($writer_status eq 0) {
 848       return 1; # Read access granted
 849     } elsif ($writer_status eq 1) {
 850       return 1; # Read access granted
 851     } else {
 852       return 1; # Read access granted
 853     } # if
 854   } # if
 855 } # IsReader
 856
 857 sub IsWriter {
 858   my $cvs_server        = shift;
 859   my $repository        = shift;
 860   my $userid            = shift;
 861
 862   my $reader_status = InFile $userid, "$cvs_server/$repository/CVSROOT/readers";
 863   my $writer_status = InFile $userid, "$cvs_server/$repository/CVSROOT/writers";
 864
 865   if ($reader_status eq 0) {
 866     # No reader file
 867     if ($writer_status eq 0) {
 868       # No writer file
 869       return 0; # Write access denied
 870     } elsif ($writer_status eq 1) {
 871       # Userid is not present in writers file
 872       return 0; # Write access denied
 873     } else {
 874       # Userid is present in writers file
 875       return 1; # Write access granted
 876     } # if
 877   } elsif ($reader_status eq 1) {
 878     # Userid is not in readers file
 879     if ($writer_status eq 0) {
 880       # No writer file
 881       return 0; # Write access denied
 882     } elsif ($writer_status eq 1) {
 883       # Userid is not present in writers file
 884       return 0; # Write access denied
 885     } else {
 886       # Userid is present in writers file
 887       return 1; # Write access granted
 888     } # if
 889   } else {
 890     # Userid is present in readers file
 891     if ($writer_status eq 0) {
 892       return 0; # Write access denied
 893     } elsif ($writer_status eq 1) {
 894       return 0; # Write access denied
 895     } else {
 896       return 0; # Write access denied
 897     } # if
 898   } # if
 899 } # IsWriter
 900
 901 sub Lock {
 902   my $file = shift;
 903
 904   flock $file, LOCK_EX;
 905 } # Lock
 906
 907 sub Login {
 908   my $cvs_server        = shift;
 909   my $repository        = shift;
 910   my $username          = shift;
 911   my $password          = shift;
 912
 913   my %passwd = OpenPasswd $cvs_server, $repository;
 914
 915   if (!defined $passwd {$username}) {
 916     return 1;
 917   } # if
 918
 919   my %fields = %{$passwd {$username}};
 920
 921   my $salt = substr $fields {password}, 0, 2;
 922
 923   $password = crypt $password, $salt;
 924
 925   if ($fields {password} eq $password) {
 926     return 0;
 927   } else {
 928     return 2;
 929   } # if
 930 } # Login
 931
 932 sub OpenPasswd {
 933   my $cvs_server        = shift;
 934   my $repository        = shift;
 935
 936   my $passwd = "$cvs_server/$repository/CVSROOT/passwd";
 937
 938   if (!-f $passwd) {
 939     # Passwd file is missing. Let's try a CVSUpdate...
 940     my $status = CVSUpdate $cvs_server, $repository;
 941
 942     if ($status ne 0) {
 943       DisplayError "Unable to update CVSROOT! (Status: $status)";
 944     } # if
 945   } # if
 946
 947   my %passwd;
 948   my @passwd = Read $passwd;
 949
 950   foreach (@passwd) {
 951     my $line = $_;
 952     chomp $line;
 953
 954     my @fields = split /:/, $line;
 955
 956     my %fields;
 957     $fields {password}          = $fields [1];
 958     $fields {system_user}       = $fields [2];
 959     $fields {fullname}          = $fields [3];
 960     $fields {email}             = $fields [4];
 961
 962     # Handle groups (comma separated)
 963     my @groups = split /,/, $fields [5];
 964     $fields {groups}            = \@groups;
 965     $passwd {$fields [0]}       = \%fields;
 966   } # foreach
 967
 968   return %passwd;
 969 } # OpenPasswd
 970
 971 sub PasswdEntry {
 972   my $cvs_server        = shift;
 973   my $repository        = shift;
 974   my $userid            = shift;
 975
 976   DisplayError "Userid not defined" if !defined $userid;
 977
 978   my %passwd = OpenPasswd $cvs_server, $repository;
 979
 980   if (!defined $userid or !defined $passwd {$userid}) {
 981     return undef;
 982   } else {
 983     return %{$passwd {$userid}};
 984   } # if
 985 } # PasswdEntry
 986
 987 sub SystemUser {
 988   my $cvs_server        = shift;
 989   my $repository        = shift;
 990   my $userid            = shift;
 991
 992   my %passwd = OpenPasswd $cvs_server, $repository;
 993
 994   my %fields = %{$passwd {$userid}};
 995
 996   return $fields {system_user}
 997 } # SystemUser
 998
 999 sub SystemUsers {
1000   my $cvs_server        = shift;
1001   my $repository        = shift;
1002
1003   my $sysusers = "$cvs_server/$repository/CVSROOT/sysusers";
1004
1005   my @lines = Read $sysusers;
1006   my @sysusers;
1007
1008   foreach (@lines) {
1009     chomp;
1010     push @sysusers, $_;
1011   } # foreach
1012
1013   return @sysusers;
1014 } # SystemUsers
1015
1016 sub Unlock {
1017   my $file = shift;
1018
1019   flock $file, LOCK_UN;
1020 } # Unlock
1021
1022 sub Read {
1023   my $filename  = shift;
1024
1025   open FILE, $filename
1026     or DisplayError "Unable to open file $filename - $!";
1027
1028   my @lines = <FILE>;
1029
1030   close FILE;
1031
1032   return @lines;
1033 } # Read
1034
1035 sub Remove {
1036   my $cvs_server        = shift;
1037   my $repository        = shift;
1038   my $file              = shift;
1039   my $userid            = shift;
1040
1041   my $filename = $file;
1042   $file = "$cvs_server/$repository/CVSROOT/$file";
1043
1044   return if !-f $file;
1045
1046   Lock $file;
1047
1048   my @lines = Read $file;
1049   my @new_lines;
1050
1051   foreach (@lines) {
1052     my $line = $_;
1053     chomp $line;
1054
1055     next if $line eq $userid;
1056
1057     push @new_lines, "$line\n";
1058   } # foreach
1059
1060   my $euid = cookie "CVSAdmUser";
1061   my $commit_msg =
1062     $euid eq "cvsroot"          ?
1063       "Removed $userid"         :
1064       "$euid removed $userid";
1065
1066   CVSCommit $cvs_server, $repository, $filename, $commit_msg, sort (@new_lines);
1067
1068   Unlock $file;
1069 } # Remove
1070
1071 sub UpdateAccess {
1072   my $cvs_server        = shift;
1073   my $repository        = shift;
1074   my $userid            = shift;
1075   my $access            = shift;
1076
1077   if ($access eq "r") {
1078     Remove $cvs_server, $repository, "writers", $userid;
1079     Add    $cvs_server, $repository, "readers", $userid;
1080   } elsif ($access eq "rw") {
1081     Remove $cvs_server, $repository, "readers", $userid;
1082     Add    $cvs_server, $repository, "writers", $userid;
1083   } else {
1084     Remove $cvs_server, $repository, "readers", $userid;
1085     Remove $cvs_server, $repository, "writers", $userid;
1086   } # if
1087 } # UpdateAccess
1088
1089 sub UpdateGroup {
1090   my $cvs_server        = shift;
1091   my $repository        = shift;
1092   my $old_group         = shift;
1093   my $new_group         = shift;
1094
1095   # CVS readers and writers files are a little weird. We will attempt
1096   # to simplify here. If a user has read only access to a repository
1097   # then we will explicitly list them in the readers file and make
1098   # sure they are not in the writers file. If they have write access
1099   # (thus implying read access) then we will arrange for them to be in
1100   # the writers file and absent from the readers file as CVS treats
1101   # users who are in both files as read only.
1102   my $groups = "$cvs_server/$repository/CVSROOT/groups";
1103
1104   Lock $groups;
1105
1106   my @groups = Read $groups;
1107   my @new_groups;
1108
1109   foreach (@groups) {
1110     my $line = $_;
1111     chomp $line;
1112
1113     if ($line eq $old_group) {
1114       push @new_groups, "$new_group\n";
1115     } else {
1116       push @new_groups, "$line\n";
1117     } # if
1118   } # foreach
1119
1120   CVSCommit $cvs_server, $repository, "groups", "Changed $old_group -> $new_group in $groups", sort (@new_groups);
1121
1122   Unlock $groups;
1123
1124   my $passwd = "$cvs_server/$repository/CVSROOT/passwd";
1125
1126   Lock $passwd;
1127
1128   my @passwd = Read $passwd;
1129   my @new_passwd;
1130
1131   foreach (@passwd) {
1132     my $line = $_;
1133     chomp $line;
1134
1135     my @fields = split /:/, $line;
1136     my @groups = split /,/, $fields [5];
1137
1138     my @new_groups;
1139
1140     foreach (my $group = @groups) {
1141       chomp $group;
1142
1143       if ($group eq $old_group) {
1144         push @new_groups, "$new_group\n";
1145       } else {
1146         push @new_groups, "$group\n";
1147       } # if
1148     } # foreach
1149
1150     my $first_time = 1;
1151     my $group_str;
1152
1153     foreach (@new_groups) {
1154       my $line = $_;
1155       chomp $line;
1156
1157       if ($first_time) {
1158         $group_str = $line;
1159         $first_time = 0;
1160       } else {
1161         $group_str .= ",$line";
1162       } # if
1163     } # foreach
1164
1165     my $passwd_line =
1166       $fields [0]       . ":" .
1167       $fields [1]       . ":" .
1168       $fields [2]       . ":" .
1169       $fields [3]       . ":" .
1170       $fields [4]       . ":" .
1171       $group_str        . "\n";
1172
1173     push @new_passwd, $passwd_line;
1174   } # foreach
1175
1176   CVSCommit $cvs_server, $repository, "passwd", "Updated $passwd changing any $old_group -> $new_group", sort (@new_passwd);
1177
1178   Unlock $passwd;
1179
1180   return 0;
1181 } # UpdateGroup
1182
1183 sub UpdateSysUser {
1184   my $cvs_server        = shift;
1185   my $repository        = shift;
1186   my $old_sysuser       = shift;
1187   my $new_sysuser       = shift;
1188
1189   my $sysusers = "$cvs_server/$repository/CVSROOT/sysusers";
1190
1191   Lock $sysusers;
1192
1193   my @sysusers = Read $sysusers;
1194   my @new_sysusers;
1195
1196   foreach (@sysusers) {
1197     my $line = $_;
1198     chomp $line;
1199
1200     if ($old_sysuser eq $line) {
1201       push @new_sysusers, "$new_sysuser\n";
1202     } else {
1203       push @new_sysusers, "$line\n";
1204     } # if
1205   } # foreach
1206
1207   CVSCommit $cvs_server, $repository, "sysusers", "Changed $old_sysuser -> $new_sysuser in $sysusers", sort (@new_sysusers);
1208
1209   Unlock $sysusers;
1210
1211   my $passwd = "$cvs_server/$repository/CVSROOT/passwd";
1212
1213   Lock $passwd;
1214
1215   my @passwd = Read $passwd;
1216   my @new_passwd;
1217
1218   foreach (@passwd) {
1219     my $line = $_;
1220     chomp $line;
1221
1222     my @fields = split /:/, $line;
1223
1224     if ($fields [2] eq $old_sysuser) {
1225       $fields [2] = $new_sysuser;
1226     } # if
1227
1228     my $passwd_line =
1229       $fields [0]       . ":" .
1230       $fields [1]       . ":" .
1231       $fields [2]       . ":" .
1232       $fields [3]       . ":" .
1233       $fields [4]       . ":" .
1234       $fields [5]       . "\n";
1235
1236     push @new_passwd, $passwd_line;
1237   } # foreach
1238
1239   CVSCommit $cvs_server, $repository, "passwd", "Updated $passwd changing any $old_sysuser -> $new_sysuser", sort (@new_passwd);
1240
1241   Unlock $passwd;
1242
1243   return 0;
1244 } # UpdateSysUser
1245
1246 sub UpdateUser {
1247   my $cvs_server        = shift;
1248   my $repository        = shift;
1249   my %user_record       = @_;
1250
1251   my $euid = cookie "CVSAdmUser";
1252
1253   if (defined $user_record {new_password} and $user_record {new_password} ne "") {
1254     if (!IsAdmin $cvs_server, $repository, $euid) {
1255       my $status = CVSAdm::Login $cvs_server, $repository,
1256         $user_record {userid}, $user_record {old_password};
1257       if ($status ne 0) {
1258         DisplayError "The old password you supplied is invalid - Go back and try again";
1259         return 1;
1260       } # if
1261     } # if
1262   } # if
1263
1264   UpdateAccess $cvs_server, $repository, $user_record {userid},  $user_record {$repository};
1265
1266   my $passwd = "$cvs_server/$repository/CVSROOT/passwd";
1267
1268   Lock $passwd;
1269
1270   my @passwd = Read $passwd;
1271   my @new_passwd;
1272
1273   foreach (@passwd) {
1274     my $line = $_;
1275     chomp $line;
1276
1277     my @fields = split /:/, $line;
1278
1279     if ($fields [0] eq $user_record {userid}) {
1280       if (defined $user_record {new_password} and $user_record {new_password} ne "") {
1281         my $salt = substr $fields [1], 0, 2;
1282         $user_record {password} = crypt $user_record {new_password}, $salt;
1283       } else {
1284         $user_record {password} = $fields [1];
1285       } # if
1286
1287       $user_record {system_user} = $fields [2] if !defined $user_record {system_user};
1288
1289       $line = $user_record {userid}             . ":" .
1290               $user_record {password}           . ":" .
1291               $user_record {system_user}        . ":" .
1292               $user_record {fullname}           . ":" .
1293               $user_record {email}              . ":" .
1294               $user_record {groups};
1295     } # if
1296
1297     push @new_passwd, "$line\n";
1298   } # foreach
1299
1300   my $euid = cookie "CVSAdmUser";
1301   my $commit_msg =
1302     $euid eq "cvsroot"                                          ?
1303       "Changed "       . $user_record {userid}  . " entry"      :
1304       "$euid changed " . $user_record {userid}  . " entry";
1305
1306   CVSCommit $cvs_server, $repository, "passwd", $commit_msg, sort (@new_passwd);
1307
1308   Unlock $passwd;
1309
1310   return 0;
1311 } # UpdateUser
1312
1313 sub UserInGroup {
1314   my $cvs_server        = shift;
1315   my $repository        = shift;
1316   my $userid            = shift;
1317   my $group             = shift;
1318
1319   my %user_fields = PasswdEntry $cvs_server, $repository, $userid;
1320
1321   return 0 if !defined $user_fields {groups};
1322
1323   my @user_groups = @{$user_fields {groups}};
1324
1325   foreach (@user_groups) {
1326     my $line = $_;
1327     chomp $line;
1328
1329     return 1 if $group eq $line;
1330   } # foreach
1331
1332   return 0;
1333 } # UserInGroup
1334
1335 sub Users {
1336   my $cvs_server        = shift;
1337   my $repository        = shift;
1338
1339   my @users;
1340
1341   my %passwd = OpenPasswd $cvs_server, $repository;
1342
1343   foreach (keys %passwd) {
1344     push @users, $_;
1345   } # foreach
1346
1347   return sort @users;
1348 } # Users
1349
1350 1;