include is deprecated - improve deprecation message w/filename
[freeside.git] / FS / FS / CurrentUser.pm
1 package FS::CurrentUser;
2
3 use vars qw($CurrentUser $CurrentSession $upgrade_hack);
4
5 #not at compile-time, circular dependancey causes trouble
6 #use FS::Record qw(qsearchs);
7 #use FS::access_user;
8
9 $upgrade_hack = 0;
10
11 =head1 NAME
12
13 FS::CurrentUser - Package representing the current user (and session)
14
15 =head1 SYNOPSIS
16
17 =head1 DESCRIPTION
18
19 =head1 CLASS METHODS
20
21 =over 4
22
23 =item load_user USERNAME
24
25 Sets the current user to the provided username
26
27 =cut
28
29 sub load_user {
30   my( $class, $username, %opt ) = @_;
31
32   if ( $upgrade_hack ) {
33     return $CurrentUser = new FS::CurrentUser::BootstrapUser;
34   }
35
36   #return "" if $username =~ /^fs_(queue|selfservice)$/;
37
38   #not the best thing in the world...
39   eval "use FS::Record qw(qsearchs);";
40   die $@ if $@;
41   eval "use FS::access_user;";
42   die $@ if $@;
43
44   my %hash = ( 'username' => $username,
45                'disabled' => '',
46              );
47
48   $CurrentUser = qsearchs('access_user', \%hash) and return $CurrentUser;
49
50   die "unknown user: $username" unless $opt{'autocreate'};
51
52   $CurrentUser = new FS::access_user \%hash;
53   $CurrentUser->set($_, $opt{$_}) foreach qw( first last );
54   my $error = $CurrentUser->insert;
55   die $error if $error; #better way to handle this error?
56
57   my $template_user =
58     $opt{'template_user'}
59       || FS::Conf->new->config('external_auth-access_group-template_user');
60
61   if ( $template_user ) {
62
63     my $tmpl_access_user =
64        qsearchs('access_user', { 'username' => $template_user } );
65
66     if ( $tmpl_access_user ) {
67       eval "use FS::access_usergroup;";
68       die $@ if $@;
69
70       foreach my $tmpl_access_usergroup
71                 ($tmpl_access_user->access_usergroup) {
72         my $access_usergroup = new FS::access_usergroup {
73           'usernum'  => $CurrentUser->usernum,
74           'groupnum' => $tmpl_access_usergroup->groupnum,
75         };
76         my $error = $access_usergroup->insert;
77         if ( $error ) {
78           #shouldn't happen, but seems better to proceed than to die
79           warn "error inserting access_usergroup: $error";
80         };
81       }
82
83     } else {
84       warn "template username $template_user not found\n";
85     }
86
87   } else {
88     warn "no access template user for autocreated user $username\n";
89   }
90
91   $CurrentUser;
92 }
93
94 =item new_session
95
96 Creates a new session for the current user and returns the session key
97
98 =cut
99
100 use vars qw( @saltset );
101 @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '+' , '/' );
102
103 sub new_session {
104   my( $class ) = @_;
105
106   #not the best thing in the world...
107   eval "use FS::access_user_session;";
108   die $@ if $@;
109
110   my $sessionkey = join('', map $saltset[int(rand(scalar @saltset))], 0..39);
111
112   my $access_user_session = new FS::access_user_session {
113     'sessionkey' => $sessionkey,
114     'usernum'    => $CurrentUser->usernum,
115     'start_date' => time,
116   };
117   my $error = $access_user_session->insert;
118   die $error if $error;
119
120   return $sessionkey;
121
122 }
123
124 =item load_user_session SESSION_KEY
125
126 Sets the current user via the provided session key
127
128 =cut
129
130 sub load_user_session {
131   my( $class, $sessionkey ) = @_;
132
133   #not the best thing in the world...
134   eval "use FS::Record qw(qsearchs);";
135   die $@ if $@;
136   eval "use FS::access_user_session;";
137   die $@ if $@;
138
139   $CurrentSession = qsearchs('access_user_session', {
140     'sessionkey' => $sessionkey,
141     #XXX check for timed out but not-yet deleted sessions here
142   }) or return '';
143
144   $CurrentSession->touch_last_date;
145
146   $CurrentUser = $CurrentSession->access_user;
147
148 }
149
150 =head1 BUGS
151
152 Minimal docs
153
154 =head1 SEE ALSO
155
156 =cut
157
158 package FS::CurrentUser::BootstrapUser;
159
160 sub new {
161   my $proto = shift;
162   my $class = ref($proto) || $proto;
163   my $self = {};
164   bless ($self, $class);
165 }
166
167 sub AUTOLOAD { 1 };
168
169 1;
170