view release on metacpan or  search on metacpan

lib/CfgTie/TieUser.pm  view on Meta::CPAN

sub add_scalar($$)
{
   my ($name,$package) =@_;
   $name=lc($name);
   $CfgTie::TieUser_rec::SDelegates->{$name}=$package;
}

sub add_hash($$)
{
   my ($name,$package) =@_;
   $name=lc($name);
   $CfgTie::TieUser_rec::HDelegates->{$name}=$package;
}

package CfgTie::TieUser_id;

sub status
{
  # the information for the /etc/passwd file
  stat '/etc/passwd';
}


sub TIEHASH
{
   my $self = shift;
   my $node = {};
   return bless $node, $self;
}

sub FIRSTKEY
{
   my $self = shift;

   #Rewind outselves to the beginning.
   setpwent;

   &NEXTKEY($self);
}

sub NEXTKEY
{
   my $self = shift;

   #Get the next user id in the database.
   # Get the information from the system and store it for later
   my @x = getpwent;
   if (! scalar @x) {return;}

   &CfgTie::TieUser_rec'TIEHASH(0,@x);
   return $x[2]; #Corresponds to the id
}

sub EXISTS
{
   my ($self,$id) = @_;
   if (exists $CfgTie::TieUser_rec'by_id{$id}) {return 1;}

   # Get the information from the system and store it for later
   my @x = getpwuid $id;
   if (! scalar @x) {return 0;}

   tie %{$CfgTie::TieUser_rec'by_name{lc($x[0])}}, 'CfgTie::TieUser_rec',@x;
   $CfgTie::TieUser_rec'by_id{$id} = $CfgTie::TieUser_rec'by_name{$x[0]};
   return 1;
}

sub FETCH
{
   my ($self,$id) = @_;

   #check out our cache first
   if (EXISTS($self,$id)) {return $CfgTie::TieUser_rec'by_id{$id};}
}

#Bug creating users is not supported yet.
sub STORE
{
   my ($self,$key,$val) = @_;
#   useradd or usermod, depending
}

#Bug need to consider how vigorously we delete things -r ? /var/mail/me, etc
sub DELETE
{
   my ($self,$id) = @_;

   if (!exists $CfgTie::TieUser_rec'by_id{$id})
     {
        #Try to look up the user id
        FETCH($self,$id);
     }
      
   if (exists $CfgTie::TieUser_rec'by_id{$id})
     {
        #Basically delete the user now.
        CfgTie::filever::system
	 ("$CfgTie::TieUser_rec'userdel $CfgTie::TieUser_rec'by_id{$id}->{Name}");

        #Remove it from out cache
        delete $CfgTie::TieUser_rec'by_id{$id};
     }
}



package CfgTie::TieUser_rec;
# A package used by both user_id and user to retain record information about
# a person.  This is the only way to access usermod.

#Two hashes are used for look up
# $by_name{$name}
# $by_id{$id}

#Delegate keys
# This are looked up by a delegate system that we basically add on
my $HDelegates={};
my $SDelegates={};

#Extended keys

lib/CfgTie/TieUser.pm  view on Meta::CPAN

{
   # Ties a single user to a register...
   my ($self,$Name,@Rest) = @_;
   my $Node;
   my $lname = lc($Name);

   if (scalar @Rest)
     {
        ($Node->{password},$Node->{id},   $Node->{groupid},
         $Node->{quota}, $Node->{comment}, $Node->{gcos}, $Node->{home},
         $Node->{shell}) = @Rest;
     }

   if (defined $Name)    {$Node->{name}=$Name;}

   #Add in the delegates
   foreach my $I (keys %{$HDelegates})
   {tie %{$Node->{$I}}, $HDelegates->{$I}, $Node->{id};}
   foreach my $I (keys %{$SDelegates})
   {tie $Node->{$I}, $SDelegates->{$I}, $Node->{id};}

   return bless $Node, $self;
}

sub FIRSTKEY
{
   my $self = shift;
   my $a = keys %{$self};
   NEXTKEY($self,undef);
}

sub NEXTKEY ($$)
{
   my ($self,$prev) = @_;
   my $a = scalar each %{$self};
   if ($a) {return $a;}

###The following is busted

   #Should also return something from the extended keys if not already set.
   #if (!exists $EKeys->{$prev}) {my $a = keys %{$EKeys};}
   #while ($a = scalar each %{$EKeys})
   # {
   #    if (exists $self->{$a}) {next;}
   #    return $a;
   # }
   return $a;
}

#Modified from PERL Cookbook:
my $lastlog_fmt="L a16 A16"; #on sunos "L A8 A16"
sub lastlog_FETCH($)
{
   use User::pwent;
   use IO::Seekable qw(SEEK_SET);

   my $LASTLOG= new Secure::File "</var/log/lastlog";
   return unless defined $LASTLOG;

   my $User = shift;
   my $U = ($User =~ /^\d+$/) ? getpwuid($User) : getpwnam($User);
   if (!$U) {goto ret_from_here;}

   my $R;
   my $sizeof = length(pack($lastlog_fmt,()));
   if ($LASTLOG->seek($U->uid + $sizeof,SEEK_SET) &&
       $LASTLOG->read($buffer, $sizeof) == $sizeof)
     {
        #time line host
        $R = [unpack($lastlog_fmt, $buffer)];
     }

  ret_from_here:
   $LASTLOG->close;
   $R;
}

sub scan_lasts
{
   #Get the last time the read their email
   my $L = new Secure::File "</var/log/maillog";
   while (<$L>)
    {
       if(/([\d\w\s:]+)\s\w+\s\w+\[\d+\]:\sLogout\suser\s(\w+).*/)
           {$Last{lc($2)} = $1;}
     }

   $L->close;
}

sub EXISTS
{
   my ($self,$key) = @_;
   my $lkey=lc($key);

   #first, check to see if it is a forbidden key
   if ($lkey eq 'delegate') {return 0;}

   #Next, check the delegates
   if (exists $self->{delegate}->{$lkey}) {return 1;}

   #otherwise check the rest
      if ($lkey eq 'login_last' && !exists $self->{'login_last'})
        {
           my $R = lastlog_FETCH($self->{name});
           if (undef $R) {return 0;}
           $self->{'login_last'} = $R;
        }
   elsif ($lkey eq 'last' && !exists $self->{'last'})
     {
        #Try to recover it from our shadow, but avoid scanning the last
        #file if we can -- it takes a *long* time
        if (!exists $Last{lc($self->{name})} && !defined $scanned_last)
          {
             &scan_lasts();
             $scanned_last=1;
          }
        if (exists $Last{lc($self->{name})})
          {$self->{'last'} = $Last{lc($self->{name})};}
     }
   return exists $self->{$lkey};