/[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 1790 - (hide annotations) (download)
Thu Jul 21 16:50:26 2011 UTC (8 years, 8 months ago) by misc
File size: 24261 byte(s)
refactor the ldap query, and do it sooner so we can use it for access control
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 misc 1767 my @promoted;
167 buchan 45 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 misc 1773 push @errors, $c->loc("More than one ID Pool");
186 buchan 45
187     #TODO forward to error page
188     }
189     my $idpool = $mesg->entry;
190     my $uidnum = $idpool->uidNumber;
191 buchan 46 my $newuidnum = $uidnum+1;
192 buchan 45 $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 buchan 56 $mesg = $entry->update;
203 buchan 45 if ($mesg->code) {
204 buchan 56 $c->log->info('LDAP update failed: ' . $mesg->error);
205 buchan 45 push @errors, $mesg->error;
206     #reverse idpool update
207     $idpool->replace( uidNumber => $uidnum );
208     $mesg = $idpool->update;
209 buchan 56 $c->log->info("ERROR IdPool could not be reset to $uidnum: ", $mesg->error) if $mesg->code;
210 misc 1767 } else {
211     push @promoted, $uid;
212 buchan 45 }
213     }
214     }
215     my $mesg =
216     $c->model('user')
217     ->search("(&(objectClass=inetOrgPerson)(!(objectClass=posixAccount)))");
218 buchan 562 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 misc 1769 @entries = sort { $a->{'uid'} cmp $b->{'uid'} } @entries;
228 buchan 562
229 buchan 45 $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 misc 1767 $c->stash( promoted => \@promoted );
236 buchan 45 }
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 buchan 56 $c->log->debug("Searching for user $user");
258 buchan 45 $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 buchan 56 $c->log->debug("Received update request for attribute $attrname");
278 buchan 45 $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 buchan 56 $c->log->debug( $mesg->error ) if $mesg->code;
298 buchan 45 $entry = $mesg->entry;
299 buchan 56 $c->log->debug( $mesg->error ) if $mesg->code;
300 buchan 45
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 buchan 559 foreach (@vals) { $_ = Encode::decode_utf8( $_ ); }
321 buchan 45 $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 buchan 46 $c->res->redirect($c->uri_for('/admin/account')) if $uid eq '';
409 buchan 45 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 buchan 56 $c->log->debug( $mesg->error ) if $mesg->code;
459 buchan 45 my $entry = $mesg->entry;
460 buchan 56 $c->log->debug( $mesg->error ) if $mesg->code;
461 buchan 45
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 buchan 56 $c->log->debug("Missing attribute $addattr");
477 buchan 45 $haveall = 0;
478     }
479     }
480     if ($haveall) {
481     $entry->add( objectClass => [$objectclass] );
482 buchan 56 $c->log->debug("About to push updates to $dn");
483 buchan 64 #$c->log->debug( Dumper( \$entry->changes ) );
484 buchan 45 $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 buchan 46 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 misc 1773 push @errors, $c->loc('More than one entry matched');
516 buchan 46 $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 buchan 56 if ($c->req->param('txnid') ne $c->session->{txnid}) {
528 misc 1773 push @errors, $c->loc('Transaction ID mismatch');
529 buchan 46 $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 misc 1773 push @errors, $c->loc("Password reset failed: ") . $mesg->error;
536 buchan 46 $c->detach;
537     }
538 buchan 56 my $email = join(',',@mail);
539     # send the mail in the users preferred language
540     my @oldlang = $c->languages;
541     if ($entry->preferredLanguage) {
542 buchan 64 #$c->log->debug("Setting languages to: " . Dumper($entry->preferredLanguage));
543 buchan 56 $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 buchan 605 url => $c->uri_for('/user/firstlogin') . "?username=$uid&key=$newpass",
556 buchan 56 );
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 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));
563 buchan 56 $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 buchan 46 }
568    
569    
570 buchan 45 sub group : Local {
571     my ( $self, $c ) = @_;
572     $c->detach('/user/login') if not $c->user;
573 buchan 588 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 buchan 45 my @errors;
587 buchan 588 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 misc 1773 $c->stash( heading => $c->loc('Groups you manage'));
592 buchan 588 }
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 misc 1773 $c->stash( heading => $c->loc('Groups matching search criteria'));
599 buchan 588 }
600 buchan 45 my $mesg =
601     $c->model('user')
602 buchan 588 ->search("(&(objectclass=groupOfNames)($attribute=$value))");
603 buchan 45 push @errors, $mesg->error if $mesg->code;
604 buchan 588 my @entries = $mesg->entries if ($mesg->entries ge 1);
605 buchan 45 push @errors, $mesg->error if $mesg->code;
606 buchan 588 $c->stash( entries => \@entries ) if (@entries);
607     $c->stash( errors => \@errors);
608 buchan 45 }
609    
610     sub group_modify : Local {
611 buchan 588 my ( $self, $c, $group, $op, $attr, $value ) = @_;
612 buchan 45 $c->detach('/user/login') if not $c->user;
613 buchan 590 my $mainrole = 'account';
614 buchan 589 if ( ! $c->check_user_roles('Account Admins') and ! $c->check_user_roles('Group Admins')) {
615 misc 1786 $c->forward('/user');
616 buchan 589 }
617 buchan 590 $mainrole = 'group' if (not $c->check_user_roles('Account Admins'));
618     $c->stash( subpages => gensubpages($mainrole) );
619 buchan 45 my @errors;
620 buchan 588 my @entries;
621     my $mesg;
622 misc 1790
623 buchan 45 $c->detach('/admin/group') if $group eq '';
624 misc 1784 if ( $group !~ /^[\w\d- ]*$/ ) {
625 misc 1773 push @errors, $c->loc('Group contains illegal characters');
626 buchan 562 $c->detach('/admin/group');
627 buchan 45 }
628 misc 1790
629     my $mesg_group = $c->model('user')->search("(&(objectClass=groupOfNames)(cn=$group))");
630     if ( $mesg_group->entries gt 1 ) {
631     push @errors, $c->loc('More than one entry matched');
632     $c->detach('/admin/group');
633     }
634    
635 buchan 590 if (defined $op and $op eq 'delete') {
636 misc 1790 @entries = $mesg_group->entries;
637 buchan 590 $entries[0]->delete( $attr => $value)->update;
638 buchan 588 $c->res->redirect("/admin/group_modify/$group");
639 misc 1790 }
640    
641 buchan 590 if ( defined $op and $op eq 'add' ) {
642 buchan 588 my $member = $c->req->param('member');
643     $mesg = $c->model('user')->search("(uid=$member)");
644     if ( $mesg->code ) {
645     $c->stash({ errors => $mesg->error});
646     $c->detach('/admin/group');
647     }
648     if ( $mesg->entries ne 1 ) {
649     $c->detach('/admin/group');
650     }
651     @entries = $mesg->entries;
652 buchan 590 my $dn = $entries[0]->dn;
653 misc 1790 @entries = $mesg_group->entries;
654 buchan 590 $entries[0]->add( 'member' => $dn )->update;
655 buchan 588 $c->res->redirect("/admin/group_modify/$group");
656     }
657 misc 1790
658     $c->stash( group => $mesg_group->entry );
659 buchan 45 }
660    
661     =head2 index
662    
663     =cut
664    
665     sub index : Path : Args(0) {
666     my ( $self, $c ) = @_;
667 buchan 56 $c->detach('/index') if not $c->user;
668     $c->assert_user_roles('Account Admins');
669 buchan 45 $c->stash( pages => roles2pages( $c->user->roles ) );
670    
671     #$c->response->body("Matched CatDap::Controller::admin in admin, roles $rolelist");
672     }
673    
674     sub roles2pages : Private {
675     my @roles = @_;
676     my @pages;
677     foreach my $role ( sort @roles ) {
678     if ( $role =~ /^(\w+) ?(\w*) (Admin|User)s$/ ) {
679     my $page = lc("/$3/$1$2");
680     push @pages, { page => lc("/$3/$1$2"), title => "$1 $2 $3" };
681     }
682     }
683     return \@pages;
684     }
685    
686     sub gensubpages : Private {
687     my ($type) = @_;
688     my @subpagenames;
689     if ( $type eq 'account' ) {
690     @subpagenames = (
691     { page => 'account', title => "Users" },
692     { page => 'account_promote', title => "Promote" },
693     #{ page => 'account_unlock', title => "Unlock" },
694     { page => 'group', title => "Groups" },
695     );
696     }
697 buchan 588 if ( $type eq 'group' ) {
698 buchan 590 @subpagenames = (
699 buchan 588 { page => 'group', title => "Groups" },
700 buchan 590 );
701 buchan 588 }
702 buchan 45 return \@subpagenames;
703     }
704    
705     =head1 AUTHOR
706    
707     Buchan Milne
708    
709     =head1 LICENSE
710    
711     This library is free software. You can redistribute it and/or modify
712     it under the same terms as Perl itself.
713    
714     =cut
715    
716     __PACKAGE__->meta->make_immutable;
717    
718     1;

  ViewVC Help
Powered by ViewVC 1.1.26