#! /usr/bin/perl -w

#
#  Access control lists for CVS.  Written by Jason Molenda who works
#  for Yahoo!, jason-ca@molenda.com.
#  Version 1.1 2000-10-16

# This is an entirely separate script from David Grubb's "cvs_acls.pl"
# which is included in the cvs distributions' contrib/ directory.

# David is obviously more familiar with perl, and his script is a lot
# more straightforward than mine.  On the other hand, his ACL mechanism
# is not very flexible.  My cvs-acls.pl script is many times more complex, 
# but it makes it possible to express more involved permission sets.

# For instance, it is not possible with David's cvs_acls.pl to express
# "User foo is only able to check in to directory bar", without explicitly
# naming every user who has global checkin permissions.

use File::Basename;
use Getopt::Long;
use strict;

use vars qw ($allow_commit $deny_commit $DEBUG $DUMP_ACL_DB $script_name);

$allow_commit = 0;
$deny_commit = 1;

$DEBUG = 0;
$DUMP_ACL_DB = 0;



#
# main
#
# It all starts here.
#



sub main 
  {
    my ($cvs_acls, $username, $dirname, @filenames);
    my ($result, $denial_message, $cvsroot, $config_file);
    my ($COMMIT_LOG_FILENAME, $LOG_COMMITS);

    use vars qw($opt_debug $opt_dump_acls $opt_conf_file $opt_commit_logfile);
    use vars qw($opt_help $opt_username);
    
    $script_name = basename ($0);


##
## Start of argument parsing
##
    
    GetOptions ("debug", "dump-acls|dump-acl|dump", "conf-file|conf|file=s", 
                "commit-logfile|commit-log-file|commit-log=s", "help",
                "username|user|name=s");
    
    if (defined ($opt_help))
      {
        usage ();
      }
    if (defined ($opt_debug))
      {
        $DEBUG = 1;
      }
    
    if (defined ($opt_dump_acls))
      {
        $DUMP_ACL_DB = 1;
      }
    
    $cvsroot = $ENV{'CVSROOT'};
    
    if (defined ($opt_conf_file))
      {
        $config_file = $opt_conf_file;
      }
    else
      {
        $config_file = $cvsroot . "/CVSROOT/cvs-acl.conf";
      }

    if ($DEBUG)
      {
        print STDERR "DEBUG: Using $config_file as our config file.\n";
      }
    
    if (defined ($opt_commit_logfile))
      {
        $LOG_COMMITS = 1;
        $COMMIT_LOG_FILENAME = $opt_commit_logfile;
      }
    elsif (defined ($LOG_COMMITS) && $LOG_COMMITS == 1)
      {
        $COMMIT_LOG_FILENAME = $cvsroot . "/CVSROOT/commit-logfile";
      }
    
    $cvs_acls = read_in_acls ($config_file);
    
    if ($DUMP_ACL_DB)
      {
        dump_acls ($cvs_acls);
      }
    
    if (@ARGV < 2)
      {
        usage ();
      }
    
    if (defined ($opt_username))
      {
        $username = $opt_username;
      }
    else
      {
        # David Grubb's cvs_acls sets username like this:
        # $myname = $ENV{"USER"} if !($myname = $ENV{"LOGNAME"});
        $username = (getpwuid($<))[0];
      }
    
    if (!defined ($username) || $username eq "")
      {
        print STDERR "$script_name: unable to determine username.\n";
        exit $allow_commit;
      }
    
    if ($DEBUG)
      {
        print STDERR "DEBUG: Doing checks as user `$username'.\n";
      }


##
## End of argument parsing
##

    
    $dirname = shift @ARGV;
    if ($dirname =~ m#^$cvsroot/#)
      {
        $dirname =~ s#^$cvsroot/##;
      }
    $dirname = canonical_dirname ($dirname);

    @filenames = @ARGV;
    
    foreach my $file (@filenames)
      {
        ($result, $denial_message) = 
            check_acl ($dirname, $file, $username, $cvs_acls);
        last if ($result eq 'deny');
      }
    
    # There isn't any locking here; this is not reliable.  If two
    # people commit at the same time (two different parts of the repo),
    # their commits will stomp on each other and you'll get a truncated
    # logfile entry.  This is only intended as a debugging feature to ensure
    # that the script is performing reasonably.
    
    if ($LOG_COMMITS)
      {
        my $timestamp = scalar (localtime (time ()));
        if (open (LOGFILE, ">> $COMMIT_LOG_FILENAME"))
          {
            print LOGFILE "[$timestamp] $result $username $dirname @filenames\n";
            close (LOGFILE);
          }
      }
    
    if ($result eq 'deny')
      {
        if (defined ($denial_message) && $denial_message ne '')
          {
            print STDERR $denial_message . "\n";
          }
        exit $deny_commit;
      }
    
    exit $allow_commit;
  }




#
# usage
#
# Tell the users what they can do.
#



sub usage
  {
    print STDERR "Usage:  $script_name [--help] [--debug] [--conf=FILENAME]\n";
    print STDERR "        [--dump-acls] [--commit-logfile=FILENAME] [--username=NAME]\n";
    print STDERR "        directory filename...\n";
    print STDERR "\n";

    print STDERR "  --help      This message.\n";
    print STDERR "  --debug     Print out debugging information while running.\n";
    print STDERR "  --conf      Location of ACL configuration file\n";
    print STDERR "  --dump-acls Print out the ACL before doing anything else.\n";
    print STDERR "  --commit-logfile  Keep a record of all commits, and whether they were\n";
    print STDERR "                    allowed or denied.\n";
    print STDERR "  --username  Useful for testing, it lets you specify what uname to try as.\n";
    print STDERR "\n";

    print STDERR "Default location for --conf is \$CVSROOT/CVSROOT/cvs-acl.conf.\n";

   exit ($allow_commit);
  }





#  read_in_acls (ACL_CONFIG_FILENAME)
#
#  Returns a pointer to a hash.  The top-level elements in the hash
#  are directory/filenames (or "*ALL*" to indicate the entire repository).  
#  The elements the next level down are usernames (or "*ALL*" to indicate
#  all users), and the 'permission' element below that is an enumerated
#  type of either 'allow' or 'deny'.  If it is deny, there is an optional
#  denial message in the 'denial message' element.
#
#  In short, you get a hash like this:
#
#    $acl_hash->{"schmoo/libraries"}->{"meng"}->{"permission"} eq "deny"
#    $acl_hash->{"schmoo/libraries"}->{"meng"}->{"denial message"} eq 
#               "Anonymous account meng not allowed to check in files."

#  The format of the file that is is reading is (briefly) like this:
#
#  DIRNAME[/FILENAME] : USERNAME[, USERNAME...] : {allow|deny} : DENIAL-MSG
#
#  DIRNAME and USERNAME may be empty or "*ALL*", both of which mean
#  "Applies to every dir/user".

sub read_in_acls 
  {
    my ($acl_config_filename) = @_;
    my $split_line;
    my $acls = {};
 
    $split_line = undef;
 
    if (!open (ACLS, $acl_config_filename))
     {
       print STDERR "$script_name: Unable to open '$acl_config_filename'\n";
       exit ($allow_commit);
     }
    while (<ACLS>)
     {
       next if (/^\s*$/ || /^\s*\#/);
       chomp;
 
       if (defined ($split_line))
         {
           s/^\s+/ /;
           $_ = $split_line . $_;
           $split_line = undef;
         }
       if (/\\$/) 
         {
           chop;
           $split_line ||= '';
           $split_line = $split_line . $_;
           next;
         }
       
       next if ($_ !~ /.*:.*:/);
       my ($dirname, $usernames, $action, $deny_msg) = split (/[\s,]*:[\s,]*/);
 
       if (!defined ($dirname) || $dirname eq "" || 
           $dirname eq "*ALL*" || $dirname eq "*all*" ||
           $dirname eq "*ANY*" || $dirname eq "*any*")
         {
           $dirname = "*ALL*";
         }
       if (!defined ($usernames) || $usernames eq "" || 
           $usernames eq "*ALL*" || $usernames eq "*all*" ||
           $usernames eq "*ANY*" || $usernames eq "*any*")
         {
           $usernames = "*ALL*";
         }

       $dirname = canonical_dirname ($dirname);

       if (!defined ($action) || $action eq "" || 
           ($action ne "allow" && ($action ne "deny")))
         {
           print STDERR "$script_name:  Badly formed line encountered " .
                "- missing action.  Line:\n$_\n";
           next;
         }
       foreach my $uname (split (/[\s,]*,[\s,]*/, $usernames))
         {
           $acls->{$dirname}{$uname}{'permission'} = $action;
           if (defined ($deny_msg) && $deny_msg ne "")
             {
               $acls->{$dirname}{$uname}{'denial message'} = $deny_msg;
             }
         }
     }
    close (ACLS);
 
    return ($acls);
  }




##
## check_acl
##
## This is the main function for checking a username/directory/filename
## against the ACL list.  It returns a list of (PERMISSION-RESULTS,
## DENIAL-MESSAGE).  PERMISSION-RESULTS is either 'allow' or 'deny'.
## DENIAL-MESSAGE is either undef or a string explaining why the commit
## was denied.
##
## Returns a result ("deny" || "allow") and a denial message, if any.
## It will return (undef, undef) if no matching directory entry is found.

sub check_acl
  {
    my ($dirname, $filename, $username, $aclh) = @_;
    my $current_permission;
    my $tmp_perm_holder;
    my $dir_so_far;
    my $denial_node = undef;
    my $tmp_node_holder = undef;
    my $denial_message = undef;

    $dirname = canonical_dirname ($dirname);
    $filename = canonical_dirname ($filename);

    ($current_permission, $denial_node) = 
        check_single_dir_acl ($username, "", $aclh);

    foreach my $cur_dir_component (split (/\//, $dirname))
      {
        if (defined ($dir_so_far))
          {
            $dir_so_far = $dir_so_far . "/" . $cur_dir_component;
          }
        else
          {
            $dir_so_far = $cur_dir_component;
          }
        ($tmp_perm_holder, $tmp_node_holder) = 
            check_single_dir_acl ($username, $dir_so_far, $aclh);
        if (defined ($tmp_perm_holder))
          {
            $current_permission = $tmp_perm_holder;
          }
        if (defined ($tmp_node_holder))
          {
            $denial_node = $tmp_node_holder;
          }
        if ($DEBUG)
          {
            $tmp_perm_holder ||= "";
            print STDERR  "DEBUG: Check dir component $dir_so_far, perm " .
                          "$tmp_perm_holder\n";
          }
      }

    ($tmp_perm_holder, $tmp_node_holder) = 
             check_single_dir_acl ($username, $dirname ."/". $filename, $aclh);

    if ($DEBUG)
      {
        $tmp_perm_holder ||= "";
        print STDERR  "DEBUG: Check entry ${dirname}/${filename}, perm " .
                      "$tmp_perm_holder\n";
      }

    if (defined ($tmp_perm_holder) && $tmp_perm_holder ne "")
      {
        $current_permission = $tmp_perm_holder;
        if (defined ($tmp_node_holder))
          {
            $denial_node = $tmp_node_holder;
          }
      }

    if ($current_permission eq 'deny' && 
        defined ($denial_node->{"denial message"}) &&
        $denial_node->{"denial message"} ne "")
      {
        $denial_message = $denial_node->{"denial message"};
      }

    if (defined ($current_permission) && $current_permission ne "")
      {
        if ($current_permission eq "allow")
          {
            return ($current_permission, undef);
          }
        else
          {
            return ($current_permission, $denial_message);
          }
      }
    else
      {
        return ('allow');
      }
  }



##
## check_single_dir_acl ()
##
## Examine a single directory's entry and determine if a checkin to this
## dir is allowed.  This func knows nothing about permissions inherited 
## from superior directories.  It returns a tuple of (PERMISSION, DENIAL-NODE).
## PERMISSION is either 'allow' or 'deny' and DENIAL-NODE is a pointer to 
## the directory/user node that caused  the denial.  
## Dereferencing $DENIAL-NODE->{"denial message"} may work.
##

## NOTE: Originally I had some clever reason for passing back a pointer
## to the denial node, but I can't see any point to it.  The denial
## msg, if any, should be returned here instead of dinking around with
## a pointer.

sub check_single_dir_acl
  {
    my ($username, $dirname, $aclh) = @_;
    my $permission = undef;
    my $node = undef;
    my ($have_global_permission_entry, $username_specified) = (1, 1);

    if (!defined ($dirname) || $dirname eq "")
      {
        $dirname = "*ALL*";
      }

    if (!defined ($aclh->{$dirname}))
      {
        return (undef, undef);
      }

    if (!defined ($aclh->{$dirname}->{"*ALL*"}))
      {
        $have_global_permission_entry = 0;
      }
    if (!defined ($username) || $username eq "" || $username eq "*ALL*")
      {
        $username_specified = 0;
        $username = "*ALL*";
      }

    if (!$have_global_permission_entry && !$username_specified)
      {
        return (undef, undef);
      }

    if (!defined ($aclh->{$dirname}->{"*ALL*"}->{"permission"}) &&
         !defined ($aclh->{$dirname}->{$username}->{"permission"}))
      {
        return (undef, undef);
      }

    if (defined ($aclh->{$dirname}->{"*ALL*"}->{"permission"}))
      {
        $node = $aclh->{$dirname}->{"*ALL*"};
        $permission = $node->{"permission"};
      }

    if ($username_specified &&
        defined ($aclh->{$dirname}->{$username}) &&
        defined ($aclh->{$dirname}->{$username}->{"permission"}))
      {
        $node = $aclh->{$dirname}->{$username};
        $permission = $node->{"permission"};
      }

    if ($DEBUG) 
      {
        print STDERR "DEBUG: user $username dirname $dirname " .
                     "permission $permission\n";
      }
    if (!defined ($permission) || $permission eq 'allow')
      {
        return ($permission, undef);
      }
    else
      {
        return ($permission, $node);
      }
  }



##
## canonical_dirname ()
##
## Eliminate slashes at the beginning, end of a string.  Eliminiate
## multiple slashes in the string.  Eliminate "./" at the beginning of
## a string.

sub canonical_dirname
  {
    my ($string) = @_;

    $string  =~ s#^\/*##;
    $string  =~ s#^\.\/##;
    $string  =~ s#/*$##;
    $string  =~ s#/+#/#g;

    return ($string);
  }





##
## dump_acls
##
## Dumps out the ACL hash in a human-readable format.
##

sub dump_acls
  {
    my ($aclh) = @_;
 
    foreach my $dirname (sort keys %$aclh)
      { 
        my $allow_namelist = '';
        my $deny_namelist = '';
        foreach my $username (sort keys %{$aclh->{$dirname}}) 
          {
            if (!defined ($aclh->{$dirname}->{$username}->{'permission'}))
              {
                # This indicates that our hash is not being treated correctly.
                # Someone is touching the hash when they shouldn't.  
                # Paper over it.
                if ($DEBUG)
                  {
                    print STDERR "DEBUG: '$dirname' u '$username'\n";
                  }
                next;
              }
            if ($aclh->{$dirname}->{$username}->{'permission'} eq "allow")
              {
                if ($allow_namelist ne '') 
                  {
                    $allow_namelist = $allow_namelist . ", ";
                  }
                $allow_namelist = $allow_namelist . $username;
              }
            else
              {
                if ($deny_namelist ne '') 
                  {
                    $deny_namelist = $deny_namelist . ", ";
                  }
                $deny_namelist = $deny_namelist . $username;
              }
          }
        print "ACL_DUMP: $dirname:";
        if ($allow_namelist ne '')
          {
            print " Allow $allow_namelist";
          }
        if ($deny_namelist ne '')
          {
            print " Deny $deny_namelist";
          }
        print "\n";
      }
  }






main ();