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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1786 - (show annotations) (download)
Thu Jul 21 12:11:34 2011 UTC (8 years, 8 months ago) by misc
File size: 24382 byte(s)
fix code, Catalyst::Result do not have a forward method

1 package CatDap::Controller::admin;
2 use Moose;
3 use namespace::autoclean;
4 use Data::UUID;
5 #use Data::Dumper;
6 use Net::LDAP::Extension::SetPassword;
7
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
51 # TODO merge this code with the one in user.pm
52 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 if ( !defined $c->user or not $c->req->cookie('key') ) {
62 $c->detach('/user/login')
63 if ( not $c->req->param('username')
64 or not $c->req->param('password') );
65 $c->log->debug("No session, logging user in");
66 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 $c->log->debug("Logging user in failed, forwarding to login page");
81 $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 $c->log->debug('Logging user in to LDAP');
92 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 $c->log->debug( "Re-authenticating user " . $c->session->{user} );
117 $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 $c->log->debug("Searching for account using attribute $attribute");
140
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 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 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 my @promoted;
167 if ( defined $c->req->param('gid') and defined $c->req->param('username') )
168 {
169 my $gid = $c->req->param('gid');
170 foreach my $uid ( $c->req->param('username') ) {
171 $c->log->info("Promoting user $uid with gid $gid");
172 my $mesg =
173 $c->model('user')
174 ->search(
175 "(&(uid=$uid)(objectclass=inetOrgPerson)(!(objectClass=posixAccount)))"
176 );
177 if ( $mesg->entries gt 1 ) {
178 push @errors, "More than one account matched user $uid";
179
180 #TODO forward to error page
181 }
182 my $entry = $mesg->entry;
183 $mesg = $c->model('user')->search("(objectclass=sambaUnixIdPool)");
184 if ( $mesg->entries gt 1 ) {
185 push @errors, $c->loc("More than one ID Pool");
186
187 #TODO forward to error page
188 }
189 my $idpool = $mesg->entry;
190 my $uidnum = $idpool->uidNumber;
191 my $newuidnum = $uidnum+1;
192 $entry->add(
193 objectclass => [ 'posixAccount', 'ldapPublicKey' ],
194 loginShell => '/bin/bash',
195 gidNumber => $c->req->param('gid'),
196 uidNumber => $uidnum,
197 homeDirectory => "/home/$uid",
198 );
199 $idpool->replace( uidNumber => $newuidnum );
200
201 $idpool->update;
202 $mesg = $entry->update;
203 if ($mesg->code) {
204 $c->log->info('LDAP update failed: ' . $mesg->error);
205 push @errors, $mesg->error;
206 #reverse idpool update
207 $idpool->replace( uidNumber => $uidnum );
208 $mesg = $idpool->update;
209 $c->log->info("ERROR IdPool could not be reset to $uidnum: ", $mesg->error) if $mesg->code;
210 } else {
211 push @promoted, $uid;
212 }
213 }
214 }
215 my $mesg =
216 $c->model('user')
217 ->search("(&(objectClass=inetOrgPerson)(!(objectClass=posixAccount)))");
218 my @orig_entries = $mesg->entries;
219 my @entries;
220 foreach my $entry (@orig_entries) {
221 my %new_entry;
222 foreach my $attr($entry->attributes) {
223 $new_entry{$attr} = Encode::decode_utf8($entry->get_value($attr));
224 }
225 push @entries, \%new_entry;
226 }
227 @entries = sort { $a->{'uid'} cmp $b->{'uid'} } @entries;
228
229 $c->stash( entries => \@entries );
230 push @errors, $mesg->error if $mesg->code;
231 $mesg = $c->model('user')->search("(objectClass=posixGroup)");
232 my @groups = $mesg->entries;
233 $c->stash( groups => \@groups );
234 $c->stash( errors => \@errors );
235 $c->stash( promoted => \@promoted );
236 }
237
238 sub account_modify : Local {
239 my ( $self, $c, $user ) = @_;
240 $c->detach('/user/login') if not $c->user;
241 $c->stash( subpages => gensubpages('account') );
242 $c->assert_user_roles('Account Admins');
243 my @errors;
244 my $mesg;
245 if ( $user eq '' ) {
246 $c->forward( $c->uri_for('/account') );
247 $c->detach;
248 }
249 my $schemaldap = Net::LDAP->new( ${ $c->config }{'Model::Proxy'}{'host'} )
250 or warn "LDAP bind failed: $!";
251 $schemaldap->start_tls if ${ $c->config }{'Model::Proxy'}{'start_tls'};
252 $schemaldap->bind;
253 my $schema = $schemaldap->schema or die("Searching schema failed: $!");
254 my $attrdef;
255
256 my $entry;
257 $c->log->debug("Searching for user $user");
258 $mesg =
259 $c->model('User')->search("(&(objectclass=inetOrgPerson)(uid=$user))");
260 $entry = $mesg->entry;
261
262 # Handle adding attributes immediately here, forwarding back to ourselves
263 if ( $c->req->param('operation') eq 'add' ) {
264 $entry->add( $c->req->param('attribute') => $c->req->param('value') );
265 $mesg = $entry->update;
266 push @errors, $mesg->error if $mesg->code;
267 $c->res->redirect( $c->uri_for( $c->req->uri ) . "/$user" );
268 }
269
270 my %mods;
271 my %params = %{ $c->req->parameters };
272 my $update = 0;
273 foreach my $req ( keys %params ) {
274 next if $req !~ /(.+)_new/;
275 my $attrname = $1;
276 next if $params{ $attrname . '_new' } eq $params{ $attrname . '_old' };
277 $c->log->debug("Received update request for attribute $attrname");
278 $update = 1;
279 $attrdef = $schema->attribute($attrname)
280 or die("getting schema failed: $!");
281 if ( $$attrdef{'single-value'} ) {
282 $entry->replace( $attrname => $params{ $attrname . '_new' } )
283 or $c->log->info($!);
284 }
285 else {
286 $entry->delete( $attrname => $params{ $attrname . '_old' } );
287 $entry->add( $attrname => $params{ $attrname . '_new' } );
288 }
289 if ($update) {
290 $mesg = $entry->update;
291 push @{ ${ $c->stash }{'errors'} }, $mesg->error if $mesg->code;
292 }
293 }
294
295 $mesg =
296 $c->model('User')->search("(&(objectclass=inetOrgPerson)(uid=$user))");
297 $c->log->debug( $mesg->error ) if $mesg->code;
298 $entry = $mesg->entry;
299 $c->log->debug( $mesg->error ) if $mesg->code;
300
301 my @values;
302 my @attributes = $entry->attributes;
303 my @may;
304 my @addable_attrs = @attributes;
305 my @ocs;
306 my @must;
307 @ocs = $entry->get_value("objectClass");
308 foreach my $oc (@ocs) {
309 foreach my $attr ( $schema->must($oc) ) {
310 push @must, $$attr{'name'} if not grep /$$attr{'name'}/, @must;
311 }
312 }
313
314 foreach my $attr ( sort @attributes ) {
315 next if ( $attr eq "objectClass" );
316 next
317 if grep /$attr/,
318 @{ ${ $c->config }{'Controller::User'}{'skip_attrs'} };
319 my @vals = $entry->get_value($attr);
320 foreach (@vals) { $_ = Encode::decode_utf8( $_ ); }
321 $attrdef = $schema->attribute($attr)
322 or die("getting schema failed: $!");
323 my %valhash = (
324 name => $attr,
325 values => \@vals,
326 desc => $$attrdef{'desc'},
327 );
328 if ( !grep /^$attr$/,
329 @{ ${ $c->config }{'Controller::User'}{'uneditable_attrs'} } )
330 {
331 $valhash{'editable'} = 1;
332 }
333 if ( !$$attrdef{'single-value'} && $valhash{'editable'} ) {
334 $valhash{'addable'} = 1;
335 }
336 if ( !grep /$attr/, @must ) { $valhash{'removable'} = 1; }
337 push @values, \%valhash;
338 }
339 foreach my $oc (@ocs) {
340 foreach my $attrdef ( $schema->may($oc) ) {
341 my $attrname = $$attrdef{'name'};
342 grep /$attrname/, @may
343 or grep /$attrname/, @attributes
344 or grep /$attrname/,
345 @{ ${ $c->config }{'Controller::User'}{'uneditable_attrs'} }
346 or grep /$attrname/,
347 @{ ${ $c->config }{'Controller::User'}{'skip_attrs'} }
348 or push @may, $attrname;
349 }
350 }
351 @may = sort @may;
352 my @available_ocs = $schema->all_objectclasses;
353 my @offer_ocs;
354 foreach my $oc (@available_ocs) {
355 my $ocname = $$oc{name};
356 next if grep /$ocname/, @ocs;
357 next if not $$oc{auxiliary};
358 push @offer_ocs, $ocname;
359 }
360 @offer_ocs = sort @offer_ocs;
361 my @groups;
362 if ( grep /posixAccount/, @offer_ocs ) {
363 my $mesg = $c->model('user')->search('objectclass=posixGroup');
364 foreach my $group ( $mesg->entries ) {
365 push @groups,
366 {
367 name => $group->cn,
368 gidNumber => $group->gidNumber,
369 };
370 }
371 }
372
373 $c->stash(
374 {
375 username => $user,
376 values => \@values,
377 attrdef => $attrdef,
378 may => \@may,
379 must => \@must,
380 offer_ocs => \@offer_ocs,
381 dn => $entry->dn,
382 uid => $entry->uid,
383 }
384 );
385 $c->stash( 'groups' => \@groups ) if (@groups);
386 }
387
388 sub account_modifydel : Local {
389 my ( $self, $c, $uid, $attr, $value ) = @_;
390 $c->detach('/user/login') if not $c->user;
391 $c->assert_user_roles('Account Admins');
392 $c->stash( subpages => gensubpages('account') );
393 my @errors;
394 my $mesg;
395 $mesg =
396 $c->model('user')->search("(&(objectClass=inetOrgPerson)(uid=$uid))");
397 push @errors, $mesg->error if $mesg->code;
398 $mesg = $mesg->entry->delete( $attr => $value )->update;
399 push @errors, $mesg->error if $mesg->code;
400 $c->res->redirect( $c->uri_for('/admin/account_modify') . "/$uid" );
401 }
402
403 sub account_group : Local {
404 my ( $self, $c, $uid ) = @_;
405 $c->detach('/user/login') if not $c->user;
406 $c->assert_user_roles('Account Admins');
407 $c->stash( subpages => gensubpages('account') );
408 $c->res->redirect($c->uri_for('/admin/account')) if $uid eq '';
409 my (@errors,@newgroups,@groups);
410 my ($mesg,$entry,$dn);
411
412 $mesg = $c->model('user')->search("(&(objectclass=inetOrgperson)(uid=$uid))");
413 $entry = $mesg->entry;
414 $dn = $entry->dn;
415 if (defined $c->req->param('op')) {
416 my $group = $c->req->param('group');
417 $mesg = $c->model('user')->search("(&(objectclass=groupOfNames)(cn=$group))");
418 $entry = $mesg->entry;
419 $entry->delete(member => $dn) if ($c->req->param('op') eq 'delete');
420 $entry->add(member => $dn) if ($c->req->param('op') eq 'add');
421 $mesg = $entry->update if ($entry->changes);
422 push @errors,$mesg->error if $mesg->code;
423 }
424
425
426 $mesg = $c->model('user')->search("(&(objectclass=groupOfNames)(member=$dn))");
427 @groups = $mesg->entries;
428 $mesg = $c->model('user')->search("(&(objectclass=groupOfNames)(!(member=$dn)))");
429 @newgroups = $mesg->entries;
430 $c->stash(
431 uid => $uid,
432 groups => \@groups,
433 newgroups => \@newgroups,
434 );
435 }
436
437 sub account_addoc : Local {
438 my ( $self, $c ) = @_;
439 $c->detach('/user/login') if not $c->user;
440 $c->assert_user_roles('Account Admins');
441 $c->stash( subpages => gensubpages('account') );
442 my $objectclass = $c->req->param('objectclass')
443 or $c->detach('/admin/group');
444 my $dn = $c->req->param('dn');
445 my $uid = $c->req->param('uid');
446 my ( @errors, @must, @may );
447 my $mesg;
448 my $schemaldap = Net::LDAP->new( ${ $c->config }{'Model::Proxy'}{'host'} )
449 or warn "LDAP bind failed: $!";
450 $mesg = $schemaldap->start_tls
451 if ${ $c->config }{'Model::Proxy'}{'start_tls'};
452 push @errors, $mesg->error if $mesg->code;
453 $schemaldap->bind;
454 push @errors, $mesg->error if $mesg->code;
455 my $schema = $schemaldap->schema or die("Searching schema failed: $!");
456 $mesg =
457 $c->model('user')->search("(&(objectclass=inetOrgPerson)(uid=$uid))");
458 $c->log->debug( $mesg->error ) if $mesg->code;
459 my $entry = $mesg->entry;
460 $c->log->debug( $mesg->error ) if $mesg->code;
461
462 foreach my $attr ( $schema->must($objectclass) ) {
463 push @must, $$attr{name} if not $entry->get_value( $$attr{name} );
464 }
465 foreach my $attr ( $schema->may($objectclass) ) {
466 push @may, $$attr{name} if not $entry->get_value( $$attr{name} );
467 }
468
469 # if we have all the musts as params
470 my $haveall = 1;
471 foreach my $addattr (@must) {
472 if ( defined $c->req->param($addattr) ) {
473 $entry->add( $addattr => $c->req->param($addattr) );
474 }
475 else {
476 $c->log->debug("Missing attribute $addattr");
477 $haveall = 0;
478 }
479 }
480 if ($haveall) {
481 $entry->add( objectClass => [$objectclass] );
482 $c->log->debug("About to push updates to $dn");
483 #$c->log->debug( Dumper( \$entry->changes ) );
484 $mesg = $entry->update;
485 push @errors, $mesg->error if $mesg->code;
486 $c->stash( template => 'admin/account.tt', errors => @errors );
487
488 #$c->detach('account_modify');
489 $c->res->redirect( $c->uri_for('/admin/account_modify') . "/" . $uid );
490 $c->detach;
491 }
492 $c->stash(
493 may => \@may,
494 must => \@must,
495 oc => $objectclass,
496 dn => $dn,
497 uid => $uid,
498 );
499 }
500
501 sub password : Local {
502 my ($self,$c,$uid) = @_;
503 $c->detach('/user/login') if not $c->user;
504 $c->assert_user_roles('Account Admins');
505 $c->stash( subpages => gensubpages('account') );
506 my (@errors,@mail);
507 my ($mesg,$entry,$newpass);
508 $c->res->redirect($c->uri_for('/admin/account')) if $uid eq '';
509
510 # Find the user so we have their email now for confirmation, or can easily
511 # set password if reset has been confirmed
512 $mesg = $c->model('user')->search("uid=$uid");
513 push @errors,$mesg->error if $mesg->code;
514 if ($mesg->entries gt 1) {
515 push @errors, $c->loc('More than one entry matched');
516 $c->detach;
517 }
518 $entry = $mesg->entry;
519 @mail = $entry->mail;
520
521 if (!$c->req->param('txnid')) {
522 my $txnid = Data::UUID->new->create_str();
523 $c->session(txnid => $txnid);
524 $c->stash( uid => $uid, txnid => $txnid, mails => @mail);
525 return 1;
526 }
527 if ($c->req->param('txnid') ne $c->session->{txnid}) {
528 push @errors, $c->loc('Transaction ID mismatch');
529 $c->detach;
530 }
531 $newpass = Data::UUID->new->create_str();
532 my $pp = Net::LDAP::Control::PasswordPolicy->new;
533 $mesg = $entry->replace( userPassword => $newpass,pwdReset => 'TRUE' )->update;
534 if ($mesg->code) {
535 push @errors, $c->loc("Password reset failed: ") . $mesg->error;
536 $c->detach;
537 }
538 my $email = join(',',@mail);
539 # send the mail in the users preferred language
540 my @oldlang = $c->languages;
541 if ($entry->preferredLanguage) {
542 #$c->log->debug("Setting languages to: " . Dumper($entry->preferredLanguage));
543 $c->languages([$entry->preferredLanguage]);
544 }
545 $c->stash(
546 email => {
547 'to' => $email,
548 'subject' => $c->config->{apptitle} . " - "
549 . $c->loc('password reset'),
550 'from' => $c->config->{emailfrom},
551 'template' => 'admin/password.tt',
552 'content_type' => 'text/plain',
553 },
554 entry => $entry,
555 url => $c->uri_for('/user/firstlogin') . "?username=$uid&key=$newpass",
556 );
557 $c->forward( $c->view('Email::Template') );
558 $c->languages(@oldlang);
559 if ( @{ $c->error } ) {
560 my $errors = join "\n",@{ $c->error };
561 $c->log->info("Sending reset mail to $email failed: $errors");
562 $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));
563 $c->error(0); # Reset the error condition if you need to
564 }
565 push @errors,$c->loc('Password reset and email sent');
566 $c->res->redirect($c->uri_for('/admin/account_modify') . "/$uid");
567 }
568
569
570 sub group : Local {
571 my ( $self, $c ) = @_;
572 $c->detach('/user/login') if not $c->user;
573 my $mainrole;
574 if ( $c->check_user_roles('Account Admins') ) {
575 $mainrole = 'account';
576 }
577 elsif ( $c->check_user_roles('Group Admins') ) {
578 $mainrole = 'group';
579 }
580 else {
581 $c->res->forward('/user');
582 }
583 #$c->assert_any_user_role({['Account Admins','Group Admins']});
584 #$mainrole = 'account' if $c->check_user_roles('Account Admins');
585 $c->stash( subpages => gensubpages($mainrole) );
586 my @errors;
587 my ($attribute,$value);
588 if ( not $c->req->param('attribute') and not $c->req->param('value') ) {
589 $attribute = 'owner';
590 $value = $c->user->ldap_entry->dn;
591 $c->stash( heading => $c->loc('Groups you manage'));
592 }
593 else {
594 $attribute = $c->req->param('attribute');
595 $attribute =~ s/[^\w\d]//g;
596 $value = $c->req->param('value');
597 $value =~ s/[^\w\d\* ]//g;
598 $c->stash( heading => $c->loc('Groups matching search criteria'));
599 }
600 my $mesg =
601 $c->model('user')
602 ->search("(&(objectclass=groupOfNames)($attribute=$value))");
603 push @errors, $mesg->error if $mesg->code;
604 my @entries = $mesg->entries if ($mesg->entries ge 1);
605 push @errors, $mesg->error if $mesg->code;
606 $c->stash( entries => \@entries ) if (@entries);
607 $c->stash( errors => \@errors);
608 }
609
610 sub group_modify : Local {
611 my ( $self, $c, $group, $op, $attr, $value ) = @_;
612 $c->detach('/user/login') if not $c->user;
613 my $mainrole = 'account';
614 if ( ! $c->check_user_roles('Account Admins') and ! $c->check_user_roles('Group Admins')) {
615 $c->forward('/user');
616 }
617 $mainrole = 'group' if (not $c->check_user_roles('Account Admins'));
618 $c->stash( subpages => gensubpages($mainrole) );
619 my @errors;
620 my @entries;
621 my $mesg;
622 $c->detach('/admin/group') if $group eq '';
623 if ( $group !~ /^[\w\d- ]*$/ ) {
624 push @errors, $c->loc('Group contains illegal characters');
625 $c->detach('/admin/group');
626 }
627 if (defined $op and $op eq 'delete') {
628 $mesg = $c->model('user')->search("(&(objectClass=groupOfNames)(cn=$group))");
629 @entries = $mesg->entries;
630 $entries[0]->delete( $attr => $value)->update;
631 $c->res->redirect("/admin/group_modify/$group");
632 }
633 if ( defined $op and $op eq 'add' ) {
634 my $member = $c->req->param('member');
635 $mesg = $c->model('user')->search("(uid=$member)");
636 if ( $mesg->code ) {
637 $c->stash({ errors => $mesg->error});
638 $c->detach('/admin/group');
639 }
640 if ( $mesg->entries ne 1 ) {
641 $c->detach('/admin/group');
642 }
643 @entries = $mesg->entries;
644 my $dn = $entries[0]->dn;
645 $mesg = $c->model('user')->search("(&(objectClass=groupOfNames)(cn=$group))");
646 @entries = $mesg->entries;
647 $entries[0]->add( 'member' => $dn )->update;
648 $c->res->redirect("/admin/group_modify/$group");
649 }
650 $mesg = $c->model('user')->search("(&(objectClass=groupOfNames)(cn=$group))");
651 if ( $mesg->entries gt 1 ) {
652 push @errors, $c->loc('More than one entry matched');
653 $c->detach('/admin/group');
654 }
655 $c->stash( group => $mesg->entry );
656 }
657
658 =head2 index
659
660 =cut
661
662 sub index : Path : Args(0) {
663 my ( $self, $c ) = @_;
664 $c->detach('/index') if not $c->user;
665 $c->assert_user_roles('Account Admins');
666 $c->stash( pages => roles2pages( $c->user->roles ) );
667
668 #$c->response->body("Matched CatDap::Controller::admin in admin, roles $rolelist");
669 }
670
671 sub roles2pages : Private {
672 my @roles = @_;
673 my @pages;
674 foreach my $role ( sort @roles ) {
675 if ( $role =~ /^(\w+) ?(\w*) (Admin|User)s$/ ) {
676 my $page = lc("/$3/$1$2");
677 push @pages, { page => lc("/$3/$1$2"), title => "$1 $2 $3" };
678 }
679 }
680 return \@pages;
681 }
682
683 sub gensubpages : Private {
684 my ($type) = @_;
685 my @subpagenames;
686 if ( $type eq 'account' ) {
687 @subpagenames = (
688 { page => 'account', title => "Users" },
689 { page => 'account_promote', title => "Promote" },
690 #{ page => 'account_unlock', title => "Unlock" },
691 { page => 'group', title => "Groups" },
692 );
693 }
694 if ( $type eq 'group' ) {
695 @subpagenames = (
696 { page => 'group', title => "Groups" },
697 );
698 }
699 return \@subpagenames;
700 }
701
702 =head1 AUTHOR
703
704 Buchan Milne
705
706 =head1 LICENSE
707
708 This library is free software. You can redistribute it and/or modify
709 it under the same terms as Perl itself.
710
711 =cut
712
713 __PACKAGE__->meta->make_immutable;
714
715 1;

  ViewVC Help
Powered by ViewVC 1.1.26