/[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 605 - (hide annotations) (download)
Fri Feb 25 10:00:44 2011 UTC (13 years, 1 month ago) by buchan
File size: 24151 byte(s)
Dont add an extra / to url in mail to user, or the path wont match in user/firstlogin

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 buchan 605 url => $c->uri_for('/user/firstlogin') . "?username=$uid&key=$newpass",
551 buchan 56 );
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 buchan 588 my $mainrole;
569     if ( $c->check_user_roles('Account Admins') ) {
570     $mainrole = 'account';
571     }
572     elsif ( $c->check_user_roles('Group Admins') ) {
573     $mainrole = 'group';
574     }
575     else {
576     $c->res->forward('/user');
577     }
578     #$c->assert_any_user_role({['Account Admins','Group Admins']});
579     #$mainrole = 'account' if $c->check_user_roles('Account Admins');
580     $c->stash( subpages => gensubpages($mainrole) );
581 buchan 45 my @errors;
582 buchan 588 my ($attribute,$value);
583     if ( not $c->req->param('attribute') and not $c->req->param('value') ) {
584     $attribute = 'owner';
585     $value = $c->user->ldap_entry->dn;
586     $c->stash( heading => 'Groups you manage');
587     }
588     else {
589     $attribute = $c->req->param('attribute');
590     $attribute =~ s/[^\w\d]//g;
591     $value = $c->req->param('value');
592     $value =~ s/[^\w\d\* ]//g;
593     $c->stash( heading => 'Groups matching search criteria');
594     }
595 buchan 45 my $mesg =
596     $c->model('user')
597 buchan 588 ->search("(&(objectclass=groupOfNames)($attribute=$value))");
598 buchan 45 push @errors, $mesg->error if $mesg->code;
599 buchan 588 my @entries = $mesg->entries if ($mesg->entries ge 1);
600 buchan 45 push @errors, $mesg->error if $mesg->code;
601 buchan 588 $c->stash( entries => \@entries ) if (@entries);
602     $c->stash( errors => \@errors);
603 buchan 45 }
604    
605     sub group_modify : Local {
606 buchan 588 my ( $self, $c, $group, $op, $attr, $value ) = @_;
607 buchan 45 $c->detach('/user/login') if not $c->user;
608 buchan 590 my $mainrole = 'account';
609 buchan 589 if ( ! $c->check_user_roles('Account Admins') and ! $c->check_user_roles('Group Admins')) {
610     $c->res->forward('/user');
611     }
612 buchan 590 $mainrole = 'group' if (not $c->check_user_roles('Account Admins'));
613     $c->stash( subpages => gensubpages($mainrole) );
614 buchan 45 my @errors;
615 buchan 588 my @entries;
616     my $mesg;
617 buchan 45 $c->detach('/admin/group') if $group eq '';
618 buchan 562 if ( $group !~ /^[\w\d ]*$/ ) {
619 buchan 45 push @errors, "Group contains illegal characters";
620 buchan 562 $c->detach('/admin/group');
621 buchan 45 }
622 buchan 590 if (defined $op and $op eq 'delete') {
623 buchan 588 $mesg = $c->model('user')->search("(&(objectClass=groupOfNames)(cn=$group))");
624     @entries = $mesg->entries;
625 buchan 590 $entries[0]->delete( $attr => $value)->update;
626 buchan 588 $c->res->redirect("/admin/group_modify/$group");
627     }
628 buchan 590 if ( defined $op and $op eq 'add' ) {
629 buchan 588 my $member = $c->req->param('member');
630     $mesg = $c->model('user')->search("(uid=$member)");
631     if ( $mesg->code ) {
632     $c->stash({ errors => $mesg->error});
633     $c->detach('/admin/group');
634     }
635     if ( $mesg->entries ne 1 ) {
636     $c->detach('/admin/group');
637     }
638     @entries = $mesg->entries;
639 buchan 590 my $dn = $entries[0]->dn;
640 buchan 588 $mesg = $c->model('user')->search("(&(objectClass=groupOfNames)(cn=$group))");
641     @entries = $mesg->entries;
642 buchan 590 $entries[0]->add( 'member' => $dn )->update;
643 buchan 588 $c->res->redirect("/admin/group_modify/$group");
644     }
645     $mesg = $c->model('user')->search("(&(objectClass=groupOfNames)(cn=$group))");
646 buchan 45 if ( $mesg->entries gt 1 ) {
647     push @errors, 'More than one entry matched';
648     $c->detach('/admin/group');
649     }
650     $c->stash( group => $mesg->entry );
651     }
652    
653     =head2 index
654    
655     =cut
656    
657     sub index : Path : Args(0) {
658     my ( $self, $c ) = @_;
659 buchan 56 $c->detach('/index') if not $c->user;
660     $c->assert_user_roles('Account Admins');
661 buchan 45 $c->stash( pages => roles2pages( $c->user->roles ) );
662    
663     #$c->response->body("Matched CatDap::Controller::admin in admin, roles $rolelist");
664     }
665    
666     sub roles2pages : Private {
667     my @roles = @_;
668     my @pages;
669     foreach my $role ( sort @roles ) {
670     if ( $role =~ /^(\w+) ?(\w*) (Admin|User)s$/ ) {
671     my $page = lc("/$3/$1$2");
672     push @pages, { page => lc("/$3/$1$2"), title => "$1 $2 $3" };
673     }
674     }
675     return \@pages;
676     }
677    
678     sub gensubpages : Private {
679     my ($type) = @_;
680     my @subpagenames;
681     if ( $type eq 'account' ) {
682     @subpagenames = (
683     { page => 'account', title => "Users" },
684     { page => 'account_promote', title => "Promote" },
685     #{ page => 'account_unlock', title => "Unlock" },
686     { page => 'group', title => "Groups" },
687     );
688     }
689 buchan 588 if ( $type eq 'group' ) {
690 buchan 590 @subpagenames = (
691 buchan 588 { page => 'group', title => "Groups" },
692 buchan 590 );
693 buchan 588 }
694 buchan 45 return \@subpagenames;
695     }
696    
697     =head1 AUTHOR
698    
699     Buchan Milne
700    
701     =head1 LICENSE
702    
703     This library is free software. You can redistribute it and/or modify
704     it under the same terms as Perl itself.
705    
706     =cut
707    
708     __PACKAGE__->meta->make_immutable;
709    
710     1;

  ViewVC Help
Powered by ViewVC 1.1.30