view release on metacpan or  search on metacpan

lib/CGI/Builder/Auth/UserAdmin.pm  view on Meta::CPAN

sub delete {
    my($self, $user) = @_;
    my $rc = 1; 
    delete($self->{'_HASH'}{$user});
    $self->{'_HASH'}{$user} and $rc = 0;
    $rc;
}

sub suspend {
    my($self, $user) = @_;
    $self->{'_HASH'}->{$user} = "!".$self->{'_HASH'}->{$user}
      if $self->{'_HASH'}->{$user} !~ m/^!/;
    return 0 unless $self->{'_HASH'}->{$user} =~ m/^!/;
    return 1;
}

sub unsuspend {
    my($self, $user) = @_;
    $self->{'_HASH'}->{$user} =~ s/^!//;
    return 0 unless $self->{'_HASH'}->{$user} !~ m/^!/;
    return 1;
}

sub list {
    keys %{$_[0]->{'_HASH'}};
}

sub exists {
    my($self, $name) = @_;
    return 0 unless defined $self->{'_HASH'}{$name};
    return $self->{'_HASH'}{$name};
}

sub db {
    my($self, $file) = @_;
    my $old = $self->{'DB'};
    return $old unless $file;
    if($self->{'_HASH'}) {
	$self->DESTROY;
    }

    $self->{'DB'} = $file;

    #return unless $self->{NAME};	
    $self->lock || Carp::croak();
    $self->_tie('_HASH', $self->{DB});
    $old;
}

sub group {
    my($self) = shift;
    $self->load('CGI::Builder::Auth::GroupAdmin');
    my %attr = %{$self};
    foreach(qw(DB _HASH)) {
	delete $attr{$_}; #just incase, everything else should be OK
    }
    return new CGI::Builder::Auth::GroupAdmin (%attr, @_);
}

sub update {
    my($self, $username, $passwd, @fields) = @_;
    return (0, "User '$username' does not exist") unless $self->exists($username);
    my ($old_encr, $bool);
    if (!defined $passwd) {
	$bool = 1;
	$passwd = $self->password($username);
	$old_encr = $self->{ENCRYPT};
	$self->{ENCRYPT} = 'none';
    }
    $self->delete($username);
    $self->add($username, $passwd, @fields);
    $self->{ENCRYPT} = $old_encr if $bool;
    1;
} 

sub convert {
    my($self) = shift;
    my $class = $self->baseclass(2); #hmm
    my $new = $class->new(@_);
    foreach($self->list) {
	$new->add($_, $self->password($_), 1);
    }
    $new;
}

sub password { 
    my $self = shift;
    my $val = $self->exists(@_);
    my($x,$y,$z) = split(':',$val);
    return defined($z) ? join(':',$x,$y,$z) : join(':',$x,$y)
	if $self->{ENCRYPT} eq 'MD5';
    return $x;
}

# from Apache's dbmmanage:
# if $newstyle is 1, then use new style salt (starts with '_' and contains
# four bytes of iteration count and four bytes of salt).  Otherwise, just use
# the traditional two-byte salt.
# see the man page on your system to decide if you have a newer crypt() lib.
# I believe that 4.4BSD derived systems do (at least BSD/OS 2.0 does).
# The new style crypt() allows up to 20 characters of the password to be
# significant rather than only 8.

#my %NewStyle = map $_,1, qw(bsd/os-2.0);

sub encrypt {
    my($self) = shift; 
    my $newstyle = defined $_[1]; # || defined $NewStyle{ join("-",@Config{qw(osname osvers)}) };
    my($passwd) = "";
    my($scheme) = $self->{ENCRYPT} || "crypt";
    # not quite sure where we're at risk here...
    # $_[0] =~ /^[^<>;|]+$/ or Carp::croak("Bad password name"); $_[0] = $&;
    if($scheme eq "crypt") {
	$passwd = crypt($_[0], salt($newstyle));
    }
    elsif ($scheme eq "MD5") {
	#I know, this isn't really "encryption", 
	#since you can't decrypt it, oh well...
	unless (defined $self->{'_MD5'}) {
	    require Digest::MD5;