PApp::UserObs - manage user and access rights

PApp documentation Contained in the PApp distribution.

Index

Code Index:

NAME

Top

PApp::UserObs - manage user and access rights

SYNOPSIS

Top

 use PApp::UserObs;
 # this module is obsolete

DESCRIPTION

Top

This is an obsolete module. See also the PApp::User module for additional documentation.

Functions

admin_p

Return true when user has the "admin" access right.

known_user_p [access]

Check wether the current user is already known in the access database. Returns his username (login) if yes, and undef otherwise.

If the optional argument access is given, it additionally checks wether the user has the given access right (even if not logged in).

update_username [$userid, ]$user

Change the login-name of the current user (or the user with id $userid) to $user and return the userid. If another user of that name already exists, do nothing and return undef. (See choose_username).

choose_username $stem

Guess a more-or-less viable but very probable unique username from the stem given. To create a new username that is unique, use something like this pseudo-code:

   while not update_username $username; do
      $username = choose_username $username
   done
update_password $pass

Set the (non-crypted) password of the current user to $pass. If $pass is undef, the password will be deleted and the user cannot log-in using verify_login anymore. This is not the same as an empty password, which is just that: a valid password with length zero.

update_comment $comment

Change the comment field for the current user by setting it to $comment.

username [$userid]

Return the username of the user with id $userid or of the current user, if no arguments are given.

userid $username

Return the userid associated with the given user.

$uid = user_create

Creates a new anonymous user and returns her user-id.

user_login $userid[, $level]

Log out the current user, switch to the userid $userid and UNCONDITIONALLY FETCH ACCESS RIGHTS FROM THE USER DB. For a safer interface using a password, see verify_login.

If the $userid is zero creates a new user without any access rights but keeps the state otherwise unchanged. You might want to call save_prefs to save the user preferences (for the current application only, the other preferences currently are discarded).

The $level argument can be used to differentiate between various levels of certainty (1 == http-password, 3 = tls-password, 4 = tls-certificate). The default is 1.

user_logout

Log the current user out (remove any access rights fromt he current session).

SURL_USER_LOGOUT

