/[soft]/identity/CatDap/trunk/lib/CatDap/Controller/admin.pm
ViewVC logotype

Annotation of /identity/CatDap/trunk/lib/CatDap/Controller/admin.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 562 - (hide annotations) (download)
Wed Feb 16 15:05:33 2011 UTC (10 years, 7 months ago) by buchan
File size: 22322 byte(s)
Fix displaying of groups with spaces in the name
Fix non-ascii user details in 'promote' page

1 buchan 45 package CatDap::Controller::admin;
2     use Moose;
3     use namespace::autoclean;
4     use Data::UUID;
5 buchan 64 #use Data::Dumper;
6 buchan 46 use Net::LDAP::Extension::SetPassword;
7 buchan 45
8     BEGIN { extends 'Catalyst::Controller'; }
9    
10     =head1 NAME
11    
12     CatDap::Controller::admin - Catalyst Controller
13    
14     =head1 DESCRIPTION
15    
16     Catalyst Controller.
17    
18     =head1 METHODS
19    
20     =cut
21    
22     =head2 auto
23    
24     Ensure the user is logged in. In order to bind as the user, we use
25     CatDap::Model::User, which uses Catalyst::Model::LDAP::FromAuthentication,
26     which effectively requires calling $c->authenticate on every request.
27    
28     To do this, we keep the password, encrypted with blowfish, using the
29     (for now), first 3 octets of IPv4 request address and a UUID string (stored in
30     a cookie) as the key. To access the password, an attacker would need:
31     - the first 3 octets of IPv4 request (not stored anywhere, but accessible
32     in server logs)
33     - the encrpyted password (only available server-side in the session variable)
34     - the UUID key portion (only available on the browser-side in a cookie)
35    
36     So, if the user does "not exist", we authenticate them, if it succeeds we encrypt
37     the password and store it in the session.
38    
39     If the user is logged in, we get the encrypted password from the session, decrypt
40     it (we need to handle failure to decrypt it better)
41    
42     =cut
43    
44     sub auto : Private {
45     my ( $self, $c ) = @_;
46     my $cipher;
47     my $password;
48     my $mesg;
49     my $dn;
50 misc 171
51     # TODO merge this code with the one in user.pm
52 misc 170 my $keyprefix;
53     if ($c->req->address =~ m/:/) {
54     my $address = $c->req->address;
55     $address =~ s/\[\]://;
56     $keyprefix = sprintf( "%06x", $address >> 104 ); # if we shift right 104 bits from 128 we have 24 bits left or 3 bytes.
57     }
58     else {
59     $keyprefix = sprintf( "%02x%02x%02x", split /\./, $c->req->address );
60     }
61 buchan 56 if ( !defined $c->user or not $c->req->cookie('key') ) {
62 buchan 45 $c->detach('/user/login')
63     if ( not $c->req->param('username')
64     or not $c->req->param('password') );
65 buchan 56 $c->log->debug("No session, logging user in");
66 buchan 45 if (
67     !$c->authenticate(
68     {
69     username => $c->req->param('username'),
70     password => $c->req->param('password')
71     || $c->req->param('key')
72     }
73     )
74     )
75     {
76    
77     #TODO: ppolicy ....
78     $c->stash( errors => ['Incorrect username or password'] );
79     $c->stash( template => 'index.tt' );
80 buchan 56 $c->log->debug("Logging user in failed, forwarding to login page");
81 buchan 45 $c->visit('/user/login');
82     $c->detach;
83     return 1;
84     }
85     else {
86    
87     #if (defined $c->user->pwdReset) {
88     # $c->res->redirect('/user');
89     #}
90     #$c->persist_user;
91 buchan 56 $c->log->debug('Logging user in to LDAP');
92 buchan 45 my $ug = Data::UUID->new;
93     my $key = $ug->create_str();
94     $cipher = Crypt::CBC->new(
95     -key => $keyprefix . $key,
96     -cipher => 'Blowfish'
97     ) or die $!;
98     $c->session->{enc_password} =
99     $cipher->encrypt( $c->req->param('password')
100     || $c->req->param('key') );
101     $c->stash( pages => roles2pages( $c->user->roles ) );
102     $c->session->{dn} = $c->user->ldap_entry->dn;
103     $c->session->{user} = $c->req->param('username');
104     $password = $c->req->param('password') || $c->req->param('key');
105     return 1;
106     }
107    
108     }
109     else {
110     my $key = $c->req->cookie('key')->value;
111     $cipher = Crypt::CBC->new(
112     -key => $keyprefix . $key,
113     -cipher => 'Blowfish'
114     ) or die $!;
115     $password = $cipher->decrypt( $c->session->{enc_password} );
116 buchan 56 $c->log->debug( "Re-authenticating user " . $c->session->{user} );
117 buchan 45 $c->authenticate(
118     { username => $c->session->{user}, password => $password } )
119     or $c->view('/user/login');
120     $c->res->cookies->{'key'} = {value => $key, expires => '+10m'};
121     $c->stash( pages => roles2pages( $c->user->roles ) );
122     $c->log->info($@) if $@;
123     return 1;
124     }
125     }
126    
127     sub account : Local {
128     my ( $self, $c ) = @_;
129     $c->detach('/user/login') if not $c->user;
130     $c->assert_user_roles('Account Admins');
131     $c->stash( subpages => gensubpages('account') );
132     my @errors;
133     return
134     if not defined $c->req->param('attribute')
135     and not defined $c->req->param('value');
136    
137     #my $attribute =~ m/^([\w\d]*)/,$c->req->param('attribute');
138     my $attribute = $c->req->param('attribute');
139 buchan 56 $c->log->debug("Searching for account using attribute $attribute");
140 buchan 45
141     #my $value =~ /^[\w\d]*/,$c->req->param('attribute');
142     my $value = $c->req->param('value');
143     my $mesg =
144     $c->model('user')
145     ->search("(&(objectClass=inetOrgPerson)($attribute=$value))");
146 buchan 559 my @orig_entries = $mesg->entries;
147     my @entries;
148     foreach my $entry (@orig_entries) {
149     my %new_entry;
150     foreach my $attr ($entry->attributes) {
151     $new_entry{$attr} = Encode::decode_utf8($entry->get_value($attr));
152     }
153     push @entries, \%new_entry;
154     }
155 buchan 45 push @errors, $mesg->error if $mesg->code;
156     $c->stash( entries => \@entries );
157     $c->stash( errors => \@errors );
158     }
159    
160     sub account_promote : Local {
161     my ( $self, $c ) = @_;
162     $c->detach('/user/login') if not $c->user;
163     $c->assert_user_roles('Account Admins');
164     $c->stash( subpages => gensubpages('account') );
165     my @errors;
166     if ( defined $c->req->param('gid') and defined $c->req->param('username') )
167     {
168     my $gid = $c->req->param('gid');
169     foreach my $uid ( $c->req->param('username') ) {
170     $c->log->info("Promoting user $uid with gid $gid");
171     my $mesg =
172     $c->model('user')
173     ->search(
174     "(&(uid=$uid)(objectclass=inetOrgPerson)(!(objectClass=posixAccount)))"
175     );
176     if ( $mesg->entries gt 1 ) {
177     push @errors, "More than one account matched user $uid";
178    
179     #TODO forward to error page
180     }
181     my $entry = $mesg->entry;
182     $mesg = $c->model('user')->search("(objectclass=sambaUnixIdPool)");
183     if ( $mesg->entries gt 1 ) {
184     push @errors, "More than one ID Pool";
185    
186     #TODO forward to error page
187     }
188     my $idpool = $mesg->entry;
189     my $uidnum = $idpool->uidNumber;
190 buchan 46 my $newuidnum = $uidnum+1;
191 buchan 45 $entry->add(
192     objectclass => [ 'posixAccount', 'ldapPublicKey' ],
193     loginShell => '/bin/bash',
194     gidNumber => $c->req->param('gid'),
195     uidNumber => $uidnum,
196     homeDirectory => "/home/$uid",
197     );
198     $idpool->replace( uidNumber => $newuidnum );
199    
200     $idpool->update;
201 buchan 56 $mesg = $entry->update;
202 buchan 45 if ($mesg->code) {
203 buchan 56 $c->log->info('LDAP update failed: ' . $mesg->error);
204 buchan 45 push @errors, $mesg->error;
205     #reverse idpool update
206     $idpool->replace( uidNumber => $uidnum );
207     $mesg = $idpool->update;
208 buchan 56 $c->log->info("ERROR IdPool could not be reset to $uidnum: ", $mesg->error) if $mesg->code;
209 buchan 45 }
210     }
211     }
212     my $mesg =
213     $c->model('user')
214     ->search("(&(objectClass=inetOrgPerson)(!(objectClass=posixAccount)))");
215 buchan 562 my @orig_entries = $mesg->entries;
216     my @entries;
217     foreach my $entry (@orig_entries) {
218     my %new_entry;
219     foreach my $attr($entry->attributes) {
220     $new_entry{$attr} = Encode::decode_utf8($entry->get_value($attr));
221     }
222     push @entries, \%new_entry;
223     }
224    
225 buchan 45 $c->stash( entries => \@entries );
226     push @errors, $mesg->error if $mesg->code;
227     $mesg = $c->model('user')->search("(objectClass=posixGroup)");
228     my @groups = $mesg->entries;
229     $c->stash( groups => \@groups );
230     $c->stash( errors => \@errors );
231     }
232    
233     sub account_modify : Local {
234     my ( $self, $c, $user ) = @_;
235     $c->detach('/user/login') if not $c->user;
236     $c->stash( subpages => gensubpages('account') );
237     $c->assert_user_roles('Account Admins');
238     my @errors;
239     my $mesg;
240     if ( $user eq '' ) {
241     $c->forward( $c->uri_for('/account') );
242     $c->detach;
243     }
244     my $schemaldap = Net::LDAP->new( ${ $c->config }{'Model::Proxy'}{'host'} )
245     or warn "LDAP bind failed: $!";
246     $schemaldap->start_tls if ${ $c->config }{'Model::Proxy'}{'start_tls'};
247     $schemaldap->bind;
248     my $schema = $schemaldap->schema or die("Searching schema failed: $!");
249     my $attrdef;
250    
251     my $entry;
252 buchan 56 $c->log->debug("Searching for user $user");
253 buchan 45 $mesg =
254     $c->model('User')->search("(&(objectclass=inetOrgPerson)(uid=$user))");
255     $entry = $mesg->entry;
256    
257     # Handle adding attributes immediately here, forwarding back to ourselves
258     if ( $c->req->param('operation') eq 'add' ) {
259     $entry->add( $c->req->param('attribute') => $c->req->param('value') );
260     $mesg = $entry->update;
261     push @errors, $mesg->error if $mesg->code;
262     $c->res->redirect( $c->uri_for( $c->req->uri ) . "/$user" );
263     }
264    
265     my %mods;
266     my %params = %{ $c->req->parameters };
267     my $update = 0;
268     foreach my $req ( keys %params ) {
269     next if $req !~ /(.+)_new/;
270     my $attrname = $1;
271     next if $params{ $attrname . '_new' } eq $params{ $attrname . '_old' };
272 buchan 56 $c->log->debug("Received update request for attribute $attrname");
273 buchan 45 $update = 1;
274     $attrdef = $schema->attribute($attrname)
275     or die("getting schema failed: $!");
276     if ( $$attrdef{'single-value'} ) {
277     $entry->replace( $attrname => $params{ $attrname . '_new' } )
278     or $c->log->info($!);
279     }
280     else {
281     $entry->delete( $attrname => $params{ $attrname . '_old' } );
282     $entry->add( $attrname => $params{ $attrname . '_new' } );
283     }
284     if ($update) {
285     $mesg = $entry->update;
286     push @{ ${ $c->stash }{'errors'} }, $mesg->error if $mesg->code;
287     }
288     }
289    
290     $mesg =
291     $c->model('User')->search("(&(objectclass=inetOrgPerson)(uid=$user))");
292 buchan 56 $c->log->debug( $mesg->error ) if $mesg->code;
293 buchan 45 $entry = $mesg->entry;
294 buchan 56 $c->log->debug( $mesg->error ) if $mesg->code;
295 buchan 45
296     my @values;
297     my @attributes = $entry->attributes;
298     my @may;
299     my @addable_attrs = @attributes;
300     my @ocs;
301     my @must;
302     @ocs = $entry->get_value("objectClass");
303     foreach my $oc (@ocs) {
304     foreach my $attr ( $schema->must($oc) ) {
305     push @must, $$attr{'name'} if not grep /$$attr{'name'}/, @must;
306     }
307     }
308    
309     foreach my $attr ( sort @attributes ) {
310     next if ( $attr eq "objectClass" );
311     next
312     if grep /$attr/,
313     @{ ${ $c->config }{'Controller::User'}{'skip_attrs'} };
314     my @vals = $entry->get_value($attr);
315 buchan 559 foreach (@vals) { $_ = Encode::decode_utf8( $_ ); }
316 buchan 45 $attrdef = $schema->attribute($attr)
317     or die("getting schema failed: $!");
318     my %valhash = (
319     name => $attr,
320     values => \@vals,
321     desc => $$attrdef{'desc'},
322     );
323     if ( !grep /^$attr$/,
324     @{ ${ $c->config }{'Controller::User'}{'uneditable_attrs'} } )
325     {
326     $valhash{'editable'} = 1;
327     }
328     if ( !$$attrdef{'single-value'} && $valhash{'editable'} ) {
329     $valhash{'addable'} = 1;
330     }
331     if ( !grep /$attr/, @must ) { $valhash{'removable'} = 1; }
332     push @values, \%valhash;
333     }
334     foreach my $oc (@ocs) {
335     foreach my $attrdef ( $schema->may($oc) ) {
336     my $attrname = $$attrdef{'name'};
337     grep /$attrname/, @may
338     or grep /$attrname/, @attributes
339     or grep /$attrname/,
340     @{ ${ $c->config }{'Controller::User'}{'uneditable_attrs'} }
341     or grep /$attrname/,
342     @{ ${ $c->config }{'Controller::User'}{'skip_attrs'} }
343     or push @may, $attrname;
344     }
345     }
346     @may = sort @may;
347     my @available_ocs = $schema->all_objectclasses;
348     my @offer_ocs;
349     foreach my $oc (@available_ocs) {
350     my $ocname = $$oc{name};
351     next if grep /$ocname/, @ocs;
352     next if not $$oc{auxiliary};
353     push @offer_ocs, $ocname;
354     }
355     @offer_ocs = sort @offer_ocs;
356     my @groups;
357     if ( grep /posixAccount/, @offer_ocs ) {
358     my $mesg = $c->model('user')->search('objectclass=posixGroup');
359     foreach my $group ( $mesg->entries ) {
360     push @groups,
361     {
362     name => $group->cn,
363     gidNumber => $group->gidNumber,
364     };
365     }
366     }
367    
368     $c->stash(
369     {
370     username => $user,
371     values => \@values,
372     attrdef => $attrdef,
373     may => \@may,
374     must => \@must,
375     offer_ocs => \@offer_ocs,
376     dn => $entry->dn,
377     uid => $entry->uid,
378     }
379     );
380     $c->stash( 'groups' => \@groups ) if (@groups);
381     }
382    
383     sub account_modifydel : Local {
384     my ( $self, $c, $uid, $attr, $value ) = @_;
385     $c->detach('/user/login') if not $c->user;
386     $c->assert_user_roles('Account Admins');
387     $c->stash( subpages => gensubpages('account') );
388     my @errors;
389     my $mesg;
390     $mesg =
391     $c->model('user')->search("(&(objectClass=inetOrgPerson)(uid=$uid))");
392     push @errors, $mesg->error if $mesg->code;
393     $mesg = $mesg->entry->delete( $attr => $value )->update;
394     push @errors, $mesg->error if $mesg->code;
395     $c->res->redirect( $c->uri_for('/admin/account_modify') . "/$uid" );
396     }
397    
398     sub account_group : Local {
399     my ( $self, $c, $uid ) = @_;
400     $c->detach('/user/login') if not $c->user;
401     $c->assert_user_roles('Account Admins');
402     $c->stash( subpages => gensubpages('account') );
403 buchan 46 $c->res->redirect($c->uri_for('/admin/account')) if $uid eq '';
404 buchan 45 my (@errors,@newgroups,@groups);
405     my ($mesg,$entry,$dn);
406    
407     $mesg = $c->model('user')->search("(&(objectclass=inetOrgperson)(uid=$uid))");
408     $entry = $mesg->entry;
409     $dn = $entry->dn;
410     if (defined $c->req->param('op')) {
411     my $group = $c->req->param('group');
412     $mesg = $c->model('user')->search("(&(objectclass=groupOfNames)(cn=$group))");
413     $entry = $mesg->entry;
414     $entry->delete(member => $dn) if ($c->req->param('op') eq 'delete');
415     $entry->add(member => $dn) if ($c->req->param('op') eq 'add');
416     $mesg = $entry->update if ($entry->changes);
417     push @errors,$mesg->error if $mesg->code;
418     }
419    
420    
421     $mesg = $c->model('user')->search("(&(objectclass=groupOfNames)(member=$dn))");
422     @groups = $mesg->entries;
423     $mesg = $c->model('user')->search("(&(objectclass=groupOfNames)(!(member=$dn)))");
424     @newgroups = $mesg->entries;
425     $c->stash(
426     uid => $uid,
427     groups => \@groups,
428     newgroups => \@newgroups,
429     );
430     }
431    
432     sub account_addoc : Local {
433     my ( $self, $c ) = @_;
434     $c->detach('/user/login') if not $c->user;
435     $c->assert_user_roles('Account Admins');
436     $c->stash( subpages => gensubpages('account') );
437     my $objectclass = $c->req->param('objectclass')
438     or $c->detach('/admin/group');
439     my $dn = $c->req->param('dn');
440     my $uid = $c->req->param('uid');
441     my ( @errors, @must, @may );
442     my $mesg;
443     my $schemaldap = Net::LDAP->new( ${ $c->config }{'Model::Proxy'}{'host'} )
444     or warn "LDAP bind failed: $!";
445     $mesg = $schemaldap->start_tls
446     if ${ $c->config }{'Model::Proxy'}{'start_tls'};
447     push @errors, $mesg->error if $mesg->code;
448     $schemaldap->bind;
449     push @errors, $mesg->error if $mesg->code;
450     my $schema = $schemaldap->schema or die("Searching schema failed: $!");
451     $mesg =
452     $c->model('user')->search("(&(objectclass=inetOrgPerson)(uid=$uid))");
453 buchan 56 $c->log->debug( $mesg->error ) if $mesg->code;
454 buchan 45 my $entry = $mesg->entry;
455 buchan 56 $c->log->debug( $mesg->error ) if $mesg->code;
456 buchan 45
457     foreach my $attr ( $schema->must($objectclass) ) {
458     push @must, $$attr{name} if not $entry->get_value( $$attr{name} );
459     }
460     foreach my $attr ( $schema->may($objectclass) ) {
461     push @may, $$attr{name} if not $entry->get_value( $$attr{name} );
462     }
463    
464     # if we have all the musts as params
465     my $haveall = 1;
466     foreach my $addattr (@must) {
467     if ( defined $c->req->param($addattr) ) {
468     $entry->add( $addattr => $c->req->param($addattr) );
469     }
470     else {
471 buchan 56 $c->log->debug("Missing attribute $addattr");
472 buchan 45 $haveall = 0;
473     }
474     }
475     if ($haveall) {
476     $entry->add( objectClass => [$objectclass] );
477 buchan 56 $c->log->debug("About to push updates to $dn");
478 buchan 64 #$c->log->debug( Dumper( \$entry->changes ) );
479 buchan 45 $mesg = $entry->update;
480     push @errors, $mesg->error if $mesg->code;
481     $c->stash( template => 'admin/account.tt', errors => @errors );
482    
483     #$c->detach('account_modify');
484     $c->res->redirect( $c->uri_for('/admin/account_modify') . "/" . $uid );
485     $c->detach;
486     }
487     $c->stash(
488     may => \@may,
489     must => \@must,
490     oc => $objectclass,
491     dn => $dn,
492     uid => $uid,
493     );
494     }
495    
496 buchan 46 sub password : Local {
497     my ($self,$c,$uid) = @_;
498     $c->detach('/user/login') if not $c->user;
499     $c->assert_user_roles('Account Admins');
500     $c->stash( subpages => gensubpages('account') );
501     my (@errors,@mail);
502     my ($mesg,$entry,$newpass);
503     $c->res->redirect($c->uri_for('/admin/account')) if $uid eq '';
504    
505     # Find the user so we have their email now for confirmation, or can easily
506     # set password if reset has been confirmed
507     $mesg = $c->model('user')->search("uid=$uid");
508     push @errors,$mesg->error if $mesg->code;
509     if ($mesg->entries gt 1) {
510     push @errors,'More than one entry matched';
511     $c->detach;
512     }
513     $entry = $mesg->entry;
514     @mail = $entry->mail;
515    
516     if (!$c->req->param('txnid')) {
517     my $txnid = Data::UUID->new->create_str();
518     $c->session(txnid => $txnid);
519     $c->stash( uid => $uid, txnid => $txnid, mails => @mail);
520     return 1;
521     }
522 buchan 56 if ($c->req->param('txnid') ne $c->session->{txnid}) {
523 buchan 46 push @errors,'Transaction ID mismatch';
524     $c->detach;
525     }
526     $newpass = Data::UUID->new->create_str();
527     my $pp = Net::LDAP::Control::PasswordPolicy->new;
528     $mesg = $entry->replace( userPassword => $newpass,pwdReset => 'TRUE' )->update;
529     if ($mesg->code) {
530     push @errors,"Password reset failed: " . $mesg->error;
531     $c->detach;
532     }
533 buchan 56 my $email = join(',',@mail);
534     # send the mail in the users preferred language
535     my @oldlang = $c->languages;
536     if ($entry->preferredLanguage) {
537 buchan 64 #$c->log->debug("Setting languages to: " . Dumper($entry->preferredLanguage));
538 buchan 56 $c->languages([$entry->preferredLanguage]);
539     }
540     $c->stash(
541     email => {
542     'to' => $email,
543     'subject' => $c->config->{apptitle} . " - "
544     . $c->loc('password reset'),
545     'from' => $c->config->{emailfrom},
546     'template' => 'admin/password.tt',
547     'content_type' => 'text/plain',
548     },
549     entry => $entry,
550     url => $c->uri_for('/user/firstlogin') . "/?username=$uid&key=$newpass",
551     );
552     $c->forward( $c->view('Email::Template') );
553     $c->languages(@oldlang);
554     if ( @{ $c->error } ) {
555     my $errors = join "\n",@{ $c->error };
556     $c->log->info("Sending reset mail to $email failed: $errors");
557 misc 101 $c->response->body($c->loc('An error occured sending the email, but your account was created. Please try the password recovery process if you entered the correct email address: [_1]', $errors));
558 buchan 56 $c->error(0); # Reset the error condition if you need to
559     }
560     push @errors,$c->loc('Password reset and email sent');
561     $c->res->redirect($c->uri_for('/admin/account_modify') . "/$uid");
562 buchan 46 }
563    
564    
565 buchan 45 sub group : Local {
566     my ( $self, $c ) = @_;
567     $c->detach('/user/login') if not $c->user;
568     $c->assert_user_roles('Account Admins');
569     $c->stash( subpages => gensubpages('account') );
570     my @errors;
571     return if not $c->req->param('attribute') and not $c->req->param('value');
572     my $attribute = $c->req->param('attribute');
573     $attribute =~ s/[^\w\d]//g;
574     my $value = $c->req->param('value');
575 buchan 562 $value =~ s/[^\w\d\* ]//g;
576 buchan 45 my $mesg =
577     $c->model('user')
578     ->search("(&(objectclass=posixGroup)($attribute=$value))");
579     push @errors, $mesg->error if $mesg->code;
580     my @entries = $mesg->entries;
581     push @errors, $mesg->error if $mesg->code;
582     $c->stash(
583     entries => \@entries,
584     errors => \@errors,
585     );
586     }
587    
588     sub group_modify : Local {
589     my ( $self, $c, $group ) = @_;
590     $c->detach('/user/login') if not $c->user;
591     $c->assert_user_roles('Account Admins');
592     $c->stash( subpages => gensubpages('account') );
593     my @errors;
594     $c->detach('/admin/group') if $group eq '';
595 buchan 562 if ( $group !~ /^[\w\d ]*$/ ) {
596 buchan 45 push @errors, "Group contains illegal characters";
597 buchan 562 $c->detach('/admin/group');
598 buchan 45 }
599     my $mesg =
600     $c->model('user')->search("(&(objectClass=posixGroup)(cn=$group))");
601     if ( $mesg->entries gt 1 ) {
602     push @errors, 'More than one entry matched';
603     $c->detach('/admin/group');
604     }
605     $c->stash( group => $mesg->entry );
606     }
607    
608     =head2 index
609    
610     =cut
611    
612     sub index : Path : Args(0) {
613     my ( $self, $c ) = @_;
614 buchan 56 $c->detach('/index') if not $c->user;
615     $c->assert_user_roles('Account Admins');
616 buchan 45 $c->stash( pages => roles2pages( $c->user->roles ) );
617    
618     #$c->response->body("Matched CatDap::Controller::admin in admin, roles $rolelist");
619     }
620    
621     sub roles2pages : Private {
622     my @roles = @_;
623     my @pages;
624     foreach my $role ( sort @roles ) {
625     if ( $role =~ /^(\w+) ?(\w*) (Admin|User)s$/ ) {
626     my $page = lc("/$3/$1$2");
627     push @pages, { page => lc("/$3/$1$2"), title => "$1 $2 $3" };
628     }
629     }
630     return \@pages;
631     }
632    
633     sub gensubpages : Private {
634     my ($type) = @_;
635     my @subpagenames;
636     if ( $type eq 'account' ) {
637     @subpagenames = (
638     { page => 'account', title => "Users" },
639     { page => 'account_promote', title => "Promote" },
640     #{ page => 'account_unlock', title => "Unlock" },
641     { page => 'group', title => "Groups" },
642     );
643     }
644     return \@subpagenames;
645     }
646    
647     =head1 AUTHOR
648    
649     Buchan Milne
650    
651     =head1 LICENSE
652    
653     This library is free software. You can redistribute it and/or modify
654     it under the same terms as Perl itself.
655    
656     =cut
657    
658     __PACKAGE__->meta->make_immutable;
659    
660     1;

  ViewVC Help
Powered by ViewVC 1.1.28