rbac-utils.lib

Perl写的CA认证程序

## OpenCA::RBAC
##
## Copyright (C) 2000-2001 Michael Bell ([e-mail])
##

sub getAccess {
  my $keys = { @_ };

  ## role
  ## if $keys->{DN} is empty then it is a request for a public action
  ## like a request
  my $role;
  if ( $keys->{ROLE} ) {
    $role = $keys->{ROLE};
  } else {
    $role = getRoleFromDN ( $keys->{DN} );
  }

  ## status and objecttype
  my $status = $keys->{DATATYPE};
  $status =~ s/^.*_//g;
  my $objecttype = $keys->{DATATYPE};
  $objecttype =~ s/_.*$//g;

  ## dn from object if available
  my $owner;
  if ( defined $keys->{OWNER} ) {
    $owner = $keys->{OWNER};
  } else {
    if ( $objecttype =~ /^(REQUEST|CERTIFICATE|CRR)$/i ) {
      $owner = getRoleFromObject ($keys->{OBJECT});
    } else {
      ## the owner of CA_CERTIFICATE and CRL is the CA itself at every time!
      $owner = "";
    }
  }

  ## operation
  my $operation = $keys->{OPERATION};

  ## load the rights
  my @rbac = $db->searchItems (DATATYPE  => "RBAC",
                               ROLE      => $role,
                               OBJECT    => $objecttype,
                               STATUS    => $status,
                               OWNER     => $owner,
                               OPERATION => $operation);

  ## search a matching result
  ## necessary if there are empty elements like ROLE
  my $ac;
  foreach $ac (@rbac) {

    if (
        ( $ac->{ROLE}      =~ /^${role}$/ )       and
        ( $ac->{OBJECT}    =~ /^${objecttype}$/ ) and
        ( $ac->{STATUS}    =~ /^${status}$/ )     and
        ( $ac->{OWNER}     =~ /^${owner}$/ )      and
        ( $ac->{OPERATION} =~ /^${operation}$/ )
       ) {
      ## verify the rbac entry
      return $ac->verify;
    }
  }

  ## doesn't find any matching entry
  return 0;
}

sub getRoleFromDN {
  my $dn = $_[0];

  my $role = $dn;

  ## empty ?
  while ($role) {

    ## remove leading blanks
    $role =~ s/^\s*//g;

    ## check the next attribute to be the ou
    if ( $role =~ /^[oO][uU]\s*=/ ) {

      ## remove ou=
      $role =~ s/^[oO][uU]\s*=//;

      ## take all until ,/
      $role =~ s/\s*[,\/].*$//g;

      ## remove leading or following blanks (done by former expression
      $role =~ s/^\s*//g;

      ## return
      return $role;
    }

    ## remove all until next ,/
    $role =~ s/^[^,\/]*[,\/]//;
  }

  return "";
}

sub getRoleFromObject {
  my $object = shift;

  return getRoleFromDN ( $object->getParsed()->{DN} );

}

sub getSectionFromRole {

  my $role = shift;

  my $file     = getRequired( 'roles2openssl' );

  ## load all lines
  my @lines;
  my $temp;
  open( FD, "$file" ) || return undef;
  while( $temp = <FD> ) {
    push ( @lines, $temp);
  }
  close(FD); 

  my $tmp;
  foreach $tmp (@lines) {
    $tmp =~ s/\n//;
  }

  # build the array
  my %map;
  my $i;
  for ($i = 0; $i < (scalar (@lines) / 3); $i++) {
    $map { $lines [$i*3] } = $lines [$i*3 +1] ;
    ## 1 -> role
    ## 2 -> section
    ## 3 -> empty line
  }

  return $map {$role};

}

sub getSectionFromDN {

  my $dn   = shift;

  return getSectionFromRole ( getRoleFromDN ( $dn ) );

}