This surl-cookie (see PApp::surl logs the user out (see user_logout) when the link is followed.

user_delete $userid

Deletes the given userid from the system, i.e. the user with the given ID can no longer log-in or do useful things. Other sessions using this userid will get errors, so don't use this function lightly.

verify_login $user, $pass

Try to login as user $user, with pass $pass. If the password verifies correctly, switch the userid (if necessary), add any access rights and return true. Otherwise, return false and do nothing else.

Unlike the unix password system, empty password fields (i.e. set to undef) never log-in successfully using this function.

grpname $gid

Return the group name associated with the given id.

newgrp $grpname, $comment

Create a new group with the given name, updates the comment only if the group already exists.

rmgrp $group

Delete the group with the given name.

SEE ALSO

Top

PApp.

AUTHOR

Top

 Marc Lehmann <schmorp@schmorp.de>
 http://home.schmorp.de/
PApp documentation Contained in the PApp distribution. 
##########################################################################
## All portions of this code are copyright (c) 2003,2004 nethype GmbH   ##
##########################################################################
## Using, reading, modifying or copying this code requires a LICENSE    ##
## from nethype GmbH, Franz-Werfel-Str. 11, 74078 Heilbronn,            ##
## Germany. If you happen to have questions, feel free to contact us at ##
## license@nethype.de.                                                  ##
##########################################################################


package PApp::UserObs;

use PApp::SQL;
use PApp::Exception qw(fancydie);
use PApp::Callback ();
use PApp::Config qw(DBH $DBH); DBH;
use PApp qw(*state $userid getuid);
use PApp::Prefs;
use PApp::Event ();

use base Exporter;

$VERSION = 1.45;
@EXPORT = qw( 
   authen_p access_p admin_p known_user_p update_username choose_username
   update_password update_comment username user_login user_logout userid
   SURL_USER_LOGOUT user_delete grant_access revoke_access verify_login
   newgrp rmgrp user_create find_access

   grpid grpname
);

use Convert::Scalar ();

use PApp::User qw(
      
      authen_p access_p grant_access revoke_access
      find_access grpid

);

sub grpid($);


sub admin_p() {
   access_p "admin";
}


sub known_user_p(;$) {
   my $user = $PApp::prefs->get("papp_username");
   if (@_) {
      (sql_exists $DBH, "usergrp where userid = ? and grpid = ?",
                  $userid, grpid shift) ? $user : undef;
   } else {
      $user;
   }
}


sub update_username($;$) {
   my $uid = @_ > 1 ? shift : getuid;
   my $user = Convert::Scalar::utf8_upgrade "$_[0]";
   lockprefs {
      if ($PApp::prefs->find_value(papp_username => $user)) {
         undef $uid;
      } else {
         $PApp::prefs->user_set($uid, papp_username => $user);
      }
   };
   $uid;
}


sub choose_username($) {
   my $stem = $_[0];
   my $id;
   for(;;) {
      my $user = Convert::Scalar::utf8_upgrade $stem.$id;
      if (!$PApp::prefs->find_value(papp_username => $user)) {
         return $user;
      }
      $id += 1 + int rand 20;
   }
}


sub update_password($) {
   my ($pass) = @_;
   Convert::Scalar::utf8_off Convert::Scalar::utf8_upgrade "$pass";
   $pass = defined $pass
              ? crypt $pass, join '', ('.', '/', 0..9, 'A'..'Z', 'a'..'z')[rand 64, rand 64]
              : "";
   $PApp::prefs->set(papp_password => $pass);
}


sub update_comment($) {
   $PApp::prefs->set(papp_comment => $_[0]);
}


sub username(;$) {
   $PApp::prefs->user_get(@_ ? $_[0] : $userid, "papp_username");
}


sub userid($) {
   $PApp::prefs->find_value(papp_username => $_[0]);
}


sub user_create() {
   $PApp::st_newuserid->execute;
   sql_insertid $PApp::st_newuserid;
}


sub user_login($;$) {
   user_logout;
   PApp::switch_userid $_[0];
   $state{papp_auth} = $_[1] || 1;
}


sub user_logout() {
   delete $state{papp_auth};
}

my $surl_logout_cb = PApp::Callback::create_callback {
   &user_logout;
} name => "papp_logout";


sub SURL_USER_LOGOUT (){ $surl_logout_cb }


sub user_delete(;$) {
   my $uid = shift || getuid;
   user_login 0 if $userid == $uid;
   sql_exec $DBH, "delete from usergrp where userid = ?", $uid;
   sql_exec $DBH, "delete from prefs where uid = ?", $uid;
}


sub verify_login($$) {
   my ($user, $pass) = @_;
   Convert::Scalar::utf8_off Convert::Scalar::utf8_upgrade "$pass";
   my $userid = userid $user;
   if ($userid) {
      my $xpass = $PApp::prefs->user_get($userid, "papp_password");
      Convert::Scalar::utf8_off $xpass;
      if ($xpass ne "" and $xpass eq crypt $pass, substr($xpass,0,2)) {
         user_login $userid;
         return 1;
      }
   }
   sleep 1;
   return 0;
}


sub grpname($) {
   sql_fetch $DBH, "select name from grp where id = ?", $_[0];
}


sub newgrp($;$) {
   my ($grp, $comment) = @_;
   eval {
      local $SIG{__DIE__};
      sql_exec $DBH, "insert into grp (name, comment) values (?, ?)",
               "$grp", "$comment";
   };
   if ($@) {
      my $st = sql_exec $DBH, "update grp set comment = ? where name = ?", $comment, $grp;
      $st->rows == 1 or die;
   }
}


sub rmgrp($) {
   sql_exec $DBH, "delete from usergrp where grpid = ?", grpid $_[0];
   sql_exec $DBH, "delete from grp where id = ?", grpid $_[0];
}

1;