PciIds/Users.pm

   1 package PciIds::Users;
   2 use strict;
   3 use warnings;
   4 use base 'Exporter';
   5 use PciIds::Db;
   6 use DBI;
   7 use PciIds::Config;
   8 use Digest::MD5 qw(md5_base64 md5_hex);#TODO Some better algorithm?
   9 use HTML::Entities;
  10 use Startup;
  11 use PciIds::Log;
  12 use Apache2::Connection;
  13
  14 my( %privnames, %privnums );
  15
  16 our @EXPORT = qw(&addUser &emailConfirm &checkConfirmHash &saltedPasswd &genAuthToken &checkAuthToken &hasRight &getRightDefs &genResetHash &changePasswd &pushProfile);
  17
  18 sub saltedPasswd( $$ ) {
  19         my( $email, $passwd ) = @_;
  20         my $salt = $config{'passwdsalt'};
  21         return md5_base64( "$email:$passwd:$salt" );
  22 }
  23
  24 sub genResetHash( $$$$ ) {
  25         my( $id, $email, $login, $passwd ) = @_;
  26         my $salt = $config{'regmailsalt'};
  27         return md5_hex( "$id:$email:$login:$passwd:$salt" );
  28 }
  29
  30 sub emailConfirm( $ ) {
  31         my( $email ) = @_;
  32         my $salt = $config{'regmailsalt'};
  33         return md5_hex( $email.$salt );
  34 }
  35
  36 sub checkConfirmHash( $$ ) {
  37         my( $email, $hash ) = @_;
  38         return 0 unless( ( defined $email ) && ( defined $hash ) );
  39         my( $expected ) = emailConfirm( $email );
  40         return ( $expected eq $hash );
  41 }
  42
  43 sub addUser( $$$$ ) {
  44         my( $tables, $name, $email, $passwd ) = @_;
  45         my $salted = saltedPasswd( $email, $passwd );
  46         tlog( "Creating user $email" . ( ( defined $name ) ? " - $name" : '' ) );
  47         my $id = $tables->addUser( $name, $email, $salted );
  48         tlog( "User ($email) id: $id" );
  49         return $id;
  50 }
  51
  52 sub changePasswd( $$$$ ) {
  53         my( $tables, $id, $passwd, $email ) = @_;
  54         my $salted = saltedPasswd( $email, $passwd );
  55         $tables->changePasswd( $id, $salted );
  56 }
  57
  58 sub genAuthToken( $$$$ ) {
  59         my( $tables, $id, $req, $rights ) = @_;
  60         unless( defined $rights ) {#Just logged in
  61                 my $from = $req->connection()->remote_ip();
  62                 $tables->setLastLog( $id, $from );
  63                 $rights = $tables->rights( $id );
  64         }
  65         my $haveRights = scalar @{$rights};
  66         my $time = time;
  67         my $ip = $req->connection()->remote_ip();
  68         return "$id:$haveRights:$time:".md5_hex( "$id:$time:$ip:".$config{'authsalt'} );
  69 }
  70
  71 sub checkAuthToken( $$$ ) {
  72         my( $tables, $req, $token ) = @_;
  73         my( $id, $haveRights, $time, $hex ) = defined( $token ) ? split( /:/, $token ) : ();
  74         return ( 0, 0, 0, [], "Not logged in" ) unless( defined $hex );
  75         my $ip = $req->connection()->remote_ip();
  76         my $expected = md5_hex( "$id:$time:$ip:".$config{'authsalt'} );
  77         my $actTime = time;
  78         my $tokOk = ( $expected eq $hex );
  79         my $authed = ( $tokOk && ( $time + $config{'authtime'} > $actTime ) );
  80         my $regen = $authed && ( $time + $config{'regenauthtime'} < $actTime );
  81         my $rights = [];
  82         if( $haveRights ) {
  83                 foreach( @{$tables->rights( $id )} ) {
  84                         my %r;
  85                         ( $r{'id'} ) = @{$_};
  86                         $r{'name'} = $privnames{$r{'id'}};
  87                         push @{$rights}, \%r;
  88                 }
  89         }
  90         return ( $authed, $id, $regen, $rights, $authed ? undef : ( $tokOk ? "Login timed out" : "Not logged in x" ) );
  91 }
  92
  93 sub hasRight( $$ ) {
  94         my( $rights, $name ) = @_;
  95         foreach( @{$rights} ) {
  96                 return 1 if( $_->{'name'} eq $name );
  97         }
  98         return 0;
  99 }
 100
 101 sub getRightDefs() {
 102         return ( \%privnums, \%privnames );
 103 }
 104
 105 sub pushProfile( $$$$ ) {
 106         my( $tables, $id, $oldData, $data ) = @_;
 107         my( $email, $passwd ) = ( $data->{'email'}, $data->{'current_password'} );
 108         if( ( defined $passwd ) && ( $passwd ne '' ) ) {
 109                 my $salted = saltedPasswd( $email, $passwd );
 110                 $tables->setEmail( $id, $email, $salted );
 111         }
 112         $data->{'login'} = undef if ( defined $data->{'login'} ) && ( $data->{'login'} eq '' );
 113         $data->{'xmpp'} = undef if ( defined $data->{'xmpp'} ) && ( $data->{'xmpp'} eq '' );
 114         $tables->pushProfile( $id, $data->{'login'}, $data->{'xmpp'}, $data->{'email_time'}, $data->{'xmpp_time'} );
 115         changePasswd( $tables, $id, $data->{'password'}, $email ) if ( defined $data->{'password'} ) && ( $data->{'password'} ne '' );
 116 }
 117
 118 checkConf( [ 'passwdsalt', 'regmailsalt', 'authsalt' ] );
 119 defConf( { 'authtime' => 2100, 'regenauthtime' => 300 } );
 120
 121 open PRIVS, $directory."/rights" or die "Could not open privilege definitions\n";
 122 foreach( <PRIVS> ) {
 123         my( $num, $name ) = /^(\d+)\s+(.*)$/ or die "Invalid syntax in privileges\n";
 124         $privnames{$num} = $name;
 125         $privnums{$name} = $num;
 126 }
 127 close PRIVS;
 128
 129 1;