sub grantAccess {

  ## <=0 is false
  ## >=1 is true

  my $keys = { @_ };
  my $cmd;
  $cmd = $keys->{CMD}      if (defined $keys->{CMD});
  $cmd = $keys->{COMMAND}  if (defined $keys->{COMMAND});
  $cmd = $keys->{FUNCTION} if (defined $keys->{FUNCTION});

  my $operation = $cmd;

  ## input is only module, function and DN of user

  ## check for all necessary data
  ## empty DN is a new user

  my ($dn, $module, $function) = ($keys->{DN}, $keys->{MODULE}, $cmd);
  return 0 if (not $module or not $function);
  $function = $module."_".$function;

  ## calculate role via DN
  my $role;
  if ( (not $dn) and ($keys->{ROLE}) ) {
    $role = $keys->{ROLE};
  } else {
    ## check DN to be a valid_certificate
    if ($dn) {
      my @certs = $db->searchItems (DATATYPE => "VALID_CERTIFICATE",
                                    DN       => $dn);
      my $ok = 0;
      foreach my $value (@certs) {
        $ok = 1 if ($value->getParsed ()->{DN} =~ /^$dn$/ );
      }
      return 0 if (not $ok);
    }
    ## get the role
    $role = getRoleFromDN ($dn);
  }

  ## set file-suffixes
  my $suffix_conf = "conf";
  my $suffix_sig  = "sig";

  ## check signature of function's conf-file

  ## load function's configuration file
  my $ret; 
  my $rbac_config =  new OpenCA::Configuration;
  if( ($ret = $rbac_config->loadCfg( 
                getRequired ( 'RBAC_DIR') ."/".$module."/".
                $function.".".$suffix_conf )) == undef ) {
    print "Content-type: text/html\n\n";
    configError( "Error while Loading Configuration (".
                  getRequired ('RBAC_DIR') .
                  "/$module/$function.$suffix_conf)!" );
    exit 100;
  }

  ## build array with access rights which are needed
  my $block;
  my @acl;
  foreach $block (@ {$rbac_config->getParam ('STRUCTURES')->{VALUES}}) {
    my %help;
    $help {OWNER_METHOD}   = 
      $rbac_config->getParam ($block."_OWNER_METHOD")  ->{VALUES}->[0];
    $help {OWNER_ARGUMENT} = 
      $rbac_config->getParam ($block."_OWNER_ARGUMENT")->{VALUES}->[0];
    $help {OBJECT_METHOD}   = 
      $rbac_config->getParam ($block."_OBJECT_METHOD")  ->{VALUES}->[0];
    $help {OBJECT_ARGUMENT} = 
      $rbac_config->getParam ($block."_OBJECT_ARGUMENT")->{VALUES}->[0];
    ##
    ## not needed any longer because the scriptname is the operation
    ##
    ## $help {OPERATION_METHOD}   = 
    ##   $rbac_config->getParam ($block."_OPERATION_METHOD")  ->{VALUES}->[0];
    ## $help {OPERATION_ARGUMENT} = 
    ##   $rbac_config->getParam ($block."_OPERATION_ARGUMENT")->{VALUES}->[0];
    ##
    $help {STATUS_METHOD}   = 
      $rbac_config->getParam ($block."_STATUS_METHOD")  ->{VALUES}->[0];
    $help {STATUS_ARGUMENT} = 
      $rbac_config->getParam ($block."_STATUS_ARGUMENT")->{VALUES}->[0];
    push (@acl, \%help);
  }

  ## actual content of @acl
  #############################
  ## owner_method
  ## owner_arg
  ## object_method
  ## object_arg
  ## operation_method
  ## operation_arg
  ## status_method
  ## status_arg
  ############################

  ## calculate objects
  for ($i = 0; $i < scalar (@acl); $i++) {
    if ($acl [$i] {OBJECT_METHOD} =~ /^CGI$/i ) {
      $acl [$i] {OBJECT} = $tristatecgi->param ($acl [$i] {OBJECT_ARGUMENT});
    } elsif ($acl [$i] {OBJECT_METHOD} =~ /^CGI_DATATYPE$/i ) {
      $acl [$i] {OBJECT} = $tristatecgi->param ($acl [$i] {OBJECT_ARGUMENT});
      $acl [$i] {OBJECT} =~ s/_.*$//;
    } else {
      $acl [$i] {OBJECT} = $acl [$i] {OBJECT_ARGUMENT};
    }
  }

  ## calculate status
  for ($i = 0; $i < scalar (@acl); $i++) {
    if ($acl [$i] {STATUS_METHOD} =~ /^CGI$/i ) {
      $acl [$i] {STATUS} = $tristatecgi->param ($acl [$i] {STATUS_ARGUMENT});
    } elsif ($acl [$i] {STATUS_METHOD} =~ /^CGI_DATATYPE$/i ) {
      $acl [$i] {STATUS} = $tristatecgi->param ($acl [$i] {STATUS_ARGUMENT});
      $acl [$i] {STATUS} =~ s/^.*_//;
    } else {
      $acl [$i] {STATUS} = $acl [$i] {STATUS_ARGUMENT};
    }
  }

  ## calculate owners
  my $i;
  my $tristatecgi = new OpenCA::TRIStateCGI;
  for ($i = 0; $i < scalar (@acl); $i++) {
    if ($acl [$i] {OWNER_METHOD} =~ /^CGI$/i ) {
      $acl [$i] {OWNER} = $tristatecgi->param ($acl [$i] {OWNER_ARGUMENT});
    } elsif ($acl [$i] {OWNER_METHOD} =~ /^CA$/i) {
      $acl [$i] {OWNER} = "";
    } elsif ($acl [$i] {OWNER_METHOD} =~ /^ANY$/i) {
      ## get all available roles
      my $rbac = getRequired ('RBAC_DIR');
      my $ls = `ls $rbac`;
      my @list = split /\n/, $ls;
      my $value;
      ## replicate record
      foreach $value (@list) {
        $value =~ s/\.conf$//;
        push @acl, { OWNER              => $value,
                     OBJECT_METHOD      => $acl [$i] {OBJECT_METHOD},
                     OBJECT_ARGUMENT    => $acl [$i] {OBJECT_ARGUMENT},
                     OPERATION_METHOD   => $acl [$i] {OPERATION_METHOD},
                     OPERATION_ARGUMENT => $acl [$i] {OPERATION_ARGUMENT},
                     STATUS_METHOD      => $acl [$i] {STATUS_METHOD},
                     STATUS_ARGUMENT    => $acl [$i] {STATUS_ARGUMENT}
                   }
      }
      ## delete record
      splice @acl, $i, 1;
    } elsif ( $acl [$i] {OWNER_METHOD} =~ /^DATABASE$/i ) {
      $object = $db->getItem ( DATATYPE => $acl [$i] {OBJECT}."_".$acl [$i] {STATUS},
                               KEY      => $tristatecgi->param ($acl [$i] {OWNER_ARGUMENT})
                             );
      my $dn = $object->getParsed ()->{DN};
      ## remove all in front of the first ou
      $dn =~ s/^(^(ou *= *))*//ig;
      ## remove "ou = "
      $dn =~ s/^ou *= *//ig;
      ## remove all after the first ou
      $dn =~ s/[,\/].*//g;
      $acl [$i] {OWNER} = $dn;
    } else {
      $acl [$i] {OWNER} = $acl [$i] {OWNER_ARGUMENT};
    }
  }

  ##
  ## not needed any longer because the scriptname is the operation
  ##
  ##  ## calculate operation
  ##  for ($i = 0; $i < scalar (@acl); $i++) {
  ##    if ($acl [$i] {OPERATION_METHOD} =~ /^CGI$/i ) {
  ##      $acl [$i] {OPERATION} = $tristatecgi->param ($acl [$i] {OPERATION_ARGUMENT});
  ##    } else {
  ##      $acl [$i] {OPERATION} = $acl [$i] {OPERATION_ARGUMENT};
  ##    }
  ##  }
  ##

  ## actual content of @acl
  ##############################
  ## owner
  ## object
  ## operation
  ## status
  ##############################

  my $grant = 0;

  ## check all necessary rights
  foreach $block (@acl) {

    ## load rights
    my @rbac = $db->searchItems (DATATYPE  => "RBAC",
                                 ROLE      => $role,
                                 OBJECT    => $block->{OBJECT},
                                 STATUS    => $block->{STATUS},
                                 OWNER     => $block->{OWNER},
                                 OPERATION => $operation);

    ## search a matching result
    ## necessary if there are empty elements like ROLE
    my $ac;
    $grant = 0;
    foreach $ac (@rbac) {

      if (
          ( $ac->{ROLE}      =~ /^$role$/ )   and
          ( $ac->{OBJECT}    =~ /^$block->{OBJECT}$/ ) and
          ( $ac->{STATUS}    =~ /^$block->{STATUS}$/ ) and
          ( $ac->{OWNER}     =~ /^$block->{OWNER}$/ )  and
          ( $ac->{OPERATION} =~ /^$operation$/ )
         ) {
        ## verify the rbac entry
        $grant = 1 if return $ac->verify;
      }
    }

    ## if not $grant check for allowed status ANY
    if (not $grant) { 
      ## load rights
      my @rbac = $db->searchItems (DATATYPE  => "RBAC",
                                   ROLE      => $role,
                                   OBJECT    => $block->{OBJECT},
                                   STATUS    => "ANY",
                                   OWNER     => $block->{OWNER},
                                   OPERATION => $operation);

      ## search a matching result
      ## necessary if there are empty elements like ROLE
      my $ac;
      foreach $ac (@rbac) {

        if (
            ( $ac->{ROLE}      =~ /^$role$/ )   and
            ( $ac->{OBJECT}    =~ /^$block->{OBJECT}$/ ) and
            ( $ac->{STATUS}    =~ /^ANY$/ ) and
            ( $ac->{OWNER}     =~ /^$block->{OWNER}$/ )  and
            ( $ac->{OPERATION} =~ /^$operation$/ )
           ) {
          ## verify the rbac entry
          $grant = 1 if return $ac->verify;
        }
      }
    }  # end of check for status any

    return $grant if (not $grant);
  }

  ## return result
  return $grant;
}

1;